procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Don't quote lambdas with 'function' in calc/*.el

Browse source 
* lisp/calc/calc-aent.el (calc-do-quick-calc)
(calc-do-calc-eval, math-build-parse-table):
* lisp/calc/calc-alg.el (math-polynomial-base):
* lisp/calc/calc-alg.el (math-is-poly-rec):
* lisp/calc/calc-arith.el (calcFunc-scf):
* lisp/calc/calc-arith.el (math-ceiling, math-round):
* lisp/calc/calc-arith.el (math-trunc-fancy, math-floor-fancy):
* lisp/calc/calc-ext.el (calc-init-extensions, calc-reset)
(calc-refresh-top, calc-z-prefix-help, calc-binary-op-fancy)
(calc-unary-op-fancy):
* lisp/calc/calc-forms.el (math-make-mod):
* lisp/calc/calc-frac.el (calcFunc-frac):
* lisp/calc/calc-funcs.el (calcFunc-euler):
* lisp/calc/calc-help.el (calc-full-help):
* lisp/calc/calc-lang.el (c, pascal, fortran, tex, latex, eqn)
(yacas, maxima, giac, math, maple):
* lisp/calc/calc-macs.el (calc-wrapper, calc-slow-wrapper):
* lisp/calc/calc-map.el (calc-get-operator, calcFunc-mapeqr)
(calcFunc-reducea, calcFunc-rreducea, calcFunc-reduced)
(calcFunc-rreduced, calcFunc-outer):
* lisp/calc/calc-misc.el (another-calc, calc-do-handle-whys):
* lisp/calc/calc-mode.el (calc-save-modes):
* lisp/calc/calc-mtx.el (math-col-matrix, math-mul-mat-vec):
* lisp/calc/calc-poly.el (math-sort-terms, math-poly-div-list)
(math-mul-list, math-sort-poly-base-list)
(math-partial-fractions):
* lisp/calc/calc-prog.el (calc-user-define-formula):
* lisp/calc/calc-rewr.el (math-rewrite, math-compile-patterns)
(math-compile-rewrites, math-parse-schedule)
(math-rwcomp-pattern):
* lisp/calc/calc-store.el (calc-var-name-map, calc-let)
(calc-permanent-variable, calc-insert-variables):
* lisp/calc/calc-stuff.el (calc-flush-caches, calcFunc-pclean)
(calcFunc-pfrac):
* lisp/calc/calc-units.el (math-build-units-table)
(math-decompose-units):
* lisp/calc/calc-vec.el (calcFunc-mrow, math-mat-col)
(calcFunc-mcol, math-mat-less-col, math-mimic-ident):
* lisp/calc/calc-yank.el (calc-edit):
* lisp/calc/calc.el
(calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values, calc-mode, calc-quit):
* lisp/calc/calccomp.el (math-compose-expr)
(math-compose-matrix, math-vector-to-string): Don't quote lambdas with
'function'.
This commit is contained in:
Stefan Kangas 2020-11-17 02:51:30 +01:00
parent 0a7ec10ac6
commit 030ad21afe
24 changed files with 467 additions and 507 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
lisp/calc/calc-aent.el
View file

@ -76,8 +76,8 @@
(calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
(setq alg-exp (list (nth 2 (car alg-exp)))))
(setq calc-quick-prev-results alg-exp
buf (mapconcat (function (lambda (x)
(math-format-value x 1000)))
buf (mapconcat (lambda (x)
(math-format-value x 1000))
alg-exp
" ")
shortbuf buf)
@ -197,18 +197,17 @@
(calc-language (if (memq calc-language '(nil big))
'flat calc-language))
(calc-dollar-values (mapcar
(function
(lambda (x)
(if (stringp x)
(progn
(setq x (math-read-exprs x))
(if (eq (car-safe x)
'error)
(throw 'calc-error
(calc-eval-error
(cdr x)))
(car x)))
x)))
(lambda (x)
(if (stringp x)
(progn
(setq x (math-read-exprs x))
(if (eq (car-safe x)
'error)
(throw 'calc-error
(calc-eval-error
(cdr x)))
(car x)))
x))
args))
(calc-dollar-used 0)
(res (if (stringp str)
@ -640,10 +639,10 @@ in Calc algebraic input.")
(math-find-user-tokens (car (car p)))
(setq p (cdr p)))
(setq calc-user-tokens (mapconcat 'identity
(sort (mapcar 'car math-toks)
(function (lambda (x y)
(> (length x)
(length y)))))
(sort (mapcar #'car math-toks)
(lambda (x y)
(> (length x)
(length y))))
"\\|")
calc-last-main-parse-table mtab
calc-last-user-lang-parse-table ltab

7
lisp/calc/calc-alg.el
View file

@ -1785,7 +1785,7 @@ and should return the simplified expression to use (or nil)."
(cons (nth 2 expr) math-poly-neg-powers))))
(not (Math-zerop (nth 2 expr)))
(let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
(mapcar (function (lambda (x) (math-div x (nth 2 expr))))
(mapcar (lambda (x) (math-div x (nth 2 expr)))
p1))))
((and (eq (car expr) 'calcFunc-exp)
(equal math-var '(var e var-e)))
@ -1838,8 +1838,9 @@ and should return the simplified expression to use (or nil)."
(defun math-polynomial-base (top-expr &optional pred)
"Find the variable (or sub-expression) which is the base of polynomial expr."
(let ((math-poly-base-pred
(or pred (function (lambda (base) (math-polynomial-p
top-expr base))))))
(or pred (lambda (base)
(math-polynomial-p
top-expr base)))))
(or (let ((math-poly-base-const-ok nil))
(math-polynomial-base-rec top-expr))
(let ((math-poly-base-const-ok t))

10
lisp/calc/calc-arith.el
View file

@ -2390,7 +2390,7 @@
(math-trunc (nth 3 a)))))
((math-provably-integerp a) a)
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a))
(math-map-vec (lambda (x) (math-trunc x math-trunc-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2453,7 +2453,7 @@
(math-add (math-floor (nth 3 a)) -1)
(math-floor (nth 3 a)))))
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a))
(math-map-vec (lambda (x) (math-floor x math-floor-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2520,7 +2520,7 @@
(math-ceiling (nth 2 a)))
(math-ceiling (nth 3 a))))
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-ceiling x prec))) a))
(math-map-vec (lambda (x) (math-ceiling x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2573,7 +2573,7 @@
((eq (car a) 'intv)
(math-floor (math-add a '(frac 1 2))))
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-round x prec))) a))
(math-map-vec (lambda (x) (math-round x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2656,7 +2656,7 @@
(calcFunc-scf (nth 2 x) n)
(calcFunc-scf (nth 3 x) n))))
((eq (car x) 'vec)
(math-map-vec (function (lambda (x) (calcFunc-scf x n))) x))
(math-map-vec (lambda (x) (calcFunc-scf x n)) x))
((math-infinitep x)
x)
(t

38
lisp/calc/calc-ext.el
View file

@ -678,14 +678,13 @@
(calc-init-prefixes)
(mapc (function
(lambda (x)
(mapc (lambda (x)
(define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
(define-key calc-mode-map (format "j%c" x) 'calc-select-part)
(define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
(define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
(define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
(define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
(define-key calc-mode-map (format "u%c" x) 'calc-quick-units))
"0123456789")
(let ((i ?A))
@ -711,9 +710,9 @@
(define-key calc-alg-map "\e\177" 'calc-pop-above)
;;;; (Autoloads here)
(mapc (function (lambda (x)
(mapcar (function (lambda (func) (autoload func (car x))))
(cdr x))))
(mapc (lambda (x)
(mapcar (lambda (func) (autoload func (car x)))
(cdr x)))
'(
("calc-alg" calc-has-rules math-defsimplify
@ -980,9 +979,9 @@ 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 (lambda (x)
(mapcar (lambda (cmd) (autoload cmd (car x) nil t))
(cdr x)))
'(
("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@ -1358,7 +1357,7 @@ calc-kill calc-kill-region calc-yank))))
calc-redo-list nil)
(let (calc-stack calc-user-parse-tables calc-standard-date-formats
calc-invocation-macro)
(mapc (function (lambda (v) (set v nil))) calc-local-var-list)
(mapc (lambda (v) (set v nil)) calc-local-var-list)
(if (and arg (<= arg 0))
(calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values)))
@ -1658,7 +1657,7 @@ calc-kill calc-kill-region calc-yank))))
(calc-pop-stack n 1 t)
(calc-push-list (mapcar #'car entries)
1
(mapcar (function (lambda (x) (nth 2 x)))
(mapcar (lambda (x) (nth 2 x))
entries)))))))
(defvar calc-refreshing-evaltos nil)
@ -1924,11 +1923,10 @@ calc-kill calc-kill-region calc-yank))))
(let* ((calc-z-prefix-msgs nil)
(calc-z-prefix-buf "")
(kmap (sort (copy-sequence (calc-user-key-map))
(function (lambda (x y) (< (car x) (car y))))))
(lambda (x y) (< (car x) (car y)))))
(flags (apply #'logior
(mapcar (function
(lambda (k)
(calc-user-function-classify (car k))))
(mapcar (lambda (k)
(calc-user-function-classify (car k)))
kmap))))
(if (= (logand flags 8) 0)
(calc-user-function-list kmap 7)
@ -2633,9 +2631,8 @@ If X is not an error form, return 1."
(let ((rhs (calc-top-n 1)))
(calc-enter-result (- 1 n)
name
(mapcar (function
(lambda (x)
(list func x rhs)))
(mapcar (lambda (x)
(list func x rhs))
(calc-top-list-n (- n) 2))))))))
(defun calc-unary-op-fancy (name func arg)
@ -2644,9 +2641,8 @@ If X is not an error form, return 1."
(cond ((> n 0)
(calc-enter-result n
name
(mapcar (function
(lambda (x)
(list func x)))
(mapcar (lambda (x)
(list func x))
(calc-top-list-n n))))
((< n 0)
(calc-enter-result 1

2
lisp/calc/calc-forms.el
View file

@ -2129,7 +2129,7 @@ and ends on the last Sunday of October at 2 a.m."
((memq (car n) '(+ - / vec neg))
(math-normalize
(cons (car n)
(mapcar (function (lambda (x) (math-make-mod x m)))
(mapcar (lambda (x) (math-make-mod x m))
(cdr n)))))
((and (eq (car n) '*) (Math-anglep (nth 1 n)))
(math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))

5
lisp/calc/calc-frac.el
View file

@ -132,9 +132,8 @@
(cond ((Math-ratp a)
a)
((memq (car a) '(cplx polar vec hms date sdev intv mod))
(cons (car a) (mapcar (function
(lambda (x)
(calcFunc-frac x tol)))
(cons (car a) (mapcar (lambda (x)
(calcFunc-frac x tol))
(cdr a))))
((Math-messy-integerp a)
(math-trunc a))

11
lisp/calc/calc-funcs.el
View file

@ -797,12 +797,11 @@
(math-reduce-vec
'math-add
(cons 'vec
(mapcar (function
(lambda (c)
(setq k (1+ k))
(math-mul (math-mul fac c)
(math-sub (math-pow x1 k)
(math-pow x2 k)))))
(mapcar (lambda (c)
(setq k (1+ k))
(math-mul (math-mul fac c)
(math-sub (math-pow x1 k)
(math-pow x2 k))))
coefs)))
x)))
(math-mul (math-pow 2 n)

50
lisp/calc/calc-help.el
View file

@ -402,32 +402,32 @@ C-w Describe how there is no warranty for Calc."
"Or type `h i' to read the full Calc manual on-line.\n\n"))
(princ "Basic keys:\n")
(let* ((calc-full-help-flag t))
(mapc (function (lambda (x) (princ (format
" %s\n"
(substitute-command-keys x)))))
(mapc (lambda (x)
(princ (format
" %s\n"
(substitute-command-keys x))))
(nreverse (cdr (reverse (cdr (calc-help))))))
(mapc (function (lambda (prefix)
(let ((msgs (ignore-errors (funcall prefix))))
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
(format-message
"\n`v' or `V' prefix (vector/matrix) keys: \n")
(if (nth 2 msgs)
(format-message
"\n`%c' prefix (%s) keys:\n"
(nth 2 msgs)
(or (cdr (assq (nth 2 msgs)
calc-help-long-names))
(nth 1 msgs)))
(format "\n%s-modified keys:\n"
(capitalize (nth 1 msgs)))))))
(mapcar (function
(lambda (x)
(princ (format
" %s\n"
(substitute-command-keys x)))))
(car msgs)))))
(mapc (lambda (prefix)
(let ((msgs (ignore-errors (funcall prefix))))
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
(format-message
"\n`v' or `V' prefix (vector/matrix) keys: \n")
(if (nth 2 msgs)
(format-message
"\n`%c' prefix (%s) keys:\n"
(nth 2 msgs)
(or (cdr (assq (nth 2 msgs)
calc-help-long-names))
(nth 1 msgs)))
(format "\n%s-modified keys:\n"
(capitalize (nth 1 msgs)))))))
(mapcar (lambda (x)
(princ (format
" %s\n"
(substitute-command-keys x))))
(car msgs))))
'(calc-inverse-prefix-help
calc-hyperbolic-prefix-help
calc-inv-hyp-prefix-help

362
lisp/calc/calc-lang.el
View file

@ -175,20 +175,19 @@
(put 'c 'math-vector-brackets "{}")
(put 'c 'math-radix-formatter
(function (lambda (r s)
(if (= r 16) (format "0x%s" s)
(if (= r 8) (format "0%s" s)
(format "%d#%s" r s))))))
(lambda (r s)
(if (= r 16) (format "0x%s" s)
(if (= r 8) (format "0%s" s)
(format "%d#%s" r s)))))
(put 'c 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(add-to-list 'calc-lang-slash-idiv 'c)
(add-to-list 'calc-lang-allow-underscores 'c)
@ -238,9 +237,9 @@
(put 'pascal 'math-output-filter 'calc-output-case-filter)
(put 'pascal 'math-radix-formatter
(function (lambda (r s)
(if (= r 16) (format "$%s" s)
(format "%d#%s" r s)))))
(lambda (r s)
(if (= r 16) (format "$%s" s)
(format "%d#%s" r s))))
(put 'pascal 'math-lang-read-symbol
'((?\$
@ -253,17 +252,16 @@
math-exp-pos (match-end 1)))))
(put 'pascal 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(add-to-list 'calc-lang-allow-underscores 'pascal)
(add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
@ -350,17 +348,16 @@
math-exp-pos (match-end 0)))))
(put 'fortran 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"("
(math-compose-vector args ", " 0)
")")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"("
(math-compose-vector args ", " 0)
")"))))
(add-to-list 'calc-lang-slash-idiv 'fortran)
(add-to-list 'calc-lang-allow-underscores 'fortran)
@ -598,18 +595,17 @@
(put 'tex 'math-input-filter 'math-tex-input-filter)
(put 'tex 'math-matrix-formatter
(function
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\matrix{")
(math-compose-tex-matrix (cdr a))
'("}"))
(append '(horiz "\\matrix{ ")
(math-compose-tex-matrix (cdr a))
'(" }"))))))
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\matrix{")
(math-compose-tex-matrix (cdr a))
'("}"))
(append '(horiz "\\matrix{ ")
(math-compose-tex-matrix (cdr a))
'(" }")))))
(put 'tex 'math-var-formatter 'math-compose-tex-var)
@ -839,18 +835,17 @@
(put 'latex 'math-complex-format 'i)
(put 'latex 'math-matrix-formatter
(function
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\begin{pmatrix}")
(math-compose-tex-matrix (cdr a) t)
'("\\end{pmatrix}"))
(append '(horiz "\\begin{pmatrix} ")
(math-compose-tex-matrix (cdr a) t)
'(" \\end{pmatrix}"))))))
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\begin{pmatrix}")
(math-compose-tex-matrix (cdr a) t)
'("\\end{pmatrix}"))
(append '(horiz "\\begin{pmatrix} ")
(math-compose-tex-matrix (cdr a) t)
'(" \\end{pmatrix}")))))
(put 'latex 'math-var-formatter 'math-compose-tex-var)
@ -1023,36 +1018,34 @@
(put 'eqn 'math-evalto '("evalto " . " -> "))
(put 'eqn 'math-matrix-formatter
(function
(lambda (a)
(append '(horiz "matrix { ")
(math-compose-eqn-matrix
(cdr (math-transpose a)))
'("}")))))
(lambda (a)
(append '(horiz "matrix { ")
(math-compose-eqn-matrix
(cdr (math-transpose a)))
'("}"))))
(put 'eqn 'math-var-formatter
(function
(lambda (a prec)
(let (v)
(if (and math-compose-hash-args
(let ((p calc-arg-values))
(setq v 1)
(while (and p (not (equal (car p) a)))
(setq p (and (eq math-compose-hash-args t) (cdr p))
v (1+ v)))
p))
(if (eq math-compose-hash-args 1)
"#"
(format "#%d" v))
(if (string-match ".'\\'" (symbol-name (nth 2 a)))
(math-compose-expr
(list 'calcFunc-Prime
(list
'var
(intern (substring (symbol-name (nth 1 a)) 0 -1))
(intern (substring (symbol-name (nth 2 a)) 0 -1))))
prec)
(symbol-name (nth 1 a))))))))
(lambda (a prec)
(let (v)
(if (and math-compose-hash-args
(let ((p calc-arg-values))
(setq v 1)
(while (and p (not (equal (car p) a)))
(setq p (and (eq math-compose-hash-args t) (cdr p))
v (1+ v)))
p))
(if (eq math-compose-hash-args 1)
"#"
(format "#%d" v))
(if (string-match ".'\\'" (symbol-name (nth 2 a)))
(math-compose-expr
(list 'calcFunc-Prime
(list
'var
(intern (substring (symbol-name (nth 1 a)) 0 -1))
(intern (substring (symbol-name (nth 2 a)) 0 -1))))
prec)
(symbol-name (nth 1 a)))))))
(defconst math-eqn-special-funcs
'( calcFunc-log
@ -1065,31 +1058,30 @@
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
(put 'eqn 'math-func-formatter
(function
(lambda (func a)
(let (left right)
(if (string-match "[^']'+\\'" func)
(let ((n (- (length func) (match-beginning 0) 1)))
(setq func (substring func 0 (- n)))
(while (>= (setq n (1- n)) 0)
(setq func (concat func " prime")))))
(cond ((or (> (length a) 2)
(not (math-tex-expr-is-flat (nth 1 a))))
(setq left "{left ( "
right " right )}"))
(lambda (func a)
(let (left right)
(if (string-match "[^']'+\\'" func)
(let ((n (- (length func) (match-beginning 0) 1)))
(setq func (substring func 0 (- n)))
(while (>= (setq n (1- n)) 0)
(setq func (concat func " prime")))))
(cond ((or (> (length a) 2)
(not (math-tex-expr-is-flat (nth 1 a))))
(setq left "{left ( "
right " right )}"))
((and
(memq (car a) math-eqn-special-funcs)
(= (length a) 2)
(or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *))))
(setq left "~{" right "}"))
(t
(setq left " ( "
right " )")))
(list 'horiz func left
(math-compose-vector (cdr a) " , " 0)
right)))))
((and
(memq (car a) math-eqn-special-funcs)
(= (length a) 2)
(or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *))))
(setq left "~{" right "}"))
(t
(setq left " ( "
right " )")))
(list 'horiz func left
(math-compose-vector (cdr a) " , " 0)
right))))
(put 'eqn 'math-lang-read-symbol
'((?\"
@ -1111,23 +1103,22 @@
("above" punc ",")))
(put 'eqn 'math-lang-adjust-words
(function
(lambda ()
(let ((code (assoc math-expr-data math-eqn-ignore-words)))
(cond ((null code))
((null (cdr code))
(math-read-token))
((consp (nth 1 code))
(math-read-token)
(if (assoc math-expr-data (cdr code))
(setq math-expr-data (format "%s %s"
(car code) math-expr-data))))
((eq (nth 1 code) 'punc)
(setq math-exp-token 'punc
math-expr-data (nth 2 code)))
(t
(math-read-token)
(math-read-token)))))))
(lambda ()
(let ((code (assoc math-expr-data math-eqn-ignore-words)))
(cond ((null code))
((null (cdr code))
(math-read-token))
((consp (nth 1 code))
(math-read-token)
(if (assoc math-expr-data (cdr code))
(setq math-expr-data (format "%s %s"
(car code) math-expr-data))))
((eq (nth 1 code) 'punc)
(setq math-exp-token 'punc
math-expr-data (nth 2 code)))
(t
(math-read-token)
(math-read-token))))))
(put 'eqn 'math-lang-read
'((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^"
@ -1357,14 +1348,13 @@
( calcFunc-in . (math-lang-compose-switch-args "Contains"))))
(put 'yacas 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(defun math-yacas-parse-Sum (f _val)
"Read in the arguments to \"Sum\" in Calc's Yacas mode."
@ -1600,24 +1590,22 @@
(add-to-list 'calc-lang-brackets-are-subscripts 'maxima)
(put 'maxima 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(put 'maxima 'math-matrix-formatter
(function
(lambda (a)
(list 'horiz
"matrix("
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
")"))))
(lambda (a)
(list 'horiz
"matrix("
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
")")))
;;; Giac
@ -1806,15 +1794,14 @@ order to Calc's."
(add-to-list 'calc-lang-allow-underscores 'giac)
(put 'giac 'math-compose-subscr
(function
(lambda (a)
;; (let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-expr
(calc-normalize (list '- (nth 2 a) 1)) 0)
"]")))) ;;)
(lambda (a)
;; (let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-expr
(calc-normalize (list '- (nth 2 a) 1)) 0)
"]"))) ;;)
(defun math-read-giac-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@ -1932,7 +1919,7 @@ order to Calc's."
(put 'math 'math-function-close "]")
(put 'math 'math-radix-formatter
(function (lambda (r s) (format "%d^^%s" r s))))
(lambda (r s) (format "%d^^%s" r s)))
(put 'math 'math-lang-read
'((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
@ -1942,13 +1929,12 @@ order to Calc's."
math-exp-pos (match-end 0))))
(put 'math 'math-compose-subscr
(function
(lambda (a)
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"[["
(math-compose-expr (nth 2 a) 0)
"]]"))))
(lambda (a)
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"[["
(math-compose-expr (nth 2 a) 0)
"]]")))
(defun math-read-math-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@ -2038,26 +2024,24 @@ order to Calc's."
(put 'maple 'math-complex-format 'I)
(put 'maple 'math-matrix-formatter
(function
(lambda (a)
(list 'horiz
"matrix("
math-comp-left-bracket
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-right-bracket
")"))))
(lambda (a)
(list 'horiz
"matrix("
math-comp-left-bracket
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-right-bracket
")")))
(put 'maple 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(add-to-list 'calc-lang-allow-underscores 'maple)
(add-to-list 'calc-lang-brackets-are-subscripts 'maple)

6
lisp/calc/calc-macs.el
View file

@ -33,12 +33,12 @@
(defmacro calc-wrapper (&rest body)
`(calc-do (function (lambda ()
,@body))))
`(calc-do (lambda ()
,@body)))
(defmacro calc-slow-wrapper (&rest body)
`(calc-do
(function (lambda () ,@body)) (point)))
(lambda () ,@body) (point)))
(defmacro math-showing-full-precision (form)
`(let ((calc-float-format calc-full-float-format))

43
lisp/calc/calc-map.el
View file

@ -612,14 +612,13 @@
"()")
minibuffer-local-map
t)))
(setq math-arglist (mapcar (function
(lambda (x)
(list 'var
x
(intern
(concat
"var-"
(symbol-name x))))))
(setq math-arglist (mapcar (lambda (x)
(list 'var
x
(intern
(concat
"var-"
(symbol-name x)))))
math-arglist))))
(setq oper (list "$"
(length math-arglist)
@ -962,12 +961,12 @@
(apply 'calcFunc-mapeqp func args)))
(defun calcFunc-mapeqr (func &rest args)
(setq args (mapcar (function (lambda (x)
(let ((func (assq (car-safe x)
calc-tweak-eqn-table)))
(if func
(cons (nth 1 func) (cdr x))
x))))
(setq args (mapcar (lambda (x)
(let ((func (assq (car-safe x)
calc-tweak-eqn-table)))
(if func
(cons (nth 1 func) (cdr x))
x)))
args))
(apply 'calcFunc-mapeqp func args))
@ -1092,28 +1091,28 @@
(defun calcFunc-reducea (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-reducer func x)))
(mapcar (lambda (x) (calcFunc-reducer func x))
(cdr vec)))
(calcFunc-reducer func vec)))
(defun calcFunc-rreducea (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-rreducer func x)))
(mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr vec)))
(calcFunc-rreducer func vec)))
(defun calcFunc-reduced (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-reducer func x)))
(mapcar (lambda (x) (calcFunc-reducer func x))
(cdr (math-transpose vec))))
(calcFunc-reducer func vec)))
(defun calcFunc-rreduced (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-rreducer func x)))
(mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr (math-transpose vec))))
(calcFunc-rreducer func vec)))
@ -1216,10 +1215,10 @@
(let ((mat nil))
(while (setq a (cdr a))
(setq mat (cons (cons 'vec
(mapcar (function (lambda (x)
(math-build-call func
(list (car a)
x))))
(mapcar (lambda (x)
(math-build-call func
(list (car a)
x)))
(cdr b)))
mat)))
(math-normalize (cons 'vec (nreverse mat)))))

11
lisp/calc/calc-misc.el
View file

@ -176,9 +176,9 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
"Create another, independent Calculator buffer."
(interactive)
(if (eq major-mode 'calc-mode)
(mapc (function
(lambda (v)
(set-default v (symbol-value v)))) calc-local-var-list))
(mapc (lambda (v)
(set-default v (symbol-value v)))
calc-local-var-list))
(set-buffer (generate-new-buffer "*Calculator*"))
(pop-to-buffer (current-buffer))
(calc-mode))
@ -274,9 +274,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
;;;###autoload
(defun calc-do-handle-whys ()
(setq calc-why (sort calc-next-why
(function
(lambda (x y)
(and (eq (car x) '*) (not (eq (car y) '*))))))
(lambda (x y)
(and (eq (car x) '*) (not (eq (car y) '*)))))
calc-next-why nil)
(if (and calc-why (or (eq calc-auto-why t)
(and (eq (car (car calc-why)) '*)

2
lisp/calc/calc-mode.el
View file

@ -268,7 +268,7 @@
(interactive)
(calc-wrapper
(let (pos
(vals (mapcar (function (lambda (v) (symbol-value (car v))))
(vals (mapcar (lambda (v) (symbol-value (car v)))
calc-mode-var-list)))
(unless calc-settings-file
(error "No `calc-settings-file' specified"))

6
lisp/calc/calc-mtx.el
View file

@ -55,7 +55,7 @@
(defun math-col-matrix (a)
(if (and (Math-vectorp a)
(not (math-matrixp a)))
(cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a)))
(cons 'vec (mapcar (lambda (x) (list 'vec x)) (cdr a)))
a))
@ -79,8 +79,8 @@
(cons 'vec (nreverse mat))))
(defun math-mul-mat-vec (a b)
(cons 'vec (mapcar (function (lambda (row)
(math-dot-product row b)))
(cons 'vec (mapcar (lambda (row)
(math-dot-product row b))
(cdr a))))

21
lisp/calc/calc-poly.el
View file

@ -202,7 +202,7 @@
(if (memq (car-safe expr) '(+ -))
(math-list-to-sum
(sort (math-sum-to-list expr)
(function (lambda (a b) (math-beforep (car a) (car b))))))
(lambda (a b) (math-beforep (car a) (car b)))))
expr))
(defun math-list-to-sum (lst)
@ -387,7 +387,7 @@ This returns only the remainder from the pseudo-division."
lst
(if (eq a -1)
(math-mul-list lst a)
(mapcar (function (lambda (x) (math-poly-div-exact x a))) lst))))
(mapcar (lambda (x) (math-poly-div-exact x a)) lst))))
(defun math-mul-list (lst a)
(if (eq a 1)
@ -395,7 +395,7 @@ This returns only the remainder from the pseudo-division."
(if (eq a -1)
(mapcar 'math-neg lst)
(and (not (eq a 0))
(mapcar (function (lambda (x) (math-mul x a))) lst)))))
(mapcar (lambda (x) (math-mul x a)) lst)))))
;;; Run GCD on all elements in a list.
(defun math-poly-gcd-list (lst)
@ -502,10 +502,10 @@ Take the base that has the highest degree considering both a and b.
(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))
(math-beforep (car a) (car b))))))))
(sort lst (lambda (a b)
(or (> (nth 1 a) (nth 1 b))
(and (= (nth 1 a) (nth 1 b))
(math-beforep (car a) (car b)))))))
;;; Given an expression find all variables that are polynomial bases.
;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
@ -1033,10 +1033,9 @@ If no partial fraction representation can be found, return nil."
(math-transpose
(cons 'vec
(mapcar
(function
(lambda (x)
(cons 'vec (math-padded-polynomial
x var tdeg))))
(lambda (x)
(cons 'vec (math-padded-polynomial
x var tdeg)))
(cdr eqns))))))
(and (math-vectorp eqns)
(let ((res 0)

14
lisp/calc/calc-prog.el
View file

@ -182,7 +182,7 @@
odef key keyname cmd cmd-base cmd-base-default
func calc-user-formula-alist is-symb)
(if is-lambda
(setq math-arglist (mapcar (function (lambda (x) (nth 1 x)))
(setq math-arglist (mapcar (lambda (x) (nth 1 x))
(nreverse (cdr (reverse (cdr form)))))
form (nth (1- (length form)) form))
(calc-default-formula-arglist form)
@ -290,10 +290,10 @@
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
(setq calc-user-formula-alist
(mapcar (function (lambda (x)
(or (cdr (assq x '((nil . arg-nil)
(t . arg-t))))
x))) calc-user-formula-alist))
(mapcar (lambda (x)
(or (cdr (assq x '((nil . arg-nil)
(t . arg-t))))
x)) calc-user-formula-alist))
(if cmd
(progn
(require 'calc-macs)
@ -319,8 +319,8 @@
(append
(list 'lambda calc-user-formula-alist)
(and is-symb
(mapcar (function (lambda (v)
(list 'math-check-const v t)))
(mapcar (lambda (v)
(list 'math-check-const v t))
calc-user-formula-alist))
(list body))))
(put func 'calc-user-defn form)

77
lisp/calc/calc-rewr.el
View file

@ -181,19 +181,18 @@
(calc-line-numbering nil)
(calc-show-selections t)
(calc-why nil)
(math-mt-func (function
(lambda (x)
(let ((result (math-apply-rewrites x (cdr crules)
heads crules)))
(if result
(progn
(if trace-buffer
(let ((fmt (math-format-stack-value
(list result nil nil))))
(with-current-buffer trace-buffer
(insert "\nrewrite to\n" fmt "\n"))))
(setq heads (math-rewrite-heads result heads t))))
result)))))
(math-mt-func (lambda (x)
(let ((result (math-apply-rewrites x (cdr crules)
heads crules)))
(if result
(progn
(if trace-buffer
(let ((fmt (math-format-stack-value
(list result nil nil))))
(with-current-buffer trace-buffer
(insert "\nrewrite to\n" fmt "\n"))))
(setq heads (math-rewrite-heads result heads t))))
result))))
(if trace-buffer
(let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
(with-current-buffer trace-buffer
@ -485,8 +484,8 @@
(let ((math-rewrite-whole t))
(cdr (math-compile-rewrites (cons
'vec
(mapcar (function (lambda (x)
(list 'vec x t)))
(mapcar (lambda (x)
(list 'vec x t))
(if (eq (car-safe pats) 'vec)
(cdr pats)
(list pats)))))))))
@ -656,15 +655,14 @@
nil
(nreverse
(mapcar
(function
(lambda (v)
(and (car v)
(list
'calcFunc-assign
(math-build-var-name
(car v))
(math-rwcomp-register-expr
(nth 1 v))))))
(lambda (v)
(and (car v)
(list
'calcFunc-assign
(math-build-var-name
(car v))
(math-rwcomp-register-expr
(nth 1 v)))))
math-regs))))
(math-rwcomp-match-vars math-rhs))
math-remembering)
@ -672,7 +670,7 @@
(let* ((heads (math-rewrite-heads math-pattern))
(rule (list (vconcat
(nreverse
(mapcar (function (lambda (x) (nth 3 x)))
(mapcar (lambda (x) (nth 3 x))
math-regs)))
math-prog
heads
@ -724,10 +722,9 @@
(setq rules (cdr rules)))
(if nil-rules
(setq rule-set (cons (cons nil nil-rules) rule-set)))
(setq all-heads (mapcar 'car
(sort all-heads (function
(lambda (x y)
(< (cdr x) (cdr y)))))))
(setq all-heads (mapcar #'car
(sort all-heads (lambda (x y)
(< (cdr x) (cdr y))))))
(let ((set rule-set)
rule heads ptr)
(while set
@ -790,15 +787,14 @@
(math-rewrite-heads-rec (car expr)))))))
(defun math-parse-schedule (sched)
(mapcar (function
(lambda (s)
(if (integerp s)
s
(if (math-vectorp s)
(math-parse-schedule (cdr s))
(if (eq (car-safe s) 'var)
(math-var-to-calcFunc s)
(error "Improper component in rewrite schedule"))))))
(mapcar (lambda (s)
(if (integerp s)
s
(if (math-vectorp s)
(math-parse-schedule (cdr s))
(if (eq (car-safe s) 'var)
(math-var-to-calcFunc s)
(error "Improper component in rewrite schedule")))))
sched))
(defun math-rwcomp-match-vars (expr)
@ -1180,9 +1176,8 @@
(list 'calcFunc-register
reg2))))
(math-rwcomp-pattern (car arg2) (cdr arg2))))
(let* ((args (mapcar (function
(lambda (x)
(cons x (math-rwcomp-best-reg x))))
(let* ((args (mapcar (lambda (x)
(cons x (math-rwcomp-best-reg x)))
(cdr expr)))
(args2 (copy-sequence args))
(argp (reverse args2))

71
lisp/calc/calc-store.el
View file

@ -168,15 +168,13 @@
()
(setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
(define-key calc-var-name-map " " 'self-insert-command)
(mapc (function
(lambda (x)
(mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
'calcVar-digit)))
'calcVar-digit))
"0123456789")
(mapc (function
(lambda (x)
(mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
'calcVar-oper)))
'calcVar-oper))
"+-*/^|"))
(defvar calc-store-opers)
@ -324,10 +322,9 @@
(calc-pop-push-record
(1+ calc-given-value-flag)
(concat "=" (calc-var-name (car (car var))))
(let ((saved-val (mapcar (function
(lambda (v)
(and (boundp (car v))
(symbol-value (car v)))))
(let ((saved-val (mapcar (lambda (v)
(and (boundp (car v))
(symbol-value (car v))))
var)))
(unwind-protect
(let ((vv var))
@ -597,13 +594,12 @@
calc-settings-file)))
(if var
(calc-insert-permanent-variable var)
(mapatoms (function
(lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(calc-insert-permanent-variable x))))))
(mapatoms (lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(calc-insert-permanent-variable x)))))
(save-buffer))))
@ -638,27 +634,26 @@
(defun calc-insert-variables (buf)
(interactive "bBuffer in which to save variable values: ")
(with-current-buffer buf
(mapatoms (function
(lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(or (not (eq x 'var-Decls))
(not (equal var-Decls '(vec))))
(or (not (eq x 'var-Holidays))
(not (equal var-Holidays '(vec (var sat var-sat)
(var sun var-sun)))))
(insert "(setq "
(symbol-name x)
" "
(prin1-to-string
(let ((calc-language
(if (memq calc-language '(nil big))
'flat
calc-language)))
(math-format-value (symbol-value x) 100000)))
")\n")))))))
(mapatoms (lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(or (not (eq x 'var-Decls))
(not (equal var-Decls '(vec))))
(or (not (eq x 'var-Holidays))
(not (equal var-Holidays '(vec (var sat var-sat)
(var sun var-sun)))))
(insert "(setq "
(symbol-name x)
" "
(prin1-to-string
(let ((calc-language
(if (memq calc-language '(nil big))
'flat
calc-language)))
(math-format-value (symbol-value x) 100000)))
")\n"))))))
(defun calc-assign (arg)
(interactive "P")

6
lisp/calc/calc-stuff.el
View file

@ -182,7 +182,7 @@ With a prefix, push that prefix as a number onto the stack."
math-eval-rules-cache-tag t
math-format-date-cache nil
math-holidays-cache-tag t)
(mapc (function (lambda (x) (set x -100))) math-cache-list)
(mapc (lambda (x) (set x -100)) math-cache-list)
(unless inhibit-msg
(message "All internal calculator caches have been reset"))))
@ -258,14 +258,14 @@ With a prefix, push that prefix as a number onto the stack."
(t (list 'calcFunc-clean a)))))
(defun calcFunc-pclean (a &optional prec)
(math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
(math-map-over-constants (lambda (x) (calcFunc-clean x prec))
a))
(defun calcFunc-pfloat (a)
(math-map-over-constants 'math-float a))
(defun calcFunc-pfrac (a &optional tol)
(math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
(math-map-over-constants (lambda (x) (calcFunc-frac x tol))
a))
;; The variable math-moc-func is local to math-map-over-constants,

40
lisp/calc/calc-units.el
View file

@ -860,23 +860,22 @@ If COMP or STD is non-nil, put that in the units table instead."
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
(setq tab (mapcar (function
(lambda (x)
(list (car x)
(and (nth 1 x)
(if (stringp (nth 1 x))
(let ((exp (math-read-plain-expr
(nth 1 x))))
(if (eq (car-safe exp) 'error)
(error "Format error in definition of %s in units table: %s"
(car x) (nth 2 exp))
exp))
(nth 1 x)))
(nth 2 x)
(nth 3 x)
(and (not (nth 1 x))
(list (cons (car x) 1)))
(nth 4 x))))
(setq tab (mapcar (lambda (x)
(list (car x)
(and (nth 1 x)
(if (stringp (nth 1 x))
(let ((exp (math-read-plain-expr
(nth 1 x))))
(if (eq (car-safe exp) 'error)
(error "Format error in definition of %s in units table: %s"
(car x) (nth 2 exp))
exp))
(nth 1 x)))
(nth 2 x)
(nth 3 x)
(and (not (nth 1 x))
(list (cons (car x) 1)))
(nth 4 x)))
combined-units))
(let ((math-units-table tab))
(mapc #'math-find-base-units tab))
@ -1100,10 +1099,9 @@ If COMP or STD is non-nil, put that in the units table instead."
(setq math-decompose-units-cache
(cons entry
(sort ulist
(function
(lambda (x y)
(not (Math-lessp (nth 1 x)
(nth 1 y))))))))))
(lambda (x y)
(not (Math-lessp (nth 1 x)
(nth 1 y)))))))))
(cdr math-decompose-units-cache))))
(defun math-decompose-unit-part (unit)

18
lisp/calc/calc-vec.el
View file

@ -744,7 +744,7 @@
;;; Get the Nth row of a matrix.
(defun calcFunc-mrow (mat n) ; [Public]
(if (Math-vectorp n)
(math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n)
(math-map-vec (lambda (x) (calcFunc-mrow mat x)) n)
(if (and (eq (car-safe n) 'intv) (math-constp n))
(calcFunc-subvec mat
(math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
@ -768,15 +768,15 @@
;;; Get the Nth column of a matrix.
(defun math-mat-col (mat n)
(cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat))))
(cons 'vec (mapcar (lambda (x) (elt x n)) (cdr mat))))
(defun calcFunc-mcol (mat n) ; [Public]
(if (Math-vectorp n)
(calcFunc-trn
(math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n))
(math-map-vec (lambda (x) (calcFunc-mcol mat x)) n))
(if (and (eq (car-safe n) 'intv) (math-constp n))
(if (math-matrixp mat)
(math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat)
(math-map-vec (lambda (x) (calcFunc-mrow x n)) mat)
(calcFunc-mrow mat n))
(or (and (integerp (setq n (math-check-integer n)))
(> n 0))
@ -804,7 +804,7 @@
;;; Remove the Nth column from a matrix.
(defun math-mat-less-col (mat n)
(cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n)))
(cons 'vec (mapcar (lambda (x) (math-mat-less-row x n))
(cdr mat))))
(defun calcFunc-mrcol (mat n) ; [Public]
@ -939,10 +939,10 @@
(calcFunc-idn a (1- (length m)))
(if (math-vectorp m)
(if (math-zerop a)
(cons 'vec (mapcar (function (lambda (x)
(if (math-vectorp x)
(math-mimic-ident a x)
a)))
(cons 'vec (mapcar (lambda (x)
(if (math-vectorp x)
(math-mimic-ident a x)
a))
(cdr m)))
(math-dimension-error))
(calcFunc-idn a))))

11
lisp/calc/calc-yank.el
View file

@ -643,12 +643,11 @@ Interactively, reads the register using `register-read-with-preview'."
(allow-ret (> n 1))
(list (math-showing-full-precision
(mapcar (if (> n 1)
(function (lambda (x)
(math-format-flat-expr x 0)))
(function
(lambda (x)
(if (math-vectorp x) (setq allow-ret t))
(math-format-nice-expr x (frame-width)))))
(lambda (x)
(math-format-flat-expr x 0))
(lambda (x)
(if (math-vectorp x) (setq allow-ret t))
(math-format-nice-expr x (frame-width))))
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))

11
lisp/calc/calc.el
View file

@ -506,7 +506,7 @@ The variable VAR will be added to `calc-mode-var-list'."
(defun calc-mode-var-list-restore-default-values ()
"Restore the default values of the variables in `calc-mode-var-list'."
(mapcar (function (lambda (v) (set (car v) (nth 1 v))))
(mapcar (lambda (v) (set (car v) (nth 1 v)))
calc-mode-var-list))
(defun calc-mode-var-list-restore-saved-values ()
@ -535,7 +535,7 @@ The variable VAR will be added to `calc-mode-var-list'."
newvarlist)))
(setq varlist (cdr varlist)))))))
(if newvarlist
(mapcar (function (lambda (v) (set (car v) (nth 1 v))))
(mapcar (lambda (v) (set (car v) (nth 1 v)))
newvarlist)
(calc-mode-var-list-restore-default-values))))
@ -1315,8 +1315,9 @@ Notations: 3.14e6 3.14 * 10^6
\\{calc-mode-map}
"
(interactive)
(mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
(lambda (v) (set-default v (symbol-value v))))
(mapc (lambda (v)
;; FIXME: Why (set-default v (symbol-value v)) ?!?!?
(set-default v (symbol-value v)))
calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
@ -1537,7 +1538,7 @@ See `window-dedicated-p' for what that means."
(let ((tail (nthcdr (1- calc-undo-length) calc-undo-list)))
(if tail (setcdr tail nil)))
(setq calc-redo-list nil))))
(mapc (function (lambda (v) (set-default v (symbol-value v))))
(mapc (lambda (v) (set-default v (symbol-value v)))
calc-local-var-list)
(let ((buf (current-buffer))
(win (get-buffer-window (current-buffer)))

117
lisp/calc/calccomp.el
View file

@ -464,14 +464,13 @@
(math-compose-vector (cdr (nth 1 a))
(math-vector-to-string sep nil)
(or cprec prec))
(cons 'horiz (mapcar (function
(lambda (x)
(if (eq (car-safe x) 'calcFunc-bstring)
(prog1
(math-compose-expr
x (or bprec cprec prec))
(setq bprec -123))
(math-compose-expr x (or cprec prec)))))
(cons 'horiz (mapcar (lambda (x)
(if (eq (car-safe x) 'calcFunc-bstring)
(prog1
(math-compose-expr
x (or bprec cprec prec))
(setq bprec -123))
(math-compose-expr x (or cprec prec))))
(cdr (nth 1 a)))))))
((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
(not (eq calc-language 'unform))
@ -482,47 +481,46 @@
(let* ((base 0)
(v 0)
(prec (or (nth 2 a) prec))
(c (mapcar (function
(lambda (x)
(let ((b nil) (cc nil) a d)
(if (and (memq (car-safe x) '(calcFunc-cbase
calcFunc-ctbase
calcFunc-cbbase))
(memq (length x) '(1 2)))
(setq b (car x)
x (nth 1 x)))
(if (and (eq (car-safe x) 'calcFunc-crule)
(memq (length x) '(1 2))
(or (null (nth 1 x))
(and (math-vectorp (nth 1 x))
(= (length (nth 1 x)) 2)
(math-vector-is-string
(nth 1 x)))
(and (natnump (nth 1 x))
(<= (nth 1 x) 255))))
(setq cc (list
'rule
(if (math-vectorp (nth 1 x))
(aref (math-vector-to-string
(nth 1 x) nil) 0)
(or (nth 1 x) ?-))))
(or (and (memq (car-safe x) '(calcFunc-cvspace
calcFunc-ctspace
calcFunc-cbspace))
(memq (length x) '(2 3))
(eq (nth 1 x) 0))
(null x)
(setq cc (math-compose-expr x prec))))
(setq a (if cc (math-comp-ascent cc) 0)
d (if cc (math-comp-descent cc) 0))
(if (eq b 'calcFunc-cbase)
(setq base (+ v a -1))
(if (eq b 'calcFunc-ctbase)
(setq base v)
(if (eq b 'calcFunc-cbbase)
(setq base (+ v a d -1)))))
(setq v (+ v a d))
cc)))
(c (mapcar (lambda (x)
(let ((b nil) (cc nil) a d)
(if (and (memq (car-safe x) '(calcFunc-cbase
calcFunc-ctbase
calcFunc-cbbase))
(memq (length x) '(1 2)))
(setq b (car x)
x (nth 1 x)))
(if (and (eq (car-safe x) 'calcFunc-crule)
(memq (length x) '(1 2))
(or (null (nth 1 x))
(and (math-vectorp (nth 1 x))
(= (length (nth 1 x)) 2)
(math-vector-is-string
(nth 1 x)))
(and (natnump (nth 1 x))
(<= (nth 1 x) 255))))
(setq cc (list
'rule
(if (math-vectorp (nth 1 x))
(aref (math-vector-to-string
(nth 1 x) nil) 0)
(or (nth 1 x) ?-))))
(or (and (memq (car-safe x) '(calcFunc-cvspace
calcFunc-ctspace
calcFunc-cbspace))
(memq (length x) '(2 3))
(eq (nth 1 x) 0))
(null x)
(setq cc (math-compose-expr x prec))))
(setq a (if cc (math-comp-ascent cc) 0)
d (if cc (math-comp-descent cc) 0))
(if (eq b 'calcFunc-cbase)
(setq base (+ v a -1))
(if (eq b 'calcFunc-ctbase)
(setq base v)
(if (eq b 'calcFunc-cbbase)
(setq base (+ v a d -1)))))
(setq v (+ v a d))
cc))
(cdr (nth 1 a)))))
(setq c (delq nil c))
(if c
@ -865,16 +863,15 @@
(while (<= (setq col (1+ col)) cols)
(setq res (cons (cons math-comp-just
(cons base
(mapcar (function
(lambda (r)
(list 'horiz
(math-compose-expr
(nth col r)
math-comp-vector-prec)
(if (= col cols)
""
(concat
math-comp-comma-spc " ")))))
(mapcar (lambda (r)
(list 'horiz
(math-compose-expr
(nth col r)
math-comp-vector-prec)
(if (= col cols)
""
(concat
math-comp-comma-spc " "))))
a)))
res)))
(nreverse res)))
@ -923,7 +920,7 @@
( ?\^? . "\\^?" )))
(defun math-vector-to-string (a &optional quoted)
(setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
(setq a (concat (mapcar (lambda (x) (if (consp x) (nth 1 x) x))
(cdr a))))
(if (string-match "[\000-\037\177\\\"]" a)
(let ((p 0)