calc.el, calc-(ext|poly), calccomp: Use lexical-binding
* lisp/calc/calc-ext.el: Use lexical-binding, silence warnings. (calc-init-extensions): Remove a few functions which can't be called directly since they depend on dynamically scoped vars. (calc-embedded-quiet): Declare. (math-defcache): Use 'declare'. (math-normalize-a): Remove declaration. (math-normalize-nonstandard): Receive 'a' as arg instead. (math-defintegral): Use 'declare'. (math-exp-pos, math-exp-old-pos, math-exp-keep-spaces, math-rb-h2) (math-read-big-baseline, math-read-big-h2, math-read-big-err-msg) (math-exp-token, math-expr-data, math-exp-str): Declare. (math-map-tree, math-read-expr): Avoid dynvars as formal arguments. * lisp/calc/calc-poly.el: Use lexical-binding, silence warnings. Turn some comments into docstrings. (math-poly-div): Avoid dynvars as formal arguments. (math-poly-base-top-expr): Move declaration before first use. (calcFunc-factors, math-factor-expr, math-factor-expr-try) (calcFunc-factor): Avoid dynvars as formal arguments. * lisp/calc/calc.el: Use lexical-binding, silence warnings. (math-normalize-a): Remove. (math-normalize): Use lexical var 'a' instead. (math-svo-c): Remove. (math-stack-value-offset): Pass 'c' explicitly as arg to math-stack-value-offset-fancy instead. * lisp/calc/calccomp.el: Use lexical-binding, silence warnings. (math-svo-c): Remove. (math-stack-value-offset-fancy): Use new arg 'c' instead. (math-comp-to-string-flat): Avoid dynvars as formal arguments.
This commit is contained in:
Stefan Monnier
parent
336681f35b
commit
11c9343fe6
4 changed files with 211 additions and 198 deletions
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-ext.el --- various extension functions for Calc
|
||||
;;; calc-ext.el --- various extension functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -88,7 +88,7 @@
|
|||
(defvar calc-alg-map)
|
||||
(defvar calc-alg-esc-map)
|
||||
|
||||
;;; The following was made a function so that it could be byte-compiled.
|
||||
;; The following was made a function so that it could be byte-compiled.
|
||||
(defun calc-init-extensions ()
|
||||
|
||||
(define-key calc-mode-map ":" 'calc-fdiv)
|
||||
|
|
@ -894,8 +894,8 @@ calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide
|
|||
calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim
|
||||
calcFunc-prem math-accum-factors math-atomic-factorp
|
||||
math-div-poly-const math-div-thru math-expand-power math-expand-term
|
||||
math-factor-contains math-factor-expr math-factor-expr-part
|
||||
math-factor-expr-try math-factor-finish math-factor-poly-coefs
|
||||
math-factor-contains math-factor-expr
|
||||
math-factor-finish
|
||||
math-factor-protect math-mul-thru math-padded-polynomial
|
||||
math-partial-fractions math-poly-degree math-poly-deriv-coefs
|
||||
math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p
|
||||
|
|
@ -984,8 +984,8 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
|
|||
))
|
||||
|
||||
(mapcar (function (lambda (x)
|
||||
(mapcar (function (lambda (cmd)
|
||||
(autoload cmd (car x) nil t))) (cdr x))))
|
||||
(mapcar (function (lambda (cmd) (autoload cmd (car x) nil t)))
|
||||
(cdr x))))
|
||||
'(
|
||||
|
||||
("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
|
||||
|
|
@ -1307,8 +1307,9 @@ calc-kill calc-kill-region calc-yank))))
|
|||
(message "%s" (if msg
|
||||
(concat group ": " msg ":"
|
||||
(make-string
|
||||
(- (apply 'max (mapcar 'length msgs))
|
||||
(length msg)) 32)
|
||||
(- (apply #'max (mapcar #'length msgs))
|
||||
(length msg))
|
||||
?\s)
|
||||
" [MORE]"
|
||||
(if key
|
||||
(concat " " (char-to-string key)
|
||||
|
|
@ -1334,6 +1335,8 @@ calc-kill calc-kill-region calc-yank))))
|
|||
|
||||
;;; General.
|
||||
|
||||
(defvar calc-embedded-quiet)
|
||||
|
||||
(defun calc-reset (arg)
|
||||
(interactive "P")
|
||||
(setq arg (if arg (prefix-numeric-value arg) nil))
|
||||
|
|
@ -1398,7 +1401,7 @@ calc-kill calc-kill-region calc-yank))))
|
|||
|
||||
(defun calc-scroll-up (n)
|
||||
(interactive "P")
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(scroll-up (or n (/ (window-height) 2)))
|
||||
(error nil))
|
||||
(if (pos-visible-in-window-p (max 1 (- (point-max) 2)))
|
||||
|
|
@ -1657,7 +1660,7 @@ calc-kill calc-kill-region calc-yank))))
|
|||
(let ((entries (calc-top-list n 1 'entry))
|
||||
(calc-undo-list nil) (calc-redo-list nil))
|
||||
(calc-pop-stack n 1 t)
|
||||
(calc-push-list (mapcar 'car entries)
|
||||
(calc-push-list (mapcar #'car entries)
|
||||
1
|
||||
(mapcar (function (lambda (x) (nth 2 x)))
|
||||
entries)))))))
|
||||
|
|
@ -1707,7 +1710,7 @@ calc-kill calc-kill-region calc-yank))))
|
|||
(calc-pop-push-record-list 1 "eval"
|
||||
(math-evaluate-expr (calc-top (- n)))
|
||||
(- n))
|
||||
(calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr
|
||||
(calc-pop-push-record-list n "eval" (mapcar #'math-evaluate-expr
|
||||
(calc-top-list n)))))
|
||||
(calc-handle-whys)))
|
||||
|
||||
|
|
@ -1928,7 +1931,7 @@ calc-kill calc-kill-region calc-yank))))
|
|||
(calc-z-prefix-buf "")
|
||||
(kmap (sort (copy-sequence (calc-user-key-map))
|
||||
(function (lambda (x y) (< (car x) (car y))))))
|
||||
(flags (apply 'logior
|
||||
(flags (apply #'logior
|
||||
(mapcar (function
|
||||
(lambda (k)
|
||||
(calc-user-function-classify (car k))))
|
||||
|
|
@ -2003,12 +2006,13 @@ calc-kill calc-kill-region calc-yank))))
|
|||
;;;; Caches.
|
||||
|
||||
(defmacro math-defcache (name init form)
|
||||
(declare (indent 2) (debug (symbolp sexp form)))
|
||||
(let ((cache-prec (intern (concat (symbol-name name) "-cache-prec")))
|
||||
(cache-val (intern (concat (symbol-name name) "-cache")))
|
||||
(last-prec (intern (concat (symbol-name name) "-last-prec")))
|
||||
(last-val (intern (concat (symbol-name name) "-last"))))
|
||||
`(progn
|
||||
; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
|
||||
;; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
|
||||
(defvar ,cache-prec (cond
|
||||
((consp ,init) (math-numdigs (nth 1 ,init)))
|
||||
(,init
|
||||
|
|
@ -2037,7 +2041,6 @@ calc-kill calc-kill-region calc-yank))))
|
|||
,cache-val))
|
||||
,last-prec calc-internal-prec))
|
||||
,last-val))))
|
||||
(put 'math-defcache 'lisp-indent-hook 2)
|
||||
|
||||
;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
|
||||
(defconst math-approx-pi
|
||||
|
|
@ -2400,7 +2403,7 @@ If X is not an error form, return 1."
|
|||
(list 'calcFunc-intv mask lo hi)
|
||||
(math-make-intv mask lo hi))))
|
||||
((eq (car a) 'vec)
|
||||
(cons 'vec (mapcar 'math-normalize (cdr a))))
|
||||
(cons 'vec (mapcar #'math-normalize (cdr a))))
|
||||
((eq (car a) 'quote)
|
||||
(math-normalize (nth 1 a)))
|
||||
((eq (car a) 'special-const)
|
||||
|
|
@ -2412,7 +2415,7 @@ If X is not an error form, return 1."
|
|||
(math-normalize-logical-op a))
|
||||
((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition))
|
||||
(let ((calc-simplify-mode 'none))
|
||||
(cons (car a) (mapcar 'math-normalize (cdr a)))))
|
||||
(cons (car a) (mapcar #'math-normalize (cdr a)))))
|
||||
((eq (car a) 'calcFunc-evalto)
|
||||
(setq a (or (nth 1 a) 0))
|
||||
(or calc-refreshing-evaltos
|
||||
|
|
@ -2435,27 +2438,25 @@ If X is not an error form, return 1."
|
|||
;; The variable math-normalize-a is local to math-normalize in calc.el,
|
||||
;; but is used by math-normalize-nonstandard, which is called by
|
||||
;; math-normalize.
|
||||
(defvar math-normalize-a)
|
||||
|
||||
(defun math-normalize-nonstandard ()
|
||||
(defun math-normalize-nonstandard (a)
|
||||
(if (consp calc-simplify-mode)
|
||||
(progn
|
||||
(setq calc-simplify-mode 'none
|
||||
math-simplify-only (car-safe (cdr-safe math-normalize-a)))
|
||||
math-simplify-only (car-safe (cdr-safe a)))
|
||||
nil)
|
||||
(and (symbolp (car math-normalize-a))
|
||||
(and (symbolp (car a))
|
||||
(or (eq calc-simplify-mode 'none)
|
||||
(and (eq calc-simplify-mode 'num)
|
||||
(let ((aptr (setq math-normalize-a
|
||||
(let ((aptr (setq a
|
||||
(cons
|
||||
(car math-normalize-a)
|
||||
(mapcar 'math-normalize
|
||||
(cdr math-normalize-a))))))
|
||||
(car a)
|
||||
(mapcar #'math-normalize
|
||||
(cdr a))))))
|
||||
(while (and aptr (math-constp (car aptr)))
|
||||
(setq aptr (cdr aptr)))
|
||||
aptr)))
|
||||
(cons (car math-normalize-a)
|
||||
(mapcar 'math-normalize (cdr math-normalize-a))))))
|
||||
(cons (car a)
|
||||
(mapcar #'math-normalize (cdr a))))))
|
||||
|
||||
|
||||
;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
|
||||
|
|
@ -2808,7 +2809,7 @@ If X is not an error form, return 1."
|
|||
x)
|
||||
(if (Math-primp x)
|
||||
x
|
||||
(cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
|
||||
(cons (car x) (mapcar #'math-evaluate-expr-rec (cdr x))))))
|
||||
x))
|
||||
|
||||
(defun math-any-floats (expr)
|
||||
|
|
@ -2822,9 +2823,10 @@ If X is not an error form, return 1."
|
|||
(defvar math-mt-many nil)
|
||||
(defvar math-mt-func nil)
|
||||
|
||||
(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many)
|
||||
(or math-mt-many (setq math-mt-many 1000000))
|
||||
(math-map-tree-rec mmt-expr))
|
||||
(defun math-map-tree (func mmt-expr &optional many)
|
||||
(let ((math-mt-func func)
|
||||
(math-mt-many (or many 1000000)))
|
||||
(math-map-tree-rec mmt-expr)))
|
||||
|
||||
(defun math-map-tree-rec (mmt-expr)
|
||||
(or (= math-mt-many 0)
|
||||
|
|
@ -2842,7 +2844,7 @@ If X is not an error form, return 1."
|
|||
(<= math-mt-many 0))
|
||||
(setq mmt-done t)
|
||||
(setq mmt-nextval (cons (car mmt-expr)
|
||||
(mapcar 'math-map-tree-rec
|
||||
(mapcar #'math-map-tree-rec
|
||||
(cdr mmt-expr))))
|
||||
(if (equal mmt-nextval mmt-expr)
|
||||
(setq mmt-done t)
|
||||
|
|
@ -2867,6 +2869,7 @@ If X is not an error form, return 1."
|
|||
(defvar math-integral-cache)
|
||||
|
||||
(defmacro math-defintegral (funcs &rest code)
|
||||
(declare (indent 1) (debug (sexp body)))
|
||||
(setq math-integral-cache nil)
|
||||
(cons 'progn
|
||||
(mapcar #'(lambda (func)
|
||||
|
|
@ -2876,9 +2879,9 @@ If X is not an error form, return 1."
|
|||
(list
|
||||
#'(lambda (u) ,@code)))))
|
||||
(if (symbolp funcs) (list funcs) funcs))))
|
||||
(put 'math-defintegral 'lisp-indent-hook 1)
|
||||
|
||||
(defmacro math-defintegral-2 (funcs &rest code)
|
||||
(declare (indent 1) (debug (sexp body)))
|
||||
(setq math-integral-cache nil)
|
||||
(cons 'progn
|
||||
(mapcar #'(lambda (func)
|
||||
|
|
@ -2887,7 +2890,6 @@ If X is not an error form, return 1."
|
|||
(get ',func 'math-integral-2)
|
||||
(list #'(lambda (u v) ,@code)))))
|
||||
(if (symbolp funcs) (list funcs) funcs))))
|
||||
(put 'math-defintegral-2 'lisp-indent-hook 1)
|
||||
|
||||
(defvar var-IntegAfterRules 'calc-IntegAfterRules)
|
||||
|
||||
|
|
@ -3097,9 +3099,16 @@ If X is not an error form, return 1."
|
|||
;;; Expression parsing.
|
||||
|
||||
(defvar math-expr-data)
|
||||
(defvar math-exp-pos)
|
||||
(defvar math-exp-old-pos)
|
||||
(defvar math-exp-keep-spaces)
|
||||
(defvar math-exp-token)
|
||||
(defvar math-expr-data)
|
||||
(defvar math-exp-str)
|
||||
|
||||
(defun math-read-expr (math-exp-str)
|
||||
(defun math-read-expr (str)
|
||||
(let ((math-exp-pos 0)
|
||||
(math-exp-str str)
|
||||
(math-exp-old-pos 0)
|
||||
(math-exp-keep-spaces nil)
|
||||
math-exp-token math-expr-data)
|
||||
|
|
@ -3138,6 +3147,10 @@ If X is not an error form, return 1."
|
|||
|
||||
;;; They said it couldn't be done...
|
||||
|
||||
(defvar math-read-big-baseline)
|
||||
(defvar math-read-big-h2)
|
||||
(defvar math-read-big-err-msg)
|
||||
|
||||
(defun math-read-big-expr (str)
|
||||
(and (> (length calc-left-label) 0)
|
||||
(string-match (concat "^" (regexp-quote calc-left-label)) str)
|
||||
|
|
@ -3179,6 +3192,8 @@ If X is not an error form, return 1."
|
|||
'(error 0 "Syntax error"))
|
||||
(math-read-expr str)))))
|
||||
|
||||
(defvar math-rb-h2)
|
||||
|
||||
(defun math-read-big-bigp (math-read-big-lines)
|
||||
(and (cdr math-read-big-lines)
|
||||
(let ((matrix nil)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-poly.el --- polynomial functions for Calc
|
||||
;;; calc-poly.el --- polynomial functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -177,8 +177,8 @@
|
|||
(math-add (car res) (math-div (cdr res) pd))))
|
||||
|
||||
|
||||
;;; Multiply two terms, expanding out products of sums.
|
||||
(defun math-mul-thru (lhs rhs)
|
||||
"Multiply two terms, expanding out products of sums."
|
||||
(if (memq (car-safe lhs) '(+ -))
|
||||
(list (car lhs)
|
||||
(math-mul-thru (nth 1 lhs) rhs)
|
||||
|
|
@ -197,8 +197,8 @@
|
|||
(math-div num den)))
|
||||
|
||||
|
||||
;;; Sort the terms of a sum into canonical order.
|
||||
(defun math-sort-terms (expr)
|
||||
"Sort the terms of a sum into canonical order."
|
||||
(if (memq (car-safe expr) '(+ -))
|
||||
(math-list-to-sum
|
||||
(sort (math-sum-to-list expr)
|
||||
|
|
@ -223,8 +223,8 @@
|
|||
(math-sum-to-list (nth 2 tree) (not neg))))
|
||||
(t (list (cons tree neg)))))
|
||||
|
||||
;;; Check if the polynomial coefficients are modulo forms.
|
||||
(defun math-poly-modulus (expr &optional expr2)
|
||||
"Check if the polynomial coefficients are modulo forms."
|
||||
(or (math-poly-modulus-rec expr)
|
||||
(and expr2 (math-poly-modulus-rec expr2))
|
||||
1))
|
||||
|
|
@ -237,12 +237,13 @@
|
|||
(math-poly-modulus-rec (nth 2 expr))))))
|
||||
|
||||
|
||||
;;; Divide two polynomials. Return (quotient . remainder).
|
||||
(defvar math-poly-div-base nil)
|
||||
(defun math-poly-div (u v &optional math-poly-div-base)
|
||||
(if math-poly-div-base
|
||||
(math-do-poly-div u v)
|
||||
(math-do-poly-div (calcFunc-expand u) (calcFunc-expand v))))
|
||||
(defun math-poly-div (u v &optional div-base)
|
||||
"Divide two polynomials. Return (quotient . remainder)."
|
||||
(let ((math-poly-div-base div-base))
|
||||
(if div-base
|
||||
(math-do-poly-div u v)
|
||||
(math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))))
|
||||
|
||||
(defun math-poly-div-exact (u v &optional base)
|
||||
(let ((res (math-poly-div u v base)))
|
||||
|
|
@ -308,8 +309,8 @@
|
|||
(math-div (math-build-polynomial-expr (cdr res) base)
|
||||
v)))))))
|
||||
|
||||
;;; Divide two polynomials in coefficient-list form. Return (quot . rem).
|
||||
(defun math-poly-div-coefs (u v)
|
||||
"Divide two polynomials in coefficient-list form. Return (quot . rem)."
|
||||
(cond ((null v) (math-reject-arg nil "Division by zero"))
|
||||
((< (length u) (length v)) (cons nil u))
|
||||
((cdr u)
|
||||
|
|
@ -334,9 +335,9 @@
|
|||
(cons (list (math-poly-div-rec (car u) (car v)))
|
||||
nil))))
|
||||
|
||||
;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.)
|
||||
;;; This returns only the remainder from the pseudo-division.
|
||||
(defun math-poly-pseudo-div (u v)
|
||||
"Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.)
|
||||
This returns only the remainder from the pseudo-division."
|
||||
(cond ((null v) nil)
|
||||
((< (length u) (length v)) u)
|
||||
((or (cdr u) (cdr v))
|
||||
|
|
@ -359,8 +360,8 @@
|
|||
(nreverse (mapcar 'math-simplify urev))))
|
||||
(t nil)))
|
||||
|
||||
;;; Compute the GCD of two multivariate polynomials.
|
||||
(defun math-poly-gcd (u v)
|
||||
"Compute the GCD of two multivariate polynomials."
|
||||
(cond ((Math-equal u v) u)
|
||||
((math-constp u)
|
||||
(if (Math-zerop u)
|
||||
|
|
@ -423,7 +424,7 @@
|
|||
(defun math-poly-gcd-coefs (u v)
|
||||
(let ((d (math-poly-gcd (math-poly-gcd-list u)
|
||||
(math-poly-gcd-list v)))
|
||||
(g 1) (h 1) (z 0) hh r delta ghd)
|
||||
(g 1) (h 1) (z 0) r delta)
|
||||
(while (and u v (Math-zerop (car u)) (Math-zerop (car v)))
|
||||
(setq u (cdr u) v (cdr v) z (1+ z)))
|
||||
(or (eq d 1)
|
||||
|
|
@ -452,8 +453,8 @@
|
|||
v))
|
||||
|
||||
|
||||
;;; Return true if is a factor containing no sums or quotients.
|
||||
(defun math-atomic-factorp (expr)
|
||||
"Return true if is a factor containing no sums or quotients."
|
||||
(cond ((eq (car-safe expr) '*)
|
||||
(and (math-atomic-factorp (nth 1 expr))
|
||||
(math-atomic-factorp (nth 2 expr))))
|
||||
|
|
@ -463,14 +464,13 @@
|
|||
(math-atomic-factorp (nth 1 expr)))
|
||||
(t t)))
|
||||
|
||||
;;; Find a suitable base for dividing a by b.
|
||||
;;; The base must exist in both expressions.
|
||||
;;; The degree in the numerator must be higher or equal than the
|
||||
;;; degree in the denominator.
|
||||
;;; If the above conditions are not met the quotient is just a remainder.
|
||||
;;; Return nil if this is the case.
|
||||
|
||||
(defun math-poly-div-base (a b)
|
||||
"Find a suitable base for dividing a by b.
|
||||
The base must exist in both expressions.
|
||||
The degree in the numerator must be higher or equal than the
|
||||
degree in the denominator.
|
||||
If the above conditions are not met the quotient is just a remainder.
|
||||
Return nil if this is the case."
|
||||
(let (a-base b-base)
|
||||
(and (setq a-base (math-total-polynomial-base a))
|
||||
(setq b-base (math-total-polynomial-base b))
|
||||
|
|
@ -482,12 +482,11 @@
|
|||
(throw 'return (car (car a-base))))))
|
||||
(setq a-base (cdr a-base)))))))
|
||||
|
||||
;;; Same as above but for gcd algorithm.
|
||||
;;; Here there is no requirement that degree(a) > degree(b).
|
||||
;;; Take the base that has the highest degree considering both a and b.
|
||||
;;; ("a^20+b^21+x^3+a+b", "a+b^2+x^5+a^22+b^10") --> (a 22)
|
||||
|
||||
(defun math-poly-gcd-base (a b)
|
||||
"Same as `math-poly-div-base' but for gcd algorithm.
|
||||
Here there is no requirement that degree(a) > degree(b).
|
||||
Take the base that has the highest degree considering both a and b.
|
||||
(\"a^20+b^21+x^3+a+b\", \"a+b^2+x^5+a^22+b^10\") --> (a 22)"
|
||||
(let (a-base b-base)
|
||||
(and (setq a-base (math-total-polynomial-base a))
|
||||
(setq b-base (math-total-polynomial-base b))
|
||||
|
|
@ -501,8 +500,8 @@
|
|||
(throw 'return (car (car b-base)))
|
||||
(setq b-base (cdr b-base)))))))))
|
||||
|
||||
;;; Sort a list of polynomial bases.
|
||||
(defun math-sort-poly-base-list (lst)
|
||||
"Sort a list of polynomial bases."
|
||||
(sort lst (function (lambda (a b)
|
||||
(or (> (nth 1 a) (nth 1 b))
|
||||
(and (= (nth 1 a) (nth 1 b))
|
||||
|
|
@ -511,10 +510,11 @@
|
|||
;;; Given an expression find all variables that are polynomial bases.
|
||||
;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
|
||||
|
||||
;; The variable math-poly-base-total-base is local to
|
||||
;; math-total-polynomial-base, but is used by math-polynomial-p1,
|
||||
;; which is called by math-total-polynomial-base.
|
||||
;; The variable math-poly-base-total-base and math-poly-base-top-expr are local
|
||||
;; to math-total-polynomial-base, but used by math-polynomial-p1, which is
|
||||
;; called by math-total-polynomial-base.
|
||||
(defvar math-poly-base-total-base)
|
||||
(defvar math-poly-base-top-expr)
|
||||
|
||||
(defun math-total-polynomial-base (expr)
|
||||
(let ((math-poly-base-total-base nil)
|
||||
|
|
@ -522,11 +522,6 @@
|
|||
(math-polynomial-base expr #'math-polynomial-p1)
|
||||
(math-sort-poly-base-list math-poly-base-total-base)))
|
||||
|
||||
;; The variable math-poly-base-top-expr is local to math-polynomial-base
|
||||
;; in calc-alg.el, but is used by math-polynomial-p1 which is called
|
||||
;; by math-polynomial-base.
|
||||
(defvar math-poly-base-top-expr)
|
||||
|
||||
(defun math-polynomial-p1 (subexpr)
|
||||
(or (assoc subexpr math-poly-base-total-base)
|
||||
(memq (car subexpr) '(+ - * / neg))
|
||||
|
|
@ -555,28 +550,30 @@
|
|||
;; called (indirectly) by calcFunc-factors and calcFunc-factor.
|
||||
(defvar math-to-list)
|
||||
|
||||
(defun calcFunc-factors (math-fact-expr &optional var)
|
||||
(defun calcFunc-factors (expr &optional var)
|
||||
(let ((math-factored-vars (if var t nil))
|
||||
(math-to-list t)
|
||||
(calc-prefer-frac t))
|
||||
(or var
|
||||
(setq var (math-polynomial-base math-fact-expr)))
|
||||
(setq var (math-polynomial-base expr)))
|
||||
(let ((res (math-factor-finish
|
||||
(or (catch 'factor (math-factor-expr-try var))
|
||||
math-fact-expr))))
|
||||
(or (catch 'factor
|
||||
(let ((math-fact-expr expr)) (math-factor-expr-try var)))
|
||||
expr))))
|
||||
(math-simplify (if (math-vectorp res)
|
||||
res
|
||||
(list 'vec (list 'vec res 1)))))))
|
||||
|
||||
(defun calcFunc-factor (math-fact-expr &optional var)
|
||||
(defun calcFunc-factor (expr &optional var)
|
||||
(let ((math-factored-vars nil)
|
||||
(math-to-list nil)
|
||||
(calc-prefer-frac t))
|
||||
(math-simplify (math-factor-finish
|
||||
(if var
|
||||
(let ((math-factored-vars t))
|
||||
(or (catch 'factor (math-factor-expr-try var)) math-fact-expr))
|
||||
(math-factor-expr math-fact-expr))))))
|
||||
(let ((math-factored-vars t)
|
||||
(math-fact-expr expr))
|
||||
(or (catch 'factor (math-factor-expr-try var)) expr))
|
||||
(math-factor-expr expr))))))
|
||||
|
||||
(defun math-factor-finish (x)
|
||||
(if (Math-primp x)
|
||||
|
|
@ -590,18 +587,19 @@
|
|||
(list 'calcFunc-Fac-Prot x)
|
||||
x))
|
||||
|
||||
(defun math-factor-expr (math-fact-expr)
|
||||
(cond ((eq math-factored-vars t) math-fact-expr)
|
||||
((or (memq (car-safe math-fact-expr) '(* / ^ neg))
|
||||
(assq (car-safe math-fact-expr) calc-tweak-eqn-table))
|
||||
(cons (car math-fact-expr) (mapcar 'math-factor-expr (cdr math-fact-expr))))
|
||||
((memq (car-safe math-fact-expr) '(+ -))
|
||||
(defun math-factor-expr (expr)
|
||||
(cond ((eq math-factored-vars t) expr)
|
||||
((or (memq (car-safe expr) '(* / ^ neg))
|
||||
(assq (car-safe expr) calc-tweak-eqn-table))
|
||||
(cons (car expr) (mapcar 'math-factor-expr (cdr expr))))
|
||||
((memq (car-safe expr) '(+ -))
|
||||
(let* ((math-factored-vars math-factored-vars)
|
||||
(y (catch 'factor (math-factor-expr-part math-fact-expr))))
|
||||
(y (catch 'factor (let ((math-fact-expr expr))
|
||||
(math-factor-expr-part expr)))))
|
||||
(if y
|
||||
(math-factor-expr y)
|
||||
math-fact-expr)))
|
||||
(t math-fact-expr)))
|
||||
expr)))
|
||||
(t expr)))
|
||||
|
||||
(defun math-factor-expr-part (x) ; uses "expr"
|
||||
(if (memq (car-safe x) '(+ - * / ^ neg))
|
||||
|
|
@ -617,20 +615,20 @@
|
|||
;; used by math-factor-poly-coefs, which is called by math-factor-expr-try.
|
||||
(defvar math-fet-x)
|
||||
|
||||
(defun math-factor-expr-try (math-fet-x)
|
||||
(defun math-factor-expr-try (x)
|
||||
(if (eq (car-safe math-fact-expr) '*)
|
||||
(let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr)))
|
||||
(math-factor-expr-try math-fet-x))))
|
||||
(math-factor-expr-try x))))
|
||||
(res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr)))
|
||||
(math-factor-expr-try math-fet-x)))))
|
||||
(math-factor-expr-try x)))))
|
||||
(and (or res1 res2)
|
||||
(throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1
|
||||
(or res2 (nth 2 math-fact-expr))))))
|
||||
(let* ((p (math-is-polynomial math-fact-expr math-fet-x 30 'gen))
|
||||
(let* ((p (math-is-polynomial math-fact-expr x 30 'gen))
|
||||
(math-poly-modulus (math-poly-modulus math-fact-expr))
|
||||
res)
|
||||
(and (cdr p)
|
||||
(setq res (math-factor-poly-coefs p))
|
||||
(setq res (let ((math-fet-x x)) (math-factor-poly-coefs p)))
|
||||
(throw 'factor res)))))
|
||||
|
||||
(defun math-accum-factors (fac pow facs)
|
||||
|
|
@ -736,7 +734,6 @@
|
|||
(let ((roots (car t1))
|
||||
(csign (if (math-negp (nth (1- (length p)) p)) -1 1))
|
||||
(expr 1)
|
||||
(unfac (nth 1 t1))
|
||||
(scale (nth 2 t1)))
|
||||
(while roots
|
||||
(let ((coef0 (car (car roots)))
|
||||
|
|
@ -1109,7 +1106,7 @@ If no partial fraction representation can be found, return nil."
|
|||
(t expr)))
|
||||
|
||||
(defun calcFunc-expand (expr &optional many)
|
||||
(math-normalize (math-map-tree 'math-expand-term expr many)))
|
||||
(math-normalize (math-map-tree #'math-expand-term expr many)))
|
||||
|
||||
(defun math-expand-power (x n &optional var else-nil)
|
||||
(or (and (natnump n)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc.el --- the GNU Emacs calculator
|
||||
;;; calc.el --- the GNU Emacs calculator -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -178,7 +178,7 @@
|
|||
(declare-function math-read-radix-digit "calc-misc" (dig))
|
||||
(declare-function calc-digit-dots "calc-incom" ())
|
||||
(declare-function math-normalize-fancy "calc-ext" (a))
|
||||
(declare-function math-normalize-nonstandard "calc-ext" ())
|
||||
(declare-function math-normalize-nonstandard "calc-ext" (a))
|
||||
(declare-function math-recompile-eval-rules "calc-alg" ())
|
||||
(declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset))
|
||||
(declare-function calc-record-why "calc-misc" (&rest stuff))
|
||||
|
|
@ -203,7 +203,7 @@
|
|||
(declare-function math-compose-expr "calccomp" (a prec &optional div))
|
||||
(declare-function math-comp-width "calccomp" (c))
|
||||
(declare-function math-composition-to-string "calccomp" (c &optional width))
|
||||
(declare-function math-stack-value-offset-fancy "calccomp" ())
|
||||
(declare-function math-stack-value-offset-fancy "calccomp" (c))
|
||||
(declare-function math-format-flat-expr-fancy "calc-ext" (a prec))
|
||||
(declare-function math-adjust-fraction "calc-ext" (a))
|
||||
(declare-function math-format-binary "calc-bin" (a))
|
||||
|
|
@ -1331,16 +1331,17 @@ Notations: 3.14e6 3.14 * 10^6
|
|||
"
|
||||
(interactive)
|
||||
(mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
|
||||
(lambda (v) (set-default v (symbol-value v)))) calc-local-var-list)
|
||||
(lambda (v) (set-default v (symbol-value v))))
|
||||
calc-local-var-list)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map (if (eq calc-algebraic-mode 'total)
|
||||
(progn (require 'calc-ext) calc-alg-map) calc-mode-map))
|
||||
(mapc #'make-local-variable calc-local-var-list)
|
||||
(make-local-variable 'overlay-arrow-position)
|
||||
(make-local-variable 'overlay-arrow-string)
|
||||
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
|
||||
(add-hook 'change-major-mode-hook #'font-lock-defontify nil t)
|
||||
(add-hook 'kill-buffer-query-functions
|
||||
'calc-kill-stack-buffer
|
||||
#'calc-kill-stack-buffer
|
||||
t t)
|
||||
(setq truncate-lines t)
|
||||
(setq buffer-read-only t)
|
||||
|
|
@ -1795,7 +1796,7 @@ See calc-keypad for details."
|
|||
(if calc-hyperbolic-flag "Hyp " "")
|
||||
(if calc-keep-args-flag "Keep " "")
|
||||
(if (/= calc-stack-top 1) "Narrow " "")
|
||||
(apply 'concat calc-other-modes)))))
|
||||
(apply #'concat calc-other-modes)))))
|
||||
(if (equal new-mode-string mode-line-buffer-identification)
|
||||
nil
|
||||
(setq mode-line-buffer-identification new-mode-string)
|
||||
|
|
@ -1869,7 +1870,7 @@ See calc-keypad for details."
|
|||
(if (and (consp vals)
|
||||
(or (integerp (car vals))
|
||||
(consp (car vals))))
|
||||
(setq vals (mapcar 'calc-normalize vals))
|
||||
(setq vals (mapcar #'calc-normalize vals))
|
||||
(setq vals (calc-normalize vals)))
|
||||
(or (and (consp vals)
|
||||
(or (integerp (car vals))
|
||||
|
|
@ -1952,8 +1953,8 @@ See calc-keypad for details."
|
|||
(mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top)))))
|
||||
|
||||
(defun calc-top-list-n (&optional n m sel-mode)
|
||||
(mapcar 'math-check-complete
|
||||
(mapcar 'calc-normalize (calc-top-list n m sel-mode))))
|
||||
(mapcar #'math-check-complete
|
||||
(mapcar #'calc-normalize (calc-top-list n m sel-mode))))
|
||||
|
||||
|
||||
(defun calc-renumber-stack ()
|
||||
|
|
@ -2207,7 +2208,7 @@ the United States."
|
|||
(setq calc-aborted-prefix name)
|
||||
(if (null arg)
|
||||
(calc-enter-result 2 name (cons (or func2 func)
|
||||
(mapcar 'math-check-complete
|
||||
(mapcar #'math-check-complete
|
||||
(calc-top-list 2))))
|
||||
(require 'calc-ext)
|
||||
(calc-binary-op-fancy name func arg ident unary)))
|
||||
|
|
@ -2619,78 +2620,78 @@ largest Emacs integer.")
|
|||
(defvar math-eval-rules-cache-other)
|
||||
;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
|
||||
|
||||
(defvar math-normalize-a)
|
||||
(defvar math-normalize-error nil
|
||||
"Non-nil if the last call the `math-normalize' returned an error.")
|
||||
|
||||
(defun math-normalize (math-normalize-a)
|
||||
(defun math-normalize (a)
|
||||
(setq math-normalize-error nil)
|
||||
(cond
|
||||
((not (consp math-normalize-a))
|
||||
(if (integerp math-normalize-a)
|
||||
(if (or (>= math-normalize-a math-small-integer-size)
|
||||
(<= math-normalize-a (- math-small-integer-size)))
|
||||
(math-bignum math-normalize-a)
|
||||
math-normalize-a)
|
||||
math-normalize-a))
|
||||
((eq (car math-normalize-a) 'bigpos)
|
||||
(if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
|
||||
(let* ((last (setq math-normalize-a
|
||||
(copy-sequence math-normalize-a))) (digs math-normalize-a))
|
||||
((not (consp a))
|
||||
(if (integerp a)
|
||||
(if (or (>= a math-small-integer-size)
|
||||
(<= a (- math-small-integer-size)))
|
||||
(math-bignum a)
|
||||
a)
|
||||
a))
|
||||
((eq (car a) 'bigpos)
|
||||
(if (eq (nth (1- (length a)) a) 0)
|
||||
(let* ((last (setq a
|
||||
(copy-sequence a)))
|
||||
(digs a))
|
||||
(while (setq digs (cdr digs))
|
||||
(or (eq (car digs) 0) (setq last digs)))
|
||||
(setcdr last nil)))
|
||||
(if (cdr (cdr (cdr math-normalize-a)))
|
||||
math-normalize-a
|
||||
(if (cdr (cdr (cdr a)))
|
||||
a
|
||||
(cond
|
||||
((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a)
|
||||
(* (nth 2 math-normalize-a)
|
||||
((cdr (cdr a)) (+ (nth 1 a)
|
||||
(* (nth 2 a)
|
||||
math-bignum-digit-size)))
|
||||
((cdr math-normalize-a) (nth 1 math-normalize-a))
|
||||
((cdr a) (nth 1 a))
|
||||
(t 0))))
|
||||
((eq (car math-normalize-a) 'bigneg)
|
||||
(if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
|
||||
(let* ((last (setq math-normalize-a (copy-sequence math-normalize-a)))
|
||||
(digs math-normalize-a))
|
||||
((eq (car a) 'bigneg)
|
||||
(if (eq (nth (1- (length a)) a) 0)
|
||||
(let* ((last (setq a (copy-sequence a)))
|
||||
(digs a))
|
||||
(while (setq digs (cdr digs))
|
||||
(or (eq (car digs) 0) (setq last digs)))
|
||||
(setcdr last nil)))
|
||||
(if (cdr (cdr (cdr math-normalize-a)))
|
||||
math-normalize-a
|
||||
(if (cdr (cdr (cdr a)))
|
||||
a
|
||||
(cond
|
||||
((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a)
|
||||
(* (nth 2 math-normalize-a)
|
||||
((cdr (cdr a)) (- (+ (nth 1 a)
|
||||
(* (nth 2 a)
|
||||
math-bignum-digit-size))))
|
||||
((cdr math-normalize-a) (- (nth 1 math-normalize-a)))
|
||||
((cdr a) (- (nth 1 a)))
|
||||
(t 0))))
|
||||
((eq (car math-normalize-a) 'float)
|
||||
(math-make-float (math-normalize (nth 1 math-normalize-a))
|
||||
(nth 2 math-normalize-a)))
|
||||
((or (memq (car math-normalize-a)
|
||||
((eq (car a) 'float)
|
||||
(math-make-float (math-normalize (nth 1 a))
|
||||
(nth 2 a)))
|
||||
((or (memq (car a)
|
||||
'(frac cplx polar hms date mod sdev intv vec var quote
|
||||
special-const calcFunc-if calcFunc-lambda
|
||||
calcFunc-quote calcFunc-condition
|
||||
calcFunc-evalto))
|
||||
(integerp (car math-normalize-a))
|
||||
(and (consp (car math-normalize-a))
|
||||
(not (eq (car (car math-normalize-a)) 'lambda))))
|
||||
(integerp (car a))
|
||||
(and (consp (car a))
|
||||
(not (eq (car (car a)) 'lambda))))
|
||||
(require 'calc-ext)
|
||||
(math-normalize-fancy math-normalize-a))
|
||||
(math-normalize-fancy a))
|
||||
(t
|
||||
(or (and calc-simplify-mode
|
||||
(require 'calc-ext)
|
||||
(math-normalize-nonstandard))
|
||||
(let ((args (mapcar 'math-normalize (cdr math-normalize-a))))
|
||||
(math-normalize-nonstandard a))
|
||||
(let ((args (mapcar #'math-normalize (cdr a))))
|
||||
(or (condition-case err
|
||||
(let ((func
|
||||
(assq (car math-normalize-a) '( ( + . math-add )
|
||||
( - . math-sub )
|
||||
( * . math-mul )
|
||||
( / . math-div )
|
||||
( % . math-mod )
|
||||
( ^ . math-pow )
|
||||
( neg . math-neg )
|
||||
( | . math-concat ) ))))
|
||||
(assq (car a) '( ( + . math-add )
|
||||
( - . math-sub )
|
||||
( * . math-mul )
|
||||
( / . math-div )
|
||||
( % . math-mod )
|
||||
( ^ . math-pow )
|
||||
( neg . math-neg )
|
||||
( | . math-concat ) ))))
|
||||
(or (and var-EvalRules
|
||||
(progn
|
||||
(or (eq var-EvalRules math-eval-rules-cache-tag)
|
||||
|
|
@ -2698,59 +2699,59 @@ largest Emacs integer.")
|
|||
(require 'calc-ext)
|
||||
(math-recompile-eval-rules)))
|
||||
(and (or math-eval-rules-cache-other
|
||||
(assq (car math-normalize-a)
|
||||
(assq (car a)
|
||||
math-eval-rules-cache))
|
||||
(math-apply-rewrites
|
||||
(cons (car math-normalize-a) args)
|
||||
(cons (car a) args)
|
||||
(cdr math-eval-rules-cache)
|
||||
nil math-eval-rules-cache))))
|
||||
(if func
|
||||
(apply (cdr func) args)
|
||||
(and (or (consp (car math-normalize-a))
|
||||
(fboundp (car math-normalize-a))
|
||||
(and (or (consp (car a))
|
||||
(fboundp (car a))
|
||||
(and (not (featurep 'calc-ext))
|
||||
(require 'calc-ext)
|
||||
(fboundp (car math-normalize-a))))
|
||||
(apply (car math-normalize-a) args)))))
|
||||
(fboundp (car a))))
|
||||
(apply (car a) args)))))
|
||||
(wrong-number-of-arguments
|
||||
(setq math-normalize-error t)
|
||||
(calc-record-why "*Wrong number of arguments"
|
||||
(cons (car math-normalize-a) args))
|
||||
(cons (car a) args))
|
||||
nil)
|
||||
(wrong-type-argument
|
||||
(or calc-next-why
|
||||
(calc-record-why "Wrong type of argument"
|
||||
(cons (car math-normalize-a) args)))
|
||||
(cons (car a) args)))
|
||||
nil)
|
||||
(args-out-of-range
|
||||
(setq math-normalize-error t)
|
||||
(calc-record-why "*Argument out of range"
|
||||
(cons (car math-normalize-a) args))
|
||||
(cons (car a) args))
|
||||
nil)
|
||||
(inexact-result
|
||||
(calc-record-why "No exact representation for result"
|
||||
(cons (car math-normalize-a) args))
|
||||
(cons (car a) args))
|
||||
nil)
|
||||
(math-overflow
|
||||
(setq math-normalize-error t)
|
||||
(calc-record-why "*Floating-point overflow occurred"
|
||||
(cons (car math-normalize-a) args))
|
||||
(cons (car a) args))
|
||||
nil)
|
||||
(math-underflow
|
||||
(setq math-normalize-error t)
|
||||
(calc-record-why "*Floating-point underflow occurred"
|
||||
(cons (car math-normalize-a) args))
|
||||
(cons (car a) args))
|
||||
nil)
|
||||
(void-variable
|
||||
(setq math-normalize-error t)
|
||||
(if (eq (nth 1 err) 'var-EvalRules)
|
||||
(progn
|
||||
(setq var-EvalRules nil)
|
||||
(math-normalize (cons (car math-normalize-a) args)))
|
||||
(math-normalize (cons (car a) args)))
|
||||
(calc-record-why "*Variable is void" (nth 1 err)))))
|
||||
(if (consp (car math-normalize-a))
|
||||
(if (consp (car a))
|
||||
(math-dimension-error)
|
||||
(cons (car math-normalize-a) args))))))))
|
||||
(cons (car a) args))))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -2834,7 +2835,7 @@ largest Emacs integer.")
|
|||
((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a)))
|
||||
((eq (car a) 'float) a)
|
||||
((memq (car a) '(cplx polar vec hms date sdev mod))
|
||||
(cons (car a) (mapcar 'math-float (cdr a))))
|
||||
(cons (car a) (mapcar #'math-float (cdr a))))
|
||||
(t (math-float-fancy a))))
|
||||
|
||||
|
||||
|
|
@ -2845,7 +2846,7 @@ largest Emacs integer.")
|
|||
((memq (car a) '(frac float))
|
||||
(list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
|
||||
((memq (car a) '(cplx vec hms date calcFunc-idn))
|
||||
(cons (car a) (mapcar 'math-neg (cdr a))))
|
||||
(cons (car a) (mapcar #'math-neg (cdr a))))
|
||||
(t (math-neg-fancy a))))
|
||||
|
||||
|
||||
|
|
@ -3425,22 +3426,21 @@ largest Emacs integer.")
|
|||
(setcar (cdr entry) (calc-count-lines s))
|
||||
s))
|
||||
|
||||
;; The variables math-svo-c, math-svo-wid and math-svo-off are local
|
||||
;; The variables math-svo-wid and math-svo-off are local
|
||||
;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy
|
||||
;; in calccomp.el.
|
||||
|
||||
(defvar math-svo-c)
|
||||
(defvar math-svo-wid)
|
||||
(defvar math-svo-off)
|
||||
|
||||
(defun math-stack-value-offset (math-svo-c)
|
||||
(defun math-stack-value-offset (c)
|
||||
(let* ((num (if calc-line-numbering 4 0))
|
||||
(math-svo-wid (calc-window-width))
|
||||
math-svo-off)
|
||||
(if calc-display-just
|
||||
(progn
|
||||
(require 'calc-ext)
|
||||
(math-stack-value-offset-fancy))
|
||||
(math-stack-value-offset-fancy c))
|
||||
(setq math-svo-off (or calc-display-origin 0))
|
||||
(when (integerp calc-line-breaking)
|
||||
(setq math-svo-wid calc-line-breaking)))
|
||||
|
|
@ -3873,7 +3873,7 @@ The prefix `calcFunc-' is added to the specified name to get the
|
|||
actual Lisp function name.
|
||||
|
||||
See Info node `(calc)Defining Functions'."
|
||||
(declare (doc-string 3))
|
||||
(declare (doc-string 3)) ;; FIXME: Edebug spec?
|
||||
(require 'calc-ext)
|
||||
(math-do-defmath func args body))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calccomp.el --- composition functions for Calc
|
||||
;;; calccomp.el --- composition functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -121,7 +121,8 @@
|
|||
calc-lang-slash-idiv)
|
||||
(math-float (nth 1 aa))
|
||||
(nth 1 aa))
|
||||
(nth 2 aa)) prec))
|
||||
(nth 2 aa))
|
||||
prec))
|
||||
(if (and (eq calc-language 'big)
|
||||
(= (length (car calc-frac-format)) 1))
|
||||
(let* ((aa (math-adjust-fraction a))
|
||||
|
|
@ -202,8 +203,9 @@
|
|||
(math-comp-comma-spc (or calc-vector-commas " "))
|
||||
(math-comp-comma (or calc-vector-commas ""))
|
||||
(math-comp-vector-prec (if (or (and calc-vector-commas
|
||||
(math-vector-no-parens a))
|
||||
(memq 'P calc-matrix-brackets)) 0 1000))
|
||||
(math-vector-no-parens a))
|
||||
(memq 'P calc-matrix-brackets))
|
||||
0 1000))
|
||||
(math-comp-just (cond ((eq calc-matrix-just 'right) 'vright)
|
||||
((eq calc-matrix-just 'center) 'vcent)
|
||||
(t 'vleft)))
|
||||
|
|
@ -803,8 +805,7 @@
|
|||
( % . calcFunc-mod )
|
||||
( ^ . calcFunc-pow )
|
||||
( neg . calcFunc-neg )
|
||||
( | . calcFunc-vconcat ))))
|
||||
left right args)
|
||||
( | . calcFunc-vconcat )))))
|
||||
(if func2
|
||||
(setq func (cdr func2)))
|
||||
(if (setq func2 (rassq func math-expr-function-mapping))
|
||||
|
|
@ -858,7 +859,7 @@
|
|||
(or (cdr (cdr a))
|
||||
(not (eq (car-safe (nth 1 a)) '*))))
|
||||
|
||||
(defun math-compose-matrix (a col cols base)
|
||||
(defun math-compose-matrix (a _col cols base)
|
||||
(let ((col 0)
|
||||
(res nil))
|
||||
(while (<= (setq col (1+ col)) cols)
|
||||
|
|
@ -968,8 +969,8 @@
|
|||
(and (memq (car a) '(^ calcFunc-subscr))
|
||||
(math-tex-expr-is-flat (nth 1 a)))))
|
||||
|
||||
(put 'calcFunc-log 'math-compose-big 'math-compose-log)
|
||||
(defun math-compose-log (a prec)
|
||||
(put 'calcFunc-log 'math-compose-big #'math-compose-log)
|
||||
(defun math-compose-log (a _prec)
|
||||
(and (= (length a) 3)
|
||||
(list 'horiz
|
||||
(list 'subscr "log"
|
||||
|
|
@ -979,8 +980,8 @@
|
|||
(math-compose-expr (nth 1 a) 1000)
|
||||
")")))
|
||||
|
||||
(put 'calcFunc-log10 'math-compose-big 'math-compose-log10)
|
||||
(defun math-compose-log10 (a prec)
|
||||
(put 'calcFunc-log10 'math-compose-big #'math-compose-log10)
|
||||
(defun math-compose-log10 (a _prec)
|
||||
(and (= (length a) 2)
|
||||
(list 'horiz
|
||||
(list 'subscr "log" "10")
|
||||
|
|
@ -988,8 +989,8 @@
|
|||
(math-compose-expr (nth 1 a) 1000)
|
||||
")")))
|
||||
|
||||
(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
|
||||
(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
|
||||
(put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv)
|
||||
(put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv)
|
||||
(defun math-compose-deriv (a prec)
|
||||
(when (= (length a) 3)
|
||||
(math-compose-expr (list '/
|
||||
|
|
@ -1003,8 +1004,8 @@
|
|||
(nth 2 a))))
|
||||
prec)))
|
||||
|
||||
(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
|
||||
(defun math-compose-sqrt (a prec)
|
||||
(put 'calcFunc-sqrt 'math-compose-big #'math-compose-sqrt)
|
||||
(defun math-compose-sqrt (a _prec)
|
||||
(when (= (length a) 2)
|
||||
(let* ((c (math-compose-expr (nth 1 a) 0))
|
||||
(a (math-comp-ascent c))
|
||||
|
|
@ -1024,8 +1025,8 @@
|
|||
" "
|
||||
c)))))
|
||||
|
||||
(put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
|
||||
(defun math-compose-choose (a prec)
|
||||
(put 'calcFunc-choose 'math-compose-big #'math-compose-choose)
|
||||
(defun math-compose-choose (a _prec)
|
||||
(let ((a1 (math-compose-expr (nth 1 a) 0))
|
||||
(a2 (math-compose-expr (nth 2 a) 0)))
|
||||
(list 'horiz
|
||||
|
|
@ -1035,7 +1036,7 @@
|
|||
a1 " " a2)
|
||||
")")))
|
||||
|
||||
(put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
|
||||
(put 'calcFunc-integ 'math-compose-big #'math-compose-integ)
|
||||
(defun math-compose-integ (a prec)
|
||||
(and (memq (length a) '(3 5))
|
||||
(eq (car-safe (nth 2 a)) 'var)
|
||||
|
|
@ -1072,7 +1073,7 @@
|
|||
(list 'horiz " d" var))
|
||||
(if parens ")" "")))))
|
||||
|
||||
(put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
|
||||
(put 'calcFunc-sum 'math-compose-big #'math-compose-sum)
|
||||
(defun math-compose-sum (a prec)
|
||||
(and (memq (length a) '(3 5 6))
|
||||
(let* ((expr (math-compose-expr (nth 1 a) 185))
|
||||
|
|
@ -1097,7 +1098,7 @@
|
|||
expr
|
||||
(if (memq prec '(180 201)) ")" "")))))
|
||||
|
||||
(put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
|
||||
(put 'calcFunc-prod 'math-compose-big #'math-compose-prod)
|
||||
(defun math-compose-prod (a prec)
|
||||
(and (memq (length a) '(3 5 6))
|
||||
(let* ((expr (math-compose-expr (nth 1 a) 198))
|
||||
|
|
@ -1124,12 +1125,11 @@
|
|||
;; The variables math-svo-c, math-svo-wid and math-svo-off are local
|
||||
;; to math-stack-value-offset in calc.el, but are used by
|
||||
;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
|
||||
(defvar math-svo-c)
|
||||
(defvar math-svo-wid)
|
||||
(defvar math-svo-off)
|
||||
|
||||
(defun math-stack-value-offset-fancy ()
|
||||
(let ((cwid (+ (math-comp-width math-svo-c))))
|
||||
(defun math-stack-value-offset-fancy (c)
|
||||
(let ((cwid (+ (math-comp-width c))))
|
||||
(cond ((eq calc-display-just 'right)
|
||||
(if calc-display-origin
|
||||
(setq math-svo-wid (max calc-display-origin 5))
|
||||
|
|
@ -1215,7 +1215,7 @@
|
|||
;; which are called by math-comp-to-string-flat.
|
||||
(defvar math-comp-pos)
|
||||
|
||||
(defun math-comp-to-string-flat (c math-comp-full-width)
|
||||
(defun math-comp-to-string-flat (c full-width)
|
||||
(if math-comp-sel-hpos
|
||||
(let ((math-comp-pos 0))
|
||||
(math-comp-sel-flat-term c))
|
||||
|
|
@ -1224,6 +1224,7 @@
|
|||
(math-comp-pos 0)
|
||||
(math-comp-margin 0)
|
||||
(math-comp-highlight (and math-comp-selected calc-show-selections))
|
||||
(math-comp-full-width full-width)
|
||||
(math-comp-level -1))
|
||||
(math-comp-to-string-flat-term '(set -1 0))
|
||||
(math-comp-to-string-flat-term c)
|
||||
|
|
@ -1387,7 +1388,7 @@
|
|||
(defvar math-comp-hpos)
|
||||
(defvar math-comp-vpos)
|
||||
|
||||
(defun math-comp-simplify (c full-width)
|
||||
(defun math-comp-simplify (c _full-width)
|
||||
(let ((math-comp-buf (list ""))
|
||||
(math-comp-base 0)
|
||||
(math-comp-hgt 1)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue