Mercurial > emacs
changeset 41047:73f364fd8aaa
Style cleanup; don't put closing parens on their
own line, add "foo.el ends here" to each file, and update
copyright date.
| author | Colin Walters <walters@gnu.org> |
|---|---|
| date | Wed, 14 Nov 2001 09:09:09 +0000 |
| parents | 14b73d89514a |
| children | 7fa61a947b61 |
| files | lisp/calc/calc-comb.el lisp/calc/calc-cplx.el lisp/calc/calc-embed.el lisp/calc/calc-fin.el lisp/calc/calc-forms.el lisp/calc/calc-frac.el lisp/calc/calc-funcs.el lisp/calc/calc-graph.el lisp/calc/calc-help.el lisp/calc/calc-incom.el lisp/calc/calc-keypd.el lisp/calc/calc-lang.el lisp/calc/calc-macs.el lisp/calc/calc-maint.el lisp/calc/calc-map.el lisp/calc/calc-mode.el lisp/calc/calc-mtx.el lisp/calc/calc-poly.el lisp/calc/calc-prog.el lisp/calc/calc-rewr.el lisp/calc/calc-rules.el lisp/calc/calc-sel.el lisp/calc/calc-stat.el lisp/calc/calc-store.el lisp/calc/calc-stuff.el lisp/calc/calc-trail.el lisp/calc/calc-undo.el lisp/calc/calc-vec.el lisp/calc/calc-yank.el lisp/calc/calc.el lisp/calc/calcalg2.el lisp/calc/calcalg3.el lisp/calc/calccomp.el lisp/calc/calcsel2.el |
| diffstat | 34 files changed, 1579 insertions(+), 3119 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/calc/calc-comb.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-comb.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-comb.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -34,52 +34,44 @@ (defun calc-gcd (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "gcd" 'calcFunc-gcd arg)) -) + (calc-binary-op "gcd" 'calcFunc-gcd arg))) (defun calc-lcm (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "lcm" 'calcFunc-lcm arg)) -) + (calc-binary-op "lcm" 'calcFunc-lcm arg))) (defun calc-extended-gcd () (interactive) (calc-slow-wrapper - (calc-enter-result 2 "egcd" (cons 'calcFunc-egcd (calc-top-list-n 2)))) -) + (calc-enter-result 2 "egcd" (cons 'calcFunc-egcd (calc-top-list-n 2))))) (defun calc-factorial (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "fact" 'calcFunc-fact arg)) -) + (calc-unary-op "fact" 'calcFunc-fact arg))) (defun calc-gamma (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "gmma" 'calcFunc-gamma arg)) -) + (calc-unary-op "gmma" 'calcFunc-gamma arg))) (defun calc-double-factorial (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "dfac" 'calcFunc-dfact arg)) -) + (calc-unary-op "dfac" 'calcFunc-dfact arg))) (defun calc-choose (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-binary-op "perm" 'calcFunc-perm arg) - (calc-binary-op "chos" 'calcFunc-choose arg))) -) + (calc-binary-op "chos" 'calcFunc-choose arg)))) (defun calc-perm (arg) (interactive "P") (calc-hyperbolic-func) - (calc-choose arg) -) + (calc-choose arg)) (defvar calc-last-random-limit '(float 1 0)) (defun calc-random (n) @@ -91,29 +83,25 @@ (prefix-numeric-value n)))) (calc-enter-result 1 "rand" (list 'calcFunc-random (calc-get-random-limit - (calc-top-n 1)))))) -) + (calc-top-n 1))))))) (defun calc-get-random-limit (val) (if (eq val 0) calc-last-random-limit - (setq calc-last-random-limit val)) -) + (setq calc-last-random-limit val))) (defun calc-rrandom () (interactive) (calc-slow-wrapper (setq calc-last-random-limit '(float 1 0)) - (calc-enter-result 0 "rand" (list 'calcFunc-random '(float 1 0)))) -) + (calc-enter-result 0 "rand" (list 'calcFunc-random '(float 1 0))))) (defun calc-random-again (arg) (interactive "p") (calc-slow-wrapper (while (>= (setq arg (1- arg)) 0) (calc-enter-result 0 "rand" (list 'calcFunc-random - calc-last-random-limit)))) -) + calc-last-random-limit))))) (defun calc-shuffle (n) (interactive "P") @@ -126,8 +114,7 @@ (calc-enter-result 2 "shuf" (list 'calcFunc-shuffle (calc-top-n 1) (calc-get-random-limit - (calc-top-n 2)))))) -) + (calc-top-n 2))))))) (defun calc-report-prime-test (res) (cond ((eq (car res) t) @@ -146,16 +133,14 @@ "prim" "Probably prime (%d iters; %s%% chance of error)" (nth 1 res) (let ((calc-float-format '(fix 2))) - (math-format-number (nth 2 res)))))) -) + (math-format-number (nth 2 res))))))) (defun calc-prime-test (iters) (interactive "p") (calc-slow-wrapper (let* ((n (calc-top-n 1)) (res (math-prime-test n iters))) - (calc-report-prime-test res))) -) + (calc-report-prime-test res)))) (defun calc-next-prime (iters) (interactive "p") @@ -165,14 +150,12 @@ (calc-enter-result 1 "prvp" (list 'calcFunc-prevprime (calc-top-n 1) (math-abs iters))) (calc-enter-result 1 "nxtp" (list 'calcFunc-nextprime - (calc-top-n 1) (math-abs iters)))))) -) + (calc-top-n 1) (math-abs iters))))))) (defun calc-prev-prime (iters) (interactive "p") (calc-invert-func) - (calc-next-prime iters) -) + (calc-next-prime iters)) (defun calc-prime-factors (iters) (interactive "p") @@ -180,23 +163,17 @@ (let ((res (calcFunc-prfac (calc-top-n 1)))) (if (not math-prime-factors-finished) (calc-record-message "pfac" "Warning: May not be fully factored")) - (calc-enter-result 1 "pfac" res))) -) + (calc-enter-result 1 "pfac" res)))) (defun calc-totient (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "phi" 'calcFunc-totient arg)) -) + (calc-unary-op "phi" 'calcFunc-totient arg))) (defun calc-moebius (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "mu" 'calcFunc-moebius arg)) -) - - - + (calc-unary-op "mu" 'calcFunc-moebius arg))) (defun calcFunc-gcd (a b) @@ -224,15 +201,13 @@ (list 'calcFunc-gcd a b)) (t (calc-record-why 'integerp b) - (list 'calcFunc-gcd a b))) -) + (list 'calcFunc-gcd a b)))) (defun calcFunc-lcm (a b) (let ((g (calcFunc-gcd a b))) (if (Math-numberp g) (math-div (math-mul a b) g) - (list 'calcFunc-lcm a b))) -) + (list 'calcFunc-lcm a b)))) (defun calcFunc-egcd (a b) ; Knuth section 4.5.2 (cond @@ -256,8 +231,7 @@ t2 (math-sub u2 (math-mul v2 (car q))) u1 v1 u2 v2 u3 v3 v1 t1 v2 t2 v3 (cdr q))) - (list 'vec u3 u1 u2)))) -) + (list 'vec u3 u1 u2))))) ;;; Factorial and related functions. @@ -318,8 +292,7 @@ (math-gammap1-raw (math-float n))))))) ((equal n '(var inf var-inf)) n) (t (calc-record-why 'numberp n) - (list 'calcFunc-fact n)))) -) + (list 'calcFunc-fact n))))) (math-defcache math-gamma-1q nil (math-with-extra-prec 3 @@ -334,8 +307,7 @@ (math-working (format "factorial(%d)" (1- n)) f)) (if (> count 0) (math-factorial-iter (1- count) (1+ n) (math-mul n f)) - f) -) + f)) (defun calcFunc-dfact (n) ; [I I] [F F] [Public] (cond ((Math-integer-negp n) @@ -364,16 +336,14 @@ (list 'calcFunc-dfact max)))) ((equal n '(var inf var-inf)) n) (t (calc-record-why 'natnump n) - (list 'calcFunc-dfact n))) -) + (list 'calcFunc-dfact n)))) (defun math-double-factorial-iter (max n f step) (if (< (% n 12) step) (math-working (format "dfact(%d)" (- n step)) f)) (if (<= n max) (math-double-factorial-iter max (+ n step) (math-mul n f) step) - f) -) + f)) (defun calcFunc-perm (n m) ; [I I I] [F F F] [Public] (cond ((and (integerp n) (integerp m) (<= m n) (>= m 0)) @@ -397,8 +367,7 @@ (or (integerp tm) (math-reject-arg tm 'fixnump)) (or (and (<= tm tn) (>= tm 0)) (math-reject-arg tm 'range)) (math-with-extra-prec 1 - (math-factorial-iter tm (1+ (- tn tm)) '(float 1 0)))))) -) + (math-factorial-iter tm (1+ (- tn tm)) '(float 1 0))))))) (defun calcFunc-choose (n m) ; [I I I] [F F F] [Public] (cond ((and (integerp n) (integerp m) (<= m n) (>= m 0)) @@ -434,8 +403,7 @@ (calcFunc-fact (math-float (math-sub n m))))) (math-with-extra-prec 1 - (math-choose-float-iter tm n 1 1)))))) -) + (math-choose-float-iter tm n 1 1))))))) (defun math-choose-iter (m n i c) (if (and (= (% i 5) 1) (> i 5)) @@ -443,8 +411,7 @@ (if (<= i m) (math-choose-iter m (1- n) (1+ i) (math-quotient (math-mul c n) i)) - c) -) + c)) (defun math-choose-float-iter (count n i c) (if (= (% i 5) 1) @@ -452,19 +419,16 @@ (if (> count 0) (math-choose-float-iter (1- count) (math-sub n 1) (1+ i) (math-div (math-mul c n) i)) - c) -) + c)) ;;; Stirling numbers. (defun calcFunc-stir1 (n m) - (math-stirling-number n m 1) -) + (math-stirling-number n m 1)) (defun calcFunc-stir2 (n m) - (math-stirling-number n m 0) -) + (math-stirling-number n m 0)) (defun math-stirling-number (n m k) (or (math-num-natnump n) (math-reject-arg n 'natnump)) @@ -487,23 +451,20 @@ (aset row i 1)))) (if (= k 1) (math-stirling-1 n m) - (math-stirling-2 n m)))) -) + (math-stirling-2 n m))))) (setq math-stirling-cache (vector [[1]] [[1]])) (defun math-stirling-1 (n m) (or (aref (aref cache n) m) (aset (aref cache n) m (math-add (math-stirling-1 (1- n) (1- m)) - (math-mul (- 1 n) (math-stirling-1 (1- n) m))))) -) + (math-mul (- 1 n) (math-stirling-1 (1- n) m)))))) (defun math-stirling-2 (n m) (or (aref (aref cache n) m) (aset (aref cache n) m (math-add (math-stirling-2 (1- n) (1- m)) - (math-mul m (math-stirling-2 (1- n) m))))) -) + (math-mul m (math-stirling-2 (1- n) m)))))) ;;; Produce a random 10-bit integer, with (random) if no seed provided, @@ -544,8 +505,7 @@ (if (> (lsh (math-abs (random)) math-random-shift) 4095) (setq math-random-shift (1- math-random-shift))))) (setq math-last-RandSeed var-RandSeed - math-gaussian-cache nil) -) + math-gaussian-cache nil)) (defun math-random-base () (if var-RandSeed @@ -558,8 +518,7 @@ (logand (- (car math-random-ptr1) (car math-random-ptr2)) 524287)) -6) 1023)) - (logand (lsh (random) math-random-shift) 1023)) -) + (logand (lsh (random) math-random-shift) 1023))) (setq math-random-table nil) (setq math-last-RandSeed nil) (setq math-random-ptr1 nil) @@ -586,8 +545,7 @@ math-random-last (aref math-random-cache i)) (aset math-random-cache i (math-random-base)) (>= math-random-last 1000))) - math-random-last) -) + math-random-last)) (setq math-random-cache nil) ;;; Produce an N-digit random integer. @@ -602,14 +560,12 @@ (setq digs (cons (math-random-digit) digs) i (1- i))) (math-normalize (math-scale-right (cons 'bigpos digs) - slop))))) -) + slop)))))) ;;; Produce a uniformly-distributed random float 0 <= N < 1. (defun math-random-float () (math-make-float (math-random-digits calc-internal-prec) - (- calc-internal-prec)) -) + (- calc-internal-prec))) ;;; Produce a Gaussian-distributed random float with mean=0, sigma=1. (defun math-gaussian-float () @@ -629,8 +585,7 @@ (let ((fac (math-sqrt (math-mul (math-div (calcFunc-ln r) r) -2)))) (setq math-gaussian-cache (cons calc-internal-prec (math-mul v1 fac))) - (math-mul v2 fac))))) -) + (math-mul v2 fac)))))) (setq math-gaussian-cache nil) ;;; Produce a random integer or real 0 <= N < MAX. @@ -668,8 +623,7 @@ (math-reject-arg max "*Empty list"))) ((and (eq (car max) 'sdev) (math-constp max) (Math-realp (nth 1 max))) (math-add (math-mul (math-gaussian-float) (nth 2 max)) (nth 1 max))) - (t (math-reject-arg max 'realp))) -) + (t (math-reject-arg max 'realp)))) ;;; Choose N objects at random from the set MAX without duplicates. (defun calcFunc-shuffle (n &optional max) @@ -724,8 +678,7 @@ (if (math-posp max) (calcFunc-shuffle n (list 'intv 2 0 max)) (calcFunc-shuffle n (list 'intv 1 max 0)))) - (t (math-reject-arg max 'realp))) -) + (t (math-reject-arg max 'realp)))) (defun math-simple-shuffle (n max) (let ((vec nil) @@ -733,8 +686,7 @@ (while (>= (setq n (1- n)) 0) (while (math-member (setq val (calcFunc-random max)) vec)) (setq vec (cons val vec))) - (cons 'vec vec)) -) + (cons 'vec vec))) (defun math-shuffle-list (n size vec) (let ((j size) @@ -746,14 +698,12 @@ temp (nth k p)) (setcar (nthcdr k p) (car p)) (setcar p temp)) - (cons 'vec (nthcdr (- size n -1) vec))) -) + (cons 'vec (nthcdr (- size n -1) vec)))) (defun math-member (x list) (while (and list (not (equal x (car list)))) (setq list (cdr list))) - list -) + list) ;;; Check if the integer N is prime. [X I] @@ -845,8 +795,7 @@ iters (if (eq (car res) 'maybe) (1- iters) 0))) - res) -) + res)) (defvar math-prime-test-cache '(-1)) (defun calcFunc-prime (n &optional iters) @@ -854,8 +803,7 @@ (or (not iters) (math-num-integerp iters) (math-reject-arg iters 'integerp)) (if (car (math-prime-test (math-trunc n) (math-trunc (or iters 1)))) 1 - 0) -) + 0)) ;;; Theory: summing base-10^6 digits modulo 111111 is "casting out 999999s". ;;; Initial probability that N is prime is 1/ln(N) = log10(e)/log10(N). @@ -897,8 +845,7 @@ (list 'vec n) (cons 'vec (cons -1 (cdr (calcFunc-prfac (math-neg n)))))) (calc-record-why 'integerp n) - (list 'calcFunc-prfac n))) -) + (list 'calcFunc-prfac n)))) (defun calcFunc-totient (n) (if (Math-messy-integerp n) @@ -921,8 +868,7 @@ (calc-record-why "*Number too big to factor" n) (list 'calcFunc-totient n)))) (calc-record-why 'natnump n) - (list 'calcFunc-totient n)) -) + (list 'calcFunc-totient n))) (defun calcFunc-moebius (n) (if (Math-messy-integerp n) @@ -944,8 +890,7 @@ (calc-record-why "Number too big to factor" n) (list 'calcFunc-moebius n)))) (calc-record-why 'posintp n) - (list 'calcFunc-moebius n)) -) + (list 'calcFunc-moebius n))) (defun calcFunc-nextprime (n &optional iters) @@ -966,8 +911,7 @@ n)) (if (Math-realp n) (calcFunc-nextprime (math-trunc n) iters) - (math-reject-arg n 'integerp))) -) + (math-reject-arg n 'integerp)))) (setq calc-verbose-nextprime nil) (defun calcFunc-prevprime (n &optional iters) @@ -986,8 +930,7 @@ n) (if (Math-realp n) (calcFunc-prevprime (math-ceiling n) iters) - (math-reject-arg n 'integerp))) -) + (math-reject-arg n 'integerp)))) (defun math-next-small-prime (n) (if (and (integerp n) (> n 2)) @@ -1000,8 +943,7 @@ (setq lo mid) (setq hi mid))) (aref math-primes-table hi)) - 2) -) + 2)) (defconst math-primes-table [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 @@ -1052,5 +994,4 @@ 4987 4993 4999 5003]) - - +;;; calc-comb.el ends here
--- a/lisp/calc/calc-cplx.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-cplx.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-cplx.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -32,20 +32,17 @@ (defun calc-argument (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "arg" 'calcFunc-arg arg)) -) + (calc-unary-op "arg" 'calcFunc-arg arg))) (defun calc-re (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "re" 'calcFunc-re arg)) -) + (calc-unary-op "re" 'calcFunc-re arg))) (defun calc-im (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "im" 'calcFunc-im arg)) -) + (calc-unary-op "im" 'calcFunc-im arg))) (defun calc-polar () @@ -55,8 +52,7 @@ (if (or (calc-is-inverse) (eq (car-safe arg) 'polar)) (calc-enter-result 1 "p-r" (list 'calcFunc-rect arg)) - (calc-enter-result 1 "r-p" (list 'calcFunc-polar arg))))) -) + (calc-enter-result 1 "r-p" (list 'calcFunc-polar arg)))))) @@ -65,22 +61,19 @@ (interactive) (calc-wrapper (calc-change-mode 'calc-complex-format nil t) - (message "Displaying complex numbers in (X,Y) format.")) -) + (message "Displaying complex numbers in (X,Y) format."))) (defun calc-i-notation () (interactive) (calc-wrapper (calc-change-mode 'calc-complex-format 'i t) - (message "Displaying complex numbers in X+Yi format.")) -) + (message "Displaying complex numbers in X+Yi format."))) (defun calc-j-notation () (interactive) (calc-wrapper (calc-change-mode 'calc-complex-format 'j t) - (message "Displaying complex numbers in X+Yj format.")) -) + (message "Displaying complex numbers in X+Yj format."))) (defun calc-polar-mode (n) @@ -93,8 +86,7 @@ (calc-change-mode 'calc-complex-mode 'polar) (message "Preferred complex form is polar.")) (calc-change-mode 'calc-complex-mode 'cplx) - (message "Preferred complex form is rectangular."))) -) + (message "Preferred complex form is rectangular.")))) ;;;; Complex numbers. @@ -113,8 +105,7 @@ ((math-negp r) (math-neg (list 'polar (math-neg r) th))) (t - (list 'polar r th)))) -) + (list 'polar r th))))) ;;; Coerce A to be complex (rectangular form). [c N] @@ -127,8 +118,7 @@ (list 'cplx (math-mul (nth 1 a) (nth 1 sc)) (math-mul (nth 1 a) (nth 2 sc)))))) - (t (list 'cplx a 0))) -) + (t (list 'cplx a 0)))) ;;; Coerce A to be complex (polar form). [c N] (defun math-polar (a) @@ -137,8 +127,7 @@ (t (list 'polar (math-abs a) - (calcFunc-arg a)))) -) + (calcFunc-arg a))))) ;;; Multiply A by the imaginary constant i. [N N] [Public] (defun math-imaginary (a) @@ -150,8 +139,7 @@ (eq calc-complex-mode 'polar))) (list 'polar 1 (math-quarter-circle nil)) '(cplx 0 1))) - (math-mul a '(var i var-i))) -) + (math-mul a '(var i var-i)))) @@ -169,8 +157,7 @@ t) ((eq (car-safe b) 'cplx) nil) - (t (eq calc-complex-mode 'polar))) -) + (t (eq calc-complex-mode 'polar)))) ;;; Force A to be in the (-pi,pi] or (-180,180] range. (defun math-fix-circular (a &optional dir) ; [R R] @@ -194,8 +181,7 @@ ((or (Math-lessp '(float -18 1) a) (eq dir -1)) a) (t - (math-fix-circular (math-add a '(float 36 1)) 1))))) -) + (math-fix-circular (math-add a '(float 36 1)) 1)))))) ;;;; Complex numbers. @@ -206,8 +192,7 @@ ((Math-realp a) a) ((Math-numberp a) (math-normalize (math-polar a))) - (t (list 'calcFunc-polar a))) -) + (t (list 'calcFunc-polar a)))) (defun calcFunc-rect (a) ; [N N] [Public] (cond ((Math-vectorp a) @@ -215,8 +200,7 @@ ((Math-realp a) a) ((Math-numberp a) (math-normalize (math-complex a))) - (t (list 'calcFunc-rect a))) -) + (t (list 'calcFunc-rect a)))) ;;; Compute the complex conjugate of A. [O O] [Public] (defun calcFunc-conj (a) @@ -255,8 +239,7 @@ (and inf (math-mul (calcFunc-conj (math-infinite-dir a inf)) inf)))) (t (calc-record-why 'numberp a) - (list 'calcFunc-conj a)))) -) + (list 'calcFunc-conj a))))) ;;; Compute the complex argument of A. [F N] [Public] @@ -284,8 +267,7 @@ '(var nan var-nan) (calcFunc-arg (math-infinite-dir a)))) (t (calc-record-why 'numvecp a) - (list 'calcFunc-arg a))) -) + (list 'calcFunc-arg a)))) (defun math-imaginary-i () (let ((val (calc-var-value 'var-i))) @@ -293,8 +275,7 @@ (equal val '(cplx 0 1)) (and (eq (car-safe val) 'polar) (eq (nth 1 val) 0) - (Math-equal (nth 1 val) (math-quarter-circle nil))))) -) + (Math-equal (nth 1 val) (math-quarter-circle nil)))))) ;;; Extract the real or complex part of a complex number. [R N] [Public] ;;; Also extracts the real part of a modulo form. @@ -332,8 +313,7 @@ ((eq (car a) 'neg) (math-neg (calcFunc-re (nth 1 a)))) (t (calc-record-why 'numberp a) - (list 'calcFunc-re a)))) -) + (list 'calcFunc-re a))))) (defun calcFunc-im (a) (let (aa bb) @@ -370,8 +350,6 @@ ((eq (car a) 'neg) (math-neg (calcFunc-im (nth 1 a)))) (t (calc-record-why 'numberp a) - (list 'calcFunc-im a)))) -) + (list 'calcFunc-im a))))) - - +;;; calc-cplx.el ends here
--- a/lisp/calc/calc-embed.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-embed.el Wed Nov 14 09:09:09 2001 +0000 @@ -35,8 +35,7 @@ (calc-set-command-flag 'renum-stack) (message (if (calc-change-mode 'calc-show-plain n nil t) "Including \"plain\" formulas in Calc Embedded mode." - "Omitting \"plain\" formulas in Calc Embedded mode."))) -) + "Omitting \"plain\" formulas in Calc Embedded mode.")))) @@ -251,8 +250,7 @@ (if calc-embedded-quiet "Type `M-# x'" "Give this command again"))))) - (scroll-down 0) ; fix a bug which occurs when truncate-lines is changed. -) + (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed. (setq calc-embedded-quiet nil) @@ -267,8 +265,7 @@ (and (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto) (eq (car-safe (nth 1 (aref calc-embedded-info 8))) 'calcFunc-assign))) - (calc-select-part 2)) -) + (calc-select-part 2))) (defun calc-embedded-update-formula (arg) @@ -294,8 +291,7 @@ (progn (save-excursion (calc-embedded-update info 14 'eval t)) - (goto-char (+ (aref info 4) pt))))))) -) + (goto-char (+ (aref info 4) pt)))))))) (defun calc-embedded-edit (arg) @@ -311,8 +307,7 @@ (math-format-nice-expr (aref info 8) (frame-width)))) (calc-edit-mode (list 'calc-embedded-finish-edit info)) (insert str "\n"))) - (calc-show-edit-buffer) -) + (calc-show-edit-buffer)) (defun calc-embedded-finish-edit (info) (let ((buf (current-buffer)) @@ -332,8 +327,7 @@ (error (nth 2 val)))) (calc-embedded-original-buffer t info) (aset info 8 val) - (calc-embedded-update info 14 t t))) -) + (calc-embedded-update info 14 t t)))) (defun calc-do-embedded-activate (arg cbuf) (calc-plain-buffer-only) @@ -362,13 +356,11 @@ (or (eq (car-safe (aref info 8)) 'error) (goto-char (aref info 5)))))) (message "Activating %s for Calc Embedded mode...done" (buffer-name))) - (calc-embedded-active-state t) -) + (calc-embedded-active-state t)) (defun calc-plain-buffer-only () (if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode)) - (error "This command should be used in a normal editing buffer")) -) + (error "This command should be used in a normal editing buffer"))) (defun calc-embedded-active-state (state) (or (assq 'calc-embedded-all-active minor-mode-alist) @@ -382,8 +374,7 @@ (and (eq state 'more) calc-embedded-all-active (setq state t)) (setq calc-embedded-all-active (eq state t) calc-embedded-some-active (not (memq state '(nil t)))) - (set-buffer-modified-p (buffer-modified-p)) -) + (set-buffer-modified-p (buffer-modified-p))) (defun calc-embedded-original-buffer (switch &optional info) @@ -392,13 +383,11 @@ (progn (error "Calc embedded mode: Original buffer has been killed"))) (if switch - (set-buffer (aref info 0))) -) + (set-buffer (aref info 0)))) (defun calc-embedded-word () (interactive) - (calc-embedded '(4)) -) + (calc-embedded '(4))) (defun calc-embedded-mark-formula (&optional body-only) "Put point at the beginning of this Calc formula, mark at the end. @@ -411,8 +400,7 @@ (save-excursion (calc-embedded-find-bounds body-only)) (push-mark (if body-only bot outer-bot) t) - (goto-char (if body-only top outer-top))) -) + (goto-char (if body-only top outer-top)))) (defun calc-embedded-find-bounds (&optional plain) ;; (while (and (bolp) (eq (following-char) ?\n)) @@ -453,8 +441,7 @@ (or (eolp) (while (eq (preceding-char) ?\ ) (backward-char 1))) - (setq bot (point))) -) + (setq bot (point)))) (defun calc-embedded-kill-formula () "Kill the formula surrounding point. @@ -466,8 +453,7 @@ (calc-embedded nil)) (calc-embedded-mark-formula) (kill-region (point) (mark)) - (pop-mark) -) + (pop-mark)) (defun calc-embedded-copy-formula-as-kill () "Save the formula surrounding point as if killed, but don't kill it." @@ -475,8 +461,7 @@ (save-excursion (calc-embedded-mark-formula) (copy-region-as-kill (point) (mark)) - (pop-mark)) -) + (pop-mark))) (defun calc-embedded-duplicate () (interactive) @@ -499,8 +484,7 @@ (calc-embedded (+ new-top (- top outer-top)) (+ new-top (- bot outer-top)) new-top - (+ new-top (- outer-bot outer-top))))) -) + (+ new-top (- outer-bot outer-top)))))) (defun calc-embedded-next (arg) (interactive "P") @@ -527,13 +511,11 @@ (setq p (cdr p))) (while (> (setq arg (1- arg)) 0) (setq p (if p (cdr p) (cdr active)))) - (goto-char (aref (car (or p active)) 2))))) -) + (goto-char (aref (car (or p active)) 2)))))) (defun calc-embedded-previous (arg) (interactive "p") - (calc-embedded-next (- (prefix-numeric-value arg))) -) + (calc-embedded-next (- (prefix-numeric-value arg)))) (defun calc-embedded-new-formula () (interactive) @@ -560,15 +542,13 @@ (setq outer-bot (point)) (goto-char top) (let ((calc-embedded-quiet 'x)) - (calc-embedded top bot outer-top outer-bot))) -) + (calc-embedded top bot outer-top outer-bot)))) (defun calc-embedded-forget () (interactive) (setq calc-embedded-active (delq (assq (current-buffer) calc-embedded-active) calc-embedded-active)) - (calc-embedded-active-state nil) -) + (calc-embedded-active-state nil)) (defun calc-embedded-set-modes (gmodes modes local-modes &optional temp) @@ -630,14 +610,12 @@ (car calc-float-format)) 0)) (calc-refresh))) - changed) -) + changed)) (defun calc-embedded-language () (if calc-language-option (list calc-language calc-language-option) - calc-language) -) + calc-language)) (defun calc-embedded-set-language (lang) (let ((option nil)) @@ -646,22 +624,19 @@ lang (car lang))) (or (and (eq lang calc-language) (equal option calc-language-option)) - (calc-set-language lang option t))) -) + (calc-set-language lang option t)))) (defun calc-embedded-justify () (if calc-display-origin (list calc-display-just calc-display-origin) - calc-display-just) -) + calc-display-just)) (defun calc-embedded-set-justify (just) (if (consp just) (setq calc-display-origin (nth 1 just) calc-display-just (car just)) (setq calc-display-just just - calc-display-origin nil)) -) + calc-display-origin nil))) (defun calc-find-globals () @@ -686,8 +661,7 @@ (match-end 2))))) modes))))) (setq calc-embedded-globals (cons t modes)) - (goto-char save-pt)) -) + (goto-char save-pt))) (defun calc-embedded-find-modes () (let ((case-fold-search nil) @@ -736,8 +710,7 @@ (setq no-defaults nil))) (backward-char 6)) (goto-char save-pt) - (list modes emodes pmodes)) -) + (list modes emodes pmodes))) (defun calc-embedded-make-info (point cbuf fresh &optional @@ -851,8 +824,7 @@ (progn (setcdr found (cons info (cdr found))) (calc-embedded-active-state 'more))) - info) -) + info)) (defun calc-embedded-find-vars (x) (cond ((Math-primp x) @@ -870,8 +842,7 @@ (not (assoc x vars-used)) (setq vars-used (cons (list x) vars-used))) (while (setq x (cdr x)) - (calc-embedded-find-vars (car x))))) -) + (calc-embedded-find-vars (car x)))))) (defun calc-embedded-evaluate-expr (x) @@ -891,8 +862,7 @@ (calc-embedded-eval-get-var (car (car vars-used)) active) (setq vars-used (cdr vars-used)))) (calc-embedded-subst x)) - (calc-normalize (math-evaluate-expr-rec x)))) -) + (calc-normalize (math-evaluate-expr-rec x))))) (defun calc-embedded-subst (x) (if (and (eq (car-safe x) 'calcFunc-evalto) (cdr x)) @@ -904,8 +874,7 @@ (list 'calcFunc-assign (nth 1 x) (calc-embedded-subst (nth 2 x))) - (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x))))) -) + (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x)))))) (defun calc-embedded-eval-get-var (var base) (let ((entry base) @@ -934,8 +903,7 @@ (setq val (nth 2 val))) (setq args (cons (cons var val) args))) (calc-embedded-activate) - (calc-embedded-eval-get-var var base))))) -) + (calc-embedded-eval-get-var var base)))))) (defun calc-embedded-update (info which need-eval need-display @@ -1027,8 +995,7 @@ (calc-embedded-set-justify (cdr (car prev-modes))))) (t (set (car (car prev-modes)) (cdr (car prev-modes))))) - (setq prev-modes (cdr prev-modes))))) -) + (setq prev-modes (cdr prev-modes)))))) @@ -1063,8 +1030,7 @@ (forward-line vert)) (forward-char (min horiz (- (point-max) (point))))) - (calc-select-buffer)) -) + (calc-select-buffer))) (setq calc-embedded-no-reselect nil) (defun calc-embedded-finish-command () @@ -1095,8 +1061,7 @@ (if (> vert 0) (forward-line vert)) (forward-char (max horiz 0)) - (set-buffer buf)))) -) + (set-buffer buf))))) (defun calc-embedded-stack-change () (or calc-executing-macro @@ -1128,16 +1093,14 @@ pos (1+ pos)))))) (calc-embedded-original-buffer t) (aset info 8 (car entry)) - (calc-embedded-update info 13 nil t str entry old-val)))) -) + (calc-embedded-update info 13 nil t str entry old-val))))) (defun calc-embedded-mode-line-change () (let ((str mode-line-buffer-identification)) (save-excursion (calc-embedded-original-buffer t) (setq mode-line-buffer-identification str) - (set-buffer-modified-p (buffer-modified-p)))) -) + (set-buffer-modified-p (buffer-modified-p))))) (defun calc-embedded-modes-change (vars) (if (eq (car vars) 'calc-language) (setq vars '(the-language))) @@ -1203,8 +1166,7 @@ (prin1-to-string (car values)) "]" calc-embedded-close-mode)))) (setq vars (cdr vars) - values (cdr values))))))) -) + values (cdr values)))))))) (defun calc-embedded-var-change (var &optional buf) (if (symbolp var) @@ -1247,10 +1209,9 @@ "(Tried to recompute but formula was changed or missing.)")))) (setq p (cdr p)))) (setq bp (if buf nil (cdr bp)))) - (or first calc-embedded-quiet (message "")))) -) + (or first calc-embedded-quiet (message ""))))) + +;;; calc-embed.el ends here - -
--- a/lisp/calc/calc-fin.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-fin.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-fin.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -38,16 +38,14 @@ (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3))) (if (calc-is-inverse) (calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3))) - (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3)))))) -) + (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3))))))) (defun calc-fin-npv (arg) (interactive "p") (calc-slow-wrapper (if (calc-is-inverse) (calc-vector-op "npvb" 'calcFunc-npvb (1+ arg)) - (calc-vector-op "npv" 'calcFunc-npv (1+ arg)))) -) + (calc-vector-op "npv" 'calcFunc-npv (1+ arg))))) (defun calc-fin-fv () (interactive) @@ -56,8 +54,7 @@ (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) (if (calc-is-inverse) (calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3))) - (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3)))))) -) + (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3))))))) (defun calc-fin-pmt () (interactive) @@ -66,8 +63,7 @@ (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) (if (calc-is-inverse) (calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3))) - (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3)))))) -) + (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3))))))) (defun calc-fin-nper () (interactive) @@ -78,8 +74,7 @@ (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb (calc-top-list-n 3))) (calc-enter-result 3 "nper" (cons 'calcFunc-nper - (calc-top-list-n 3)))))) -) + (calc-top-list-n 3))))))) (defun calc-fin-rate () (interactive) @@ -92,34 +87,29 @@ (cons (if (calc-is-hyperbolic) 'calcFunc-ratel (if (calc-is-hyperbolic) 'calcFunc-rateb 'calcFunc-rate)) - (calc-top-list-n 3)))))) -) + (calc-top-list-n 3))))))) (defun calc-fin-irr (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (calc-vector-op "irrb" 'calcFunc-irrb arg) - (calc-vector-op "irr" 'calcFunc-irr arg))) -) + (calc-vector-op "irr" 'calcFunc-irr arg)))) (defun calc-fin-sln () (interactive) (calc-slow-wrapper - (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3)))) -) + (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3))))) (defun calc-fin-syd () (interactive) (calc-slow-wrapper - (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4)))) -) + (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4))))) (defun calc-fin-ddb () (interactive) (calc-slow-wrapper - (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4)))) -) + (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4))))) (defun calc-to-percentage (x) @@ -130,24 +120,18 @@ (list 'calcFunc-percent x)) ((Math-vectorp x) (cons 'vec (mapcar 'calc-to-percentage (cdr x)))) - (t x)) -) + (t x))) (defun calc-convert-percent () (interactive) (calc-slow-wrapper - (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1)))) -) + (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1))))) (defun calc-percent-change () (interactive) (calc-slow-wrapper (let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2))))) - (calc-pop-push-record 2 "%ch" (calc-to-percentage res)))) -) - - - + (calc-pop-push-record 2 "%ch" (calc-to-percentage res))))) ;;; Financial functions. @@ -159,13 +143,11 @@ (math-add (math-mul amount (math-div (math-sub 1 (math-div 1 p)) rate)) - (math-div (or lump 0) p)))) -) + (math-div (or lump 0) p))))) (put 'calcFunc-pv 'math-expandable t) (defun calcFunc-pvl (rate num amount) - (calcFunc-pv rate num 0 amount) -) + (calcFunc-pv rate num 0 amount)) (put 'calcFunc-pvl 'math-expandable t) (defun calcFunc-pvb (rate num amount &optional lump) @@ -176,8 +158,7 @@ (math-div (math-mul (math-sub 1 (math-div 1 p)) (math-add 1 rate)) rate)) - (math-div (or lump 0) p)))) -) + (math-div (or lump 0) p))))) (put 'calcFunc-pvb 'math-expandable t) (defun calcFunc-npv (rate &rest flows) @@ -190,8 +171,7 @@ (while (setq flat (cdr flat)) (setq accum (math-add accum (math-div (car flat) p)) p (math-mul p pp))) - accum)) -) + accum))) (put 'calcFunc-npv 'math-expandable t) (defun calcFunc-npvb (rate &rest flows) @@ -204,8 +184,7 @@ (while (setq flat (cdr flat)) (setq accum (math-add accum (math-div (car flat) p)) p (math-mul p pp))) - accum)) -) + accum))) (put 'calcFunc-npvb 'math-expandable t) (defun calcFunc-fv (rate num amount &optional initial) @@ -215,13 +194,11 @@ (math-add (math-mul amount (math-div (math-sub p 1) rate)) - (math-mul (or initial 0) p)))) -) + (math-mul (or initial 0) p))))) (put 'calcFunc-fv 'math-expandable t) (defun calcFunc-fvl (rate num amount) - (calcFunc-fv rate num 0 amount) -) + (calcFunc-fv rate num 0 amount)) (put 'calcFunc-fvl 'math-expandable t) (defun calcFunc-fvb (rate num amount &optional initial) @@ -232,8 +209,7 @@ (math-div (math-mul (math-sub p 1) (math-add 1 rate)) rate)) - (math-mul (or initial 0) p)))) -) + (math-mul (or initial 0) p))))) (put 'calcFunc-fvb 'math-expandable t) (defun calcFunc-pmt (rate num amount &optional lump) @@ -243,8 +219,7 @@ (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate) - (math-sub 1 (math-div 1 p))))) -) + (math-sub 1 (math-div 1 p)))))) (put 'calcFunc-pmt 'math-expandable t) (defun calcFunc-pmtb (rate num amount &optional lump) @@ -253,23 +228,19 @@ (let ((p (math-pow (math-add 1 rate) num))) (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate) (math-mul (math-sub 1 (math-div 1 p)) - (math-add 1 rate))))) -) + (math-add 1 rate)))))) (put 'calcFunc-pmtb 'math-expandable t) (defun calcFunc-nper (rate pmt amount &optional lump) - (math-compute-nper rate pmt amount lump nil) -) + (math-compute-nper rate pmt amount lump nil)) (put 'calcFunc-nper 'math-expandable t) (defun calcFunc-nperb (rate pmt amount &optional lump) - (math-compute-nper rate pmt amount lump 'b) -) + (math-compute-nper rate pmt amount lump 'b)) (put 'calcFunc-nperb 'math-expandable t) (defun calcFunc-nperl (rate pmt amount) - (math-compute-nper rate pmt amount nil 'l) -) + (math-compute-nper rate pmt amount nil 'l)) (put 'calcFunc-nperl 'math-expandable t) (defun math-compute-nper (rate pmt amount lump bflag) @@ -315,16 +286,13 @@ pmt)))))) (if (or (math-posp temp) math-expand-formulas) (math-neg (calcFunc-log temp (math-add 1 rate))) - (math-reject-arg pmt "*Payment too small to cover interest rate"))))) -) + (math-reject-arg pmt "*Payment too small to cover interest rate")))))) (defun calcFunc-rate (num pmt amount &optional lump) - (math-compute-rate num pmt amount lump 'calcFunc-pv) -) + (math-compute-rate num pmt amount lump 'calcFunc-pv)) (defun calcFunc-rateb (num pmt amount &optional lump) - (math-compute-rate num pmt amount lump 'calcFunc-pvb) -) + (math-compute-rate num pmt amount lump 'calcFunc-pvb)) (defun math-compute-rate (num pmt amount lump func) (or (math-objectp num) @@ -348,8 +316,7 @@ t))) (if (math-vectorp root) (nth 1 root) - root)) -) + root))) (defun calcFunc-ratel (num pmt amount) (or (math-objectp num) math-expand-formulas @@ -359,16 +326,13 @@ (or (math-objectp amount) math-expand-formulas (math-reject-arg amount 'numberp)) (math-with-extra-prec 2 - (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1)) -) + (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1))) (defun calcFunc-irr (&rest vecs) - (math-compute-irr vecs 'calcFunc-npv) -) + (math-compute-irr vecs 'calcFunc-npv)) (defun calcFunc-irrb (&rest vecs) - (math-compute-irr vecs 'calcFunc-npvb) -) + (math-compute-irr vecs 'calcFunc-npvb)) (defun math-compute-irr (vecs func) (let* ((flat (math-flatten-many-vecs vecs)) @@ -380,8 +344,7 @@ t))) (if (math-vectorp root) (nth 1 root) - root)) -) + root))) (defun math-check-financial (rate num) (or (math-objectp rate) math-expand-formulas @@ -389,8 +352,7 @@ (and (math-zerop rate) (math-reject-arg rate 'nonzerop)) (or (math-objectp num) math-expand-formulas - (math-reject-arg num 'numberp)) -) + (math-reject-arg num 'numberp))) (defun calcFunc-sln (cost salvage life &optional period) @@ -406,8 +368,7 @@ (or (Math-lessp life period) (not (math-posp period))) (math-reject-arg period 'integerp))) 0 - (math-div (math-sub cost salvage) life)) -) + (math-div (math-sub cost salvage) life))) (put 'calcFunc-sln 'math-expandable t) (defun calcFunc-syd (cost salvage life period) @@ -424,8 +385,7 @@ 0 (math-div (math-mul (math-sub cost salvage) (math-add (math-sub life period) 1)) - (math-div (math-mul life (math-add life 1)) 2))) -) + (math-div (math-mul life (math-add life 1)) 2)))) (put 'calcFunc-syd 'math-expandable t) (defun calcFunc-ddb (cost salvage life period) @@ -445,8 +405,6 @@ (if (Math-lessp book salvage) (setq res (math-add res (math-sub book salvage)) book salvage))) - res)) -) + res))) - - +;;; calc-fin.el ends here
--- a/lisp/calc/calc-forms.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-forms.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-forms.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -39,11 +39,7 @@ (string-to-int (substring time 11 13)) (string-to-int (substring time 14 16)) (string-to-int (substring time 17 19))) - (list 'hms 24 0 0))))) -) - - - + (list 'hms 24 0 0)))))) (defun calc-to-hms (arg) (interactive "P") @@ -52,14 +48,12 @@ (if (eq calc-angle-mode 'rad) (calc-unary-op ">rad" 'calcFunc-rad arg) (calc-unary-op ">deg" 'calcFunc-deg arg)) - (calc-unary-op ">hms" 'calcFunc-hms arg))) -) + (calc-unary-op ">hms" 'calcFunc-hms arg)))) (defun calc-from-hms (arg) (interactive "P") (calc-invert-func) - (calc-to-hms arg) -) + (calc-to-hms arg)) (defun calc-hms-notation (fmt) @@ -75,8 +69,7 @@ "%s" (math-match-substring fmt 5)) t) (setq-default calc-hms-format calc-hms-format)) ; for minibuffer - (error "Bad hours-minutes-seconds format."))) -) + (error "Bad hours-minutes-seconds format.")))) (defun calc-date-notation (fmt arg) (interactive "sDate format (e.g., M/D/YY h:mm:ss): \nP") @@ -154,22 +147,19 @@ (and lfmt (if time (setq fullfmt (cons (nreverse lfmt) fullfmt)) (setq fullfmt (nconc lfmt fullfmt)))) - (calc-change-mode 'calc-date-format (nreverse fullfmt) t))) -) + (calc-change-mode 'calc-date-format (nreverse fullfmt) t)))) (defun calc-hms-mode () (interactive) (calc-wrapper (calc-change-mode 'calc-angle-mode 'hms) - (message "Angles measured in degrees-minutes-seconds.")) -) + (message "Angles measured in degrees-minutes-seconds."))) (defun calc-now (arg) (interactive "P") - (calc-date-zero-args "now" 'calcFunc-now arg) -) + (calc-date-zero-args "now" 'calcFunc-now arg)) (defun calc-date-part (arg) (interactive "NPart code (1-9 = Y,M,D,H,M,S,Wd,Yd,Hms): ") @@ -184,31 +174,26 @@ calcFunc-minute calcFunc-second calcFunc-weekday calcFunc-yearday calcFunc-time)) - (calc-top-n 1)))) -) + (calc-top-n 1))))) (defun calc-date (arg) (interactive "p") (if (or (< arg 1) (> arg 6)) (error "Between one and six arguments are allowed")) (calc-wrapper - (calc-enter-result arg "date" (cons 'calcFunc-date (calc-top-list-n arg)))) -) + (calc-enter-result arg "date" (cons 'calcFunc-date (calc-top-list-n arg))))) (defun calc-julian (arg) (interactive "P") - (calc-date-one-arg "juln" 'calcFunc-julian arg) -) + (calc-date-one-arg "juln" 'calcFunc-julian arg)) (defun calc-unix-time (arg) (interactive "P") - (calc-date-one-arg "unix" 'calcFunc-unixtime arg) -) + (calc-date-one-arg "unix" 'calcFunc-unixtime arg)) (defun calc-time-zone (arg) (interactive "P") - (calc-date-zero-args "zone" 'calcFunc-tzone arg) -) + (calc-date-zero-args "zone" 'calcFunc-tzone arg)) (defun calc-convert-time-zones (old &optional new) (interactive "sFrom time zone: ") @@ -227,40 +212,33 @@ (if (eq (car-safe new) 'error) (error "Error in expression: " (nth 1 new))) (calc-enter-result 1 "tzcv" (list 'calcFunc-tzconv - (calc-top-n 1) old new)))) -) + (calc-top-n 1) old new))))) (defun calc-new-week (arg) (interactive "P") - (calc-date-one-arg "nwwk" 'calcFunc-newweek arg) -) + (calc-date-one-arg "nwwk" 'calcFunc-newweek arg)) (defun calc-new-month (arg) (interactive "P") - (calc-date-one-arg "nwmn" 'calcFunc-newmonth arg) -) + (calc-date-one-arg "nwmn" 'calcFunc-newmonth arg)) (defun calc-new-year (arg) (interactive "P") - (calc-date-one-arg "nwyr" 'calcFunc-newyear arg) -) + (calc-date-one-arg "nwyr" 'calcFunc-newyear arg)) (defun calc-inc-month (arg) (interactive "p") - (calc-date-one-arg "incm" 'calcFunc-incmonth arg) -) + (calc-date-one-arg "incm" 'calcFunc-incmonth arg)) (defun calc-business-days-plus (arg) (interactive "P") (calc-wrapper - (calc-binary-op "bus+" 'calcFunc-badd arg)) -) + (calc-binary-op "bus+" 'calcFunc-badd arg))) (defun calc-business-days-minus (arg) (interactive "P") (calc-wrapper - (calc-binary-op "bus-" 'calcFunc-bsub arg)) -) + (calc-binary-op "bus-" 'calcFunc-bsub arg))) (defun calc-date-zero-args (prefix func arg) (calc-wrapper @@ -268,8 +246,7 @@ (calc-enter-result 1 prefix (list func (calc-top-n 1))) (calc-enter-result 0 prefix (if arg (list func (prefix-numeric-value arg)) - (list func))))) -) + (list func)))))) (defun calc-date-one-arg (prefix func arg) (calc-wrapper @@ -278,14 +255,7 @@ (calc-enter-result 1 prefix (if arg (list func (calc-top-n 1) (prefix-numeric-value arg)) - (list func (calc-top-n 1)))))) -) - - - - - - + (list func (calc-top-n 1))))))) ;;;; Hours-minutes-seconds forms. @@ -325,8 +295,7 @@ (<= (+ (math-numdigs (nth 1 s)) (nth 2 s)) (- 2 calc-internal-prec))) (setq s 0)) - (list 'hms h m s)) -) + (list 'hms h m s))) ;;; Convert A from ANG or current angular mode to HMS format. (defun math-to-hms (a &optional ang) ; [X R] [Public] @@ -351,8 +320,7 @@ (list 'hms (car hmd) (cdr hmd) - (math-sub b (math-mul hm 60))))))) -) + (math-sub b (math-mul hm 60)))))))) (defun calcFunc-hms (h &optional m s) (or (Math-realp h) (math-reject-arg h 'realp)) (or m (setq m 0)) @@ -366,8 +334,7 @@ (math-to-hms (math-add h (math-add (math-div (or m 0) 60) (math-div (or s 0) 3600))) - 'deg)) -) + 'deg))) ;;; Convert A from HMS format to ANG or current angular mode. (defun math-from-hms (a &optional ang) ; [R X] [Public] @@ -389,10 +356,7 @@ '(float 6 1)) (nth 2 a)) 60) - (nth 1 a)))) -) - - + (nth 1 a))))) ;;;; Date forms. @@ -442,8 +406,7 @@ (list year month day (/ time 3600) (% (/ time 60) 60) - (math-add (% time 60) (nth 2 parts))))) -) + (math-add (% time 60) (nth 2 parts)))))) (defun math-dt-to-date (dt) (or (integerp (nth 1 dt)) @@ -461,8 +424,7 @@ (* (nth 4 dt) 60)) (nth 5 dt)) '(float 864 2))) - date)) -) + date))) (defun math-date-parts (value &optional offset) (let* ((date (math-floor value)) @@ -472,13 +434,11 @@ (ftime (math-floor time))) (list date ftime - (math-sub time ftime))) -) + (math-sub time ftime)))) (defun math-this-year () - (string-to-int (substring (current-time-string) -4)) -) + (string-to-int (substring (current-time-string) -4))) (defun math-leap-year-p (year) (if (Math-lessp year 1752) @@ -487,14 +447,12 @@ (= (math-imod year 4) 0)) (setq year (math-imod year 400)) (or (and (= (% year 4) 0) (/= (% year 100) 0)) - (= year 0))) -) + (= year 0)))) (defun math-days-in-month (year month) (if (and (= month 2) (math-leap-year-p year)) 29 - (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))) -) + (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) (defun math-day-number (year month day) (let ((day-of-year (+ day (* 31 (1- month))))) @@ -507,8 +465,7 @@ (or (> month 9) (and (= month 9) (>= day 14))) (setq day-of-year (- day-of-year 11))) - day-of-year) -) + day-of-year)) (defun math-absolute-from-date (year month day) (if (eq year 0) (setq year -1)) @@ -528,8 +485,7 @@ (math-add (if (= (cdr res) 0) -1 0) - (car res))))))) -) + (car res)))))))) ;;; It is safe to redefine these in your .emacs file to use a different @@ -564,8 +520,7 @@ math-format-date-cache)) (and (setq dt (nthcdr 10 math-format-date-cache)) (setcdr dt nil)) - fmt))) -) + fmt)))) (setq math-format-date-cache nil) (defun math-format-date-part (x) @@ -731,8 +686,7 @@ (let ((calc-float-format (list 'fix (min (- 12 calc-internal-prec) 0)))) - (math-format-number second))))))) -) + (math-format-number second)))))))) (defun math-parse-date (str) @@ -880,8 +834,7 @@ (setq year (math-neg (math-abs year)))) (math-parse-date-validate year bigyear month day - hour minute second)))) -) + hour minute second))))) (defun math-parse-date-validate (year bigyear month day hour minute second) (and (not bigyear) (natnump year) (< year 100) @@ -901,8 +854,7 @@ (if (or (math-negp second) (not (Math-lessp second 60))) (throw 'syntax "Seconds value is out of range")))) (list 'date (math-dt-to-date (append (list year month day) - (and hour (list hour minute second))))) -) + (and hour (list hour minute second)))))) (defun math-parse-date-word (names &optional front) (let ((n 1)) @@ -918,8 +870,7 @@ (setq str (concat (substring str 0 (match-beginning 0)) (if front "" " ") (substring str (match-end 0)))) - n))) -) + n)))) (defun math-parse-standard-date (str with-time) (let ((case-fold-search t) @@ -1077,8 +1028,7 @@ hour minute second)) (if yearday (setq day (math-add day (1- yearday)))) - day)))) -) + day))))) (defun calcFunc-now (&optional zone) @@ -1091,58 +1041,48 @@ '(float 864 2))) date) (calc-record-why "*Unable to interpret current date from system") - (append (list 'calcFunc-now) (and zone (list zone))))) -) + (append (list 'calcFunc-now) (and zone (list zone)))))) (defun calcFunc-year (date) - (car (math-date-to-dt date)) -) + (car (math-date-to-dt date))) (defun calcFunc-month (date) - (nth 1 (math-date-to-dt date)) -) + (nth 1 (math-date-to-dt date))) (defun calcFunc-day (date) - (nth 2 (math-date-to-dt date)) -) + (nth 2 (math-date-to-dt date))) (defun calcFunc-weekday (date) (if (eq (car-safe date) 'date) (setq date (nth 1 date))) (or (math-realp date) (math-reject-arg date 'datep)) - (math-mod (math-add (math-floor date) 6) 7) -) + (math-mod (math-add (math-floor date) 6) 7)) (defun calcFunc-yearday (date) (let ((dt (math-date-to-dt date))) - (math-day-number (car dt) (nth 1 dt) (nth 2 dt))) -) + (math-day-number (car dt) (nth 1 dt) (nth 2 dt)))) (defun calcFunc-hour (date) (if (eq (car-safe date) 'hms) (nth 1 date) - (or (nth 3 (math-date-to-dt date)) 0)) -) + (or (nth 3 (math-date-to-dt date)) 0))) (defun calcFunc-minute (date) (if (eq (car-safe date) 'hms) (nth 2 date) - (or (nth 4 (math-date-to-dt date)) 0)) -) + (or (nth 4 (math-date-to-dt date)) 0))) (defun calcFunc-second (date) (if (eq (car-safe date) 'hms) (nth 3 date) - (or (nth 5 (math-date-to-dt date)) 0)) -) + (or (nth 5 (math-date-to-dt date)) 0))) (defun calcFunc-time (date) (let ((dt (math-date-to-dt date))) (if (nth 3 dt) (cons 'hms (nthcdr 3 dt)) - (list 'hms 0 0 0))) -) + (list 'hms 0 0 0)))) (defun calcFunc-date (date &optional month day hour minute second) (and (math-messy-integerp month) (setq month (math-trunc month))) @@ -1174,8 +1114,7 @@ (list 'date date) (if (eq (car date) 'date) (nth 1 date) - (math-reject-arg date 'datep)))) -) + (math-reject-arg date 'datep))))) (defun calcFunc-julian (date &optional zone) (if (math-realp date) @@ -1190,8 +1129,7 @@ (math-add '(float (bigpos 235 214 17) -1) (math-div (calcFunc-tzone zone date) '(float 864 2))))) - (math-reject-arg date 'datep))) -) + (math-reject-arg date 'datep)))) (defun calcFunc-unixtime (date &optional zone) (if (math-realp date) @@ -1202,8 +1140,7 @@ (if (eq (car date) 'date) (math-add (nth 1 (math-date-parts (nth 1 date) 719164)) (calcFunc-tzone zone date)) - (math-reject-arg date 'datep))) -) + (math-reject-arg date 'datep)))) (defun calcFunc-tzone (&optional zone date) (if zone @@ -1281,8 +1218,7 @@ (kill-buffer " *Calc Temporary*") (setq var-TimeZone tz) (calc-refresh-evaltos 'var-TimeZone) - (calcFunc-tzone tz date)))) -) + (calcFunc-tzone tz date))))) ;;; Note: Longer names must appear before shorter names which are ;;; substrings of them. @@ -1319,8 +1255,7 @@ (setq date (math-float date)) (or dt (setq dt (math-date-to-dt date))) (and math-daylight-savings-hook - (funcall math-daylight-savings-hook date dt zone bump))) -) + (funcall math-daylight-savings-hook date dt zone bump)))) (defun calcFunc-dsadj (date &optional zone) (if zone @@ -1336,14 +1271,12 @@ (or zadj (math-reject-arg zone "*Unrecognized time zone name")) (if (integerp (nth 2 zadj)) (nth 2 zadj) - (math-daylight-savings-adjust date zone))) -) + (math-daylight-savings-adjust date zone)))) (defun calcFunc-tzconv (date z1 z2) (if (math-realp date) (nth 1 (calcFunc-tzconv (list 'date date) z1 z2)) - (calcFunc-unixtime (calcFunc-unixtime date z1) z2)) -) + (calcFunc-unixtime (calcFunc-unixtime date z1) z2))) (defvar math-daylight-savings-hook 'math-std-daylight-savings) @@ -1366,8 +1299,7 @@ ((= (nth 2 dt) sunday) (if (>= (nth 3 dt) (+ 2 bump)) 0 -1)) (t 0)))) - (t 0)) -) + (t 0))) ;;; Compute the day (1-31) of the WDAY (0-6) on or preceding the given ;;; day of the given month. @@ -1376,8 +1308,7 @@ (if (> day (math-days-in-month (car dt) (nth 1 dt))) (setq day (math-days-in-month (car dt) (nth 1 dt)))) (let ((zeroth (math-sub (math-floor date) (nth 2 dt)))) - (math-sub (nth 1 (calcFunc-newweek (math-add zeroth day))) zeroth)) -) + (math-sub (nth 1 (calcFunc-newweek (math-add zeroth day))) zeroth))) (defun calcFunc-pwday (date &optional day weekday) (if (eq (car-safe date) 'date) @@ -1388,8 +1319,7 @@ (or (integerp day) (math-reject-arg day 'fixnump)) (if (= day 0) (setq day 31)) (and (or (< day 7) (> day 31)) (math-reject-arg day 'range)) - (math-prev-weekday-in-month date (math-date-to-dt date) day (or weekday 0)) -) + (math-prev-weekday-in-month date (math-date-to-dt date) day (or weekday 0))) (defun calcFunc-newweek (date &optional weekday) @@ -1402,8 +1332,7 @@ (or (integerp weekday) (math-reject-arg weekday 'fixnump)) (and (or (< weekday 0) (> weekday 6)) (math-reject-arg weekday 'range)) (setq date (math-floor date)) - (list 'date (math-sub date (calcFunc-weekday (math-sub date weekday)))) -) + (list 'date (math-sub date (calcFunc-weekday (math-sub date weekday))))) (defun calcFunc-newmonth (date &optional day) (or day (setq day 1)) @@ -1416,8 +1345,7 @@ (and (eq (car dt) 1752) (= (nth 1 dt) 9) (if (>= day 14) (setq day (- day 11)))) (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) - (1- day)))) -) + (1- day))))) (defun calcFunc-newyear (date &optional day) (or day (setq day 1)) @@ -1432,8 +1360,7 @@ (1- day)))) (if (and (>= day -12) (<= day -1)) (list 'date (math-dt-to-date (list (car dt) (- day) 1))) - (math-reject-arg day 'range)))) -) + (math-reject-arg day 'range))))) (defun calcFunc-incmonth (date &optional step) (or step (setq step 1)) @@ -1452,12 +1379,10 @@ (and (math-negp (car dt)) (not (math-negp year)) (setq year (math-add year 1))) (list 'date (math-dt-to-date - (cons year (cons month (cons day (cdr (cdr (cdr dt))))))))) -) + (cons year (cons month (cons day (cdr (cdr (cdr dt)))))))))) (defun calcFunc-incyear (date &optional step) - (calcFunc-incmonth date (math-mul (or step 1) 12)) -) + (calcFunc-incmonth date (math-mul (or step 1) 12))) @@ -1472,8 +1397,7 @@ (db (math-to-business-day b))) (math-add (math-sub (car da) (car db)) (if (and (cdr db) (not (cdr da))) 1 0)))) - (calcFunc-badd a (math-neg b))) -) + (calcFunc-badd a (math-neg b)))) (defun calcFunc-badd (a b) (if (eq (car-safe b) 'date) @@ -1497,12 +1421,10 @@ (setq b (math-div b (cdr hours)))) (calcFunc-badd a b)) (math-reject-arg nil "*Illegal combination in date arithmetic"))) - (math-reject-arg a 'datep))) -) + (math-reject-arg a 'datep)))) (defun calcFunc-holiday (a) - (if (cdr (math-to-business-day a)) 1 0) -) + (if (cdr (math-to-business-day a)) 1 0)) (setq math-holidays-cache nil) @@ -1547,8 +1469,7 @@ (setq time (math-sub 1 (math-div 1 (math-mul 86400 (cdr hours))))))))) - (cons (math-add (math-sub day delta) time) holiday)) -) + (cons (math-add (math-sub day delta) time) holiday))) ;;; Compute the date a certain number of business days since Jan 1, 1 AD. @@ -1579,8 +1500,7 @@ (if hours (setq time (math-add (math-mul time (cdr hours)) (car hours))))) (and (not (math-setup-holidays day)) - (list 'date (math-add day time))))) -) + (list 'date (math-add day time)))))) (defun math-setup-holidays (&optional date) @@ -1686,8 +1606,7 @@ (t (setq done t) nil))) - (or done (setq math-holidays-cache-tag t))))) -) + (or done (setq math-holidays-cache-tag t)))))) (defun math-setup-year-holidays (year) (let ((exprs (nth 2 math-holidays-cache))) @@ -1700,8 +1619,7 @@ (while (<= (setq var-m (1+ var-m)) 12) (math-setup-add-holidays (math-evaluate-expr expr)))) (math-setup-add-holidays expr))) - (setq exprs (cdr exprs)))) -) + (setq exprs (cdr exprs))))) (defun math-setup-add-holidays (days) ; uses "year" (cond ((eq (car-safe days) 'vec) @@ -1731,8 +1649,7 @@ ((Math-realp days) (math-reject-arg (list 'date days) "*Invalid holiday value")) (t - (math-reject-arg days "*Holiday formula failed to evaluate"))) -) + (math-reject-arg days "*Holiday formula failed to evaluate")))) @@ -1749,11 +1666,9 @@ (setq sigma (math-abs sigma))) (if (and (Math-zerop sigma) (Math-scalarp x)) x - (list 'sdev x sigma)) -) + (list 'sdev x sigma))) (defun calcFunc-sdev (x sigma) - (math-make-sdev x sigma) -) + (math-make-sdev x sigma)) @@ -1764,8 +1679,7 @@ (m (math-normalize (nth 2 a)))) (if (and (math-anglep n) (math-anglep m) (math-posp m)) (math-make-mod n m) - (math-normalize (list 'calcFunc-makemod n m)))) -) + (math-normalize (list 'calcFunc-makemod n m))))) ;;; Build a modulo form. [N R R] (defun math-make-mod (n m) @@ -1789,11 +1703,9 @@ (math-mul (math-make-mod (nth 1 n) m) (nth 2 n))) ((memq (car n) '(* ^ var calcFunc-subscr)) (math-mul (math-make-mod 1 m) n)) - (t (math-reject-arg n 'anglep)))) -) + (t (math-reject-arg n 'anglep))))) (defun calcFunc-makemod (n m) - (math-make-mod n m) -) + (math-make-mod n m)) @@ -1819,20 +1731,17 @@ (list 'intv 2 lo lo) (list 'intv mask lo lo)) (list 'intv mask lo hi)))) - (list 'intv mask lo hi)) -) + (list 'intv mask lo hi))) (defun calcFunc-intv (mask lo hi) (if (math-messy-integerp mask) (setq mask (math-trunc mask))) (or (natnump mask) (math-reject-arg mask 'fixnatnump)) (or (<= mask 3) (math-reject-arg mask 'range)) - (math-make-intv mask lo hi) -) + (math-make-intv mask lo hi)) (defun math-sort-intv (mask lo hi) (if (Math-lessp hi lo) (math-make-intv (aref [0 2 1 3] mask) hi lo) - (math-make-intv mask lo hi)) -) + (math-make-intv mask lo hi))) @@ -1847,8 +1756,7 @@ (setq b d bm dm) (if (= res 0) (setq bm (or bm dm)))) - (math-make-intv (+ (if am 2 0) (if bm 1 0)) a b)) -) + (math-make-intv (+ (if am 2 0) (if bm 1 0)) a b))) (defun math-div-mod (a b m) ; [R R R R] (Returns nil if no solution) @@ -1860,8 +1768,7 @@ (setq u1 v1 u3 v3 v1 t1 v3 (cdr q)))) (let ((q (math-idivmod a u3))) (and (eq (cdr q) 0) - (math-mod (math-mul (car q) u1) m))))) -) + (math-mod (math-mul (car q) u1) m)))))) (defun math-mod-intv (a b) (let* ((q1 (math-floor (math-div (nth 2 a) b))) @@ -1875,8 +1782,7 @@ (memq (nth 1 a) '(0 2))) (math-make-intv (nth 1 a) m1 b)) (t - (math-make-intv 2 0 b)))) -) + (math-make-intv 2 0 b))))) (defun math-read-angle-brackets () @@ -1909,6 +1815,6 @@ (throw 'syntax (nth 2 res))) (setq exp-pos (1+ last)) (math-read-token) - res) -) + res)) +;;; calc-forms.el ends here
--- a/lisp/calc/calc-frac.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-frac.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-frac.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -32,8 +32,7 @@ (defun calc-fdiv (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op ":" 'calcFunc-fdiv arg 1)) -) + (calc-binary-op ":" 'calcFunc-fdiv arg 1))) (defun calc-fraction (arg) @@ -46,8 +45,7 @@ (calc-top-n 1))) (calc-enter-result 1 "frac" (list func (calc-top-n 1) - (prefix-numeric-value (or arg 0))))))) -) + (prefix-numeric-value (or arg 0)))))))) (defun calc-over-notation (fmt) @@ -60,14 +58,12 @@ fmt (math-match-substring fmt 1))) (if (eq n 0) (error "Bad denominator")) (calc-change-mode 'calc-frac-format (list fmt n) t)) - (error "Bad fraction separator format."))) -) + (error "Bad fraction separator format.")))) (defun calc-slash-notation (n) (interactive "P") (calc-wrapper - (calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t)) -) + (calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t))) (defun calc-frac-mode (n) @@ -76,8 +72,7 @@ (calc-change-mode 'calc-prefer-frac n nil t) (message (if calc-prefer-frac "Integer division will now generate fractions." - "Integer division will now generate floating-point results."))) -) + "Integer division will now generate floating-point results.")))) @@ -99,8 +94,7 @@ (list 'frac num den)) (if (equal gcd den) (math-quotient num gcd) - (list 'frac (math-quotient num gcd) (math-quotient den gcd))))) -) + (list 'frac (math-quotient num gcd) (math-quotient den gcd)))))) (defun calc-add-fractions (a b) (if (eq (car-safe a) 'frac) @@ -113,8 +107,7 @@ (nth 2 a))) (math-make-frac (math-add (math-mul a (nth 2 b)) (nth 1 b)) - (nth 2 b))) -) + (nth 2 b)))) (defun calc-mul-fractions (a b) (if (eq (car-safe a) 'frac) @@ -124,8 +117,7 @@ (math-make-frac (math-mul (nth 1 a) b) (nth 2 a))) (math-make-frac (math-mul a (nth 1 b)) - (nth 2 b))) -) + (nth 2 b)))) (defun calc-div-fractions (a b) (if (eq (car-safe a) 'frac) @@ -135,8 +127,7 @@ (math-make-frac (nth 1 a) (math-mul (nth 2 a) b))) (math-make-frac (math-mul a (nth 2 b)) - (nth 1 b))) -) + (nth 1 b)))) @@ -183,8 +174,7 @@ (t (let ((cfrac (math-continued-fraction a tol)) (calc-prefer-frac t)) - (math-eval-continued-fraction cfrac)))) -) + (math-eval-continued-fraction cfrac))))) (defun math-continued-fraction (a tol) (let ((calc-internal-prec (+ calc-internal-prec 2))) @@ -207,8 +197,7 @@ cfrac (cons int cfrac)) (or (Math-zerop aa) (setq aa (math-div 1 aa)))) - cfrac)) -) + cfrac))) (defun math-eval-continued-fraction (cf) (let ((n (car cf)) @@ -218,8 +207,7 @@ (setq temp (math-add (math-mul (car cf) n) d) d n n temp)) - (math-div n d)) -) + (math-div n d))) @@ -230,6 +218,6 @@ (math-reject-arg a "*Division by zero") (math-make-frac (math-trunc a) (math-trunc b))) (math-reject-arg b 'integerp)) - (math-reject-arg a 'integerp)) -) + (math-reject-arg a 'integerp))) +;;; calc-frac.el ends here
--- a/lisp/calc/calc-funcs.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-funcs.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-funcs.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -38,102 +38,86 @@ (calc-binary-op "gamQ" 'calcFunc-gammaQ arg)) (if (calc-is-hyperbolic) (calc-binary-op "gamg" 'calcFunc-gammag arg) - (calc-binary-op "gamP" 'calcFunc-gammaP arg)))) -) + (calc-binary-op "gamP" 'calcFunc-gammaP arg))))) (defun calc-erf (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (calc-unary-op "erfc" 'calcFunc-erfc arg) - (calc-unary-op "erf" 'calcFunc-erf arg))) -) + (calc-unary-op "erf" 'calcFunc-erf arg)))) (defun calc-erfc (arg) (interactive "P") (calc-invert-func) - (calc-erf arg) -) + (calc-erf arg)) (defun calc-beta (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "beta" 'calcFunc-beta arg)) -) + (calc-binary-op "beta" 'calcFunc-beta arg))) (defun calc-inc-beta () (interactive) (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-enter-result 3 "betB" (cons 'calcFunc-betaB (calc-top-list-n 3))) - (calc-enter-result 3 "betI" (cons 'calcFunc-betaI (calc-top-list-n 3))))) -) + (calc-enter-result 3 "betI" (cons 'calcFunc-betaI (calc-top-list-n 3)))))) (defun calc-bessel-J (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "besJ" 'calcFunc-besJ arg)) -) + (calc-binary-op "besJ" 'calcFunc-besJ arg))) (defun calc-bessel-Y (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "besY" 'calcFunc-besY arg)) -) + (calc-binary-op "besY" 'calcFunc-besY arg))) (defun calc-bernoulli-number (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-binary-op "bern" 'calcFunc-bern arg) - (calc-unary-op "bern" 'calcFunc-bern arg))) -) + (calc-unary-op "bern" 'calcFunc-bern arg)))) (defun calc-euler-number (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-binary-op "eulr" 'calcFunc-euler arg) - (calc-unary-op "eulr" 'calcFunc-euler arg))) -) + (calc-unary-op "eulr" 'calcFunc-euler arg)))) (defun calc-stirling-number (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-binary-op "str2" 'calcFunc-stir2 arg) - (calc-binary-op "str1" 'calcFunc-stir1 arg))) -) + (calc-binary-op "str1" 'calcFunc-stir1 arg)))) (defun calc-utpb () (interactive) - (calc-prob-dist "b" 3) -) + (calc-prob-dist "b" 3)) (defun calc-utpc () (interactive) - (calc-prob-dist "c" 2) -) + (calc-prob-dist "c" 2)) (defun calc-utpf () (interactive) - (calc-prob-dist "f" 3) -) + (calc-prob-dist "f" 3)) (defun calc-utpn () (interactive) - (calc-prob-dist "n" 3) -) + (calc-prob-dist "n" 3)) (defun calc-utpp () (interactive) - (calc-prob-dist "p" 2) -) + (calc-prob-dist "p" 2)) (defun calc-utpt () (interactive) - (calc-prob-dist "t" 2) -) + (calc-prob-dist "t" 2)) (defun calc-prob-dist (letter nargs) (calc-slow-wrapper @@ -145,8 +129,7 @@ (calc-enter-result nargs (concat "utp" letter) (append (list (intern (concat "calcFunc-utp" letter)) (calc-top-n 1)) - (calc-top-list-n (1- nargs) 2))))) -) + (calc-top-list-n (1- nargs) 2)))))) @@ -159,8 +142,7 @@ (defun calcFunc-gamma (x) (or (math-numberp x) (math-reject-arg x 'numberp)) - (calcFunc-fact (math-add x -1)) -) + (calcFunc-fact (math-add x -1))) (defun math-gammap1-raw (x &optional fprec nfprec) ; compute gamma(1 + x) (or fprec @@ -193,8 +175,7 @@ xinv (math-sqr xinv) '(float 0 0) - 2)))))) -) + 2))))))) (defun math-gamma-series (sum x xinvsqr oterm n) (math-working "gamma" sum) @@ -212,8 +193,7 @@ (calc-record-why "*Gamma computation stopped early, not all digits may be valid") next) - (math-gamma-series next (math-mul x xinvsqr) xinvsqr term (+ n 2))))) -) + (math-gamma-series next (math-mul x xinvsqr) xinvsqr term (+ n 2)))))) ;;; Incomplete gamma function. @@ -229,8 +209,7 @@ (> a 0) (< a 20)) (math-sub 1 (calcFunc-gammaQ a x)) (let ((math-current-gamma-value (calcFunc-gamma a))) - (math-div (calcFunc-gammag a x) math-current-gamma-value)))) -) + (math-div (calcFunc-gammag a x) math-current-gamma-value))))) (defun calcFunc-gammaQ (a x) (if (equal x '(var inf var-inf)) @@ -251,8 +230,7 @@ (math-working "gamma" sum)) (math-mul sum (calcFunc-exp (math-neg x))))) (let ((math-current-gamma-value (calcFunc-gamma a))) - (math-div (calcFunc-gammaG a x) math-current-gamma-value)))) -) + (math-div (calcFunc-gammaG a x) math-current-gamma-value))))) (defun calcFunc-gammag (a x) (if (equal x '(var inf var-inf)) @@ -269,8 +247,7 @@ '(float 1 0)))) (math-inc-gamma-series a x) (math-sub (or math-current-gamma-value (calcFunc-gamma a)) - (math-inc-gamma-cfrac a x))))) -) + (math-inc-gamma-cfrac a x)))))) (setq math-current-gamma-value nil) (defun calcFunc-gammaG (a x) @@ -288,8 +265,7 @@ '(float 1 0)))) (math-sub (or math-current-gamma-value (calcFunc-gamma a)) (math-inc-gamma-series a x)) - (math-inc-gamma-cfrac a x)))) -) + (math-inc-gamma-cfrac a x))))) (defun math-inc-gamma-series (a x) (if (Math-zerop x) @@ -297,8 +273,7 @@ (math-mul (math-exp-raw (math-sub (math-mul a (math-ln-raw x)) x)) (math-with-extra-prec 2 (let ((start (math-div '(float 1 0) a))) - (math-inc-gamma-series-step start start a x))))) -) + (math-inc-gamma-series-step start start a x)))))) (defun math-inc-gamma-series-step (sum term a x) (math-working "gamma" sum) @@ -307,8 +282,7 @@ (let ((next (math-add sum term))) (if (math-nearly-equal sum next) next - (math-inc-gamma-series-step next term a x))) -) + (math-inc-gamma-series-step next term a x)))) (defun math-inc-gamma-cfrac (a x) (if (Math-zerop x) @@ -317,8 +291,7 @@ (math-inc-gamma-cfrac-step '(float 1 0) x '(float 0 0) '(float 1 0) '(float 1 0) '(float 1 0) '(float 0 0) - a x))) -) + a x)))) (defun math-inc-gamma-cfrac-step (a0 a1 b0 b1 n fac g a x) (let ((ana (math-sub n a)) @@ -335,8 +308,7 @@ (math-working "gamma" next) (if (math-nearly-equal next g) next - (math-inc-gamma-cfrac-step a0 a1 b0 b1 n fac next a x))))) -) + (math-inc-gamma-cfrac-step a0 a1 b0 b1 n fac next a x)))))) ;;; Error function. @@ -353,8 +325,7 @@ (math-div (calcFunc-gammag '(float 5 -1) (math-sqr (math-to-complex-quad-one x))) math-current-gamma-value) - x))))) -) + x)))))) (defun calcFunc-erfc (x) (if (equal x '(var inf var-inf)) @@ -363,15 +334,13 @@ (let ((math-current-gamma-value (math-sqrt-pi))) (math-div (calcFunc-gammaG '(float 5 -1) (math-sqr x)) math-current-gamma-value)) - (math-sub 1 (calcFunc-erf x)))) -) + (math-sub 1 (calcFunc-erf x))))) (defun math-to-complex-quad-one (x) (if (eq (car-safe x) 'polar) (setq x (math-complex x))) (if (eq (car-safe x) 'cplx) (list 'cplx (math-abs (nth 1 x)) (math-abs (nth 2 x))) - x) -) + x)) (defun math-to-same-complex-quad (x y) (if (eq (car-safe y) 'cplx) @@ -384,8 +353,7 @@ (if (eq (car-safe x) 'cplx) (list 'cplx (math-neg (nth 1 x)) (nth 2 x)) (math-neg x)) - x)) -) + x))) ;;; Beta function. @@ -398,8 +366,7 @@ (if (math-num-integerp b) (calcFunc-beta b a) (math-div (math-mul (calcFunc-gamma a) (calcFunc-gamma b)) - (calcFunc-gamma (math-add a b))))) -) + (calcFunc-gamma (math-add a b)))))) ;;; Incomplete beta function. @@ -425,8 +392,7 @@ ((not (math-numberp b)) (math-reject-arg b 'numberp)) ((math-inexact-result)) (t (let ((math-current-beta-value (calcFunc-beta a b))) - (math-div (calcFunc-betaB x a b) math-current-beta-value)))) -) + (math-div (calcFunc-betaB x a b) math-current-beta-value))))) (defun calcFunc-betaB (x a b) (cond @@ -478,8 +444,7 @@ (math-sub (or math-current-beta-value (calcFunc-beta a b)) (math-div (math-mul bt (math-beta-cfrac b a (math-sub 1 x))) - b))))))) -) + b)))))))) (setq math-current-beta-value nil) (defun math-beta-cfrac (a b x) @@ -491,8 +456,7 @@ (math-div (math-mul qab x) qap)) '(float 1 0) '(float 1 0) '(float 1 0) - qab qap qam a b x)) -) + qab qap qam a b x))) (defun math-beta-cfrac-step (az bz am bm m qab qap qam a b x) (let* ((two-m (math-mul m '(float 2 0))) @@ -512,8 +476,7 @@ (math-beta-cfrac-step next '(float 1 0) (math-div ap bpp) (math-div bp bpp) (math-add m '(float 1 0)) - qab qap qam a b x))) -) + qab qap qam a b x)))) ;;; Bessel functions. @@ -583,8 +546,7 @@ (setq sum (math-add sum bj))) (if (= j v) (setq ans bjp))) - (math-div ans (math-sub (math-mul 2 sum) bj))))))) -) + (math-div ans (math-sub (math-mul 2 sum) bj)))))))) (defun math-besJ-series (sum term k zz vk) (math-working "besJ" sum) @@ -594,8 +556,7 @@ (let ((next (math-add sum term))) (if (math-nearly-equal next sum) next - (math-besJ-series next term k zz vk))) -) + (math-besJ-series next term k zz vk)))) (defun math-besJ0 (x &optional yflag) (cond ((and (not yflag) (math-negp (calcFunc-re x))) @@ -638,8 +599,7 @@ (float (bigpos 853 264 927 5) -5) (float (bigpos 718 680 494 9) -3) (float (bigpos 985 532 029 1) 0) - (float (bigpos 411 490 568 57) 0))))))) -) + (float (bigpos 411 490 568 57) 0)))))))) (defun math-besJ1 (x &optional yflag) (cond ((and (math-negp (calcFunc-re x)) (not yflag)) @@ -686,8 +646,7 @@ (float (bigpos 474 330 858 1) -2) (float (bigpos 178 535 300 2) 0) (float (bigpos 442 228 725 144) - 0)))))))) -) + 0))))))))) (defun calcFunc-besY (v x) (math-inexact-result) @@ -721,8 +680,7 @@ bym) bym by by byp)) - by))))) -) + by)))))) (defun math-besY0 (x) (cond ((Math-lessp (math-abs-approx x) '(float 8 0)) @@ -749,8 +707,7 @@ (math-mul '(cplx 0 2) (math-besJ0 (math-neg x))))) (t - (math-besJ0 x t))) -) + (math-besJ0 x t)))) (defun math-besY1 (x) (cond ((Math-lessp (math-abs-approx x) '(float 8 0)) @@ -782,15 +739,13 @@ (math-mul '(cplx 0 2) (math-besJ1 (math-neg x)))))) (t - (math-besJ1 x t))) -) + (math-besJ1 x t)))) (defun math-poly-eval (x coefs) (let ((accum (car coefs))) (while (setq coefs (cdr coefs)) (setq accum (math-add (car coefs) (math-mul accum x)))) - accum) -) + accum)) ;;;; Bernoulli and Euler polynomials and numbers. @@ -805,8 +760,7 @@ (progn (math-inexact-result) (math-float (math-bernoulli-number (math-trunc n)))) - (math-bernoulli-number n))) -) + (math-bernoulli-number n)))) (defun calcFunc-euler (n &optional x) (or (math-num-natnump n) (math-reject-arg n 'natnump)) @@ -840,8 +794,7 @@ (progn (math-inexact-result) (calcFunc-euler n '(float 5 -1))) - (calcFunc-euler n '(frac 1 2))))) -) + (calcFunc-euler n '(frac 1 2)))))) (defun math-bernoulli-coefs (n) (let* ((coefs (list (calcFunc-bern n))) @@ -855,8 +808,7 @@ coef (math-mul term (math-bernoulli-number k)) coefs (cons (if (consp n) (math-float coef) coef) coefs) term (math-mul term k))) - (nreverse coefs)) -) + (nreverse coefs))) (defun math-bernoulli-number (n) (if (= (% n 2) 1) @@ -884,8 +836,7 @@ math-bernoulli-B-cache (cons (math-mul sum ofact) math-bernoulli-B-cache) math-bernoulli-cache-size (1+ math-bernoulli-cache-size)))) - (nth (- math-bernoulli-cache-size n 1) math-bernoulli-B-cache)) -) + (nth (- math-bernoulli-cache-size n 1) math-bernoulli-B-cache))) ;;; Bn = n! bn ;;; bn = - sum_k=0^n-1 bk / (n-k+1)! @@ -919,28 +870,24 @@ (defun calcFunc-utpb (x n p) (if math-expand-formulas (math-normalize (list 'calcFunc-betaI p x (list '+ (list '- n x) 1))) - (calcFunc-betaI p x (math-add (math-sub n x) 1))) -) + (calcFunc-betaI p x (math-add (math-sub n x) 1)))) (put 'calcFunc-utpb 'math-expandable t) (defun calcFunc-ltpb (x n p) - (math-sub 1 (calcFunc-utpb x n p)) -) + (math-sub 1 (calcFunc-utpb x n p))) (put 'calcFunc-ltpb 'math-expandable t) ;;; Chi-square. (defun calcFunc-utpc (chisq v) (if math-expand-formulas (math-normalize (list 'calcFunc-gammaQ (list '/ v 2) (list '/ chisq 2))) - (calcFunc-gammaQ (math-div v 2) (math-div chisq 2))) -) + (calcFunc-gammaQ (math-div v 2) (math-div chisq 2)))) (put 'calcFunc-utpc 'math-expandable t) (defun calcFunc-ltpc (chisq v) (if math-expand-formulas (math-normalize (list 'calcFunc-gammaP (list '/ v 2) (list '/ chisq 2))) - (calcFunc-gammaP (math-div v 2) (math-div chisq 2))) -) + (calcFunc-gammaP (math-div v 2) (math-div chisq 2)))) (put 'calcFunc-ltpc 'math-expandable t) ;;; F-distribution. @@ -952,13 +899,11 @@ (list '/ v1 2))) (calcFunc-betaI (math-div v2 (math-add v2 (math-mul v1 f))) (math-div v2 2) - (math-div v1 2))) -) + (math-div v1 2)))) (put 'calcFunc-utpf 'math-expandable t) (defun calcFunc-ltpf (f v1 v2) - (math-sub 1 (calcFunc-utpf f v1 v2)) -) + (math-sub 1 (calcFunc-utpf f v1 v2))) (put 'calcFunc-ltpf 'math-expandable t) ;;; Normal. @@ -975,8 +920,7 @@ (calcFunc-erf (math-div (math-sub mean x) (math-mul sdev (math-sqrt-2))))) - '(float 5 -1))) -) + '(float 5 -1)))) (put 'calcFunc-utpn 'math-expandable t) (defun calcFunc-ltpn (x mean sdev) @@ -992,23 +936,20 @@ (calcFunc-erf (math-div (math-sub x mean) (math-mul sdev (math-sqrt-2))))) - '(float 5 -1))) -) + '(float 5 -1)))) (put 'calcFunc-ltpn 'math-expandable t) ;;; Poisson. (defun calcFunc-utpp (n x) (if math-expand-formulas (math-normalize (list 'calcFunc-gammaP x n)) - (calcFunc-gammaP x n)) -) + (calcFunc-gammaP x n))) (put 'calcFunc-utpp 'math-expandable t) (defun calcFunc-ltpp (n x) (if math-expand-formulas (math-normalize (list 'calcFunc-gammaQ x n)) - (calcFunc-gammaQ x n)) -) + (calcFunc-gammaQ x n))) (put 'calcFunc-ltpp 'math-expandable t) ;;; Student's t. (As defined in Abramowitz & Stegun and Numerical Recipes.) @@ -1020,15 +961,12 @@ '(float 5 -1))) (calcFunc-betaI (math-div v (math-add v (math-sqr tt))) (math-div v 2) - '(float 5 -1))) -) + '(float 5 -1)))) (put 'calcFunc-utpt 'math-expandable t) (defun calcFunc-ltpt (tt v) - (math-sub 1 (calcFunc-utpt tt v)) -) + (math-sub 1 (calcFunc-utpt tt v))) (put 'calcFunc-ltpt 'math-expandable t) - - +;;; calc-funcs.el ends here
--- a/lisp/calc/calc-graph.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-graph.el Wed Nov 14 09:09:09 2001 +0000 @@ -64,16 +64,14 @@ (let ((calc-graph-no-auto-view t)) (calc-graph-delete t) (calc-graph-add many) - (calc-graph-plot nil)) -) + (calc-graph-plot nil))) (defun calc-graph-fast-3d (many) (interactive "P") (let ((calc-graph-no-auto-view t)) (calc-graph-delete t) (calc-graph-add-3d many) - (calc-graph-plot nil)) -) + (calc-graph-plot nil))) (defun calc-graph-delete (all) (interactive "P") @@ -88,8 +86,7 @@ (setq calc-graph-var-cache nil) (delete-region (point) (point-max))) (delete-region (point) (1- (point-max))))))) - (calc-graph-view-commands)) -) + (calc-graph-view-commands))) (defun calc-graph-find-plot (&optional before all) (goto-char (point-min)) @@ -105,8 +102,7 @@ (beginning-of-line))) (or before (re-search-forward ",[ \t]+"))) - t)) -) + t))) (defun calc-graph-add (many) (interactive "P") @@ -139,8 +135,7 @@ (calc-graph-add-curve (calc-graph-lookup (nth 1 pair)) (calc-graph-lookup (nth 2 pair))) (setq many (1- many)))))) - (calc-graph-view-commands)) -) + (calc-graph-view-commands))) (defun calc-graph-add-3d (many) (interactive "P") @@ -178,8 +173,7 @@ (calc-graph-lookup (nth 2 curve)) (calc-graph-lookup (nth 3 curve))) (setq many (1- many)))))) - (calc-graph-view-commands)) -) + (calc-graph-view-commands))) (defun calc-graph-add-curve (xdata ydata &optional zdata) (let ((num (calc-graph-count-curves)) @@ -214,8 +208,7 @@ 0) (or (and (Math-num-integerp pstyle) (math-trunc pstyle)) (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec) - 0 -1))))) -) + 0 -1)))))) (defun calc-graph-lookup (thing) (if (and (eq (car-safe thing) 'var) @@ -232,8 +225,7 @@ found (cons thing var) calc-graph-var-cache (cons found calc-graph-var-cache)) (set (nth 2 var) thing))) - (cdr found))) -) + (cdr found)))) (defun calc-graph-juggle (arg) (interactive "p") @@ -246,8 +238,7 @@ (while (< arg 0) (setq arg (+ arg num)))))) (while (>= (setq arg (1- arg)) 0) - (calc-graph-do-juggle))) -) + (calc-graph-do-juggle)))) (defun calc-graph-count-curves () (save-excursion @@ -258,8 +249,7 @@ (while (search-forward "," nil t) (setq num (1+ num))) num) - 0)) -) + 0))) (defun calc-graph-do-juggle () (let (base) @@ -271,13 +261,11 @@ (let ((str (buffer-substring (+ (point) 2) (1- (point-max))))) (delete-region (point) (1- (point-max))) (goto-char (+ base 5)) - (insert str ", ")))))) -) + (insert str ", "))))))) (defun calc-graph-print (flag) (interactive "P") - (calc-graph-plot flag t) -) + (calc-graph-plot flag t)) (defun calc-graph-plot (flag &optional printing) (interactive "P") @@ -522,8 +510,7 @@ calc-gnuplot-print-output))) (if (symbolp command) (funcall command output) - (eval command))))))))) -) + (eval command)))))))))) (defun calc-graph-compute-2d () (if (setq yvec (eq (car-safe yvalue) 'vec)) @@ -560,8 +547,7 @@ (if (and (not (setq xvec (eq (car-safe xvalue) 'vec))) refine (cdr (cdr ycache))) (calc-graph-refine-2d) - (calc-graph-recompute-2d))) -) + (calc-graph-recompute-2d)))) (defun calc-graph-refine-2d () (setq keep-file nil @@ -592,8 +578,7 @@ (cdr ycacheptr))) (setq ycacheptr (cdr (cdr ycacheptr)))) (setq yp ycache - numsteps 1000000) -) + numsteps 1000000)) (defun calc-graph-recompute-2d () (setq ycacheptr ycache) @@ -645,8 +630,7 @@ yvec t yp (cons 'vec (nreverse yvector)) numsteps (1- (length xp))) - (setq numsteps 1000000)) -) + (setq numsteps 1000000))) (defun calc-graph-compute-3d () (if (setq yvec (eq (car-safe yvalue) 'vec)) @@ -760,8 +744,7 @@ var-DUMMY2 (car y3step) zp (cons (math-evaluate-expr yvalue) zp)))) (setq zp (nreverse zp) - numsteps (1- (* numsteps (1+ numsteps3))))) -) + numsteps (1- (* numsteps (1+ numsteps3)))))) (defun calc-graph-format-data () (while (<= (setq stepcount (1+ stepcount)) numsteps) @@ -848,8 +831,7 @@ (or blank (progn (insert "\n") - (setq blank t))))) -) + (setq blank t)))))) (defun calc-temp-file-name (num) (while (<= (length calc-graph-file-cache) (1+ num)) @@ -861,8 +843,7 @@ (if (<= num 0) (char-to-string (- ?A num)) (int-to-string num)))) - nil)))) -) + nil))))) (defun calc-graph-delete-temps () (while calc-graph-file-cache @@ -871,22 +852,19 @@ (condition-case err (delete-file (car (car calc-graph-file-cache))) (error nil))) - (setq calc-graph-file-cache (cdr calc-graph-file-cache))) -) + (setq calc-graph-file-cache (cdr calc-graph-file-cache)))) (defun calc-graph-kill-hook () (calc-graph-delete-temps) (if calc-graph-prev-kill-hook - (funcall calc-graph-prev-kill-hook)) -) + (funcall calc-graph-prev-kill-hook))) (defun calc-graph-show-tty (output) "Default calc-gnuplot-plot-command for \"tty\" output mode. This is useful for tek40xx and other graphics-terminal types." (call-process-region 1 1 shell-file-name nil calc-gnuplot-buffer nil - "-c" (format "cat %s >/dev/tty; rm %s" output output)) -) + "-c" (format "cat %s >/dev/tty; rm %s" output output))) (defun calc-graph-show-dumb (&optional output) "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type. @@ -934,8 +912,7 @@ (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch) " or `M-# M-#'" "")) (recursive-edit) - (bury-buffer "*Gnuplot Trail*")) -) + (bury-buffer "*Gnuplot Trail*"))) (defun calc-graph-clear () (interactive) @@ -946,41 +923,34 @@ (if (equal calc-graph-last-output "STDOUT") "" (prin1-to-string calc-graph-last-output))) - (calc-gnuplot-command "clear"))) -) + (calc-gnuplot-command "clear")))) (defun calc-graph-title-x (title) (interactive "sX axis title: ") (calc-graph-set-command "xlabel" (if (not (equal title "")) - (prin1-to-string title))) -) + (prin1-to-string title)))) (defun calc-graph-title-y (title) (interactive "sY axis title: ") (calc-graph-set-command "ylabel" (if (not (equal title "")) - (prin1-to-string title))) -) + (prin1-to-string title)))) (defun calc-graph-title-z (title) (interactive "sZ axis title: ") (calc-graph-set-command "zlabel" (if (not (equal title "")) - (prin1-to-string title))) -) + (prin1-to-string title)))) (defun calc-graph-range-x (range) (interactive "sX axis range: ") - (calc-graph-set-range "xrange" range) -) + (calc-graph-set-range "xrange" range)) (defun calc-graph-range-y (range) (interactive "sY axis range: ") - (calc-graph-set-range "yrange" range) -) + (calc-graph-set-range "yrange" range)) (defun calc-graph-range-z (range) (interactive "sZ axis range: ") - (calc-graph-set-range "zrange" range) -) + (calc-graph-set-range "zrange" range)) (defun calc-graph-set-range (cmd range) (if (equal range "$") @@ -1004,23 +974,19 @@ (string-match " " range))) (aset range (match-beginning 0) ?\:)) (calc-graph-set-command cmd (if (not (equal range "")) - (concat "[" range "]"))) -) + (concat "[" range "]")))) (defun calc-graph-log-x (flag) (interactive "P") - (calc-graph-set-log flag 0 0) -) + (calc-graph-set-log flag 0 0)) (defun calc-graph-log-y (flag) (interactive "P") - (calc-graph-set-log 0 flag 0) -) + (calc-graph-set-log 0 flag 0)) (defun calc-graph-log-z (flag) (interactive "P") - (calc-graph-set-log 0 0 flag) -) + (calc-graph-set-log 0 0 flag)) (defun calc-graph-set-log (xflag yflag zflag) (let* ((old (or (calc-graph-find-command "logscale") "")) @@ -1040,18 +1006,15 @@ (if (eq zflag 0) zold (> (prefix-numeric-value zflag) 0)) (not zold)) "z" ""))) - (calc-graph-set-command "logscale" (if (not (equal str "")) str))) -) + (calc-graph-set-command "logscale" (if (not (equal str "")) str)))) (defun calc-graph-line-style (style) (interactive "P") - (calc-graph-set-styles (and style (prefix-numeric-value style)) t) -) + (calc-graph-set-styles (and style (prefix-numeric-value style)) t)) (defun calc-graph-point-style (style) (interactive "P") - (calc-graph-set-styles t (and style (prefix-numeric-value style))) -) + (calc-graph-set-styles t (and style (prefix-numeric-value style)))) (defun calc-graph-set-styles (lines points) (calc-graph-init) @@ -1104,8 +1067,7 @@ " " (int-to-string pstyle)) (if (and lstyle (> lstyle 0)) (insert " " (int-to-string lstyle)))))) - (calc-graph-view-commands) -) + (calc-graph-view-commands)) (defun calc-graph-zero-x (flag) (interactive "P") @@ -1113,8 +1075,7 @@ (and (if flag (<= (prefix-numeric-value flag) 0) (not (calc-graph-find-command "noxzeroaxis"))) - " ")) -) + " "))) (defun calc-graph-zero-y (flag) (interactive "P") @@ -1122,8 +1083,7 @@ (and (if flag (<= (prefix-numeric-value flag) 0) (not (calc-graph-find-command "noyzeroaxis"))) - " ")) -) + " "))) (defun calc-graph-name (name) (interactive "sTitle for current curve: ") @@ -1143,8 +1103,7 @@ (delete-region (point) end)) (goto-char end)) (insert " title " (prin1-to-string name)))) - (calc-graph-view-commands) -) + (calc-graph-view-commands)) (defun calc-graph-hide (flag) (interactive "P") @@ -1158,14 +1117,12 @@ (if (or (null flag) (<= (prefix-numeric-value flag) 0)) (delete-char 1)) (if (or (null flag) (> (prefix-numeric-value flag) 0)) - (insert "*"))))) -) + (insert "*")))))) (defun calc-graph-header (title) (interactive "sTitle for entire graph: ") (calc-graph-set-command "title" (if (not (equal title "")) - (prin1-to-string title))) -) + (prin1-to-string title)))) (defun calc-graph-border (flag) (interactive "P") @@ -1173,24 +1130,21 @@ (and (if flag (<= (prefix-numeric-value flag) 0) (not (calc-graph-find-command "noborder"))) - " ")) -) + " "))) (defun calc-graph-grid (flag) (interactive "P") (calc-graph-set-command "grid" (and (if flag (> (prefix-numeric-value flag) 0) (not (calc-graph-find-command "grid"))) - " ")) -) + " "))) (defun calc-graph-key (flag) (interactive "P") (calc-graph-set-command "key" (and (if flag (> (prefix-numeric-value flag) 0) (not (calc-graph-find-command "key"))) - " ")) -) + " "))) (defun calc-graph-num-points (res flag) (interactive "sNumber of data points: \nP") @@ -1204,8 +1158,7 @@ (message "Default 3D resolution is %d." calc-graph-default-resolution-3d) (setq calc-graph-default-resolution-3d (string-to-int res)))) - (calc-graph-set-command "samples" (if (not (equal res "")) res))) -) + (calc-graph-set-command "samples" (if (not (equal res "")) res)))) (defun calc-graph-device (name flag) (interactive "sDevice name: \nP") @@ -1224,8 +1177,7 @@ calc-gnuplot-print-device) (setq calc-gnuplot-print-device name))) (calc-graph-set-command "terminal" (if (not (equal name "")) - name)))) -) + name))))) (defun calc-graph-output (name flag) (interactive "FOutput file name: \np") @@ -1249,8 +1201,7 @@ calc-gnuplot-print-output) (setq calc-gnuplot-print-output name))) (calc-graph-set-command "output" (if (not (equal name "")) - (prin1-to-string name)))) -) + (prin1-to-string name))))) (defun calc-graph-display (name) (interactive "sX display name: ") @@ -1259,8 +1210,7 @@ (or calc-gnuplot-display "<none>")) (setq calc-gnuplot-display name) (if (calc-gnuplot-alive) - (calc-gnuplot-command "exit"))) -) + (calc-gnuplot-command "exit")))) (defun calc-graph-geometry (name) (interactive "sX geometry spec (or \"default\"): ") @@ -1269,8 +1219,7 @@ (or calc-gnuplot-geometry "default")) (setq calc-gnuplot-geometry (and (not (equal name "default")) name)) (if (calc-gnuplot-alive) - (calc-gnuplot-command "exit"))) -) + (calc-gnuplot-command "exit")))) (defun calc-graph-find-command (cmd) (calc-graph-init) @@ -1278,8 +1227,7 @@ (set-buffer calc-gnuplot-input) (goto-char (point-min)) (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t) - (buffer-substring (match-beginning 1) (match-end 1)))) -) + (buffer-substring (match-beginning 1) (match-end 1))))) (defun calc-graph-set-command (cmd &rest args) (calc-graph-init) @@ -1302,8 +1250,7 @@ (or (bolp) (insert "\n")) (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n")))) - (calc-graph-view-commands) -) + (calc-graph-view-commands)) (defun calc-graph-command (cmd) (interactive "sGNUPLOT command: ") @@ -1312,8 +1259,7 @@ (calc-graph-view-trail) (calc-gnuplot-command cmd) (accept-process-output) - (calc-graph-view-trail)) -) + (calc-graph-view-trail))) (defun calc-graph-kill (&optional no-view) (interactive) @@ -1326,8 +1272,7 @@ (sit-for 1) (if (process-status calc-gnuplot-process) (delete-process calc-gnuplot-process)) - (setq calc-gnuplot-process nil))) -) + (setq calc-gnuplot-process nil)))) (defun calc-graph-quit () (interactive) @@ -1335,20 +1280,17 @@ (calc-graph-view-commands t)) (if (get-buffer-window calc-gnuplot-buffer) (calc-graph-view-trail t)) - (calc-graph-kill t) -) + (calc-graph-kill t)) (defun calc-graph-view-commands (&optional no-need) (interactive "p") (or calc-graph-no-auto-view (calc-graph-init-buffers)) - (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)) -) + (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need))) (defun calc-graph-view-trail (&optional no-need) (interactive "p") (or calc-graph-no-auto-view (calc-graph-init-buffers)) - (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)) -) + (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need))) (defun calc-graph-view (buf other-buf need) (let (win) @@ -1383,8 +1325,7 @@ (vertical-motion (- 6 (window-height win))) (set-window-start win (point)) (goto-char (point-max))))) - (or calc-graph-no-auto-view (sit-for 0))) -) + (or calc-graph-no-auto-view (sit-for 0)))) (setq calc-graph-no-auto-view nil) (defun calc-gnuplot-check-for-errors () @@ -1396,8 +1337,7 @@ (re-search-forward "^[ \t]+\\^$" nil t) (goto-char (point-max)) (setq calc-gnuplot-last-error-pos (point-max)))) - (calc-graph-view-trail)) -) + (calc-graph-view-trail))) (defun calc-gnuplot-command (&rest args) (calc-graph-init) @@ -1418,8 +1358,7 @@ calc-gnuplot-process)) (calc-gnuplot-check-for-errors) (if (get-buffer-window calc-gnuplot-buffer) - (calc-graph-view-trail)))) -) + (calc-graph-view-trail))))) (setq calc-graph-no-wait nil) (defun calc-graph-init-buffers () @@ -1428,8 +1367,7 @@ (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*"))) (or (and calc-gnuplot-input (buffer-name calc-gnuplot-input)) - (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))) -) + (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*")))) (defun calc-graph-init () (or (calc-gnuplot-alive) @@ -1491,6 +1429,6 @@ (eq (char-after (1- (point-max))) ?\n) (progn (goto-char (point-max)) - (insert "\n"))))) -) + (insert "\n")))))) +;;; calc-graph.el ends here
--- a/lisp/calc/calc-help.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-help.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-help.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -43,8 +43,7 @@ (message "") (if key (call-interactively key) - (beep))) -) + (beep)))) (defun calc-help-for-help (arg) "You have typed `h', the Calc help character. Type a Help option: @@ -84,20 +83,17 @@ (calc-unread-command (cdr key)) (calc-help-prefix nil)) (let ((calc-dispatch-help t)) - (calc-help-prefix arg))) -) + (calc-help-prefix arg)))) (defun calc-describe-copying () (interactive) (calc-info) - (Info-goto-node "Copying") -) + (Info-goto-node "Copying")) (defun calc-describe-distribution () (interactive) (calc-info) - (Info-goto-node "Reporting Bugs") -) + (Info-goto-node "Reporting Bugs")) (defun calc-describe-no-warranty () (interactive) @@ -106,8 +102,7 @@ (let ((case-fold-search nil)) (search-forward " NO WARRANTY")) (beginning-of-line) - (recenter 0) -) + (recenter 0)) (defun calc-describe-bindings () (interactive) @@ -141,13 +136,11 @@ (delete-backward-char 1) (delete-char 1) (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2))))) - (goto-char (point-min))) -) + (goto-char (point-min)))) (defun calc-describe-key-briefly (key) (interactive "kDescribe key briefly: ") - (calc-describe-key key t) -) + (calc-describe-key key t)) (defun calc-describe-key (key &optional briefly) (interactive "kDescribe key: ") @@ -298,8 +291,7 @@ (if inv (setq desc (concat "I " desc))) (if hyp (setq desc (concat "H " desc))) (calc-describe-thing desc "Key Index" nil - (string-match "[A-Z][A-Z][A-Z]" desc))))) -) + (string-match "[A-Z][A-Z][A-Z]" desc)))))) (defun calc-describe-function (&optional func) (interactive) @@ -312,8 +304,7 @@ (calc-describe-thing (if (string-match "\\`calcFunc-." func) (substring func 9) func) - "Function Index")) -) + "Function Index"))) (defun calc-describe-variable (&optional var) (interactive) @@ -324,8 +315,7 @@ (calc-describe-thing var "Variable Index" (if (string-match "\\`var-." var) (substring var 4) - var)) -) + var))) (defun calc-describe-thing (thing where &optional target not-quoted) (message "Looking for `%s' in %s..." thing where) @@ -365,8 +355,7 @@ (search-forward (format "`%s'" (or target thing)) nil t) (search-forward (or target thing) nil t)))) (beginning-of-line) - (message "Found `%s' in %s" thing where)) -) + (message "Found `%s' in %s" thing where))) (defun calc-view-news () (interactive) @@ -384,10 +373,7 @@ (search-forward "Summary of changes") (forward-line -1) (delete-region (point-min) (point)) - (goto-char (point-min))) -) - - + (goto-char (point-min)))) (defun calc-full-help () (interactive) @@ -444,23 +430,20 @@ calc-shift-Y-prefix-help calc-shift-Z-prefix-help calc-z-prefix-help))) - (print-help-return-message)) -) + (print-help-return-message))) -(defvar calc-help-long-names '( ( ?b . "binary/business" ) - ( ?g . "graphics" ) - ( ?j . "selection" ) - ( ?k . "combinatorics/statistics" ) - ( ?u . "units/statistics" ) -)) +(defvar calc-help-long-names '((?b . "binary/business") + (?g . "graphics") + (?j . "selection") + (?k . "combinatorics/statistics") + (?u . "units/statistics"))) (defun calc-h-prefix-help () (interactive) (calc-do-prefix-help '("Help; Bindings; Info, Tutorial, Summary; News" "describe: Key, C (briefly), Function, Variable") - "help" ?h) -) + "help" ?h)) (defun calc-inverse-prefix-help () (interactive) @@ -474,8 +457,7 @@ "I + v s (remove subvec); v h (tail)" "I + t + (alt sum), t M (mean with error)" "I + t S (pop std dev), t C (pop covar)") - "inverse" nil) -) + "inverse" nil)) (defun calc-hyperbolic-prefix-help () (interactive) @@ -490,8 +472,7 @@ "H + a R (widen/root), a N (widen/min), a X (widen/max)" "H + t M (median), t S (variance), t C (correlation coef)" "H + c f/F/c (pervasive float/frac/clean)") - "hyperbolic" nil) -) + "hyperbolic" nil)) (defun calc-inv-hyp-prefix-help () (interactive) @@ -501,8 +482,7 @@ "I H + F (float ceiling), R (float truncate)" "I H + t S (pop variance)" "I H + a S (general invert func); v h (rtail)") - "inverse-hyperbolic" nil) -) + "inverse-hyperbolic" nil)) (defun calc-f-prefix-help () @@ -513,8 +493,7 @@ "SHIFT + int-sQrt; Int-log, Exp(x)-1, Ln(x+1); arcTan2" "SHIFT + Abssqr; Mantissa, eXponent, Scale" "SHIFT + incomplete: Gamma-P, Beta-I") - "functions" ?f) -) + "functions" ?f)) (defun calc-s-prefix-help () @@ -526,15 +505,13 @@ "SHIFT + Decls, GenCount, TimeZone, Holidays; IntegLimit" "SHIFT + LineStyles, PointStyles, plotRejects; Units" "SHIFT + Eval-, AlgSimp-, ExtSimp-, FitRules") - "store" ?s) -) + "store" ?s)) (defun calc-r-prefix-help () (interactive) (calc-do-prefix-help '("digits 0-9: recall, same as `s r 0-9'") - "recall" ?r) -) + "recall" ?r)) (defun calc-j-prefix-help () @@ -547,8 +524,7 @@ "SHIFT + swap: Left, Right; maybe: Select, Once" "SHIFT + Commute, Merge, Distrib, jump-Eqn, Isolate" "SHIFT + Negate, & (invert); Unpack") - "select" ?j) -) + "select" ?j)) (defun calc-a-prefix-help () @@ -564,8 +540,7 @@ "relations: =, # (not =), <, >, [ (< or =), ] (> or =)" "logical: & (and), | (or), ! (not); : (if)" "misc: { (in-set); . (rmeq)") - "algebra" ?a) -) + "algebra" ?a)) (defun calc-b-prefix-help () @@ -575,8 +550,7 @@ "Lshift, Rshift, roTate; SHIFT + signed Lshift, Rshift" "SHIFT + business: Pv, Npv, Fv, pMt, #pmts, raTe, Irr" "SHIFT + business: Sln, sYd, Ddb; %ch") - "binary/bus" ?b) -) + "binary/bus" ?b)) (defun calc-c-prefix-help () @@ -584,8 +558,7 @@ (calc-do-prefix-help '("Deg, Rad, HMS; Float; Polar/rect; Clean, 0-9; %" "SHIFT + Fraction") - "convert" ?c) -) + "convert" ?c)) (defun calc-d-prefix-help () @@ -598,8 +571,7 @@ "SHIFT + language: Normal, One-line, Big, Unformatted" "SHIFT + language: C, Pascal, Fortran; TeX, Eqn" "SHIFT + language: Mathematica, W=Maple") - "display" ?d) -) + "display" ?d)) (defun calc-g-prefix-help () @@ -612,8 +584,7 @@ "SHIFT + Print; Device, Output-file; X-geometry" "SHIFT + Num-pts; Command, Kill, View-trail" "SHIFT + 3d: Fast, Add; CTRL + z-axis: Range, Title, Log") - "graph" ?g) -) + "graph" ?g)) (defun calc-k-prefix-help () @@ -626,8 +597,7 @@ "SHIFT + Extended-gcd" "SHIFT + dists: Binomial, Chi-square, F, Normal" "SHIFT + dists: Poisson, student's-T") - "combinatorics" ?k) -) + "combinatorics" ?k)) (defun calc-m-prefix-help () @@ -637,8 +607,7 @@ "Working; Xtensions; Mode-save" "SHIFT + Shifted-prefixes, mode-Filename; Record; reCompute" "SHIFT + simplify: Off, Num, Default, Bin, Alg, Ext, Units") - "mode" ?m) -) + "mode" ?m)) (defun calc-t-prefix-help () @@ -650,8 +619,7 @@ "SHIFT + time: newWeek, newMonth, newYear; Incmonth" "SHIFT + time: +, - (business days)" "digits 0-9: store-to, same as `s t 0-9'") - "trail/time" ?t) -) + "trail/time" ?t)) (defun calc-u-prefix-help () @@ -663,8 +631,7 @@ "SHIFT + View-table-other-window" "SHIFT + stat: Mean, G-mean, Std-dev, Covar, maX, miN" "SHIFT + stat: + (sum), - (asum), * (prod), # (count)") - "units/stat" ?u) -) + "units/stat" ?u)) (defun calc-v-prefix-help () @@ -681,6 +648,6 @@ "SHIFT + sets: : (span), # (card), + (rdup)" "<, =, > (justification); , (commas); [, {, ( (brackets)" "} (matrix brackets); . (abbreviate); / (multi-lines)") - "vec/mat" ?v) -) + "vec/mat" ?v)) +;;; calc-help.el ends here
--- a/lisp/calc/calc-incom.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-incom.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-incom.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -36,8 +36,7 @@ (calc-wrapper (if (or calc-algebraic-mode calc-incomplete-algebraic-mode) (calc-alg-entry "(") - (calc-push (list 'incomplete calc-complex-mode)))) -) + (calc-push (list 'incomplete calc-complex-mode))))) (defun calc-end-complex () (interactive) @@ -60,16 +59,14 @@ (if (not (and (math-realp (nth 2 top)) (math-anglep (nth 3 top)))) (error "Components must be real")) - (calc-enter-result 1 "()" (cdr top))))) -) + (calc-enter-result 1 "()" (cdr top)))))) (defun calc-begin-vector () (interactive) (calc-wrapper (if (or calc-algebraic-mode calc-incomplete-algebraic-mode) (calc-alg-entry "[") - (calc-push '(incomplete vec)))) -) + (calc-push '(incomplete vec))))) (defun calc-end-vector () (interactive) @@ -88,8 +85,7 @@ (if (not (and (eq (car-safe top) 'incomplete) (eq (nth 1 top) 'vec))) (error "Not entering a vector")) - (calc-pop-push-record 1 "[]" (cdr top))))) -) + (calc-pop-push-record 1 "[]" (cdr top)))))) (defun calc-comma (&optional allow-polar) (interactive) @@ -121,8 +117,7 @@ (if (and (eq (nth 1 new) 'intv) (> (length new) 5)) (error "Too many components in interval form")) - (calc-pop-push num new)))) -) + (calc-pop-push num new))))) (defun calc-semi () (interactive) @@ -169,8 +164,7 @@ (calc-pop-push num (list 'incomplete 'vec (cons 'vec (append (cdr (cdr inc)) stuff))) - (list 'incomplete 'vec))))))) -) + (list 'incomplete 'vec)))))))) (defun calc-digit-dots () (if (eq calc-prev-char ?.) @@ -186,8 +180,7 @@ (erase-buffer) (exit-minibuffer))) ;; just ignore extra decimal point, anticipating ".." - (delete-backward-char 1)) -) + (delete-backward-char 1))) (defun calc-dots () (interactive) @@ -208,8 +201,7 @@ (setq new (append new '((neg (var inf var-inf)))))) (if (> (length new) 5) (error "Too many components in interval form")) - (calc-pop-push num new)))) -) + (calc-pop-push num new))))) (defun calc-find-first-incomplete (stack n) (cond ((null stack) @@ -217,8 +209,7 @@ ((eq (car-safe (car-safe (car stack))) 'incomplete) n) (t - (calc-find-first-incomplete (cdr stack) (1+ n)))) -) + (calc-find-first-incomplete (cdr stack) (1+ n))))) (defun calc-incomplete-error (a) (cond ((memq (nth 1 a) '(cplx polar)) @@ -227,8 +218,6 @@ (error "Vector is incomplete")) ((eq (nth 1 a) 'intv) (error "Interval form is incomplete")) - (t (error "Object is incomplete"))) -) + (t (error "Object is incomplete")))) - - +;;; calc-incom.el ends here
--- a/lisp/calc/calc-keypd.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-keypd.el Wed Nov 14 09:09:09 2001 +0000 @@ -127,8 +127,7 @@ (interactive) (if calc-standalone-flag (save-buffers-kill-emacs nil) - (calc-keypad)) -) + (calc-keypad))) (defun calc-keypad-redraw () (set-buffer calc-keypad-buffer) @@ -176,8 +175,7 @@ row (cdr row))))) (setq calc-keypad-prev-input t) (calc-keypad-show-input) - (goto-char (point-min)) -) + (goto-char (point-min))) (defun calc-keypad-show-input () (or (equal calc-keypad-input calc-keypad-prev-input) @@ -191,8 +189,7 @@ (insert "----+-----Calc " calc-version "-----+----" (int-to-string (1+ calc-keypad-menu)) "\n"))))) - (setq calc-keypad-prev-input calc-keypad-input) -) + (setq calc-keypad-prev-input calc-keypad-input)) (defun calc-keypad-press () (interactive) @@ -343,8 +340,7 @@ (command-execute (car cmd)))) (command-execute cmd))))) (set-buffer calc-keypad-buffer) - (calc-keypad-show-input))) -) + (calc-keypad-show-input)))) (defun calc-keypad-left-click (event) "Handle a left-button mouse click in Calc Keypad window." @@ -372,8 +368,7 @@ (while (progn (setq calc-keypad-menu (% (1+ calc-keypad-menu) (length calc-keypad-menus))) (not (symbol-value (nth calc-keypad-menu calc-keypad-menus))))) - (calc-keypad-redraw) -) + (calc-keypad-redraw)) (defun calc-keypad-menu-back () (interactive) @@ -383,25 +378,21 @@ (length calc-keypad-menus))) (length calc-keypad-menus))) (not (symbol-value (nth calc-keypad-menu calc-keypad-menus))))) - (calc-keypad-redraw) -) + (calc-keypad-redraw)) (defun calc-keypad-store () (interactive) - (setq calc-keypad-input "STO") -) + (setq calc-keypad-input "STO")) (defun calc-keypad-recall () (interactive) - (setq calc-keypad-input "RCL") -) + (setq calc-keypad-input "RCL")) (defun calc-pack-interval (mode) (interactive "p") (if (or (< mode 0) (> mode 3)) (error "Open/close code should be in the range from 0 to 3.")) - (calc-pack (- -6 mode)) -) + (calc-pack (- -6 mode))) (defun calc-keypad-execute () (interactive) @@ -430,8 +421,7 @@ (message "") (if (commandp cmd) (command-execute cmd) - (error "Not a Calc command: %s" (key-description keys)))) -) + (error "Not a Calc command: %s" (key-description keys))))) ;;; |----+----+----+----+----+----| @@ -474,8 +464,7 @@ ( "0" ("0") calc-imaginary ) ( "." (".") calc-precision ) ( "PI" calc-pi ) - ( "+" calc-plus calc-sqrt ) ) ) -) + ( "+" calc-plus calc-sqrt ) ) )) (defvar calc-keypad-menus '( calc-keypad-math-menu calc-keypad-funcs-menu @@ -509,8 +498,7 @@ ( "TAN" calc-tan ) ( "SQRT" calc-sqrt ) ( "y^x" calc-power ) - ( "1/x" calc-inv ) ) ) -) + ( "1/x" calc-inv ) ) )) ;;; |----+----+----+----+----+----| ;;; |IGAM|BETA|IBET|ERF |BESJ|BESY| @@ -537,8 +525,7 @@ ( "DFCT" calc-double-factorial ) ( "BNOM" calc-choose ) ( "PERM" calc-perm ) - ( "NXTP" calc-next-prime calc-prev-prime ) ) ) -) + ( "NXTP" calc-next-prime calc-prev-prime ) ) )) ;;; |----+----+----+----+----+----| ;;; |AND | OR |XOR |NOT |LSH |RSH | @@ -565,8 +552,7 @@ ( "C" ("C") ) ( "D" ("D") ) ( "E" ("E") ) - ( "F" ("F") ) ) ) -) + ( "F" ("F") ) ) )) ;;; |----+----+----+----+----+----| ;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$| @@ -598,8 +584,7 @@ ( "INDX" (progn calc-num-prefix calc-index) "\C-u\excalc-index\r" ) ( "BLD" (progn calc-num-prefix calc-build-vector) ) ( "LEN" calc-vlength ) - ( "..." calc-full-vectors ) ) ) -) + ( "..." calc-full-vectors ) ) )) ;;; |----+----+----+----+----+----| ;;; |FLT |FIX |SCI |ENG |GRP | | @@ -630,6 +615,6 @@ ( "RLL4" (progn 4 calc-roll-up) (progn 4 calc-roll-down) ) ( "OVER" calc-over ) ( "STO" calc-keypad-store ) - ( "RCL" calc-keypad-recall ) ) ) -) + ( "RCL" calc-keypad-recall ) ) )) +;;; calc-keypd.el ends here
--- a/lisp/calc/calc-lang.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-lang.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-lang.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -46,44 +46,38 @@ (setq calc-language lang calc-language-option option) (calc-change-mode '(calc-language calc-language-option) - (list lang option) t)) -) + (list lang option) t))) (defun calc-normal-language () (interactive) (calc-wrapper (calc-set-language nil) - (message "Normal language mode.")) -) + (message "Normal language mode."))) (defun calc-flat-language () (interactive) (calc-wrapper (calc-set-language 'flat) - (message "Flat language mode (all stack entries shown on one line).")) -) + (message "Flat language mode (all stack entries shown on one line)."))) (defun calc-big-language () (interactive) (calc-wrapper (calc-set-language 'big) - (message "\"Big\" language mode.")) -) + (message "\"Big\" language mode."))) (defun calc-unformatted-language () (interactive) (calc-wrapper (calc-set-language 'unform) - (message "Unformatted language mode.")) -) + (message "Unformatted language mode."))) (defun calc-c-language () (interactive) (calc-wrapper (calc-set-language 'c) - (message "`C' language mode.")) -) + (message "`C' language mode."))) (put 'c 'math-oper-table '( ( "u+" ident -1 1000 ) @@ -114,8 +108,7 @@ ( "|||" calcFunc-por 75 76 ) ( "=" calcFunc-assign 51 50 ) ( ":=" calcFunc-assign 51 50 ) - ( "::" calcFunc-condition 45 46 ) -)) ; should support full assignments + ( "::" calcFunc-condition 45 46 ))) ; should support full assignments (put 'c 'math-function-table '( ( acos . calcFunc-arccos ) @@ -124,13 +117,11 @@ ( asinh . calcFunc-arcsinh ) ( atan . calcFunc-arctan ) ( atan2 . calcFunc-arctan2 ) - ( atanh . calcFunc-arctanh ) -)) + ( atanh . calcFunc-arctanh ))) (put 'c 'math-variable-table '( ( M_PI . var-pi ) - ( M_E . var-e ) -)) + ( M_E . var-e ))) (put 'c 'math-vector-brackets "{}") @@ -150,8 +141,7 @@ (if (> n 0) "Pascal language mode (all uppercase)." "Pascal language mode (all lowercase).") - "Pascal language mode."))) -) + "Pascal language mode.")))) (put 'pascal 'math-oper-table '( ( "not" calcFunc-lnot -1 1000 ) @@ -179,8 +169,7 @@ ( "&&&" calcFunc-pand 80 81 ) ( "|||" calcFunc-por 75 76 ) ( ":=" calcFunc-assign 51 50 ) - ( "::" calcFunc-condition 45 46 ) -)) + ( "::" calcFunc-condition 45 46 ))) (put 'pascal 'math-input-filter 'calc-input-case-filter) (put 'pascal 'math-output-filter 'calc-output-case-filter) @@ -194,8 +183,7 @@ (cond ((or (null calc-language-option) (= calc-language-option 0)) str) (t - (downcase str))) -) + (downcase str)))) (defun calc-output-case-filter (str) (cond ((or (null calc-language-option) (= calc-language-option 0)) @@ -203,8 +191,7 @@ ((> calc-language-option 0) (upcase str)) (t - (downcase str))) -) + (downcase str)))) (defun calc-fortran-language (n) @@ -216,8 +203,7 @@ (if (> n 0) "FORTRAN language mode (all uppercase)." "FORTRAN language mode (all lowercase).") - "FORTRAN language mode."))) -) + "FORTRAN language mode.")))) (put 'fortran 'math-oper-table '( ( "u/" (math-parse-fortran-vector) -1 1 ) @@ -243,8 +229,7 @@ ( "|||" calcFunc-por 75 76 ) ( "=" calcFunc-assign 51 50 ) ( ":=" calcFunc-assign 51 50 ) - ( "::" calcFunc-condition 45 46 ) -)) + ( "::" calcFunc-condition 45 46 ))) (put 'fortran 'math-vector-brackets "//") @@ -261,8 +246,7 @@ ( conjg . calcFunc-conj ) ( log . calcFunc-ln ) ( nint . calcFunc-round ) - ( real . calcFunc-re ) -)) + ( real . calcFunc-re ))) (put 'fortran 'math-input-filter 'calc-input-case-filter) (put 'fortran 'math-output-filter 'calc-output-case-filter) @@ -272,8 +256,7 @@ (prog1 (math-read-brackets t "]") (setq exp-token (car math-parsing-fortran-vector) - exp-data (cdr math-parsing-fortran-vector)))) -) + exp-data (cdr math-parsing-fortran-vector))))) (defun math-parse-fortran-vector-end (x op) (if math-parsing-fortran-vector @@ -282,8 +265,7 @@ exp-token 'end exp-data "\000") x) - (throw 'syntax "Unmatched closing `/'")) -) + (throw 'syntax "Unmatched closing `/'"))) (setq math-parsing-fortran-vector nil) (defun math-parse-fortran-subscr (sym args) @@ -291,8 +273,7 @@ (while args (setq sym (list 'calcFunc-subscr sym (car args)) args (cdr args))) - sym -) + sym) (defun calc-tex-language (n) @@ -304,8 +285,7 @@ (if (> n 0) "TeX language mode with \\hbox{func}(\\hbox{var})." "TeX language mode with \\func{\\hbox{var}}.") - "TeX language mode."))) -) + "TeX language mode.")))) (put 'tex 'math-oper-table '( ( "u+" ident -1 1000 ) @@ -360,8 +340,7 @@ ( "\\to" calcFunc-evalto 40 41 ) ( "\\to" calcFunc-evalto 40 -1 ) ( "=>" calcFunc-evalto 40 41 ) - ( "=>" calcFunc-evalto 40 -1 ) -)) + ( "=>" calcFunc-evalto 40 -1 ))) (put 'tex 'math-function-table '( ( \\arccos . calcFunc-arccos ) @@ -383,8 +362,7 @@ ( \\sqrt . calcFunc-sqrt ) ( \\tanh . calcFunc-tanh ) ( \\phi . calcFunc-totient ) - ( \\mu . calcFunc-moebius ) -)) + ( \\mu . calcFunc-moebius ))) (put 'tex 'math-variable-table '( ( \\pi . var-pi ) @@ -393,8 +371,7 @@ ( \\phi . var-phi ) ( \\gamma . var-gamma ) ( \\sum . (math-parse-tex-sum calcFunc-sum) ) - ( \\prod . (math-parse-tex-sum calcFunc-prod) ) -)) + ( \\prod . (math-parse-tex-sum calcFunc-prod) ))) (put 'tex 'math-complex-format 'i) @@ -411,15 +388,13 @@ (or (equal exp-data "^") (throw 'syntax "Expected `^'")) (math-read-token) (setq high (math-read-factor)) - (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high)) -) + (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))) (defun math-tex-input-filter (str) ; allow parsing of 123\,456\,789. (while (string-match "[0-9]\\\\,[0-9]" str) (setq str (concat (substring str 0 (1+ (match-beginning 0))) (substring str (1- (match-end 0)))))) - str -) + str) (put 'tex 'math-input-filter 'math-tex-input-filter) @@ -427,8 +402,7 @@ (interactive "P") (calc-wrapper (calc-set-language 'eqn) - (message "Eqn language mode.")) -) + (message "Eqn language mode."))) (put 'eqn 'math-oper-table '( ( "u+" ident -1 1000 ) @@ -482,8 +456,7 @@ ( "->" calcFunc-evalto 40 41 ) ( "->" calcFunc-evalto 40 -1 ) ( "=>" calcFunc-evalto 40 41 ) - ( "=>" calcFunc-evalto 40 -1 ) -)) + ( "=>" calcFunc-evalto 40 -1 ))) (put 'eqn 'math-function-table '( ( arc\ cos . calcFunc-arccos ) @@ -495,12 +468,10 @@ ( GAMMA . calcFunc-gamma ) ( phi . calcFunc-totient ) ( mu . calcFunc-moebius ) - ( matrix . (math-parse-eqn-matrix) ) -)) + ( matrix . (math-parse-eqn-matrix) ))) (put 'eqn 'math-variable-table - '( ( inf . var-uinf ) -)) + '( ( inf . var-uinf ))) (put 'eqn 'math-complex-format 'i) @@ -518,8 +489,7 @@ (or (equal exp-data calc-function-close) (throw 'syntax "Expected `}'")) (math-read-token) - (math-transpose (cons 'vec (nreverse vec)))) -) + (math-transpose (cons 'vec (nreverse vec))))) (defun math-parse-eqn-prime (x sym) (if (eq (car-safe x) 'var) @@ -538,16 +508,14 @@ (list 'var (intern (concat (symbol-name (nth 1 x)) "'")) (intern (concat (symbol-name (nth 2 x)) "'")))) - (list 'calcFunc-Prime x)) -) + (list 'calcFunc-Prime x))) (defun calc-mathematica-language () (interactive) (calc-wrapper (calc-set-language 'math) - (message "Mathematica language mode.")) -) + (message "Mathematica language mode."))) (put 'math 'math-oper-table '( ( "[[" (math-read-math-subscr) 250 -1 ) @@ -653,16 +621,14 @@ (equal exp-data "]"))) (throw 'syntax "Expected ']]'")) (math-read-token) - (list 'calcFunc-subscr x idx)) -) + (list 'calcFunc-subscr x idx))) (defun calc-maple-language () (interactive) (calc-wrapper (calc-set-language 'maple) - (message "Maple language mode.")) -) + (message "Maple language mode."))) (put 'maple 'math-oper-table '( ( "matrix" ident -1 300 ) @@ -732,8 +698,7 @@ (put 'maple 'math-complex-format 'I) (defun math-read-maple-dots (x op) - (list 'intv 3 x (math-read-expr-level (nth 3 op))) -) + (list 'intv 3 x (math-read-expr-level (nth 3 op)))) @@ -1074,8 +1039,7 @@ the-h2 h) (or short (= the-h2 h2) (math-read-big-error h baseline)) - p)) -) + p))) (defun math-read-big-char (h v) (or (and (>= h h1) @@ -1086,8 +1050,7 @@ (and line (< h (length line)) (aref line h)))) - ?\ ) -) + ?\ )) (defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error) (and (< ev1 v1) (setq ev1 v1)) @@ -1109,8 +1072,7 @@ (< h eh1))) (setq ev1 (1+ ev1) p (cdr p))) - (>= ev1 ev2)) -) + (>= ev1 ev2))) (defun math-read-big-error (h v &optional msg) (let ((pos 0) @@ -1121,8 +1083,7 @@ v (1- v))) (setq h (+ pos (min h (length (car p)))) err-msg (list 'error h (or msg "Syntax error"))) - (throw 'syntax nil)) -) + (throw 'syntax nil))) (defun math-read-big-balance (h v what &optional commas) (let* ((line (nth v lines)) @@ -1143,9 +1104,6 @@ (memq (aref line h) '(?\) ?\]))) (setq count (1- count)))) (setq h (1+ h)))) - h) -) + h)) - - - +;;; calc-lang.el ends here
--- a/lisp/calc/calc-macs.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-macs.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part I [calc-macs.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -32,27 +32,23 @@ (defmacro calc-wrapper (&rest body) - (list 'calc-do (list 'function (append (list 'lambda ()) body))) -) + (list 'calc-do (list 'function (append (list 'lambda ()) body)))) ;; We use "point" here to generate slightly smaller byte-code than "t". (defmacro calc-slow-wrapper (&rest body) - (list 'calc-do (list 'function (append (list 'lambda ()) body)) (point)) -) + (list 'calc-do (list 'function (append (list 'lambda ()) body)) (point))) (defmacro math-showing-full-precision (body) (list 'let '((calc-float-format calc-full-float-format)) - body) -) + body)) (defmacro math-with-extra-prec (delta &rest body) (` (math-normalize (let ((calc-internal-prec (+ calc-internal-prec (, delta)))) - (,@ body)))) -) + (,@ body))))) ;;; Faster in-line version zerop, normalized values only. @@ -62,20 +58,17 @@ (if (eq (car (, a)) 'float) (eq (nth 1 (, a)) 0) (math-zerop (, a)))) - (eq (, a) 0))) -) + (eq (, a) 0)))) (defmacro Math-integer-negp (a) (` (if (consp (, a)) (eq (car (, a)) 'bigneg) - (< (, a) 0))) -) + (< (, a) 0)))) (defmacro Math-integer-posp (a) (` (if (consp (, a)) (eq (car (, a)) 'bigpos) - (> (, a) 0))) -) + (> (, a) 0)))) (defmacro Math-negp (a) @@ -85,8 +78,7 @@ (if (memq (car (, a)) '(frac float)) (Math-integer-negp (nth 1 (, a))) (math-negp (, a))))) - (< (, a) 0))) -) + (< (, a) 0)))) (defmacro Math-looks-negp (a) ; [P x] [Public] @@ -94,8 +86,7 @@ (and (consp (, a)) (or (eq (car (, a)) 'neg) (and (memq (car (, a)) '(* /)) (or (math-looks-negp (nth 1 (, a))) - (math-looks-negp (nth 2 (, a))))))))) -) + (math-looks-negp (nth 2 (, a)))))))))) (defmacro Math-posp (a) @@ -105,69 +96,57 @@ (if (memq (car (, a)) '(frac float)) (Math-integer-posp (nth 1 (, a))) (math-posp (, a))))) - (> (, a) 0))) -) + (> (, a) 0)))) (defmacro Math-integerp (a) (` (or (not (consp (, a))) - (memq (car (, a)) '(bigpos bigneg)))) -) + (memq (car (, a)) '(bigpos bigneg))))) (defmacro Math-natnump (a) (` (if (consp (, a)) (eq (car (, a)) 'bigpos) - (>= (, a) 0))) -) + (>= (, a) 0)))) (defmacro Math-ratp (a) (` (or (not (consp (, a))) - (memq (car (, a)) '(bigpos bigneg frac)))) -) + (memq (car (, a)) '(bigpos bigneg frac))))) (defmacro Math-realp (a) (` (or (not (consp (, a))) - (memq (car (, a)) '(bigpos bigneg frac float)))) -) + (memq (car (, a)) '(bigpos bigneg frac float))))) (defmacro Math-anglep (a) (` (or (not (consp (, a))) - (memq (car (, a)) '(bigpos bigneg frac float hms)))) -) + (memq (car (, a)) '(bigpos bigneg frac float hms))))) (defmacro Math-numberp (a) (` (or (not (consp (, a))) - (memq (car (, a)) '(bigpos bigneg frac float cplx polar)))) -) + (memq (car (, a)) '(bigpos bigneg frac float cplx polar))))) (defmacro Math-scalarp (a) (` (or (not (consp (, a))) - (memq (car (, a)) '(bigpos bigneg frac float cplx polar hms)))) -) + (memq (car (, a)) '(bigpos bigneg frac float cplx polar hms))))) (defmacro Math-vectorp (a) - (` (and (consp (, a)) (eq (car (, a)) 'vec))) -) + (` (and (consp (, a)) (eq (car (, a)) 'vec)))) (defmacro Math-messy-integerp (a) (` (and (consp (, a)) (eq (car (, a)) 'float) - (>= (nth 2 (, a)) 0))) -) + (>= (nth 2 (, a)) 0)))) (defmacro Math-objectp (a) ; [Public] (` (or (not (consp (, a))) (memq (car (, a)) - '(bigpos bigneg frac float cplx polar hms date sdev intv mod)))) -) + '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))) (defmacro Math-objvecp (a) ; [Public] (` (or (not (consp (, a))) (memq (car (, a)) '(bigpos bigneg frac float cplx polar hms date - sdev intv mod vec)))) -) + sdev intv mod vec))))) ;;; Compute the negative of A. [O O; o o] [Public] @@ -176,38 +155,32 @@ (if (eq (car (, a)) 'bigpos) (cons 'bigneg (cdr (, a))) (cons 'bigpos (cdr (, a)))) - (- (, a)))) -) + (- (, a))))) (defmacro Math-equal (a b) - (` (= (math-compare (, a) (, b)) 0)) -) + (` (= (math-compare (, a) (, b)) 0))) (defmacro Math-lessp (a b) - (` (= (math-compare (, a) (, b)) -1)) -) + (` (= (math-compare (, a) (, b)) -1))) (defmacro math-working (msg arg) ; [Public] (` (if (eq calc-display-working-message 'lots) - (math-do-working (, msg) (, arg)))) -) + (math-do-working (, msg) (, arg))))) (defmacro calc-with-default-simplification (body) (list 'let '((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num))) calc-simplify-mode))) - body) -) + body)) (defmacro Math-primp (a) (` (or (not (consp (, a))) (memq (car (, a)) '(bigpos bigneg frac float cplx polar - hms date mod var)))) -) + hms date mod var))))) (defmacro calc-with-trail-buffer (&rest body) @@ -218,23 +191,20 @@ (set-buffer (calc-trail-display t)) (goto-char calc-trail-pointer)) body)) - (set-buffer save-buf)))) -) + (set-buffer save-buf))))) (defmacro Math-num-integerp (a) (` (or (not (consp (, a))) (memq (car (, a)) '(bigpos bigneg)) (and (eq (car (, a)) 'float) - (>= (nth 2 (, a)) 0)))) -) + (>= (nth 2 (, a)) 0))))) (defmacro Math-bignum-test (a) ; [B N; B s; b b] (` (if (consp (, a)) (, a) - (math-bignum (, a)))) -) + (math-bignum (, a))))) (defmacro Math-equal-int (a b) @@ -242,20 +212,18 @@ (and (consp (, a)) (eq (car (, a)) 'float) (eq (nth 1 (, a)) (, b)) - (= (nth 2 (, a)) 0)))) -) + (= (nth 2 (, a)) 0))))) (defmacro Math-natnum-lessp (a b) (` (if (consp (, a)) (and (consp (, b)) (= (math-compare-bignum (cdr (, a)) (cdr (, b))) -1)) (or (consp (, b)) - (< (, a) (, b))))) -) + (< (, a) (, b)))))) (defmacro math-format-radix-digit (a) ; [X D] - (` (aref math-radix-digits (, a))) -) + (` (aref math-radix-digits (, a)))) +;;; calc-macs.el ends here
--- a/lisp/calc/calc-maint.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-maint.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, maintenance routines -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -42,8 +42,7 @@ (calc-do-compile)) (fset 'message old-message) (fset 'write-region old-write-region))) - (calc-do-compile)) -) + (calc-do-compile))) (defun calc-do-compile () (let ((make-backup-files nil) @@ -133,8 +132,7 @@ (sort rules 'string<)) (save-buffer)))) (error (message "Unable to pre-build tables %s" err)))) - (message "Done. Don't forget to install with \"make public\" or \"make private\".")) -) + (message "Done. Don't forget to install with \"make public\" or \"make private\"."))) (defun calc-compile-message (fmt &rest args) (cond ((and (= (length args) 2) @@ -166,8 +164,7 @@ (send-string-to-terminal (apply 'format fmt args))) ((string-match "\\(Preparing\\|Building\\).*\\.\\.\\. *done$" fmt) (send-string-to-terminal "done\n")) - (t (apply old-message fmt args))) -) + (t (apply old-message fmt args)))) (defun calc-compile-write-region (start end filename &optional append visit &rest rest) (if (eq visit t) @@ -182,8 +179,7 @@ (setq end (point-max)))) (apply old-write-region start end filename append 'quietly rest) (message "Wrote %s" filename) - nil -) + nil) @@ -241,8 +237,7 @@ (goto-char 1)) (message (cond ((eq part 1) "Wrote file calctut.tex") ((eq part 2) "Wrote file calcref.tex") - (t "Wrote files calctut.tex and calcref.tex"))) -) + (t "Wrote files calctut.tex and calcref.tex")))) (defun calc-split-volume (number fix name other-name) (goto-char 1) @@ -270,14 +265,12 @@ (while (search-forward "@c [not-split]\n" nil t) (while (not (looking-at "@c")) (insert "@c ") - (forward-line 1))) -) + (forward-line 1)))) (defun calc-inline-summary () "Make a special \"calcsum.tex\" file to be used with main manual." - (calc-split-summary nil t) -) + (calc-split-summary nil t)) (defun calc-split-summary (&optional force in-line) "Make a special \"calcsum.tex\" file with just the Calc summary." @@ -392,8 +385,7 @@ "Unable to find Key Index (calc.ky); no page numbers inserted")) (switch-to-buffer buf)) (save-buffer)) - (message "Wrote file calcsum.tex") -) + (message "Wrote file calcsum.tex")) @@ -414,8 +406,7 @@ (find-file name) (if buffer-read-only (error "No write permission for \"%s\"" buffer-file-name)) (goto-char (point-max)) - (calc-add-autoloads home "calc-public-autoloads")) -) + (calc-add-autoloads home "calc-public-autoloads"))) (defun calc-private-autoloads () "Modify the user's \".emacs\" file to contain the necessary autoload and @@ -424,8 +415,7 @@ (let ((home default-directory)) (find-file "~/.emacs") (goto-char (point-max)) - (calc-add-autoloads home "calc-private-autoloads")) -) + (calc-add-autoloads home "calc-private-autoloads"))) (defun calc-add-autoloads (home cmd) (barf-if-buffer-read-only) @@ -458,9 +448,6 @@ \(global-set-key \"\\e#\" 'calc-dispatch) ;;; End of Calc autoloads.\n") (let ((trim-versions-without-asking t)) - (save-buffer)) -) + (save-buffer))) - - -;;; End. +;;; calc-maint.el ends here
--- a/lisp/calc/calc-map.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-map.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-map.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -48,8 +48,7 @@ (nth 2 oper)) (list 'calcFunc-apply (math-calcFunc-to-var (nth 1 oper)) - expr)))) -) + expr))))) (defun calc-reduce (&optional oper accum) (interactive) @@ -91,13 +90,11 @@ "reduce" calc-mapping-dir))) (math-calcFunc-to-var (nth 1 oper)) - (calc-top-n (1+ calc-dollar-used))))))) -) + (calc-top-n (1+ calc-dollar-used)))))))) (defun calc-accumulate (&optional oper) (interactive) - (calc-reduce oper t) -) + (calc-reduce oper t)) (defun calc-map (&optional oper) (interactive) @@ -118,8 +115,7 @@ (cons (math-calcFunc-to-var (nth 1 oper)) (calc-top-list-n nargs - (1+ calc-dollar-used))))))) -) + (1+ calc-dollar-used)))))))) (defun calc-map-equation (&optional oper) (interactive) @@ -142,16 +138,14 @@ (cons (math-calcFunc-to-var (nth 1 oper)) (calc-top-list-n nargs - (1+ calc-dollar-used))))))) -) + (1+ calc-dollar-used)))))))) (defun calc-map-stack () "This is meant to be called by calc-keypad mode." (interactive) (let ((calc-verify-arglist nil)) (calc-unread-command ?\$) - (calc-map)) -) + (calc-map))) (defun calc-outer-product (&optional oper) (interactive) @@ -169,8 +163,7 @@ (cons 'calcFunc-outer (cons (math-calcFunc-to-var (nth 1 oper)) (calc-top-list-n - 2 (1+ calc-dollar-used))))))) -) + 2 (1+ calc-dollar-used)))))))) (defun calc-inner-product (&optional mul-oper add-oper) (interactive) @@ -196,8 +189,7 @@ (math-calcFunc-to-var (nth 1 mul-oper)) (math-calcFunc-to-var (nth 1 add-oper))) (calc-top-list-n - 2 (+ 1 mul-used calc-dollar-used)))))) -) + 2 (+ 1 mul-used calc-dollar-used))))))) ;;; Return a list of the form (nargs func name) (defun calc-get-operator (msg &optional nargs) @@ -448,8 +440,7 @@ (char-to-string key)))) (if (> (length name) 3) (substring name 0 3) - name))))) -) + name)))))) (setq calc-verify-arglist t) (setq calc-mapping-dir nil) @@ -763,8 +754,7 @@ (intern (concat "calcFunc-" (symbol-name (nth 1 f))))) (if (memq (car-safe f) '(lambda calcFunc-lambda)) f - (math-reject-arg f "*Expected a function name"))) -) + (math-reject-arg f "*Expected a function name")))) ;;; Convert a function name into a like-looking variable name formula. (defun math-calcFunc-to-var (f) @@ -785,8 +775,7 @@ (list 'var (intern base) (intern (concat "var-" base)))) - f) -) + f)) ;;; Expand a function call using "lambda" notation. (defun math-build-call (f args) @@ -807,8 +796,7 @@ ( calcFunc-vconcat . | ) )))) (if (and func (= (length args) 2)) (cons (cdr func) args) - (cons f args))))) -) + (cons f args)))))) ;;; Do substitutions in parallel to avoid crosstalk. (defun math-multi-subst (expr olds news) @@ -818,8 +806,7 @@ (setq args (cons (cons (car olds) (car news)) args) olds (cdr olds) news (cdr news))) - (math-multi-subst-rec expr)) -) + (math-multi-subst-rec expr))) (defun math-multi-subst-rec (expr) (cond ((setq temp (assoc expr args)) (cdr temp)) @@ -834,21 +821,18 @@ (nreverse (cons (math-multi-subst-rec (car expr)) new)))) (t (cons (car expr) - (mapcar 'math-multi-subst-rec (cdr expr))))) -) + (mapcar 'math-multi-subst-rec (cdr expr)))))) (defun calcFunc-call (f &rest args) (setq args (math-build-call (math-var-to-calcFunc f) args)) (if (eq (car-safe args) 'calcFunc-call) args - (math-normalize args)) -) + (math-normalize args))) (defun calcFunc-apply (f args) (or (Math-vectorp args) (math-reject-arg args 'vectorp)) - (apply 'calcFunc-call (cons f (cdr args))) -) + (apply 'calcFunc-call (cons f (cdr args)))) @@ -928,32 +912,26 @@ (setq vec (cons head (nreverse vec))) (if (and (eq mode 'cols) (math-matrixp vec)) (math-transpose vec) - vec)) -) + vec))) (defun calcFunc-map (func &rest args) - (math-symb-map func 'elems args) -) + (math-symb-map func 'elems args)) (defun calcFunc-mapr (func &rest args) - (math-symb-map func 'rows args) -) + (math-symb-map func 'rows args)) (defun calcFunc-mapc (func &rest args) - (math-symb-map func 'cols args) -) + (math-symb-map func 'cols args)) (defun calcFunc-mapa (func arg) (if (math-matrixp arg) (math-symb-map func 'elems (cdr (math-transpose arg))) - (math-symb-map func 'elems arg)) -) + (math-symb-map func 'elems arg))) (defun calcFunc-mapd (func arg) (if (math-matrixp arg) (math-symb-map func 'elems (cdr arg)) - (math-symb-map func 'elems arg)) -) + (math-symb-map func 'elems arg))) (defun calcFunc-mapeq (func &rest args) (if (and (or (equal func '(var mul var-mul)) @@ -974,8 +952,7 @@ (equal func '(var neg var-neg)) (equal func '(var inv var-inv))) (apply 'calcFunc-mapeqr func args) - (apply 'calcFunc-mapeqp func args)) -) + (apply 'calcFunc-mapeqp func args))) (defun calcFunc-mapeqr (func &rest args) (setq args (mapcar (function (lambda (x) @@ -985,8 +962,7 @@ (cons (nth 1 func) (cdr x)) x)))) args)) - (apply 'calcFunc-mapeqp func args) -) + (apply 'calcFunc-mapeqp func args)) (defun calcFunc-mapeqp (func &rest args) (if (or (and (memq (car-safe (car args)) '(calcFunc-lt calcFunc-leq)) @@ -999,8 +975,7 @@ (nth 2 (nth 1 args)) (nth 1 (nth 1 args))) (cdr (cdr args)))))) - (math-symb-map func 'eqn args) -) + (math-symb-map func 'eqn args)) @@ -1019,8 +994,7 @@ (math-build-call func (list expr (car row)))) (car row))))) (math-normalize expr)) - (calcFunc-reducer func vec)) -) + (calcFunc-reducer func vec))) (defun calcFunc-rreduce (func vec) (if (math-matrixp vec) @@ -1036,8 +1010,7 @@ row (cdr row))) (setq vec (cdr vec))) (math-normalize expr)) - (calcFunc-rreducer func vec)) -) + (calcFunc-rreducer func vec))) (defun calcFunc-reducer (func vec) (setq func (math-var-to-calcFunc func)) @@ -1066,8 +1039,7 @@ (setq expr (math-build-call func (list expr (car vec))))) (math-normalize expr)) (or (math-identity-value func) - (math-reject-arg vec "*Vector is empty")))) -) + (math-reject-arg vec "*Vector is empty"))))) (defun math-identity-value (func) (cdr (assq func '( (calcFunc-add . 0) (calcFunc-sub . 0) @@ -1076,8 +1048,7 @@ (calcFunc-min . (var inf var-inf)) (calcFunc-max . (neg (var inf var-inf))) (calcFunc-vconcat . (vec)) - (calcFunc-append . (vec)) ))) -) + (calcFunc-append . (vec)) )))) (defun calcFunc-rreducer (func vec) (setq func (math-var-to-calcFunc func)) @@ -1100,52 +1071,45 @@ (setq expr (math-build-call func (list (car vec) expr)))) (math-normalize expr)) (or (math-identity-value func) - (math-reject-arg vec "*Vector is empty"))))) -) + (math-reject-arg vec "*Vector is empty")))))) (defun calcFunc-reducec (func vec) (if (math-matrixp vec) (calcFunc-reducer func (math-transpose vec)) - (calcFunc-reducer func vec)) -) + (calcFunc-reducer func vec))) (defun calcFunc-rreducec (func vec) (if (math-matrixp vec) (calcFunc-rreducer func (math-transpose vec)) - (calcFunc-rreducer func vec)) -) + (calcFunc-rreducer func vec))) (defun calcFunc-reducea (func vec) (if (math-matrixp vec) (cons 'vec (mapcar (function (lambda (x) (calcFunc-reducer func x))) (cdr vec))) - (calcFunc-reducer func vec)) -) + (calcFunc-reducer func vec))) (defun calcFunc-rreducea (func vec) (if (math-matrixp vec) (cons 'vec (mapcar (function (lambda (x) (calcFunc-rreducer func x))) (cdr vec))) - (calcFunc-rreducer func vec)) -) + (calcFunc-rreducer func vec))) (defun calcFunc-reduced (func vec) (if (math-matrixp vec) (cons 'vec (mapcar (function (lambda (x) (calcFunc-reducer func x))) (cdr (math-transpose vec)))) - (calcFunc-reducer func vec)) -) + (calcFunc-reducer func vec))) (defun calcFunc-rreduced (func vec) (if (math-matrixp vec) (cons 'vec (mapcar (function (lambda (x) (calcFunc-rreducer func x))) (cdr (math-transpose vec)))) - (calcFunc-rreducer func vec)) -) + (calcFunc-rreducer func vec))) (defun calcFunc-accum (func vec) (setq func (math-var-to-calcFunc func)) @@ -1158,8 +1122,7 @@ (while (setq vec (cdr vec)) (setq expr (math-build-call func (list expr (car vec))) res (nconc res (list expr)))) - (math-normalize res)) -) + (math-normalize res))) (defun calcFunc-raccum (func vec) (setq func (math-var-to-calcFunc func)) @@ -1172,8 +1135,7 @@ (while (setq vec (cdr vec)) (setq expr (math-build-call func (list (car vec) expr)) res (cons (list expr) res))) - (math-normalize (cons 'vec res))) -) + (math-normalize (cons 'vec res)))) (defun math-nest-calls (func base iters accum tol) @@ -1226,24 +1188,19 @@ (setq avalues (cons value avalues)))) (if accum (cons 'vec (nreverse avalues)) - value))) -) + value)))) (defun calcFunc-nest (func base iters) - (math-nest-calls func base iters nil nil) -) + (math-nest-calls func base iters nil nil)) (defun calcFunc-anest (func base iters) - (math-nest-calls func base iters t nil) -) + (math-nest-calls func base iters t nil)) (defun calcFunc-fixp (func base &optional iters tol) - (math-nest-calls func base iters nil (or tol t)) -) + (math-nest-calls func base iters nil (or tol t))) (defun calcFunc-afixp (func base &optional iters tol) - (math-nest-calls func base iters t (or tol t)) -) + (math-nest-calls func base iters t (or tol t))) (defun calcFunc-outer (func a b) @@ -1259,8 +1216,7 @@ x)))) (cdr b))) mat))) - (math-normalize (cons 'vec (nreverse mat)))) -) + (math-normalize (cons 'vec (nreverse mat))))) (defun calcFunc-inner (mul-func add-func a b) @@ -1281,8 +1237,7 @@ (math-dimension-error)))) (if (math-matrixp b) (nth 1 (math-inner-mats (list 'vec a) b)) - (calcFunc-reduce add-func (calcFunc-map mul-func a b)))) -) + (calcFunc-reduce add-func (calcFunc-map mul-func a b))))) (defun math-inner-mats (a b) (let ((mat nil) @@ -1298,8 +1253,7 @@ (math-mat-col b col))) row))) (setq mat (cons (cons 'vec row) mat))) - (cons 'vec (nreverse mat))) -) + (cons 'vec (nreverse mat)))) +;;; calc-map.el ends here -
--- a/lisp/calc/calc-mode.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-mode.el Wed Nov 14 09:09:09 2001 +0000 @@ -34,8 +34,7 @@ (calc-wrapper (message (if (calc-change-mode 'calc-line-numbering n t t) "Displaying stack level numbers." - "Hiding stack level numbers."))) -) + "Hiding stack level numbers.")))) (defun calc-line-breaking (n) (interactive "P") @@ -49,8 +48,7 @@ (if (integerp calc-line-breaking) (message "Breaking lines longer than %d characters." n) (message "Breaking long lines in Stack display.")) - (message "Not breaking long lines in Stack display."))) -) + (message "Not breaking long lines in Stack display.")))) (defun calc-left-justify (n) @@ -61,8 +59,7 @@ (list nil n) t) (if n (message "Displaying stack entries indented by %d." n) - (message "Displaying stack entries left-justified."))) -) + (message "Displaying stack entries left-justified.")))) (defun calc-center-justify (n) (interactive "P") @@ -72,8 +69,7 @@ (list 'center n) t) (if n (message "Displaying stack entries centered on column %d." n) - (message "Displaying stack entries centered in window."))) -) + (message "Displaying stack entries centered in window.")))) (defun calc-right-justify (n) (interactive "P") @@ -83,24 +79,21 @@ (list 'right n) t) (if n (message "Displaying stack entries right-justified to column %d." n) - (message "Displaying stack entries right-justified in window."))) -) + (message "Displaying stack entries right-justified in window.")))) (defun calc-left-label (s) (interactive "sLefthand label: ") (calc-wrapper (or (equal s "") (setq s (concat s " "))) - (calc-change-mode 'calc-left-label s t)) -) + (calc-change-mode 'calc-left-label s t))) (defun calc-right-label (s) (interactive "sRighthand label: ") (calc-wrapper (or (equal s "") (setq s (concat " " s))) - (calc-change-mode 'calc-right-label s t)) -) + (calc-change-mode 'calc-right-label s t))) (defun calc-auto-why (n) (interactive "P") @@ -117,8 +110,7 @@ ((eq n t) (message "Automatically doing `w' to explain unsimplified results.")) (t - (message "Automatically doing `w' only for unusual messages.")))) -) + (message "Automatically doing `w' only for unusual messages."))))) (defun calc-group-digits (n) (interactive "P") @@ -138,8 +130,7 @@ ((integerp n) (message "Grouping every %d digits." (math-abs n))) (t - (message "Grouping is on.")))) -) + (message "Grouping is on."))))) (defun calc-group-char (ch) (interactive "cGrouping character: ") @@ -150,8 +141,7 @@ (setq ch "\\,") (setq ch (char-to-string ch))) (calc-change-mode 'calc-group-char ch calc-group-digits) - (message "Digit grouping character is \"%s\"." ch)) -) + (message "Digit grouping character is \"%s\"." ch))) (defun calc-point-char (ch) (interactive "cCharacter to use as decimal point: ") @@ -159,8 +149,7 @@ (or (>= ch 32) (error "Control characters not allowed as decimal point.")) (calc-change-mode 'calc-point-char (char-to-string ch) t) - (message "Decimal point character is \"%c\"." ch)) -) + (message "Decimal point character is \"%c\"." ch))) (defun calc-normal-notation (n) (interactive "P") @@ -180,8 +169,7 @@ "Displaying floating-point numbers with %d significant digits." (nth 1 n)) (message "Displaying floating-point numbers with (precision%d)." - (nth 1 n))))) -) + (nth 1 n)))))) (defun calc-fix-notation (n) (interactive "NDigits after decimal point: ") @@ -190,8 +178,7 @@ (setq n (list 'fix (if n (prefix-numeric-value n) 0))) t) (message "Displaying floats with %d digits after decimal." - (math-abs (nth 1 n)))) -) + (math-abs (nth 1 n))))) (defun calc-sci-notation (n) (interactive "P") @@ -205,8 +192,7 @@ (message "Displaying scientific notation with %d significant digits." (nth 1 n)) (message "Displaying scientific notation with (precision%d)." - (nth 1 n))))) -) + (nth 1 n)))))) (defun calc-eng-notation (n) (interactive "P") @@ -220,8 +206,7 @@ (message "Displaying engineering notation with %d significant digits." (nth 1 n)) (message "Displaying engineering notation with (precision%d)." - (nth 1 n))))) -) + (nth 1 n)))))) (defun calc-truncate-stack (n &optional rel) @@ -253,18 +238,15 @@ (if calc-line-numbering (calc-refresh)))) (calc-record-undo (list 'set 'saved-stack-top 0)) - (setq calc-stack-top newtop))) -) + (setq calc-stack-top newtop)))) (defun calc-truncate-up (n) (interactive "p") - (calc-truncate-stack n t) -) + (calc-truncate-stack n t)) (defun calc-truncate-down (n) (interactive "p") - (calc-truncate-stack (- n) t) -) + (calc-truncate-stack (- n) t)) (defun calc-display-raw (arg) (interactive "P") @@ -272,8 +254,7 @@ (setq calc-display-raw (if calc-display-raw nil (if arg 0 t))) (calc-do-refresh) (if calc-display-raw - (message "Press d ' again to cancel \"raw\" display mode."))) -) + (message "Press d ' again to cancel \"raw\" display mode.")))) @@ -323,8 +304,7 @@ ;; FIXME: why is this here? -cgw 2001.11.12 (let ((executing-kbd-macro "")) ; what a kludge! (save-buffer)) - (save-buffer)))) -) + (save-buffer))))) (defun calc-settings-file-name (name &optional arg) (interactive @@ -381,8 +361,7 @@ (t 1)) (cond ((eq calc-infinite-mode 1) 0) (calc-infinite-mode 1) - (t -1))) -) + (t -1)))) (defun calc-get-modes (n) (interactive "P") @@ -394,8 +373,7 @@ (< n (length modes))) (nth n modes) (error "Prefix out of range")) - modes)))) -) + modes))))) (defun calc-shift-prefix (arg) (interactive "P") @@ -406,8 +384,7 @@ (calc-init-prefixes) (message (if calc-shift-prefix "Prefix keys are now case-insensitive" - "Prefix keys must be unshifted (except V, Z)"))) -) + "Prefix keys must be unshifted (except V, Z)")))) (defun calc-mode-record-mode (n) (interactive "P") @@ -441,8 +418,7 @@ (format "Recording mode changes in \"%s\"." calc-settings-file)) (t - "Not recording mode changes permanently.")))) -) + "Not recording mode changes permanently."))))) (defun calc-total-algebraic-mode (flag) (interactive "P") @@ -455,8 +431,7 @@ '(total nil)) (use-local-map calc-alg-map) (message - "All keys begin algebraic entry; use Meta (ESC) for Calc keys."))) -) + "All keys begin algebraic entry; use Meta (ESC) for Calc keys.")))) (defun calc-algebraic-mode (flag) (interactive "P") @@ -472,8 +447,7 @@ "Numeric keys and ( and [ begin algebraic entry." (if calc-incomplete-algebraic-mode "Only ( and [ begin algebraic entry." - "No keys except ' and $ begin algebraic entry.")))) -) + "No keys except ' and $ begin algebraic entry."))))) (defun calc-symbolic-mode (n) (interactive "P") @@ -481,8 +455,7 @@ (message (if (calc-change-mode 'calc-symbolic-mode n nil t) "Inexact computations like sqrt(2) are deferred." - "Numerical computations are always done immediately."))) -) + "Numerical computations are always done immediately.")))) (defun calc-infinite-mode (n) (interactive "P") @@ -493,8 +466,7 @@ (message "Computations like 1 / 0 produce \"inf\".")) (message (if (calc-change-mode 'calc-infinite-mode n nil t) "Computations like 1 / 0 produce \"uinf\"." - "Computations like 1 / 0 are left unsimplified.")))) -) + "Computations like 1 / 0 are left unsimplified."))))) (defun calc-matrix-mode (arg) (interactive "P") @@ -514,8 +486,7 @@ "Variables are assumed to be matrices." (if calc-matrix-mode "Variables are assumed to be scalars (non-matrices)." - "Variables are not assumed to be matrix or scalar."))))) -) + "Variables are not assumed to be matrix or scalar.")))))) (defun calc-set-simplify-mode (mode arg msg) (calc-change-mode 'calc-simplify-mode @@ -526,22 +497,19 @@ mode))) (message (if (eq calc-simplify-mode mode) msg - "Default simplifications enabled.")) -) + "Default simplifications enabled."))) (defun calc-no-simplify-mode (arg) (interactive "P") (calc-wrapper (calc-set-simplify-mode 'none arg - "All default simplifications are disabled.")) -) + "All default simplifications are disabled."))) (defun calc-num-simplify-mode (arg) (interactive "P") (calc-wrapper (calc-set-simplify-mode 'num arg - "Default simplifications apply only if arguments are numeric.")) -) + "Default simplifications apply only if arguments are numeric."))) (defun calc-default-simplify-mode (arg) (interactive "p") @@ -555,37 +523,32 @@ ((= arg 3) (calc-alg-simplify-mode 1)) ((= arg 4) (calc-ext-simplify-mode 1)) ((= arg 5) (calc-units-simplify-mode 1)) - (t (error "Prefix argument out of range"))) -) + (t (error "Prefix argument out of range")))) (defun calc-bin-simplify-mode (arg) (interactive "P") (calc-wrapper (calc-set-simplify-mode 'binary arg (format "Binary simplification occurs by default (word size=%d)." - calc-word-size))) -) + calc-word-size)))) (defun calc-alg-simplify-mode (arg) (interactive "P") (calc-wrapper (calc-set-simplify-mode 'alg arg - "Algebraic simplification occurs by default.")) -) + "Algebraic simplification occurs by default."))) (defun calc-ext-simplify-mode (arg) (interactive "P") (calc-wrapper (calc-set-simplify-mode 'ext arg - "Extended algebraic simplification occurs by default.")) -) + "Extended algebraic simplification occurs by default."))) (defun calc-units-simplify-mode (arg) (interactive "P") (calc-wrapper (calc-set-simplify-mode 'units arg - "Units simplification occurs by default.")) -) + "Units simplification occurs by default."))) (defun calc-auto-recompute (arg) (interactive "P") @@ -594,8 +557,7 @@ (calc-refresh-evaltos) (message (if calc-auto-recompute "Automatically recomputing `=>' forms when necessary." - "Not recomputing `=>' forms automatically."))) -) + "Not recomputing `=>' forms automatically.")))) (defun calc-working (n) (interactive "P") @@ -613,70 +575,61 @@ (calc-display-working-message (message "Detailed \"Working...\" messages enabled.")) (t - (message "\"Working...\" messages disabled.")))) -) + (message "\"Working...\" messages disabled."))))) (defun calc-always-load-extensions () (interactive) (calc-wrapper (if (setq calc-always-load-extensions (not calc-always-load-extensions)) (message "Always loading extensions package.") - (message "Loading extensions package on demand only."))) -) + (message "Loading extensions package on demand only.")))) (defun calc-matrix-left-justify () (interactive) (calc-wrapper (calc-change-mode 'calc-matrix-just nil t) - (message "Matrix elements will be left-justified in columns.")) -) + (message "Matrix elements will be left-justified in columns."))) (defun calc-matrix-center-justify () (interactive) (calc-wrapper (calc-change-mode 'calc-matrix-just 'center t) - (message "Matrix elements will be centered in columns.")) -) + (message "Matrix elements will be centered in columns."))) (defun calc-matrix-right-justify () (interactive) (calc-wrapper (calc-change-mode 'calc-matrix-just 'right t) - (message "Matrix elements will be right-justified in columns.")) -) + (message "Matrix elements will be right-justified in columns."))) (defun calc-full-vectors (n) (interactive "P") (calc-wrapper (message (if (calc-change-mode 'calc-full-vectors n t t) "Displaying long vectors in full." - "Displaying long vectors in [a, b, c, ..., z] notation."))) -) + "Displaying long vectors in [a, b, c, ..., z] notation.")))) (defun calc-full-trail-vectors (n) (interactive "P") (calc-wrapper (message (if (calc-change-mode 'calc-full-trail-vectors n nil t) "Recording long vectors in full." - "Recording long vectors in [a, b, c, ..., z] notation."))) -) + "Recording long vectors in [a, b, c, ..., z] notation.")))) (defun calc-break-vectors (n) (interactive "P") (calc-wrapper (message (if (calc-change-mode 'calc-break-vectors n t t) "Displaying vector elements one-per-line." - "Displaying vector elements all on one line."))) -) + "Displaying vector elements all on one line.")))) (defun calc-vector-commas () (interactive) (calc-wrapper (if (calc-change-mode 'calc-vector-commas (if calc-vector-commas nil ",") t) (message "Separating vector elements with \",\".") - (message "Separating vector elements with spaces."))) -) + (message "Separating vector elements with spaces.")))) (defun calc-vector-brackets () (interactive) @@ -684,8 +637,7 @@ (if (calc-change-mode 'calc-vector-brackets (if (equal calc-vector-brackets "[]") nil "[]") t) (message "Surrounding vectors with \"[]\".") - (message "Not surrounding vectors with brackets."))) -) + (message "Not surrounding vectors with brackets.")))) (defun calc-vector-braces () (interactive) @@ -693,8 +645,7 @@ (if (calc-change-mode 'calc-vector-brackets (if (equal calc-vector-brackets "{}") nil "{}") t) (message "Surrounding vectors with \"{}\".") - (message "Not surrounding vectors with brackets."))) -) + (message "Not surrounding vectors with brackets.")))) (defun calc-vector-parens () (interactive) @@ -702,8 +653,7 @@ (if (calc-change-mode 'calc-vector-brackets (if (equal calc-vector-brackets "()") nil "()") t) (message "Surrounding vectors with \"()\".") - (message "Not surrounding vectors with brackets."))) -) + (message "Not surrounding vectors with brackets.")))) (defun calc-matrix-brackets (arg) (interactive "sCode letters (R, O, C, P): ") @@ -715,6 +665,6 @@ (bad (string-match "[^rRoOcCpP ]" arg))) (if bad (error "Unrecognized character: %c" (aref arg bad))) - (calc-change-mode 'calc-matrix-brackets code t))) -) + (calc-change-mode 'calc-matrix-brackets code t)))) +;;; calc-mode.el ends here
--- a/lisp/calc/calc-mtx.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-mtx.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-mat.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -32,20 +32,17 @@ (defun calc-mdet (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "mdet" 'calcFunc-det arg)) -) + (calc-unary-op "mdet" 'calcFunc-det arg))) (defun calc-mtrace (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "mtr" 'calcFunc-tr arg)) -) + (calc-unary-op "mtr" 'calcFunc-tr arg))) (defun calc-mlud (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "mlud" 'calcFunc-lud arg)) -) + (calc-unary-op "mlud" 'calcFunc-lud arg))) ;;; Coerce row vector A to be a matrix. [V V] @@ -53,16 +50,14 @@ (if (and (Math-vectorp a) (not (math-matrixp a))) (list 'vec a) - a) -) + a)) ;;; Coerce column vector A to be a matrix. [V V] (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))) - a) -) + a)) @@ -82,29 +77,25 @@ (setq accum (math-add accum (math-mul (car ap) (nth col (car bp)))))) (setq row (cons accum row))) (setq mat (cons (cons 'vec row) mat))) - (cons 'vec (nreverse mat))) -) + (cons 'vec (nreverse mat)))) (defun math-mul-mat-vec (a b) (cons 'vec (mapcar (function (lambda (row) (math-dot-product row b))) - (cdr a))) -) + (cdr a)))) (defun calcFunc-tr (mat) ; [Public] (if (math-square-matrixp mat) (math-matrix-trace-step 2 (1- (length mat)) mat (nth 1 (nth 1 mat))) - (math-reject-arg mat 'square-matrixp)) -) + (math-reject-arg mat 'square-matrixp))) (defun math-matrix-trace-step (n size mat sum) (if (<= n size) (math-matrix-trace-step (1+ n) size mat (math-add sum (nth n (nth n mat)))) - sum) -) + sum)) ;;; Matrix inverse and determinant. @@ -167,8 +158,7 @@ det))) (let ((lud (math-matrix-lud m))) (and lud - (math-lud-solve lud (calcFunc-idn 1 n)))))) -) + (math-lud-solve lud (calcFunc-idn 1 n))))))) (defun calcFunc-det (m) (if (math-square-matrixp m) @@ -177,8 +167,7 @@ (or (math-zerop (nth 1 m)) (math-equal-int (nth 1 m) 1))) (nth 1 m) - (math-reject-arg m 'square-matrixp))) -) + (math-reject-arg m 'square-matrixp)))) (defun math-det-raw (m) (let ((n (1- (length m)))) @@ -217,14 +206,12 @@ (if lud (let ((lu (car lud))) (math-det-step n (nth 2 lud))) - 0))))) -) + 0)))))) (defun math-det-step (n prod) (if (> n 0) (math-det-step (1- n) (math-mul prod (nth n (nth n lu)))) - prod) -) + prod)) ;;; This returns a list (LU index d), or NIL if not possible. ;;; Argument M must be a square matrix. @@ -238,8 +225,7 @@ (if old (setcdr old entry) (setq math-lud-cache (cons (cons m entry) math-lud-cache))) - lud))) -) + lud)))) (defvar math-lud-cache nil) ;;; Numerical Recipes section 2.3; implicit pivoting omitted. @@ -288,8 +274,7 @@ (setcar (nthcdr j (nth i lu)) (math-div (nth j (nth i lu)) pivot))))) (setq j (1+ j))) - (list lu (nreverse index) d)) -) + (list lu (nreverse index) d))) (defun math-swap-rows (m r1 r2) (or (= r1 r2) @@ -302,8 +287,7 @@ (setcdr r1prev row2) (setcdr row2 (cdr row1)) (setcdr row1 r2next))) - m -) + m) (defun math-lud-solve (lud b &optional need) @@ -345,8 +329,7 @@ (setq col (1+ col))) x) (and need - (math-reject-arg need "*Singular matrix"))) -) + (math-reject-arg need "*Singular matrix")))) (defun calcFunc-lud (m) (if (math-square-matrixp m) @@ -373,6 +356,6 @@ (setq perm (math-swap-rows perm j pos))))) (list 'vec perm lmat umat))))) (math-reject-arg m "*Singular matrix")) - (math-reject-arg m 'square-matrixp)) -) + (math-reject-arg m 'square-matrixp))) +;;; calc-mtx.el ends here
--- a/lisp/calc/calc-poly.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-poly.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-poly.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -65,23 +65,20 @@ (math-neg (math-poly-gcd cont c2)) (math-poly-gcd cont c2)))))) (var expr) - (t 1)) -) + (t 1))) (defun calcFunc-pprim (expr &optional var) (let ((cont (calcFunc-pcont expr var))) (if (math-equal-int cont 1) expr - (math-poly-div-exact expr cont var))) -) + (math-poly-div-exact expr cont var)))) (defun math-div-poly-const (expr c) (cond ((memq (car-safe expr) '(+ -)) (list (car expr) (math-div-poly-const (nth 1 expr) c) (math-div-poly-const (nth 2 expr) c))) - (t (math-div expr c))) -) + (t (math-div expr c)))) (defun calcFunc-pdeg (expr &optional var) (if (Math-zerop expr) @@ -89,8 +86,7 @@ (if var (or (math-polynomial-p expr var) (math-reject-arg expr "Expected a polynomial")) - (math-poly-degree expr))) -) + (math-poly-degree expr)))) (defun math-poly-degree (expr) (cond ((Math-primp expr) @@ -108,8 +104,7 @@ ((memq (car expr) '(+ -)) (max (math-poly-degree (nth 1 expr)) (math-poly-degree (nth 2 expr)))) - (t 1)) -) + (t 1))) (defun calcFunc-plead (expr var) (cond ((eq (car-safe expr) '*) @@ -128,8 +123,7 @@ (let ((p (math-is-polynomial expr var))) (if (cdr p) (nth (1- (length p)) p) - 1)))) -) + 1))))) @@ -149,8 +143,7 @@ (math-reject-arg pd "Coefficients must be rational")) (let ((calc-prefer-frac t) (math-poly-modulus (math-poly-modulus pn pd))) - (math-poly-gcd pn pd)) -) + (math-poly-gcd pn pd))) ;;; Return only quotient to top of stack (nil if zero) (defun calcFunc-pdiv (pn pd &optional base) @@ -158,29 +151,25 @@ (math-poly-modulus (math-poly-modulus pn pd)) (res (math-poly-div pn pd base))) (setq calc-poly-div-remainder (cdr res)) - (car res)) -) + (car res))) ;;; Return only remainder to top of stack (defun calcFunc-prem (pn pd &optional base) (let ((calc-prefer-frac t) (math-poly-modulus (math-poly-modulus pn pd))) - (cdr (math-poly-div pn pd base))) -) + (cdr (math-poly-div pn pd base)))) (defun calcFunc-pdivrem (pn pd &optional base) (let* ((calc-prefer-frac t) (math-poly-modulus (math-poly-modulus pn pd)) (res (math-poly-div pn pd base))) - (list 'vec (car res) (cdr res))) -) + (list 'vec (car res) (cdr res)))) (defun calcFunc-pdivide (pn pd &optional base) (let* ((calc-prefer-frac t) (math-poly-modulus (math-poly-modulus pn pd)) (res (math-poly-div pn pd base))) - (math-add (car res) (math-div (cdr res) pd))) -) + (math-add (car res) (math-div (cdr res) pd)))) ;;; Multiply two terms, expanding out products of sums. @@ -193,16 +182,14 @@ (list (car rhs) (math-mul-thru lhs (nth 1 rhs)) (math-mul-thru lhs (nth 2 rhs))) - (math-mul lhs rhs))) -) + (math-mul lhs rhs)))) (defun math-div-thru (num den) (if (memq (car-safe num) '(+ -)) (list (car num) (math-div-thru (nth 1 num) den) (math-div-thru (nth 2 num) den)) - (math-div num den)) -) + (math-div num den))) ;;; Sort the terms of a sum into canonical order. @@ -211,8 +198,7 @@ (math-list-to-sum (sort (math-sum-to-list expr) (function (lambda (a b) (math-beforep (car a) (car b)))))) - expr) -) + expr)) (defun math-list-to-sum (lst) (if (cdr lst) @@ -221,8 +207,7 @@ (car (car lst))) (if (cdr (car lst)) (math-neg (car (car lst))) - (car (car lst)))) -) + (car (car lst))))) (defun math-sum-to-list (tree &optional neg) (cond ((eq (car-safe tree) '+) @@ -231,39 +216,34 @@ ((eq (car-safe tree) '-) (nconc (math-sum-to-list (nth 1 tree) neg) (math-sum-to-list (nth 2 tree) (not neg)))) - (t (list (cons tree neg)))) -) + (t (list (cons tree neg))))) ;;; Check if the polynomial coefficients are modulo forms. (defun math-poly-modulus (expr &optional expr2) (or (math-poly-modulus-rec expr) (and expr2 (math-poly-modulus-rec expr2)) - 1) -) + 1)) (defun math-poly-modulus-rec (expr) (if (and (eq (car-safe expr) 'mod) (Math-natnump (nth 2 expr))) (list 'mod 1 (nth 2 expr)) (and (memq (car-safe expr) '(+ - * /)) (or (math-poly-modulus-rec (nth 1 expr)) - (math-poly-modulus-rec (nth 2 expr))))) -) + (math-poly-modulus-rec (nth 2 expr)))))) ;;; Divide two polynomials. Return (quotient . remainder). (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))) -) + (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))) (setq math-poly-div-base nil) (defun math-poly-div-exact (u v &optional base) (let ((res (math-poly-div u v base))) (if (eq (cdr res) 0) (car res) - (math-reject-arg (list 'vec u v) "Argument is not a polynomial"))) -) + (math-reject-arg (list 'vec u v) "Argument is not a polynomial")))) (defun math-do-poly-div (u v) (cond ((math-constp u) @@ -293,8 +273,7 @@ (setq up (math-is-polynomial u base nil 'gen) res (math-poly-div-coefs up vp)) (cons (math-build-polynomial-expr (car res) base) - (math-build-polynomial-expr (cdr res) base)))))) -) + (math-build-polynomial-expr (cdr res) base))))))) (defun math-poly-div-rec (u v) (cond ((math-constp u) @@ -322,8 +301,7 @@ res (math-poly-div-coefs up vp)) (math-add (math-build-polynomial-expr (car res) base) (math-div (math-build-polynomial-expr (cdr res) base) - v)))))) -) + v))))))) ;;; Divide two polynomials in coefficient-list form. Return (quot . rem). (defun math-poly-div-coefs (u v) @@ -349,8 +327,7 @@ (cons q (nreverse (mapcar 'math-simplify urev))))) (t (cons (list (math-poly-div-rec (car u) (car v))) - nil))) -) + nil)))) ;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.) ;;; This returns only the remainder from the pseudo-division. @@ -375,8 +352,7 @@ (while (and urev (Math-zerop (car urev))) (setq urev (cdr urev))) (nreverse (mapcar 'math-simplify urev)))) - (t nil)) -) + (t nil))) ;;; Compute the GCD of two multivariate polynomials. (defun math-poly-gcd (u v) @@ -398,16 +374,14 @@ (math-poly-gcd-coefs (math-is-polynomial u base nil 'gen) (math-is-polynomial v base nil 'gen)) base))) - (calcFunc-gcd (calcFunc-pcont u) (calcFunc-pcont u)))))) -) + (calcFunc-gcd (calcFunc-pcont u) (calcFunc-pcont u))))))) (defun math-poly-div-list (lst a) (if (eq a 1) lst (if (eq a -1) (math-mul-list lst a) - (mapcar (function (lambda (x) (math-poly-div-exact x a))) lst))) -) + (mapcar (function (lambda (x) (math-poly-div-exact x a))) lst)))) (defun math-mul-list (lst a) (if (eq a 1) @@ -415,8 +389,7 @@ (if (eq a -1) (mapcar 'math-neg lst) (and (not (eq a 0)) - (mapcar (function (lambda (x) (math-mul x a))) lst)))) -) + (mapcar (function (lambda (x) (math-mul x a))) lst))))) ;;; Run GCD on all elements in a list. (defun math-poly-gcd-list (lst) @@ -427,8 +400,7 @@ (or (eq (car lst) 0) (setq gcd (math-poly-gcd gcd (car lst))))) (if lst (setq lst (math-poly-gcd-frac-list lst))) - gcd)) -) + gcd))) (defun math-poly-gcd-frac-list (lst) (while (and lst (not (eq (car-safe (car lst)) 'frac))) @@ -439,8 +411,7 @@ (if (eq (car-safe (car lst)) 'frac) (setq denom (calcFunc-lcm denom (nth 2 (car lst)))))) (list 'frac 1 denom)) - 1) -) + 1)) ;;; Compute the GCD of two monovariate polynomial lists. ;;; Knuth section 4.6.1, algorithm C. @@ -473,8 +444,7 @@ (setq v (math-mul-list v -1))) (while (>= (setq z (1- z)) 0) (setq v (cons 0 v))) - v) -) + v)) ;;; Return true if is a factor containing no sums or quotients. @@ -486,8 +456,7 @@ nil) ((memq (car-safe expr) '(^ neg)) (math-atomic-factorp (nth 1 expr))) - (t t)) -) + (t t))) ;;; Find a suitable base for dividing a by b. ;;; The base must exist in both expressions. @@ -506,8 +475,7 @@ (if maybe (if (>= (nth 1 (car a-base)) (nth 1 maybe)) (throw 'return (car (car a-base)))))) - (setq a-base (cdr 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). @@ -526,16 +494,14 @@ (setq a-base (cdr a-base))) (if (assoc (car (car b-base)) a-base) (throw 'return (car (car b-base))) - (setq b-base (cdr b-base)))))))) -) + (setq b-base (cdr b-base))))))))) ;;; Sort a list of polynomial bases. (defun math-sort-poly-base-list (lst) (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))))))) -) + (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) ... ). @@ -543,8 +509,7 @@ (defun math-total-polynomial-base (expr) (let ((mpb-total-base nil)) (math-polynomial-base expr 'math-polynomial-p1) - (math-sort-poly-base-list mpb-total-base)) -) + (math-sort-poly-base-list mpb-total-base))) (defun math-polynomial-p1 (subexpr) (or (assoc subexpr mpb-total-base) @@ -555,8 +520,7 @@ (if exponent (setq mpb-total-base (cons (list subexpr exponent) mpb-total-base))))) - nil -) + nil) @@ -572,8 +536,7 @@ expr)))) (math-simplify (if (math-vectorp res) res - (list 'vec (list 'vec res 1)))))) -) + (list 'vec (list 'vec res 1))))))) (defun calcFunc-factor (expr &optional var) (let ((math-factored-vars nil) @@ -583,22 +546,19 @@ (if var (let ((math-factored-vars t)) (or (catch 'factor (math-factor-expr-try var)) expr)) - (math-factor-expr expr))))) -) + (math-factor-expr expr)))))) (defun math-factor-finish (x) (if (Math-primp x) x (if (eq (car x) 'calcFunc-Fac-Prot) (math-factor-finish (nth 1 x)) - (cons (car x) (mapcar 'math-factor-finish (cdr x))))) -) + (cons (car x) (mapcar 'math-factor-finish (cdr x)))))) (defun math-factor-protect (x) (if (memq (car-safe x) '(+ -)) (list 'calcFunc-Fac-Prot x) - x) -) + x)) (defun math-factor-expr (expr) (cond ((eq math-factored-vars t) expr) @@ -611,8 +571,7 @@ (if y (math-factor-expr y) expr))) - (t expr)) -) + (t expr))) (defun math-factor-expr-part (x) ; uses "expr" (if (memq (car-safe x) '(+ - * / ^ neg)) @@ -622,8 +581,7 @@ (not (assoc x math-factored-vars)) (> (math-factor-contains expr x) 1) (setq math-factored-vars (cons (list x) math-factored-vars)) - (math-factor-expr-try x))) -) + (math-factor-expr-try x)))) (defun math-factor-expr-try (x) (if (eq (car-safe expr) '*) @@ -639,8 +597,7 @@ res) (and (cdr p) (setq res (math-factor-poly-coefs p)) - (throw 'factor res)))) -) + (throw 'factor res))))) (defun math-accum-factors (fac pow facs) (if math-to-list @@ -671,8 +628,7 @@ (cons 'vec (cons (nth 1 facs) (cons (list 'vec fac pow) (cdr (cdr facs))))) (cons 'vec (cons (list 'vec fac pow) (cdr facs)))))))) - (math-mul (math-pow fac pow) facs)) -) + (math-mul (math-pow fac pow) facs))) (defun math-factor-poly-coefs (p &optional square-free) ; uses "x" (let (t1 t2) @@ -813,8 +769,7 @@ (and (setq temp (math-factor-poly-coefs p)) (math-pow temp (nth 2 math-poly-modulus)))) (t - (math-reject-arg nil "*Modulo factorization not yet implemented")))) -) + (math-reject-arg nil "*Modulo factorization not yet implemented"))))) (defun math-poly-deriv-coefs (p) (let ((n 1) @@ -822,8 +777,7 @@ (while (setq p (cdr p)) (setq dp (cons (math-mul (car p) n) dp) n (1+ n))) - (nreverse dp)) -) + (nreverse dp))) (defun math-factor-contains (x a) (if (equal x a) @@ -836,8 +790,7 @@ (if (and (eq (car-safe x) '^) (natnump (nth 2 x))) (* (math-factor-contains (nth 1 x) a) (nth 2 x)) - 0))) -) + 0)))) @@ -860,14 +813,12 @@ (den2 (math-poly-div den g))) (and (eq (cdr num2) 0) (eq (cdr den2) 0) (setq num (car num2) den (car den2))))) - (math-simplify (math-div num den)))) -) + (math-simplify (math-div num den))))) ;;; Returns expressions (num . denom). (defun math-to-ratpoly (expr) (let ((res (math-to-ratpoly-rec expr))) - (cons (math-simplify (car res)) (math-simplify (cdr res)))) -) + (cons (math-simplify (car res)) (math-simplify (cdr res))))) (defun math-to-ratpoly-rec (expr) (cond ((Math-primp expr) @@ -933,8 +884,7 @@ ((eq (car expr) 'neg) (let ((r1 (math-to-ratpoly-rec (nth 1 expr)))) (cons (math-neg (car r1)) (cdr r1)))) - (t (cons expr 1))) -) + (t (cons expr 1)))) (defun math-ratpoly-p (expr &optional var) @@ -963,8 +913,7 @@ (and p1 (* p1 (nth 2 expr))))) ((not var) 1) ((math-poly-depends expr var) nil) - (t 0)) -) + (t 0))) (defun calcFunc-apart (expr &optional var) @@ -990,14 +939,12 @@ (math-add q (or (and var (math-expr-contains den var) (math-partial-fractions r den var)) - (math-div r den)))))) -) + (math-div r den))))))) (defun math-padded-polynomial (expr var deg) (let ((p (math-is-polynomial expr var deg))) - (append p (make-list (- deg (length p)) 0))) -) + (append p (make-list (- deg (length p)) 0)))) (defun math-partial-fractions (r den var) (let* ((fden (calcFunc-factors den var)) @@ -1063,8 +1010,7 @@ res (math-add res (math-div num (car dlist))) num nil)) (setq dlist (cdr dlist))) - (math-normalize res)))))) -) + (math-normalize res))))))) @@ -1096,12 +1042,10 @@ (list '^ (nth 1 expr) (1- (nth 2 expr))))) (if (< (nth 2 expr) 0) (list '/ 1 (list '^ (nth 1 expr) (- (nth 2 expr)))))))) - (t expr)) -) + (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) @@ -1184,12 +1128,9 @@ (setq p1 (cdr p1))) accum)))))) (and (not else-nil) - (list '^ x n))) -) + (list '^ x n)))) (defun calcFunc-expandpow (x n) - (math-normalize (math-expand-power x n)) -) + (math-normalize (math-expand-power x n))) - - +;;; calc-poly.el ends here
--- a/lisp/calc/calc-prog.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-prog.el Wed Nov 14 09:09:09 2001 +0000 @@ -34,76 +34,64 @@ (calc-wrapper (if (and (integerp arg) (> arg 2)) (calc-enter-result arg "eq" (cons 'calcFunc-eq (calc-top-list-n arg))) - (calc-binary-op "eq" 'calcFunc-eq arg))) -) + (calc-binary-op "eq" 'calcFunc-eq arg)))) (defun calc-remove-equal (arg) (interactive "P") (calc-wrapper - (calc-unary-op "rmeq" 'calcFunc-rmeq arg)) -) + (calc-unary-op "rmeq" 'calcFunc-rmeq arg))) (defun calc-not-equal-to (arg) (interactive "P") (calc-wrapper (if (and (integerp arg) (> arg 2)) (calc-enter-result arg "neq" (cons 'calcFunc-neq (calc-top-list-n arg))) - (calc-binary-op "neq" 'calcFunc-neq arg))) -) + (calc-binary-op "neq" 'calcFunc-neq arg)))) (defun calc-less-than (arg) (interactive "P") (calc-wrapper - (calc-binary-op "lt" 'calcFunc-lt arg)) -) + (calc-binary-op "lt" 'calcFunc-lt arg))) (defun calc-greater-than (arg) (interactive "P") (calc-wrapper - (calc-binary-op "gt" 'calcFunc-gt arg)) -) + (calc-binary-op "gt" 'calcFunc-gt arg))) (defun calc-less-equal (arg) (interactive "P") (calc-wrapper - (calc-binary-op "leq" 'calcFunc-leq arg)) -) + (calc-binary-op "leq" 'calcFunc-leq arg))) (defun calc-greater-equal (arg) (interactive "P") (calc-wrapper - (calc-binary-op "geq" 'calcFunc-geq arg)) -) + (calc-binary-op "geq" 'calcFunc-geq arg))) (defun calc-in-set (arg) (interactive "P") (calc-wrapper - (calc-binary-op "in" 'calcFunc-in arg)) -) + (calc-binary-op "in" 'calcFunc-in arg))) (defun calc-logical-and (arg) (interactive "P") (calc-wrapper - (calc-binary-op "land" 'calcFunc-land arg 1)) -) + (calc-binary-op "land" 'calcFunc-land arg 1))) (defun calc-logical-or (arg) (interactive "P") (calc-wrapper - (calc-binary-op "lor" 'calcFunc-lor arg 0)) -) + (calc-binary-op "lor" 'calcFunc-lor arg 0))) (defun calc-logical-not (arg) (interactive "P") (calc-wrapper - (calc-unary-op "lnot" 'calcFunc-lnot arg)) -) + (calc-unary-op "lnot" 'calcFunc-lnot arg))) (defun calc-logical-if () (interactive) (calc-wrapper - (calc-enter-result 3 "if" (cons 'calcFunc-if (calc-top-list-n 3)))) -) + (calc-enter-result 3 "if" (cons 'calcFunc-if (calc-top-list-n 3))))) @@ -115,8 +103,7 @@ (calc-change-mode 'calc-timing n nil t) (message (if calc-timing "Reporting timing of slow commands in Trail." - "Not reporting timing of commands."))) -) + "Not reporting timing of commands.")))) (defun calc-pass-errors () (interactive) @@ -129,8 +116,7 @@ (or (memq (car (car place)) '(error xxxerror)) (error "foo")) (setcar (car place) 'xxxerror)) - (error (error "The calc-do function has been modified; unable to patch."))) -) + (error (error "The calc-do function has been modified; unable to patch.")))) (defun calc-user-define () (interactive) @@ -149,8 +135,7 @@ (old (assq key kmap))) (if old (setcdr old func) - (setcdr kmap (cons (cons key func) (cdr kmap))))))) -) + (setcdr kmap (cons (cons key func) (cdr kmap)))))))) (defun calc-user-undefine () (interactive) @@ -163,8 +148,7 @@ (assq (upcase key) kmap) (assq (downcase key) kmap) (error "No such user key is defined")) - kmap))) -) + kmap)))) (defun calc-user-define-formula () (interactive) @@ -304,8 +288,7 @@ (if old (setcdr old cmd) (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) - (message "")) -) + (message ""))) (defun calc-default-formula-arglist (form) (if (consp form) @@ -314,21 +297,18 @@ (math-const-var form)) () (setq arglist (cons (nth 1 form) arglist))) - (calc-default-formula-arglist-step (cdr form)))) -) + (calc-default-formula-arglist-step (cdr form))))) (defun calc-default-formula-arglist-step (l) (and l (progn (calc-default-formula-arglist (car l)) - (calc-default-formula-arglist-step (cdr l)))) -) + (calc-default-formula-arglist-step (cdr l))))) (defun calc-subsetp (a b) (or (null a) (and (memq (car a) b) - (calc-subsetp (cdr a) b))) -) + (calc-subsetp (cdr a) b)))) (defun calc-fix-user-formula (f) (if (consp f) @@ -356,8 +336,7 @@ (cons 'list (cons (list 'quote (car f)) (mapcar 'calc-fix-user-formula (cdr f))))))) - f) -) + f)) (defun calc-user-define-composition () (interactive) @@ -395,8 +374,7 @@ (cons (setq entry2 (list (length alist))) (cdr entry)))) (setcdr entry2 (list 'lambda alist (calc-fix-user-formula comp)))) (calc-pop-stack 1) - (calc-do-refresh))) -) + (calc-do-refresh)))) (defun calc-user-define-kbd-macro (arg) @@ -443,8 +421,7 @@ (old (assq key kmap))) (if old (setcdr old cmd) - (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) -) + (setcdr kmap (cons (cons key cmd) (cdr kmap)))))))) (defun calc-edit-user-syntax () @@ -459,8 +436,7 @@ (t (capitalize (symbol-name lang)))))) (calc-write-parse-table (cdr (assq lang calc-user-parse-tables)) lang))) - (calc-show-edit-buffer) -) + (calc-show-edit-buffer)) (defun calc-finish-user-syntax-edit (lang) (let ((tab (calc-read-parse-table calc-original-buffer lang)) @@ -473,8 +449,7 @@ (if entry (setq calc-user-parse-tables (delq entry calc-user-parse-tables))))) - (switch-to-buffer calc-original-buffer) -) + (switch-to-buffer calc-original-buffer)) (defun calc-write-parse-table (tab calc-lang) (let ((p tab)) @@ -484,8 +459,7 @@ (let ((math-format-hash-args t)) (math-format-flat-expr (cdr (car p)) 0)) "\n") - (setq p (cdr p)))) -) + (setq p (cdr p))))) (defun calc-write-parse-table-part (p) (while p @@ -515,8 +489,7 @@ (if (nth 2 (car p)) (calc-write-parse-table-part (list (car (nth 2 (car p))))) (insert " ")))) - (setq p (cdr p))) -) + (setq p (cdr p)))) (defun calc-read-parse-table (calc-buf calc-lang) (let ((tab nil)) @@ -551,8 +524,7 @@ (goto-char (+ pos (nth 1 exp))) (error (nth 2 exp)))) (setq tab (nconc tab (list (cons p exp))))))))) - tab) -) + tab)) (defun calc-fix-token-name (name &optional unquoted) (cond ((string-match "\\`\\.\\." name) @@ -571,8 +543,7 @@ ((not (string-match "[^ ]" name)) (search-backward "\"" nil t) (error "Blank tokens are not allowed")) - (t name)) -) + (t name))) (defun calc-read-parse-table-part (term eterm) (let ((part nil) @@ -634,8 +605,7 @@ (not (eq (car last) quoted)) (setcar last (list '\? (list (car last)) '("$$")))))))) - part) -) + part)) (defun calc-user-define-invocation () @@ -643,8 +613,7 @@ (or last-kbd-macro (error "No keyboard macro defined")) (setq calc-invocation-macro last-kbd-macro) - (message "Use `M-# Z' to invoke this macro") -) + (message "Use `M-# Z' to invoke this macro")) (defun calc-user-define-edit (prefix) @@ -746,8 +715,7 @@ (math-format-nice-expr defn (frame-width))) "\n")) (calc-show-edit-buffer)) - (error "That command's definition cannot be edited")))))) -) + (error "That command's definition cannot be edited"))))))) (defun calc-finish-macro-edit (def keys) (forward-line 1) @@ -764,14 +732,12 @@ (aset (car mac) 0 (if keys true-str (key-description str))) (aset (car mac) 1 str)) (setcar mac str)))) - (setcdr def str))) -) + (setcdr def str)))) ;;; The following are hooks into the MacEdit package from macedit.el. (put 'calc-execute-extended-command 'MacEdit-print (function (lambda () - (setq macro-str (concat "\excalc-" macro-str)))) -) + (setq macro-str (concat "\excalc-" macro-str))))) (put 'calcDigit-start 'MacEdit-print (function (lambda () @@ -809,8 +775,7 @@ (MacEdit-unread-chars ch)) (insert "type \"") (MacEdit-insert-string str) - (insert "\"\n"))))) -) + (insert "\"\n")))))) (defun calc-macro-edit-algebraic () (MacEdit-unread-chars key-last) @@ -842,8 +807,7 @@ (progn (insert "type \"") (MacEdit-insert-string str) - (insert "\"\n")))) -) + (insert "\"\n"))))) (put 'calc-algebraic-entry 'MacEdit-print 'calc-macro-edit-algebraic) (put 'calc-auto-algebraic-entry 'MacEdit-print 'calc-macro-edit-algebraic) @@ -858,8 +822,7 @@ (char-to-string (MacEdit-read-char)) "\"\n") (if (> (length str) 0) (insert "type \"" str "\"\n")) - (MacEdit-read-argument))) -) + (MacEdit-read-argument)))) (put 'calc-store 'MacEdit-print 'calc-macro-edit-variable) (put 'calc-store-into 'MacEdit-print 'calc-macro-edit-variable) (put 'calc-store-neg 'MacEdit-print 'calc-macro-edit-variable) @@ -880,14 +843,12 @@ (defun calc-macro-edit-variable-2 () (calc-macro-edit-variable) - (calc-macro-edit-variable t) -) + (calc-macro-edit-variable t)) (put 'calc-copy-variable 'MacEdit-print 'calc-macro-edit-variable-2) (put 'calc-declare-variable 'MacEdit-print 'calc-macro-edit-variable-2) (defun calc-macro-edit-quick-digit () - (insert "type \"" key-str "\" # " (symbol-name key-symbol) "\n") -) + (insert "type \"" key-str "\" # " (symbol-name key-symbol) "\n")) (put 'calc-store-quick 'MacEdit-print 'calc-macro-edit-quick-digit) (put 'calc-store-into-quick 'MacEdit-print 'calc-macro-edit-quick-digit) (put 'calc-recall-quick 'MacEdit-print 'calc-macro-edit-quick-digit) @@ -910,8 +871,7 @@ (setcar (cdr body) (let ((alist (nth 1 (symbol-function func)))) (calc-fix-user-formula val))) - (put func 'calc-user-defn val))) -) + (put func 'calc-user-defn val)))) (defun calc-valid-formula-func (func) (let ((def (symbol-function func))) @@ -922,8 +882,7 @@ (while (and def (not (eq (car (car def)) 'math-normalize))) (setq def (cdr def))) - (car def)))) -) + (car def))))) (defun calc-get-user-defn () @@ -953,8 +912,7 @@ func))) (list defn)))) (calc-enter-result 0 "gdef" defn)) - (error "That command is not defined by a formula"))))))) -) + (error "That command is not defined by a formula")))))))) (defun calc-user-define-permanent () @@ -1051,8 +1009,7 @@ (prin1-to-string cmd) ")\n"))) (insert "))\n") - (save-buffer))) -) + (save-buffer)))) (defun calc-stack-command-p (cmd) (if (and cmd (symbolp cmd)) @@ -1065,8 +1022,7 @@ (setq cmd (assq 'calc-enter-result cmd)) (memq (car (nth 3 cmd)) '(cons list)) (eq (car (nth 1 (nth 3 cmd))) 'quote) - (nth 1 (nth 1 (nth 3 cmd))))) -) + (nth 1 (nth 1 (nth 3 cmd)))))) (defun calc-call-last-kbd-macro (arg) @@ -1075,8 +1031,7 @@ (error "Can't execute anonymous macro while defining one")) (or last-kbd-macro (error "No kbd macro has been defined")) - (calc-execute-kbd-macro last-kbd-macro arg) -) + (calc-execute-kbd-macro last-kbd-macro arg)) (defun calc-execute-kbd-macro (mac arg &rest prefix) (if (and (vectorp mac) (> (length mac) 0) (stringp (aref mac 0))) @@ -1127,8 +1082,7 @@ (calc-record-undo (list 'push 1)) (setq new-stack (cdr new-stack))) (calc-refresh)) - (calc-record-undo (list 'set 'saved-stack-top 0)))))))) -) + (calc-record-undo (list 'set 'saved-stack-top 0))))))))) (defun calc-push-list-in-macro (vals m sels) (let ((entry (list (car vals) 1 (car sels))) @@ -1136,15 +1090,13 @@ (if (> mm 1) (setcdr (nthcdr (- mm 2) calc-stack) (cons entry (nthcdr (1- mm) calc-stack))) - (setq calc-stack (cons entry calc-stack)))) -) + (setq calc-stack (cons entry calc-stack))))) (defun calc-pop-stack-in-macro (n mm) (if (> mm 1) (setcdr (nthcdr (- mm 2) calc-stack) (nthcdr (+ n mm -1) calc-stack)) - (setq calc-stack (nthcdr n calc-stack))) -) + (setq calc-stack (nthcdr n calc-stack)))) (defun calc-kbd-if () @@ -1157,13 +1109,11 @@ (message "If true...")) (if defining-kbd-macro (message "Condition is false; skipping to Z: or Z] ...")) - (calc-kbd-skip-to-else-if t)))) -) + (calc-kbd-skip-to-else-if t))))) (defun calc-kbd-else-if () (interactive) - (calc-kbd-if) -) + (calc-kbd-if)) (defun calc-kbd-skip-to-else-if (else-okay) (let ((count 0) @@ -1188,21 +1138,18 @@ (and defining-kbd-macro (if (= ch ?\:) (message "Else...") - (message "End-if...")))) -) + (message "End-if..."))))) (defun calc-kbd-end-if () (interactive) (if defining-kbd-macro - (message "End-if...")) -) + (message "End-if..."))) (defun calc-kbd-else () (interactive) (if defining-kbd-macro (message "Else; skipping to Z] ...")) - (calc-kbd-skip-to-else-if nil) -) + (calc-kbd-skip-to-else-if nil)) (defun calc-kbd-repeat () @@ -1217,8 +1164,7 @@ (or (integerp count) (setq count 1000000)) (calc-pop-stack 1)) - (calc-kbd-loop count)) -) + (calc-kbd-loop count))) (defun calc-kbd-for (dir) (interactive "P") @@ -1229,8 +1175,7 @@ (or (and (math-anglep init) (math-anglep final)) (error "Initial and final values must be real numbers")) (calc-pop-stack 2)) - (calc-kbd-loop nil init final (and dir (prefix-numeric-value dir)))) -) + (calc-kbd-loop nil init final (and dir (prefix-numeric-value dir))))) (defun calc-kbd-loop (rpt-count &optional initial final dir) (interactive "P") @@ -1301,23 +1246,19 @@ (setq counter (calcFunc-add counter step))) (setq rpt-count (1- rpt-count)))))))) (or executing-kbd-macro - (message "Looping...done"))) -) + (message "Looping...done")))) (defun calc-kbd-end-repeat () (interactive) - (error "Unbalanced Z> in keyboard macro") -) + (error "Unbalanced Z> in keyboard macro")) (defun calc-kbd-end-for () (interactive) - (error "Unbalanced Z) in keyboard macro") -) + (error "Unbalanced Z) in keyboard macro")) (defun calc-kbd-end-loop () (interactive) - (error "Unbalanced Z} in keyboard macro") -) + (error "Unbalanced Z} in keyboard macro")) (defun calc-kbd-break () (interactive) @@ -1325,8 +1266,7 @@ (let ((cond (calc-top-n 1))) (calc-pop-stack 1) (if (math-is-true cond) - (error "Keyboard macro aborted.")))) -) + (error "Keyboard macro aborted."))))) (defun calc-kbd-push (arg) @@ -1383,8 +1323,7 @@ (execute-kbd-macro (substring body 0 -2)))) (let ((calc-kbd-push-level (1+ calc-kbd-push-level))) (message "Saving modes; type Z' to restore") - (recursive-edit))))) -) + (recursive-edit)))))) (setq calc-kbd-push-level 0) (defun calc-kbd-pop () @@ -1393,8 +1332,7 @@ (progn (message "Mode settings restored") (exit-recursive-edit)) - (error "Unbalanced Z' in keyboard macro")) -) + (error "Unbalanced Z' in keyboard macro"))) (defun calc-kbd-report (msg) @@ -1402,16 +1340,14 @@ (calc-wrapper (let ((executing-kbd-macro nil) (defining-kbd-macro nil)) - (math-working msg (calc-top-n 1)))) -) + (math-working msg (calc-top-n 1))))) (defun calc-kbd-query (msg) (interactive "sPrompt: ") (calc-wrapper (let ((executing-kbd-macro nil) (defining-kbd-macro nil)) - (calc-alg-entry nil (and (not (equal msg "")) msg)))) -) + (calc-alg-entry nil (and (not (equal msg "")) msg))))) @@ -1443,8 +1379,7 @@ (if (and (or (math-looks-negp a) (math-zerop a)) (or (math-looks-negp b) (math-zerop b))) (list 'calcFunc-eq (math-neg a) (math-neg b)) - (list 'calcFunc-eq a b)))) -) + (list 'calcFunc-eq a b))))) (defun calcFunc-neq (a b &rest more) (if more @@ -1468,8 +1403,7 @@ (if (and (or (math-looks-negp a) (math-zerop a)) (or (math-looks-negp b) (math-zerop b))) (list 'calcFunc-neq (math-neg a) (math-neg b)) - (list 'calcFunc-neq a b)))) -) + (list 'calcFunc-neq a b))))) (defun math-two-eq (a b) (if (eq (car-safe a) 'vec) @@ -1495,8 +1429,7 @@ 1 (if (and (= res 2) (not (and (Math-scalarp a) (Math-scalarp b)))) nil - 0))))) -) + 0)))))) (defun calcFunc-lt (a b) (let ((res (math-compare a b))) @@ -1507,8 +1440,7 @@ (or (math-looks-negp b) (math-zerop b))) (list 'calcFunc-gt (math-neg a) (math-neg b)) (list 'calcFunc-lt a b)) - 0))) -) + 0)))) (defun calcFunc-gt (a b) (let ((res (math-compare a b))) @@ -1519,8 +1451,7 @@ (or (math-looks-negp b) (math-zerop b))) (list 'calcFunc-lt (math-neg a) (math-neg b)) (list 'calcFunc-gt a b)) - 0))) -) + 0)))) (defun calcFunc-leq (a b) (let ((res (math-compare a b))) @@ -1531,8 +1462,7 @@ (or (math-looks-negp b) (math-zerop b))) (list 'calcFunc-geq (math-neg a) (math-neg b)) (list 'calcFunc-leq a b)) - 1))) -) + 1)))) (defun calcFunc-geq (a b) (let ((res (math-compare a b))) @@ -1543,8 +1473,7 @@ (or (math-looks-negp b) (math-zerop b))) (list 'calcFunc-leq (math-neg a) (math-neg b)) (list 'calcFunc-geq a b)) - 1))) -) + 1)))) (defun calcFunc-rmeq (a) (if (math-vectorp a) @@ -1558,8 +1487,7 @@ (nth 2 a) (if (eq (car-safe a) 'calcFunc-evalto) (nth 1 a) - (list 'calcFunc-rmeq a))))) -) + (list 'calcFunc-rmeq a)))))) (defun calcFunc-land (a b) (cond ((Math-zerop a) @@ -1570,8 +1498,7 @@ b) ((math-is-true b) a) - (t (list 'calcFunc-land a b))) -) + (t (list 'calcFunc-land a b)))) (defun calcFunc-lor (a b) (cond ((Math-zerop a) @@ -1582,8 +1509,7 @@ a) ((math-is-true b) b) - (t (list 'calcFunc-lor a b))) -) + (t (list 'calcFunc-lor a b)))) (defun calcFunc-lnot (a) (if (Math-zerop a) @@ -1594,8 +1520,7 @@ (assq (car a) calc-tweak-eqn-table)))) (if op (cons (nth 2 op) (cdr a)) - (list 'calcFunc-lnot a))))) -) + (list 'calcFunc-lnot a)))))) (defun calcFunc-if (c e1 e2) (if (Math-zerop c) @@ -1616,16 +1541,14 @@ (list e2)))) (and ee1 ee2 (cons 'vec (math-if-vector (cdr c) ee1 ee2))))) - (list 'calcFunc-if c e1 e2)))) -) + (list 'calcFunc-if c e1 e2))))) (defun math-if-vector (c e1 e2) (and c (cons (if (Math-zerop (car c)) (car e2) (car e1)) (math-if-vector (cdr c) (or (cdr e1) e1) - (or (cdr e2) e2)))) -) + (or (cdr e2) e2))))) (defun math-normalize-logical-op (a) (or (and (eq (car a) 'calcFunc-if) @@ -1644,8 +1567,7 @@ (list 'calcFunc-if a1 (math-normalize (nth 2 a)) (math-normalize (nth 3 a))))))))) - a) -) + a)) (defun calcFunc-in (a b) (or (and (eq (car-safe b) 'vec) @@ -1678,8 +1600,7 @@ 1) (and (math-constp a) (math-constp b) 0) - (list 'calcFunc-in a b)) -) + (list 'calcFunc-in a b))) (defun calcFunc-typeof (a) (cond ((Math-integerp a) 1) @@ -1695,40 +1616,35 @@ ((eq (car a) 'var) (if (memq (nth 2 a) '(var-inf var-uinf var-nan)) 12 100)) ((eq (car a) 'vec) (if (math-matrixp a) 102 101)) - (t (math-calcFunc-to-var func))) -) + (t (math-calcFunc-to-var func)))) (defun calcFunc-integer (a) (if (Math-integerp a) 1 (if (Math-objvecp a) 0 - (list 'calcFunc-integer a))) -) + (list 'calcFunc-integer a)))) (defun calcFunc-real (a) (if (Math-realp a) 1 (if (Math-objvecp a) 0 - (list 'calcFunc-real a))) -) + (list 'calcFunc-real a)))) (defun calcFunc-constant (a) (if (math-constp a) 1 (if (Math-objvecp a) 0 - (list 'calcFunc-constant a))) -) + (list 'calcFunc-constant a)))) (defun calcFunc-refers (a b) (if (math-expr-contains a b) 1 (if (eq (car-safe a) 'var) (list 'calcFunc-refers a b) - 0)) -) + 0))) (defun calcFunc-negative (a) (if (math-looks-negp a) @@ -1736,28 +1652,24 @@ (if (or (math-zerop a) (math-posp a)) 0 - (list 'calcFunc-negative a))) -) + (list 'calcFunc-negative a)))) (defun calcFunc-variable (a) (if (eq (car-safe a) 'var) 1 (if (Math-objvecp a) 0 - (list 'calcFunc-variable a))) -) + (list 'calcFunc-variable a)))) (defun calcFunc-nonvar (a) (if (eq (car-safe a) 'var) (list 'calcFunc-nonvar a) - 1) -) + 1)) (defun calcFunc-istrue (a) (if (math-is-true a) 1 - 0) -) + 0)) @@ -1851,14 +1763,12 @@ (append (list 'defun fname clargs) doc (math-do-arg-list-check args nil nil) - body))) -) + body)))) (defun math-clean-arg (arg) (if (consp arg) (math-clean-arg (nth 1 arg)) - arg) -) + arg)) (defun math-do-arg-check (arg var is-opt is-rest) (if is-opt @@ -1915,8 +1825,7 @@ (list 'and (list chk var) (list 'math-reject-arg var qqual))))) - (error "Unknown qualifier `%s'" qual-name))))))) -) + (error "Unknown qualifier `%s'" qual-name)))))))) (defun math-do-arg-list-check (args is-opt is-rest) (cond ((null args) nil) @@ -1929,8 +1838,7 @@ (math-do-arg-list-check (cdr args) t nil)) ((eq (car args) '&rest) (math-do-arg-list-check (cdr args) nil t)) - (t (math-do-arg-list-check (cdr args) is-opt is-rest))) -) + (t (math-do-arg-list-check (cdr args) is-opt is-rest)))) (defconst math-prim-funcs '( (~= . math-nearly-equal) @@ -1949,27 +1857,23 @@ (if . if) (^ . math-pow) (expt . math-pow) - ) -) + )) (defconst math-prim-vars '( (nil . nil) (t . t) (&optional . &optional) (&rest . &rest) - ) -) + )) (defun math-define-function-body (body env) (let ((body (math-define-body body env))) (if (math-body-refers-to body 'math-return) (list (cons 'catch (cons '(quote math-return) body))) - body)) -) + body))) (defun math-define-body (body exp-env) - (math-define-list body) -) + (math-define-list body)) (defun math-define-list (body &optional quote) (cond ((null body) @@ -1988,8 +1892,7 @@ (math-define-list (cdr body)))) (t (cons (math-define-exp (car body)) - (math-define-list (cdr body))))) -) + (math-define-list (cdr body)))))) (defun math-define-exp (exp) (cond ((consp exp) @@ -2140,26 +2043,22 @@ (if (or (<= exp -1000000) (>= exp 1000000)) (list 'quote (math-normalize exp)) exp)) - (t exp)) -) + (t exp))) (defun math-define-cond (forms) (and forms (cons (math-define-list (car forms)) - (math-define-cond (cdr forms)))) -) + (math-define-cond (cdr forms))))) (defun math-complicated-lhs (body) (and body (or (not (symbolp (car body))) - (math-complicated-lhs (cdr (cdr body))))) -) + (math-complicated-lhs (cdr (cdr body)))))) (defun math-define-setf-list (body) (and body (cons (math-define-setf (nth 0 body) (nth 1 body)) - (math-define-setf-list (cdr (cdr body))))) -) + (math-define-setf-list (cdr (cdr body)))))) (defun math-define-setf (place value) (setq place (math-define-exp place) @@ -2175,16 +2074,14 @@ ((eq (car-safe place) 'cdr) (list 'setcdr (nth 1 place) value)) (t - (error "Bad place form for setf: %s" place))) -) + (error "Bad place form for setf: %s" place)))) (defun math-define-binop (op ident arg1 rest) (if rest (math-define-binop op ident (list op arg1 (car rest)) (cdr rest)) - (or arg1 ident)) -) + (or arg1 ident))) (defun math-define-let (vlist) (and vlist @@ -2192,29 +2089,25 @@ (cons (car (car vlist)) (math-define-list (cdr (car vlist)))) (car vlist)) - (math-define-let (cdr vlist)))) -) + (math-define-let (cdr vlist))))) (defun math-define-let-env (vlist) (and vlist (cons (if (consp (car vlist)) (car (car vlist)) (car vlist)) - (math-define-let-env (cdr vlist)))) -) + (math-define-let-env (cdr vlist))))) (defun math-define-lambda (exp exp-env) (nconc (list (nth 0 exp) ; 'lambda (nth 1 exp)) ; arg list (math-define-function-body (cdr (cdr exp)) - (append (nth 1 exp) exp-env))) -) + (append (nth 1 exp) exp-env)))) (defun math-define-elt (seq idx) (if idx (math-define-elt (list 'elt seq (car idx)) (cdr idx)) - seq) -) + seq)) @@ -2224,8 +2117,7 @@ (let ((body (cons 'while (cons head body)))) (if (math-body-refers-to body 'math-break) (cons 'catch (cons '(quote math-break) (list body))) - body)) -) + body))) (defmacro math-for (head &rest body) @@ -2234,8 +2126,7 @@ (cons 'while (cons t body))))) (if (math-body-refers-to body 'math-break) (cons 'catch (cons '(quote math-break) (list body))) - body)) -) + body))) (defun math-handle-for (head body) (let* ((var (nth 0 (car head))) @@ -2291,16 +2182,14 @@ '+ 'math-add) var - save-step)))))))))) -) + save-step))))))))))) (defmacro math-foreach (head &rest body) (let ((body (math-handle-foreach head body))) (if (math-body-refers-to body 'math-break) (cons 'catch (cons '(quote math-break) (list body))) - body)) -) + body))) (defun math-handle-foreach (head body) @@ -2317,24 +2206,20 @@ (append body (list (list 'setq var - (list 'cdr var)))))))))) -) + (list 'cdr var))))))))))) (defun math-body-refers-to (body thing) (or (equal body thing) (and (consp body) (or (math-body-refers-to (car body) thing) - (math-body-refers-to (cdr body) thing)))) -) + (math-body-refers-to (cdr body) thing))))) (defun math-break (&optional value) - (throw 'math-break value) -) + (throw 'math-break value)) (defun math-return (&optional value) - (throw 'math-return value) -) + (throw 'math-return value)) @@ -2359,6 +2244,6 @@ (+ (if (eq (nth 1 op) 'calcFunc-geq) 2 0) (if (eq (car x) 'calcFunc-geq) 1 0)) (math-read-expr-level (nth 3 op)) (nth 1 x)) - (throw 'syntax "Syntax error"))))) -) + (throw 'syntax "Syntax error")))))) +;;; calc-prog.el ends here
--- a/lisp/calc/calc-rewr.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-rewr.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-rewr.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -85,8 +85,7 @@ (calc-pop-push-record-list 1 (or prefix "rwrt") (list expr) (- num (if pop-rules 1 0)) (list (and reselect sel)))) - (calc-handle-whys)) -) + (calc-handle-whys))) (defun calc-locate-select-marker (expr) ; changes "sel" (if (Math-primp expr) @@ -97,8 +96,7 @@ (setq sel (if sel t (nth 1 expr))) (nth 1 expr)) (cons (car expr) - (mapcar 'calc-locate-select-marker (cdr expr))))) -) + (mapcar 'calc-locate-select-marker (cdr expr)))))) @@ -136,8 +134,7 @@ (let (sel) (setq expr (calc-locate-select-marker expr))) (calc-pop-push-record-list n "rwrt" (list expr))) - (calc-handle-whys)) -) + (calc-handle-whys))) (defun calc-match (pat) (interactive "sPattern: \n") @@ -158,8 +155,7 @@ (or (math-vectorp expr) (error "Argument must be a vector")) (if (calc-is-inverse) (calc-enter-result n "mtcn" (math-match-patterns pat expr t)) - (calc-enter-result n "mtch" (math-match-patterns pat expr nil))))) -) + (calc-enter-result n "mtch" (math-match-patterns pat expr nil)))))) @@ -206,8 +202,7 @@ (insert "\nDone rewriting" (if (= mmt-many 0) " (reached iteration limit)" "") ":\n" fmt "\n")))) - whole-expr) -) + whole-expr)) (setq math-rewrite-default-iters 100) (defun math-rewrite-phase (sched) @@ -236,8 +231,7 @@ (setq whole-expr (math-normalize (math-map-tree-rec whole-expr))) (not (equal whole-expr save-expr))))))) - (setq sched (cdr sched))) -) + (setq sched (cdr sched)))) (defun calcFunc-rewrite (expr rules &optional many) (or (null many) (integerp many) @@ -245,22 +239,19 @@ (math-reject-arg many 'fixnump)) (condition-case err (math-rewrite expr rules (or many 1)) - (error (math-reject-arg rules (nth 1 err)))) -) + (error (math-reject-arg rules (nth 1 err))))) (defun calcFunc-match (pat vec) (or (math-vectorp vec) (math-reject-arg vec 'vectorp)) (condition-case err (math-match-patterns pat vec nil) - (error (math-reject-arg pat (nth 1 err)))) -) + (error (math-reject-arg pat (nth 1 err))))) (defun calcFunc-matchnot (pat vec) (or (math-vectorp vec) (math-reject-arg vec 'vectorp)) (condition-case err (math-match-patterns pat vec t) - (error (math-reject-arg pat (nth 1 err)))) -) + (error (math-reject-arg pat (nth 1 err))))) (defun math-match-patterns (pat vec &optional not-flag) (let ((newvec nil) @@ -269,23 +260,20 @@ (if (eq (not (math-apply-rewrites (car vec) crules)) not-flag) (setq newvec (cons (car vec) newvec)))) - (cons 'vec (nreverse newvec))) -) + (cons 'vec (nreverse newvec)))) (defun calcFunc-matches (expr pat) (condition-case err (if (math-apply-rewrites expr (math-compile-patterns pat)) 1 0) - (error (math-reject-arg pat (nth 1 err)))) -) + (error (math-reject-arg pat (nth 1 err))))) (defun calcFunc-vmatches (expr pat) (condition-case err (or (math-apply-rewrites expr (math-compile-patterns pat)) 0) - (error (math-reject-arg pat (nth 1 err)))) -) + (error (math-reject-arg pat (nth 1 err))))) @@ -490,8 +478,7 @@ (list 'vec x t))) (if (eq (car-safe pats) 'vec) (cdr pats) - (list pats)))))))) -) + (list pats))))))))) (setq math-rewrite-whole nil) (setq math-make-import-list nil) @@ -730,15 +717,13 @@ (or math-schedule (sort math-all-phases '<) (list 1))) - rule-set))) -) + rule-set)))) (defun math-flatten-lands (expr) (if (eq (car-safe expr) 'calcFunc-land) (append (math-flatten-lands (nth 1 expr)) (math-flatten-lands (nth 2 expr))) - (list expr)) -) + (list expr))) (defun math-rewrite-heads (expr &optional more all) (let ((heads more) @@ -751,8 +736,7 @@ calcFunc-pand)))) (or (Math-primp expr) (math-rewrite-heads-rec expr)) - heads) -) + heads)) (defun math-rewrite-heads-rec (expr) (or (memq (car expr) skips) @@ -763,8 +747,7 @@ (setq heads (cons (car expr) heads))) (while (setq expr (cdr expr)) (or (Math-primp (car expr)) - (math-rewrite-heads-rec (car expr)))))) -) + (math-rewrite-heads-rec (car expr))))))) (defun math-parse-schedule (sched) (mapcar (function @@ -776,8 +759,7 @@ (if (eq (car-safe s) 'var) (math-var-to-calcFunc s) (error "Improper component in rewrite schedule")))))) - sched) -) + sched)) (defun math-rwcomp-match-vars (expr) (if (Math-primp expr) @@ -797,15 +779,13 @@ (cons (car (nth 1 expr)) (mapcar 'math-rwcomp-match-vars (cdr (nth 1 expr))))) (cons (car expr) - (mapcar 'math-rwcomp-match-vars (cdr expr)))))) -) + (mapcar 'math-rwcomp-match-vars (cdr expr))))))) (defun math-rwcomp-register-expr (num) (let ((entry (nth (1- (- math-num-regs num)) math-regs))) (if (nth 2 entry) (list 'neg (list 'calcFunc-register (nth 1 entry))) - (list 'calcFunc-register (nth 1 entry)))) -) + (list 'calcFunc-register (nth 1 entry))))) (defun math-rwcomp-substitute (expr old new) (if (and (eq (car-safe old) 'var) @@ -814,8 +794,7 @@ (new-func (math-var-to-calcFunc new))) (math-rwcomp-subst-rec expr)) (let ((old-func nil)) - (math-rwcomp-subst-rec expr))) -) + (math-rwcomp-subst-rec expr)))) (defun math-rwcomp-subst-rec (expr) (cond ((equal expr old) new) @@ -824,37 +803,31 @@ (math-build-call new-func (mapcar 'math-rwcomp-subst-rec (cdr expr))) (cons (car expr) - (mapcar 'math-rwcomp-subst-rec (cdr expr)))))) -) + (mapcar 'math-rwcomp-subst-rec (cdr expr))))))) (setq math-rwcomp-tracing nil) (defun math-rwcomp-trace (instr) (if math-rwcomp-tracing (progn (terpri) (princ instr))) - instr -) + instr) (defun math-rwcomp-instr (&rest instr) (setcdr math-prog-last - (setq math-prog-last (list (math-rwcomp-trace instr)))) -) + (setq math-prog-last (list (math-rwcomp-trace instr))))) (defun math-rwcomp-multi-instr (tail &rest instr) (setcdr math-prog-last - (setq math-prog-last (list (math-rwcomp-trace (append instr tail))))) -) + (setq math-prog-last (list (math-rwcomp-trace (append instr tail)))))) (defun math-rwcomp-bind-var (reg var) (setcar (math-rwcomp-reg-entry reg) (nth 2 var)) (setq math-bound-vars (cons (nth 2 var) math-bound-vars)) - (math-rwcomp-do-conditions) -) + (math-rwcomp-do-conditions)) (defun math-rwcomp-unbind-vars (mark) (while (not (eq math-bound-vars mark)) (setcar (assq (car math-bound-vars) math-regs) nil) - (setq math-bound-vars (cdr math-bound-vars))) -) + (setq math-bound-vars (cdr math-bound-vars)))) (defun math-rwcomp-do-conditions () (let ((cond math-conds)) @@ -864,8 +837,7 @@ (setq math-conds (delq (car cond) math-conds)) (setcar cond 1) (math-rwcomp-cond-instr expr))) - (setq cond (cdr cond)))) -) + (setq cond (cdr cond))))) (defun math-rwcomp-cond-instr (expr) (let (op arg) @@ -929,8 +901,7 @@ (list 'calcFunc-lor math-remembering (nth 1 expr)) (nth 1 expr)))) - (t (math-rwcomp-instr 'cond expr)))) -) + (t (math-rwcomp-instr 'cond expr))))) (defun math-rwcomp-same-instr (reg1 reg2 neg) (math-rwcomp-instr (if (eq (eq (nth 2 (math-rwcomp-reg-entry reg1)) @@ -938,8 +909,7 @@ neg) 'same-neg 'same) - reg1 reg2) -) + reg1 reg2)) (defun math-rwcomp-copy-instr (reg1 reg2 neg) (if (eq (eq (nth 2 (math-rwcomp-reg-entry reg1)) @@ -947,19 +917,16 @@ neg) (math-rwcomp-instr 'copy-neg reg1 reg2) (or (eq reg1 reg2) - (math-rwcomp-instr 'copy reg1 reg2))) -) + (math-rwcomp-instr 'copy reg1 reg2)))) (defun math-rwcomp-reg () (prog1 math-num-regs (setq math-regs (cons (list nil math-num-regs nil 0) math-regs) - math-num-regs (1+ math-num-regs))) -) + math-num-regs (1+ math-num-regs)))) (defun math-rwcomp-reg-entry (num) - (nth (1- (- math-num-regs num)) math-regs) -) + (nth (1- (- math-num-regs num)) math-regs)) (defun math-rwcomp-pattern (expr part &optional not-direct) @@ -1195,8 +1162,7 @@ (while args (math-rwcomp-pattern (car (car args)) (cdr (car args))) (setq num (1+ num) - args (cdr args))))))))) -) + args (cdr args)))))))))) (defun math-rwcomp-best-reg (x) (or (and (eq (car-safe x) 'var) @@ -1207,8 +1173,7 @@ (progn (setcar (cdr (cdr entry)) t) (nth 1 entry))))) - (math-rwcomp-reg)) -) + (math-rwcomp-reg))) (defun math-rwcomp-all-regs-done (expr) (if (Math-primp expr) @@ -1226,8 +1191,7 @@ (math-rwcomp-all-regs-done (nth 2 (nth 1 expr))) (while (and (setq expr (cdr expr)) (math-rwcomp-all-regs-done (car expr)))) - (null expr)))) -) + (null expr))))) (defun math-rwcomp-no-vars (expr) (if (Math-primp expr) @@ -1242,8 +1206,7 @@ (progn (while (and (setq expr (cdr expr)) (math-rwcomp-no-vars (car expr)))) - (null expr)))) -) + (null expr))))) (defun math-rwcomp-is-algebraic (expr) (if (Math-primp expr) @@ -1254,8 +1217,7 @@ (progn (while (and (setq expr (cdr expr)) (math-rwcomp-is-algebraic (car expr)))) - (null expr)))) -) + (null expr))))) (defun math-rwcomp-is-constrained (expr not-these) (if (Math-primp expr) @@ -1266,8 +1228,7 @@ (memq (car expr) not-these) (and (memq 'commut (get (car expr) 'math-rewrite-props)) (or (eq (car-safe (nth 1 expr)) 'calcFunc-opt) - (eq (car-safe (nth 2 expr)) 'calcFunc-opt))))))) -) + (eq (car-safe (nth 2 expr)) 'calcFunc-opt)))))))) (defun math-rwcomp-optional-arg (head argp) (let ((arg (car argp))) @@ -1286,8 +1247,7 @@ (partp (math-rwcomp-optional-arg head part))) (and partp (setcar argp (math-rwcomp-neg (car part))) - (math-neg partp)))))) -) + (math-neg partp))))))) (defun math-rwcomp-neg (expr) (if (memq (car-safe expr) '(* /)) @@ -1296,8 +1256,7 @@ (if (eq (car-safe (nth 2 expr)) 'var) (list (car expr) (nth 1 expr) (list 'neg (nth 2 expr))) (math-neg expr))) - (math-neg expr)) -) + (math-neg expr))) (defun math-rwcomp-assoc-args (expr) (if (and (eq (car-safe (nth 1 expr)) (car expr)) @@ -1307,8 +1266,7 @@ (if (and (eq (car-safe (nth 2 expr)) (car expr)) (= (length (nth 2 expr)) 3)) (math-rwcomp-assoc-args (nth 2 expr)) - (setq math-args (cons (nth 2 expr) math-args))) -) + (setq math-args (cons (nth 2 expr) math-args)))) (defun math-rwcomp-addsub-args (expr) (if (memq (car-safe (nth 1 expr)) '(+ -)) @@ -1318,13 +1276,11 @@ (setq math-args (cons (math-rwcomp-neg (nth 2 expr)) math-args)) (if (eq (car-safe (nth 2 expr)) '+) (math-rwcomp-addsub-args (nth 2 expr)) - (setq math-args (cons (nth 2 expr) math-args)))) -) + (setq math-args (cons (nth 2 expr) math-args))))) (defun math-rwcomp-order (a b) (< (math-rwcomp-priority (car a)) - (math-rwcomp-priority (car b))) -) + (math-rwcomp-priority (car b)))) ;;; Order of priority: 0 Constants and other exact matches (first) ;;; 10 Functions (except below) @@ -1355,8 +1311,7 @@ 40 (if (memq 'algebraic props) 30 - 10)))))) -) + 10))))))) (defun math-rwcomp-count-refs (var) (let ((count (or (math-expr-contains-count math-pattern var) 0)) @@ -1374,8 +1329,7 @@ (or (math-expr-contains-count (nth 2 (nth 1 (car p))) var) 0)))))) (setq p (cdr p))) - count) -) + count)) (defun math-rwcomp-count-pnots (expr) (if (Math-primp expr) @@ -1385,8 +1339,7 @@ (let ((count 0)) (while (setq expr (cdr expr)) (setq count (+ count (math-rwcomp-count-pnots (car expr))))) - count))) -) + count)))) ;;; In the current implementation, all associative functions must ;;; also be commutative. @@ -1448,8 +1401,7 @@ (if back '(setq btrack (cdr btrack)) 'btrack) - ''((backtrack)))) -) + ''((backtrack))))) ;;; This monstrosity is necessary because the use of static vectors of ;;; registers makes rewrite rules non-reentrant. Yucko! @@ -1458,8 +1410,7 @@ '(setcar rules (quote (nil nil nil no-phase))) (list 'unwind-protect form - '(setcar rules orig))) -) + '(setcar rules orig)))) (setq math-rewrite-phase 1) @@ -1922,8 +1873,7 @@ (t (error "%s is not a valid rewrite opcode" op)))))) (setq rules (cdr rules))) - result)) -) + result))) (defun math-rwapply-neg (expr) (if (and (consp expr) @@ -1935,15 +1885,13 @@ (math-neg (nth 1 expr)) (list '* -1 (nth 1 expr))) (nth 2 expr))) - (math-neg expr)) -) + (math-neg expr))) (defun math-rwapply-inv (expr) (if (and (Math-integerp expr) calc-prefer-frac) (math-make-frac 1 expr) - (list '/ 1 expr)) -) + (list '/ 1 expr))) (defun math-rwapply-replace-regs (expr) (cond ((Math-primp expr) @@ -2049,16 +1997,14 @@ (aref regs (nth 1 (nth 1 expr))) (cons (car (nth 1 expr)) (mapcar 'math-rwapply-replace-regs (cdr (nth 1 expr))))))) - (t (cons (car expr) (mapcar 'math-rwapply-replace-regs (cdr expr))))) -) + (t (cons (car expr) (mapcar 'math-rwapply-replace-regs (cdr expr)))))) (defun math-rwapply-reg-looks-negp (expr) (if (eq (car-safe expr) 'calcFunc-register) (math-looks-negp (aref regs (nth 1 expr))) (if (memq (car-safe expr) '(* /)) (or (math-rwapply-reg-looks-negp (nth 1 expr)) - (math-rwapply-reg-looks-negp (nth 2 expr))))) -) + (math-rwapply-reg-looks-negp (nth 2 expr)))))) (defun math-rwapply-reg-neg (expr) ; expr must satisfy rwapply-reg-looks-negp (if (eq (car expr) 'calcFunc-register) @@ -2069,8 +2015,7 @@ (nth 2 expr))) (math-rwapply-replace-regs (list (car expr) (nth 1 expr) - (math-rwapply-reg-neg (nth 2 expr)))))) -) + (math-rwapply-reg-neg (nth 2 expr))))))) (defun math-rwapply-remember (old new) (let ((varval (symbol-value (nth 2 (car ruleset)))) @@ -2089,9 +2034,8 @@ (list (list 'same 0 1) (list 'done new nil)) nil nil) - (cdr rules)))))) -) + (cdr rules))))))) + +;;; calc-rewr.el ends here - -
--- a/lisp/calc/calc-rules.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-rules.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-rules.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -33,8 +33,7 @@ (prog2 (message "Preparing rule set %s..." name) (math-read-plain-expr rules t) - (message "Preparing rule set %s...done" name)) -) + (message "Preparing rule set %s...done" name))) (defun calc-CommuteRules () "CommuteRules" @@ -56,8 +55,7 @@ select(a < b) := select(b > a), select(a > b) := select(b < a), select(a <= b) := select(b >= a), -select(a >= b) := select(b <= a) ]") -) +select(a >= b) := select(b <= a) ]")) (defun calc-JumpRules () "JumpRules" @@ -87,8 +85,7 @@ plain(y = a ^ select(x)) := y ^ select(1/x) = a, plain(y = select(x) ^ a) := log(y, select(x)) = a, plain(y = log(a, select(x))) := select(x) ^ y = a, -plain(y = log(select(x), a)) := select(x) ^ (1/y) = a ]") -) +plain(y = log(select(x), a)) := select(x) ^ (1/y) = a ]")) (defun calc-DistribRules () "DistribRules" @@ -161,8 +158,7 @@ x && select(a || b) := (x && select(a)) || (x && b), select(a || b) && x := (select(a) && x) || (b && x), ! select(a && b) := (!a) || (!b), -! select(a || b) := (!a) && (!b) ]") -) +! select(a || b) := (!a) && (!b) ]")) (defun calc-MergeRules () "MergeRules" @@ -235,8 +231,7 @@ log(a,x) / select(log(b,x)) := select(log(a, b)), select(log(a,x)) / b := select(log(a ^ (1/b),x)), log(a,x) / select(b) := select(log(a ^ (1/b),x)), -select(x && a) || (x && opt(b)) := x && (select(a) || b) ]") -) +select(x && a) || (x && opt(b)) := x && (select(a) || b) ]")) (defun calc-NegateRules () "NegateRules" @@ -290,8 +285,7 @@ a > select(x) := -a < select(-x), a <= select(x) := -a >= select(-x), a >= select(x) := -a <= select(-x), -select(x) := -select(-x) ]") -) +select(x) := -select(-x) ]")) (defun calc-InvertRules () "InvertRules" @@ -319,8 +313,7 @@ a > select(x) := 1/a < select(1/x), a <= select(x) := 1/a >= select(1/x), a >= select(x) := 1/a <= select(1/x), -select(x) := 1 / select(1/x) ]") -) +select(x) := 1 / select(1/x) ]")) (defun calc-FactorRules () @@ -340,8 +333,7 @@ :: negative(c) :: let(rz := esimplify(sqrt(z))) :: !matches(rz, sqrt(rzz)) :: let(rc := esimplify(sqrt(-c))) :: !matches(rc, sqrt(rcc)) - ]") -) + ]")) ;;(setq var-FactorRules 'calc-FactorRules) @@ -352,8 +344,7 @@ opt(a) ln(x) + opt(b) ln(y) := 2 a esimplify(arctanh(x-1)) :: a + b = 0 :: nrat(x + y) = 2 || nrat(x - y) = 2, a * (b + c) := a b + a c :: constant(a) - ]") -) + ]")) ;;(setq var-IntegAfterRules 'calc-IntegAfterRules) @@ -439,6 +430,6 @@ :: let(cons(fvh,fvt), solve(pv, table(fitparam(j), j, 1, hasfitparams(pv)))), -fitparam(n) = x := x ]") -) +fitparam(n) = x := x ]")) +;;; calc-rules.el ends here
--- a/lisp/calc/calc-sel.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-sel.el Wed Nov 14 09:09:09 2001 +0000 @@ -52,23 +52,19 @@ (car entry) found))) found) (calc-grow-assoc-formula (car entry) found)) - (car entry))))))) -) + (car entry)))))))) (defun calc-select-once (num) (interactive "P") - (calc-select-here num t) -) + (calc-select-here num t)) (defun calc-select-here-maybe (num) (interactive "P") - (calc-select-here num nil t) -) + (calc-select-here num nil t)) (defun calc-select-once-maybe (num) (interactive "P") - (calc-select-here num t t) -) + (calc-select-here num t t)) (defun calc-select-additional () (interactive) @@ -88,8 +84,7 @@ (car entry) sel))) sel) (calc-grow-assoc-formula (car entry) found))) - (car entry))))) -) + (car entry)))))) (defun calc-select-more (num) (interactive "P") @@ -102,8 +97,7 @@ (>= (setq num (1- (prefix-numeric-value num))) 0)) (setq sel (calc-find-assoc-parent-formula (car entry) sel))) (calc-change-current-selection sel)) - (calc-select-here num)))) -) + (calc-select-here num))))) (defun calc-select-less (num) (interactive "p") @@ -125,8 +119,7 @@ (setq op (assq (car-safe sel) calc-assoc-ops)) (memq (car old) (nth index op)) (setq num (1+ num)))) - sel))))) -) + sel)))))) (defun calc-select-part (num) (interactive "P") @@ -138,8 +131,7 @@ num))) (if sel (calc-change-current-selection sel) - (error "%d is not a valid sub-formula index" num)))) -) + (error "%d is not a valid sub-formula index" num))))) (defun calc-find-nth-part (expr num) (if (and calc-assoc-selections @@ -149,8 +141,7 @@ (if (eq (car-safe expr) 'intv) (and (>= num 1) (<= num 2) (nth (1+ num) expr)) (and (not (Math-primp expr)) (>= num 1) (< num (length expr)) - (nth num expr)))) -) + (nth num expr))))) (defun calc-find-nth-part-rec (expr) ; uses num, op (or (if (and (setq op (assq (car-safe (nth 1 expr)) calc-assoc-ops)) @@ -162,8 +153,7 @@ (memq (car expr) (nth 2 op))) (calc-find-nth-part-rec (nth 2 expr)) (and (= (setq num (1- num)) 0) - (nth 2 expr)))) -) + (nth 2 expr))))) (defun calc-select-next (num) (interactive "p") @@ -200,8 +190,7 @@ (calc-change-current-selection sel)) (if (Math-primp (car entry)) (calc-change-current-selection (car entry)) - (calc-select-part num)))))) -) + (calc-select-part num))))))) (defun calc-select-previous (num) (interactive "p") @@ -246,8 +235,7 @@ (calc-find-nth-part-rec (car entry)) (- 1 num)) (length (car entry))))) - (calc-select-part (- len num)))))))) -) + (calc-select-part (- len num))))))))) (defun calc-find-parent-formula (expr part) (cond ((eq expr part) t) @@ -258,13 +246,11 @@ (not (setq res (calc-find-parent-formula (car p) part))))) (and p - (if (eq res t) expr res))))) -) + (if (eq res t) expr res)))))) (defun calc-find-assoc-parent-formula (expr part) - (calc-grow-assoc-formula expr (calc-find-parent-formula expr part)) -) + (calc-grow-assoc-formula expr (calc-find-parent-formula expr part))) (defun calc-grow-assoc-formula (expr part) (if calc-assoc-selections @@ -277,8 +263,7 @@ (nth (calc-find-sub-formula new part) op))) (setq part new)))) part) - part) -) + part)) (defun calc-find-sub-formula (expr part) (cond ((eq expr part) t) @@ -288,15 +273,13 @@ (while (and (setq expr (cdr expr)) (not (calc-find-sub-formula (car expr) part))) (setq num (1+ num))) - (and expr num)))) -) + (and expr num))))) (defun calc-unselect (num) (interactive "P") (calc-wrapper (calc-prepare-selection num) - (calc-change-current-selection nil)) -) + (calc-change-current-selection nil))) (defun calc-clear-selections () (interactive) @@ -309,8 +292,7 @@ (calc-prepare-selection n) (calc-change-current-selection nil))) (setq n (1+ n)))) - (calc-clear-command-flag 'position-point)) -) + (calc-clear-command-flag 'position-point))) (defun calc-show-selections (arg) (interactive "P") @@ -334,8 +316,7 @@ (calc-change-current-selection sel))))) (message (if calc-show-selections "Displaying only selected part of formulas" - "Displaying all but selected part of formulas"))) -) + "Displaying all but selected part of formulas")))) (defun calc-preserve-point () (or (looking-at "\\.\n+\\'") @@ -343,8 +324,7 @@ (setq calc-final-point-line (+ (count-lines (point-min) (point)) (if (bolp) 1 0)) calc-final-point-column (current-column)) - (calc-set-command-flag 'position-point))) -) + (calc-set-command-flag 'position-point)))) (defun calc-enable-selections (arg) (interactive "P") @@ -356,8 +336,7 @@ (calc-set-command-flag 'renum-stack) (message (if calc-use-selections "Commands operate only on selected sub-formulas" - "Selections of sub-formulas have no effect"))) -) + "Selections of sub-formulas have no effect")))) (defun calc-break-selections (arg) (interactive "P") @@ -368,8 +347,7 @@ (not calc-assoc-selections))) (message (if calc-assoc-selections "Selection treats a+b+c as a sum of three terms" - "Selection treats a+b+c as (a+b)+c"))) -) + "Selection treats a+b+c as (a+b)+c")))) (defun calc-prepare-selection (&optional num) (or num (setq num (calc-locate-cursor-element (point)))) @@ -392,8 +370,7 @@ (+ (car (math-stack-value-offset calc-selection-cache-comp)) (length calc-left-label) (if calc-line-numbering 4 0)))))) - (calc-preserve-point) -) + (calc-preserve-point)) (setq calc-selection-cache-entry nil) ;;; The following ensures that no two subformulas will be "eq" to each other! @@ -402,8 +379,7 @@ (equal x '(float 0 0))) (list 'cplx x 0) (calc-encase-atoms-rec x) - x) -) + x)) (defun calc-encase-atoms-rec (x) (or (Math-primp x) @@ -414,8 +390,7 @@ (if (or (not (consp (car x))) (equal (car x) '(float 0 0))) (setcar x (list 'cplx (car x) 0)) - (calc-encase-atoms-rec (car x)))))) -) + (calc-encase-atoms-rec (car x))))))) (defun calc-find-selected-part () (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset)) @@ -441,8 +416,7 @@ (and (>= math-comp-sel-hpos 0) (> calc-selection-true-num 0) (math-composition-to-string calc-selection-cache-comp 1000000)) - (nth 1 math-comp-sel-tag)) -) + (nth 1 math-comp-sel-tag))) (defun calc-change-current-selection (sub-expr) (or (eq sub-expr (nth 2 calc-selection-cache-entry)) @@ -457,8 +431,7 @@ (delete-region top (point)) (let ((calc-selection-cache-default-entry calc-selection-cache-entry)) (insert (math-format-stack-value calc-selection-cache-entry) - "\n")))) -) + "\n"))))) (defun calc-top-selected (&optional n m) (and calc-any-selections @@ -473,25 +446,21 @@ (if (nth 2 (car top)) (setq sel (if sel t (nth 2 (car top))))) (setq top (cdr top))) - sel))) -) + sel)))) (defun calc-replace-sub-formula (expr old new) (setq new (calc-encase-atoms new)) - (calc-replace-sub-formula-rec expr) -) + (calc-replace-sub-formula-rec expr)) (defun calc-replace-sub-formula-rec (expr) (cond ((eq expr old) new) ((Math-primp expr) expr) (t (cons (car expr) - (mapcar 'calc-replace-sub-formula-rec (cdr expr))))) -) + (mapcar 'calc-replace-sub-formula-rec (cdr expr)))))) (defun calc-sel-error () - (error "Illegal operation on sub-formulas") -) + (error "Illegal operation on sub-formulas")) (defun calc-replace-selections (n vals m) (if (calc-top-selected n m) @@ -538,8 +507,7 @@ (calc-push-list vals)))) (t (calc-sel-error)))) (calc-pop-stack n m t) - (calc-push-list vals m)) -) + (calc-push-list vals m))) (setq calc-keep-selection t) (defun calc-delete-selection (n) @@ -590,32 +558,28 @@ (copy-sequence parent))))) n))))) - (calc-pop-stack 1 n t))) -) + (calc-pop-stack 1 n t)))) (defun calc-roll-down-with-selections (n m) (let ((vals (append (calc-top-list m 1) (calc-top-list (- n m) (1+ m)))) (sels (append (calc-top-list m 1 'sel) (calc-top-list (- n m) (1+ m) 'sel)))) - (calc-pop-push-list n vals 1 sels)) -) + (calc-pop-push-list n vals 1 sels))) (defun calc-roll-up-with-selections (n m) (let ((vals (append (calc-top-list (- n m) 1) (calc-top-list m (- n m -1)))) (sels (append (calc-top-list (- n m) 1 'sel) (calc-top-list m (- n m -1) 'sel)))) - (calc-pop-push-list n vals 1 sels)) -) + (calc-pop-push-list n vals 1 sels))) (defun calc-auto-selection (entry) (or (nth 2 entry) (progn (and (boundp 'reselect) (setq reselect nil)) (calc-prepare-selection) - (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))) -) + (calc-grow-assoc-formula (car entry) (calc-find-selected-part))))) (defun calc-copy-selection () (interactive) @@ -623,8 +587,7 @@ (calc-preserve-point) (let* ((num (max 1 (calc-locate-cursor-element (point)))) (entry (calc-top num 'entry))) - (calc-push (or (calc-auto-selection entry) (car entry))))) -) + (calc-push (or (calc-auto-selection entry) (car entry)))))) (defun calc-del-selection () (interactive) @@ -634,8 +597,7 @@ (entry (calc-top num 'entry)) (sel (calc-auto-selection entry))) (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel)) - (calc-delete-selection num))) -) + (calc-delete-selection num)))) (defun calc-enter-selection () (interactive) @@ -658,8 +620,7 @@ expr sel alg)) num (list (and reselect alg)))))) - (calc-handle-whys))) -) + (calc-handle-whys)))) (defun calc-edit-selection () (interactive) @@ -676,8 +637,7 @@ (calc-edit-mode (list 'calc-finish-selection-edit num (list 'quote sel) reselect)) (insert str "\n")))) - (calc-show-edit-buffer) -) + (calc-show-edit-buffer)) (defun calc-finish-selection-edit (num sel reselect) (let ((buf (current-buffer)) @@ -703,8 +663,7 @@ num (list (and reselect val))) (calc-push val) - (error "Original selection has been lost")))))) -) + (error "Original selection has been lost"))))))) (defun calc-sel-evaluate (arg) (interactive "p") @@ -723,8 +682,7 @@ (car entry) sel val)) num (list (and reselect val)))))) - (calc-handle-whys))) -) + (calc-handle-whys)))) (defun calc-sel-expand-formula (arg) (interactive "p") @@ -749,8 +707,7 @@ (car entry) sel val)) num (list (and reselect val)))))) - (calc-handle-whys))) -) + (calc-handle-whys)))) (defun calc-sel-mult-both-sides (no-simp &optional divide) (interactive "P") @@ -811,13 +768,11 @@ expr sel alg)) num (list (and reselect alg))))) - (calc-handle-whys))) -) + (calc-handle-whys)))) (defun calc-sel-div-both-sides (no-simp) (interactive "P") - (calc-sel-mult-both-sides no-simp t) -) + (calc-sel-mult-both-sides no-simp t)) (defun calc-sel-add-both-sides (no-simp &optional subtract) (interactive "P") @@ -857,11 +812,10 @@ expr sel alg)) num (list (and reselect alg))))) - (calc-handle-whys))) -) + (calc-handle-whys)))) (defun calc-sel-sub-both-sides (no-simp) (interactive "P") - (calc-sel-add-both-sides no-simp t) -) + (calc-sel-add-both-sides no-simp t)) +;;; calc-sel.el ends here
--- a/lisp/calc/calc-stat.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-stat.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-stat.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -34,36 +34,31 @@ (defun calc-vector-count (arg) (interactive "P") (calc-slow-wrapper - (calc-vector-op "coun" 'calcFunc-vcount arg)) -) + (calc-vector-op "coun" 'calcFunc-vcount arg))) (defun calc-vector-sum (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-vector-op "vprd" 'calcFunc-vprod arg) - (calc-vector-op "vsum" 'calcFunc-vsum arg))) -) + (calc-vector-op "vsum" 'calcFunc-vsum arg)))) (defun calc-vector-product (arg) (interactive "P") (calc-hyperbolic-func) - (calc-vector-sum arg) -) + (calc-vector-sum arg)) (defun calc-vector-max (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (calc-vector-op "vmin" 'calcFunc-vmin arg) - (calc-vector-op "vmax" 'calcFunc-vmax arg))) -) + (calc-vector-op "vmax" 'calcFunc-vmax arg)))) (defun calc-vector-min (arg) (interactive "P") (calc-invert-func) - (calc-vector-max arg) -) + (calc-vector-max arg)) (defun calc-vector-mean (arg) (interactive "P") @@ -74,35 +69,30 @@ (calc-vector-op "medn" 'calcFunc-vmedian arg)) (if (calc-is-inverse) (calc-vector-op "meae" 'calcFunc-vmeane arg) - (calc-vector-op "mean" 'calcFunc-vmean arg)))) -) + (calc-vector-op "mean" 'calcFunc-vmean arg))))) (defun calc-vector-mean-error (arg) (interactive "P") (calc-invert-func) - (calc-vector-mean arg) -) + (calc-vector-mean arg)) (defun calc-vector-median (arg) (interactive "P") (calc-hyperbolic-func) - (calc-vector-mean arg) -) + (calc-vector-mean arg)) (defun calc-vector-harmonic-mean (arg) (interactive "P") (calc-invert-func) (calc-hyperbolic-func) - (calc-vector-mean arg) -) + (calc-vector-mean arg)) (defun calc-vector-geometric-mean (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-binary-op "geom" 'calcFunc-agmean arg) - (calc-vector-op "geom" 'calcFunc-vgmean arg))) -) + (calc-vector-op "geom" 'calcFunc-vgmean arg)))) (defun calc-vector-sdev (arg) (interactive "P") @@ -113,27 +103,23 @@ (calc-vector-op "var" 'calcFunc-vvar arg)) (if (calc-is-inverse) (calc-vector-op "psdv" 'calcFunc-vpsdev arg) - (calc-vector-op "sdev" 'calcFunc-vsdev arg)))) -) + (calc-vector-op "sdev" 'calcFunc-vsdev arg))))) (defun calc-vector-pop-sdev (arg) (interactive "P") (calc-invert-func) - (calc-vector-sdev arg) -) + (calc-vector-sdev arg)) (defun calc-vector-variance (arg) (interactive "P") (calc-hyperbolic-func) - (calc-vector-sdev arg) -) + (calc-vector-sdev arg)) (defun calc-vector-pop-variance (arg) (interactive "P") (calc-invert-func) (calc-hyperbolic-func) - (calc-vector-sdev arg) -) + (calc-vector-sdev arg)) (defun calc-vector-covariance (arg) (interactive "P") @@ -146,28 +132,24 @@ (calc-enter-result n "pcov" (cons 'calcFunc-vpcov (calc-top-list-n n))) (calc-enter-result n "cov" (cons 'calcFunc-vcov - (calc-top-list-n n))))))) -) + (calc-top-list-n n)))))))) (defun calc-vector-pop-covariance (arg) (interactive "P") (calc-invert-func) - (calc-vector-covariance arg) -) + (calc-vector-covariance arg)) (defun calc-vector-correlation (arg) (interactive "P") (calc-hyperbolic-func) - (calc-vector-covariance arg) -) + (calc-vector-covariance arg)) (defun calc-vector-op (name func arg) (setq calc-aborted-prefix name arg (prefix-numeric-value arg)) (if (< arg 0) (error "Negative arguments not allowed")) - (calc-enter-result arg name (cons func (calc-top-list-n arg))) -) + (calc-enter-result arg name (cons func (calc-top-list-n arg)))) @@ -180,12 +162,10 @@ ;;; non-vectors. (defun calcFunc-vsum (&rest vecs) - (math-reduce-many-vecs 'calcFunc-add 'calcFunc-vsum vecs 0) -) + (math-reduce-many-vecs 'calcFunc-add 'calcFunc-vsum vecs 0)) (defun calcFunc-vprod (&rest vecs) - (math-reduce-many-vecs 'calcFunc-mul 'calcFunc-vprod vecs 1) -) + (math-reduce-many-vecs 'calcFunc-mul 'calcFunc-vprod vecs 1)) (defun calcFunc-vmax (&rest vecs) (if (eq (car-safe (car vecs)) 'sdev) @@ -193,8 +173,7 @@ (if (eq (car-safe (car vecs)) 'intv) (nth 3 (math-fix-int-intv (car vecs))) (math-reduce-many-vecs 'calcFunc-max 'calcFunc-vmax vecs - '(neg (var inf var-inf))))) -) + '(neg (var inf var-inf)))))) (defun calcFunc-vmin (&rest vecs) (if (eq (car-safe (car vecs)) 'sdev) @@ -202,8 +181,7 @@ (if (eq (car-safe (car vecs)) 'intv) (nth 2 (math-fix-int-intv (car vecs))) (math-reduce-many-vecs 'calcFunc-min 'calcFunc-vmin vecs - '(var inf var-inf)))) -) + '(var inf var-inf))))) (defun math-reduce-many-vecs (func whole-func vecs ident) (let ((const-part nil) @@ -236,8 +214,7 @@ (if symb-part (funcall func const-part (cons whole-func symb-part)) const-part)) - (if symb-part (cons whole-func symb-part) ident))) -) + (if symb-part (cons whole-func symb-part) ident)))) ;;; Return the number of data elements among the arguments. @@ -256,8 +233,7 @@ (symbol-value (nth 2 (car vecs))))) (math-reject-arg (car vecs) 'numvecp)))) vecs (cdr vecs))) - count) -) + count)) (defun math-count-elements (vec) (let ((count 0)) @@ -265,8 +241,7 @@ (setq count (if (Math-vectorp (car vec)) (+ count (math-count-elements (car vec))) (1+ count)))) - count) -) + count)) (defun math-flatten-many-vecs (vecs) @@ -285,12 +260,10 @@ (nth 2 (car p)))) (math-reject-arg (car p) 'numvecp))))) p (cdr p))) - vec) -) + vec)) (defun calcFunc-vflat (&rest vecs) - (math-flatten-many-vecs vecs) -) + (math-flatten-many-vecs vecs)) (defun math-split-sdev-vec (vec zero-ok) (let ((means (list 'vec)) @@ -317,8 +290,7 @@ exact t)) (setq means (cons p means))))) (list (nreverse means) - (and wts (nreverse wts))))) -) + (and wts (nreverse wts)))))) ;;; Return the arithmetic mean of the argument numbers or vectors. @@ -344,16 +316,14 @@ (calcFunc-map '(var div var-div) means sqrwts)) suminvsqrwts)) - (math-div (calcFunc-reduce '(var add var-add) means) len)))))) -) + (math-div (calcFunc-reduce '(var add var-add) means) len))))))) (defun math-fix-int-intv (x) (if (math-floatp x) x (list 'intv 3 (if (memq (nth 1 x) '(2 3)) (nth 2 x) (math-add (nth 2 x) 1)) - (if (memq (nth 1 x) '(1 3)) (nth 3 x) (math-sub (nth 3 x) 1)))) -) + (if (memq (nth 1 x) '(1 3)) (nth 3 x) (math-sub (nth 3 x) 1))))) ;;; Compute the mean with an error estimate. (defun calcFunc-vmeane (&rest vecs) @@ -390,8 +360,7 @@ means (math-neg mean))) 2)) - (math-mul len (1- len)))))))))) -) + (math-mul len (1- len))))))))))) ;;; Compute the median of a list of values. @@ -413,8 +382,7 @@ (setq flat (sort flat 'math-lessp)) (if (= (% len 2) 0) (math-div (math-add (nth (1- hlen) flat) (nth hlen flat)) 2) - (nth hlen flat))))) -) + (nth hlen flat)))))) (defun calcFunc-vgmean (&rest vecs) @@ -426,8 +394,7 @@ (let ((x (calcFunc-reduce '(var mul math-mul) flat))) (if (= len 2) (math-sqrt x) - (math-pow x (list 'frac 1 len))))))) -) + (math-pow x (list 'frac 1 len)))))))) (defun calcFunc-agmean (a b) @@ -446,8 +413,7 @@ (setq mean (math-mul-float (math-add-float a b) '(float 5 -1)) b (math-sqrt-float (math-mul-float a b)) a mean)) - a)))) -) + a))))) (defun calcFunc-vhmean (&rest vecs) @@ -458,8 +424,7 @@ (math-with-extra-prec 2 (math-div len (calcFunc-reduce '(var add math-add) - (calcFunc-map '(var inv var-inv) flat)))))) -) + (calcFunc-map '(var inv var-inv) flat))))))) @@ -471,8 +436,7 @@ (if (eq (car-safe (car vecs)) 'intv) (math-intv-variance (car vecs) nil) (math-sqr (nth 2 (car vecs)))) - (math-covariance vecs nil nil 0)) -) + (math-covariance vecs nil nil 0))) (defun calcFunc-vsdev (&rest vecs) (if (and (= (length vecs) 1) @@ -483,8 +447,7 @@ (math-sqrt-12)) (math-sqrt (calcFunc-vvar (car vecs)))) (nth 2 (car vecs))) - (math-sqrt (math-covariance vecs nil nil 0))) -) + (math-sqrt (math-covariance vecs nil nil 0)))) ;;; Compute the population variance or std deviation of numbers or vectors. (defun calcFunc-vpvar (&rest vecs) @@ -493,8 +456,7 @@ (if (eq (car-safe (car vecs)) 'intv) (math-intv-variance (car vecs) t) (math-sqr (nth 2 (car vecs)))) - (math-covariance vecs nil t 0)) -) + (math-covariance vecs nil t 0))) (defun calcFunc-vpsdev (&rest vecs) (if (and (= (length vecs) 1) @@ -505,8 +467,7 @@ (math-sqrt-12)) (math-sqrt (calcFunc-vpvar (car vecs)))) (nth 2 (car vecs))) - (math-sqrt (math-covariance vecs nil t 0))) -) + (math-sqrt (math-covariance vecs nil t 0)))) (defun math-intv-variance (x pop) (or (math-constp x) (math-reject-arg x 'constp)) @@ -521,21 +482,17 @@ (calcFunc-sum '(^ (- (var X var-X) (/ 1 2)) 2) '(var X var-X) (math-neg hlen) (math-add hlen 1))) - (if pop (math-add len 1) len)))) -) + (if pop (math-add len 1) len))))) ;;; Compute the covariance and linear correlation coefficient. (defun calcFunc-vcov (vec1 &optional vec2) - (math-covariance (list vec1) (list vec2) nil 1) -) + (math-covariance (list vec1) (list vec2) nil 1)) (defun calcFunc-vpcov (vec1 &optional vec2) - (math-covariance (list vec1) (list vec2) t 1) -) + (math-covariance (list vec1) (list vec2) t 1)) (defun calcFunc-vcorr (vec1 &optional vec2) - (math-covariance (list vec1) (list vec2) nil 2) -) + (math-covariance (list vec1) (list vec2) nil 2)) (defun math-covariance (vec1 vec2 pop mode) @@ -621,9 +578,6 @@ (if pop suminvsqrwts (math-div (math-mul suminvsqrwts (1- len)) len)) - (if pop len (1- len)))))))) -) + (if pop len (1- len))))))))) - - - +;;; calc-stat.el ends here
--- a/lisp/calc/calc-store.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-store.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-store.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -34,8 +34,7 @@ (defun calc-store (&optional var) (interactive) (let ((calc-store-keep t)) - (calc-store-into var)) -) + (calc-store-into var))) (setq calc-store-keep nil) (defun calc-store-into (&optional var) @@ -62,58 +61,47 @@ (calc-store-value (car (car var)) (cdr (car var)) (if (not (cdr var)) "") (if (not (cdr var)) 1)) - (setq var (cdr var))))))) -) + (setq var (cdr var)))))))) (defun calc-store-plus (&optional var) (interactive) - (calc-store-binary var "+" '+) -) + (calc-store-binary var "+" '+)) (defun calc-store-minus (&optional var) (interactive) - (calc-store-binary var "-" '-) -) + (calc-store-binary var "-" '-)) (defun calc-store-times (&optional var) (interactive) - (calc-store-binary var "*" '*) -) + (calc-store-binary var "*" '*)) (defun calc-store-div (&optional var) (interactive) - (calc-store-binary var "/" '/) -) + (calc-store-binary var "/" '/)) (defun calc-store-power (&optional var) (interactive) - (calc-store-binary var "^" '^) -) + (calc-store-binary var "^" '^)) (defun calc-store-concat (&optional var) (interactive) - (calc-store-binary var "|" '|) -) + (calc-store-binary var "|" '|)) (defun calc-store-neg (n &optional var) (interactive "p") - (calc-store-binary var "n" '/ (- n)) -) + (calc-store-binary var "n" '/ (- n))) (defun calc-store-inv (n &optional var) (interactive "p") - (calc-store-binary var "&" '^ (- n)) -) + (calc-store-binary var "&" '^ (- n))) (defun calc-store-incr (n &optional var) (interactive "p") - (calc-store-binary var "n" '- (- n)) -) + (calc-store-binary var "n" '- (- n))) (defun calc-store-decr (n &optional var) (interactive "p") - (calc-store-binary var "n" '- n) -) + (calc-store-binary var "n" '- n)) (defun calc-store-value (var value tag &optional pop) (if var @@ -131,15 +119,13 @@ (null old) (message "(Note: %s has built-in meanings which may interfere)" var)) - (calc-refresh-evaltos var))) -) + (calc-refresh-evaltos var)))) (defun calc-var-name (var) (if (symbolp var) (setq var (symbol-name var))) (if (string-match "\\`var-." var) (substring var 4) - var) -) + var)) (defun calc-store-binary (var tag func &optional val) (calc-wrapper @@ -160,8 +146,7 @@ (list func value old) (list func old value))) tag (and (not val) 1)) - (message "Stored to variable \"%s\"" (calc-var-name var)))))) -) + (message "Stored to variable \"%s\"" (calc-var-name var))))))) (defun calc-read-var-name (prompt &optional calc-store-opers) (setq calc-given-value nil @@ -184,8 +169,7 @@ (error "Bad format: %s" (nth 2 calc-given-value))) (setq calc-given-value (math-evaluate-expr calc-given-value)) svar)) - (intern var)))) -) + (intern var))))) (setq calc-given-value-flag nil) (defvar calc-var-name-map nil "Keymap for reading Calc variable names.") @@ -202,8 +186,7 @@ (lambda (x) (define-key calc-var-name-map (char-to-string x) 'calcVar-oper))) - "+-*/^|") -) + "+-*/^|")) (defun calcVar-digit () (interactive) @@ -212,8 +195,7 @@ (beep) (insert "q") (self-insert-and-exit)) - (self-insert-command 1)) -) + (self-insert-command 1))) (defun calcVar-oper () (interactive) @@ -222,8 +204,7 @@ (progn (erase-buffer) (self-insert-and-exit)) - (self-insert-command 1)) -) + (self-insert-command 1))) (defun calc-store-map (&optional oper var) (interactive) @@ -256,8 +237,7 @@ (calc-store-value var (calc-normalize (cons (nth 1 oper) values)) (nth 2 oper) - (+ calc-dollar-used (1- nargs))))))) -) + (+ calc-dollar-used (1- nargs)))))))) (defun calc-store-exchange (&optional var) (interactive) @@ -275,8 +255,7 @@ (setq top (or calc-given-value (calc-top 1))) (calc-store-value var top nil) (calc-pop-push-record calc-given-value-flag - (concat "<>" (calc-var-name var)) value))))) -) + (concat "<>" (calc-var-name var)) value)))))) (defun calc-unstore (&optional var) (interactive) @@ -291,8 +270,7 @@ (message "Unstored variable \"%s\"" (calc-var-name var)) (message "Variable \"%s\" remains unstored" (calc-var-name var))) (makunbound var) - (calc-refresh-evaltos var)))) -) + (calc-refresh-evaltos var))))) (defun calc-let (&optional var) (interactive) @@ -331,8 +309,7 @@ (makunbound (car (car var)))) (setq saved-val (cdr saved-val) var (cdr var))) - (calc-handle-whys))))))) -) + (calc-handle-whys)))))))) (defun calc-is-assignments (value) (if (memq (car-safe value) '(calcFunc-eq calcFunc-assign)) @@ -348,8 +325,7 @@ (nth 2 (car value))) vv))) (and (not value) - vv)))) -) + vv))))) (defun calc-recall (&optional var) (interactive) @@ -366,23 +342,19 @@ (setq value (calc-normalize value)) (let ((calc-full-trail-vectors nil)) (calc-record value (concat "<" (calc-var-name var)))) - (calc-push value)))) -) + (calc-push value))))) (defun calc-store-quick () (interactive) - (calc-store (intern (format "var-q%c" last-command-char))) -) + (calc-store (intern (format "var-q%c" last-command-char)))) (defun calc-store-into-quick () (interactive) - (calc-store-into (intern (format "var-q%c" last-command-char))) -) + (calc-store-into (intern (format "var-q%c" last-command-char)))) (defun calc-recall-quick () (interactive) - (calc-recall (intern (format "var-q%c" last-command-char))) -) + (calc-recall (intern (format "var-q%c" last-command-char)))) (defun calc-copy-variable (&optional var1 var2) (interactive) @@ -395,8 +367,7 @@ (or var2 (setq var2 (calc-read-var-name (format "Copy variable: %s, to: " var1)))) (if var2 - (calc-store-value var2 value ""))))) -) + (calc-store-value var2 value "")))))) (defun calc-edit-variable (&optional var) (interactive) @@ -416,75 +387,61 @@ t (concat "Editing " (calc-var-name var))) (and value - (insert (math-format-nice-expr value (screen-width)) "\n"))))) - (calc-show-edit-buffer) -) + (insert (math-format-nice-expr value (frame-width)) "\n"))))) + (calc-show-edit-buffer)) (setq calc-last-edited-variable nil) (defun calc-edit-Decls () (interactive) - (calc-edit-variable 'var-Decls) -) + (calc-edit-variable 'var-Decls)) (defun calc-edit-EvalRules () (interactive) - (calc-edit-variable 'var-EvalRules) -) + (calc-edit-variable 'var-EvalRules)) (defun calc-edit-FitRules () (interactive) - (calc-edit-variable 'var-FitRules) -) + (calc-edit-variable 'var-FitRules)) (defun calc-edit-GenCount () (interactive) - (calc-edit-variable 'var-GenCount) -) + (calc-edit-variable 'var-GenCount)) (defun calc-edit-Holidays () (interactive) - (calc-edit-variable 'var-Holidays) -) + (calc-edit-variable 'var-Holidays)) (defun calc-edit-IntegLimit () (interactive) - (calc-edit-variable 'var-IntegLimit) -) + (calc-edit-variable 'var-IntegLimit)) (defun calc-edit-LineStyles () (interactive) - (calc-edit-variable 'var-LineStyles) -) + (calc-edit-variable 'var-LineStyles)) (defun calc-edit-PointStyles () (interactive) - (calc-edit-variable 'var-PointStyles) -) + (calc-edit-variable 'var-PointStyles)) (defun calc-edit-PlotRejects () (interactive) - (calc-edit-variable 'var-PlotRejects) -) + (calc-edit-variable 'var-PlotRejects)) (defun calc-edit-AlgSimpRules () (interactive) - (calc-edit-variable 'var-AlgSimpRules) -) + (calc-edit-variable 'var-AlgSimpRules)) (defun calc-edit-TimeZone () (interactive) - (calc-edit-variable 'var-TimeZone) -) + (calc-edit-variable 'var-TimeZone)) (defun calc-edit-Units () (interactive) - (calc-edit-variable 'var-Units) -) + (calc-edit-variable 'var-Units)) (defun calc-edit-ExtSimpRules () (interactive) - (calc-edit-variable 'var-ExtSimpRules) -) + (calc-edit-variable 'var-ExtSimpRules)) (defun calc-declare-variable (&optional var) (interactive) @@ -554,8 +511,7 @@ (list (list 'vec (math-build-var-name var) decl))))))) - (calc-refresh-evaltos 'var-Decls))) -) + (calc-refresh-evaltos 'var-Decls)))) (defun calc-permanent-variable (&optional var) (interactive) @@ -575,8 +531,7 @@ (calc-var-value x) (not (eq (car-safe (symbol-value x)) 'special-const)) (calc-insert-permanent-variable x)))))) - (save-buffer))) -) + (save-buffer)))) (defvar calc-dont-insert-variables '(var-FitRules var-FactorRules var-CommuteRules var-JumpRules var-DistribRules var-MergeRules @@ -613,8 +568,7 @@ " ')\n") (backward-char 2)) (insert (prin1-to-string (calc-var-value var))) - (forward-line 1) -) + (forward-line 1)) (defun calc-insert-variables (buf) (interactive "bBuffer in which to save variable values: ") @@ -640,24 +594,21 @@ 'flat calc-language))) (math-format-value (symbol-value x) 100000))) - ")\n")))))) -) + ")\n"))))))) (defun calc-assign (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op ":=" 'calcFunc-assign arg)) -) + (calc-binary-op ":=" 'calcFunc-assign arg))) (defun calc-evalto (arg) (interactive "P") (calc-slow-wrapper - (calc-unary-op "=>" 'calcFunc-evalto arg)) -) + (calc-unary-op "=>" 'calcFunc-evalto arg))) (defun calc-subscript (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "sub" 'calcFunc-subscr arg)) -) + (calc-binary-op "sub" 'calcFunc-subscr arg))) +;;; calc-store.el ends here
--- a/lisp/calc/calc-stuff.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-stuff.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-stuff.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -43,8 +43,7 @@ (error "Argument must be a small integer")) (calc-pop-stack 1) (setq prefix-arg num) - (message "%d-" num)))) ; a (lame) simulation of the real thing... -) + (message "%d-" num))))) ; a (lame) simulation of the real thing... (defun calc-more-recursion-depth (n) @@ -56,8 +55,7 @@ (if (> n 1) (setq max-specpdl-size (* max-specpdl-size n) max-lisp-eval-depth (* max-lisp-eval-depth n)))) - (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))) -) + (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)))) (defun calc-less-recursion-depth (n) (interactive "P") @@ -67,8 +65,7 @@ (max (/ max-specpdl-size n) 600) max-lisp-eval-depth (max (/ max-lisp-eval-depth n) 200)))) - (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth) -) + (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)) (defun calc-explain-why (why &optional more) @@ -137,8 +134,7 @@ (car why) (math-format-flat-expr (car why) 0))) punc ", "))) - (message "%s%s" msg (if more " [w=more]" ""))) -) + (message "%s%s" msg (if more " [w=more]" "")))) (defun calc-why () (interactive) @@ -154,8 +150,7 @@ (progn (message "(No further explanations available)") (setq calc-which-why calc-why)) - (message "No explanations available"))) -) + (message "No explanations available")))) (setq calc-which-why nil) (setq calc-last-why-command nil) @@ -184,8 +179,7 @@ math-format-date-cache nil math-holidays-cache-tag t) (mapcar (function (lambda (x) (set x -100))) math-cache-list) - (message "All internal calculator caches have been reset.")) -) + (message "All internal calculator caches have been reset."))) ;;; Conversions. @@ -203,8 +197,7 @@ (if (<= n 0) (+ n calc-internal-prec) n))) - (list func (calc-top-n 1))))))) -) + (list func (calc-top-n 1)))))))) (defun calc-clean-num (num) (interactive "P") @@ -213,8 +206,7 @@ (if (and (>= last-command-char ?0) (<= last-command-char ?9)) (- last-command-char ?0) - (error "Number required"))))) -) + (error "Number required")))))) (defun calcFunc-clean (a &optional prec) ; [X X S] [Public] @@ -257,27 +249,22 @@ a)) ((Math-objectp a) a) ((math-infinitep a) a) - (t (list 'calcFunc-clean a)))) -) + (t (list 'calcFunc-clean a))))) (setq math-chopping-small nil) (defun calcFunc-pclean (a &optional prec) (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec))) - a) -) + a)) (defun calcFunc-pfloat (a) - (math-map-over-constants 'math-float 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))) - a) -) + a)) (defun math-map-over-constants (func expr) - (math-map-over-constants-rec expr) -) + (math-map-over-constants-rec expr)) (defun math-map-over-constants-rec (expr) (cond ((or (Math-primp expr) @@ -292,9 +279,6 @@ (list (car expr) (math-map-over-constants-rec (nth 1 expr)) (nth 2 expr))) - (t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr))))) -) + (t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr)))))) - - - +;;; calc-stuff.el ends here
--- a/lisp/calc/calc-trail.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-trail.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-trail.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -34,8 +34,7 @@ (defun calc-trail-in () (interactive) (let ((win (get-buffer-window (calc-trail-display t)))) - (and win (select-window win))) -) + (and win (select-window win)))) (defun calc-trail-out () (interactive) @@ -45,38 +44,33 @@ (progn (select-window win) (calc-align-stack-window)) - (calc))) -) + (calc)))) (defun calc-trail-next (n) (interactive "p") (calc-with-trail-buffer (forward-line n) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-previous (n) (interactive "p") (calc-with-trail-buffer (forward-line (- n)) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-first (n) (interactive "p") (calc-with-trail-buffer (goto-char (point-min)) (forward-line n) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-last (n) (interactive "p") (calc-with-trail-buffer (goto-char (point-max)) (forward-line (- n)) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-scroll-left (n) (interactive "P") @@ -86,8 +80,7 @@ (progn (select-window (get-buffer-window (current-buffer))) (calc-scroll-left n)) - (select-window curwin)))) -) + (select-window curwin))))) (defun calc-trail-scroll-right (n) (interactive "P") @@ -97,22 +90,19 @@ (progn (select-window (get-buffer-window (current-buffer))) (calc-scroll-right n)) - (select-window curwin)))) -) + (select-window curwin))))) (defun calc-trail-forward (n) (interactive "p") (calc-with-trail-buffer (forward-line (* n (1- (window-height)))) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-backward (n) (interactive "p") (calc-with-trail-buffer (forward-line (- (* n (1- (window-height))))) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-isearch-forward () (interactive) @@ -121,8 +111,7 @@ (select-window (get-buffer-window (current-buffer))) (let ((search-exit-char ?\r)) (isearch-forward))) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-isearch-backward () (interactive) @@ -131,8 +120,7 @@ (select-window (get-buffer-window (current-buffer))) (let ((search-exit-char ?\r)) (isearch-backward))) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-yank (arg) (interactive "P") @@ -158,8 +146,7 @@ (math-read-plain-expr str)))) (if (eq (car-safe val) 'error) (error "Can't yank that line: %s" (nth 2 val)) - val))))) -) + val)))))) (defun calc-trail-marker (str) (interactive "sText to insert in trail: ") @@ -168,8 +155,7 @@ (let ((buffer-read-only nil)) (insert "---- " str "\n")) (forward-line -1) - (calc-trail-here)) -) + (calc-trail-here))) (defun calc-trail-kill (n) (interactive "p") @@ -183,8 +169,6 @@ (point)) (point-max)) (kill-line n))) - (calc-trail-here)) -) + (calc-trail-here))) - - +;;; calc-trail.el ends here
--- a/lisp/calc/calc-undo.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-undo.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-undo.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -49,8 +49,7 @@ (let ((calc-stack-top 0)) (calc-handle-undos calc-undo-list n)) (setq calc-stack-top saved-stack-top)))) - (message "Undo!"))) -) + (message "Undo!")))) (defun calc-handle-undos (cl n) (if (> n 0) @@ -59,8 +58,7 @@ (setq calc-undo-list nil) (calc-handle-undo (car cl)) (setq calc-redo-list (append calc-undo-list old-redo))) - (calc-handle-undos (cdr cl) (1- n)))) -) + (calc-handle-undos (cdr cl) (1- n))))) (defun calc-handle-undo (list) (and list @@ -88,8 +86,7 @@ (calc-record-undo (append (list 'eval (nth 2 action) (nth 1 action)) (cdr (cdr (cdr action))))) (apply (nth 1 action) (cdr (cdr (cdr action)))))) - (calc-handle-undo (cdr list)))) -) + (calc-handle-undo (cdr list))))) (defun calc-redo (n) (interactive "p") @@ -107,8 +104,7 @@ (let ((calc-stack-top 0)) (calc-handle-redos calc-redo-list n)) (setq calc-stack-top saved-stack-top)))) - (message "Redo!"))) -) + (message "Redo!")))) (defun calc-handle-redos (cl n) (if (> n 0) @@ -117,8 +113,7 @@ (setq calc-undo-list nil) (calc-handle-undo (car cl)) (setq calc-undo-list (append calc-undo-list old-undo))) - (calc-handle-redos (cdr cl) (1- n)))) -) + (calc-handle-redos (cdr cl) (1- n))))) (defun calc-last-args (n) (interactive "p") @@ -128,8 +123,7 @@ (let ((urec (calc-find-last-x calc-undo-list n))) (if urec (calc-handle-last-x urec) - (error "Not enough undo information available")))) -) + (error "Not enough undo information available"))))) (defun calc-handle-last-x (list) (and list @@ -137,8 +131,7 @@ (if (eq (car action) 'pop) (calc-pop-push-record-list 0 "larg" (delq 'top-of-stack (nth 2 action)))) - (calc-handle-last-x (cdr list)))) -) + (calc-handle-last-x (cdr list))))) (defun calc-find-last-x (ul n) (and ul @@ -146,14 +139,11 @@ (if (<= n 1) (car ul) (calc-find-last-x (cdr ul) (1- n))) - (calc-find-last-x (cdr ul) n))) -) + (calc-find-last-x (cdr ul) n)))) (defun calc-undo-does-pushes (list) (and list (or (eq (car (car list)) 'pop) - (calc-undo-does-pushes (cdr list)))) -) + (calc-undo-does-pushes (cdr list))))) - - +;;; calc-undo.el ends here
--- a/lisp/calc/calc-vec.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-vec.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-vec.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -34,8 +34,7 @@ (calc-wrapper (message (if (calc-change-mode 'calc-display-strings n t t) "Displaying vectors of integers as quoted strings." - "Displaying vectors of integers normally."))) -) + "Displaying vectors of integers normally.")))) (defun calc-pack (n) @@ -48,8 +47,7 @@ (error "Packing mode must be an integer or vector of integers")))) (num (calc-pack-size mode)) (items (calc-top-list num nn))) - (calc-enter-result (+ nn num -1) "pack" (calc-pack-items mode items)))) -) + (calc-enter-result (+ nn num -1) "pack" (calc-pack-items mode items))))) (defun calc-pack-size (mode) (cond ((consp mode) @@ -63,8 +61,7 @@ size))) ((>= mode 0) mode) (t (or (cdr (assq mode '((-3 . 3) (-13 . 1) (-14 . 3) (-15 . 6)))) - 2))) -) + 2)))) (defun calc-pack-items (mode items) (cond ((consp mode) @@ -205,8 +202,7 @@ (list 'calcFunc-float (car items)) (nth 1 items))))) (t - (error "Invalid packing mode: %d" mode))) -) + (error "Invalid packing mode: %d" mode)))) (defun calc-unpack (mode) (interactive "P") @@ -215,8 +211,7 @@ (calc-pop-push-record-list 1 "unpk" (calc-unpack-item (and mode (prefix-numeric-value mode)) - (calc-top))))) -) + (calc-top)))))) (defun calc-unpack-type (item) (cond ((eq (car-safe item) 'vec) @@ -228,8 +223,7 @@ (hms . -3) (sdev . -4) (mod . -5) (frac . -10) (float . -11) (date . -13) ))) - (error "Argument must be a composite object")))) -) + (error "Argument must be a composite object"))))) (defun calc-unpack-item (mode item) (cond ((not mode) @@ -333,8 +327,7 @@ (list (calcFunc-mant item) (calcFunc-xpon item)) (error "Expected a floating-point number"))) (t - (error "Invalid unpacking mode: %d" mode))) -) + (error "Invalid unpacking mode: %d" mode)))) (setq calc-unpack-with-type nil) (defun calc-diag (n) @@ -343,8 +336,7 @@ (calc-enter-result 1 "diag" (if n (list 'calcFunc-diag (calc-top-n 1) (prefix-numeric-value n)) - (list 'calcFunc-diag (calc-top-n 1))))) -) + (list 'calcFunc-diag (calc-top-n 1)))))) (defun calc-ident (n) (interactive "NDimension of identity matrix = ") @@ -352,8 +344,7 @@ (calc-enter-result 0 "idn" (if (eq n 0) '(calcFunc-idn 1) (list 'calcFunc-idn 1 - (prefix-numeric-value n))))) -) + (prefix-numeric-value n)))))) (defun calc-index (n &optional stack) (interactive "NSize of vector = \nP") @@ -361,24 +352,21 @@ (if (consp stack) (calc-enter-result 3 "indx" (cons 'calcFunc-index (calc-top-list-n 3))) (calc-enter-result 0 "indx" (list 'calcFunc-index - (prefix-numeric-value n))))) -) + (prefix-numeric-value n)))))) (defun calc-build-vector (n) (interactive "NSize of vector = ") (calc-wrapper (calc-enter-result 1 "bldv" (list 'calcFunc-cvec (calc-top-n 1) - (prefix-numeric-value n)))) -) + (prefix-numeric-value n))))) (defun calc-cons (arg) (interactive "P") (calc-wrapper (if (calc-is-hyperbolic) (calc-binary-op "rcns" 'calcFunc-rcons arg) - (calc-binary-op "cons" 'calcFunc-cons arg))) -) + (calc-binary-op "cons" 'calcFunc-cons arg)))) (defun calc-head (arg) @@ -390,29 +378,25 @@ (calc-unary-op "tail" 'calcFunc-tail arg)) (if (calc-is-hyperbolic) (calc-unary-op "rhed" 'calcFunc-rhead arg) - (calc-unary-op "head" 'calcFunc-head arg)))) -) + (calc-unary-op "head" 'calcFunc-head arg))))) (defun calc-tail (arg) (interactive "P") (calc-invert-func) - (calc-head arg) -) + (calc-head arg)) (defun calc-vlength (arg) (interactive "P") (calc-wrapper (if (calc-is-hyperbolic) (calc-unary-op "dims" 'calcFunc-mdims arg) - (calc-unary-op "len" 'calcFunc-vlen arg))) -) + (calc-unary-op "len" 'calcFunc-vlen arg)))) (defun calc-arrange-vector (n) (interactive "NNumber of columns = ") (calc-wrapper (calc-enter-result 1 "arng" (list 'calcFunc-arrange (calc-top-n 1) - (prefix-numeric-value n)))) -) + (prefix-numeric-value n))))) (defun calc-vector-find (arg) (interactive "P") @@ -420,8 +404,7 @@ (let ((func (cons 'calcFunc-find (calc-top-list-n 2)))) (calc-enter-result 2 "find" - (if arg (append func (list (prefix-numeric-value arg))) func)))) -) + (if arg (append func (list (prefix-numeric-value arg))) func))))) (defun calc-subvector () (interactive) @@ -429,44 +412,38 @@ (if (calc-is-inverse) (calc-enter-result 3 "rsvc" (cons 'calcFunc-rsubvec (calc-top-list-n 3))) - (calc-enter-result 3 "svec" (cons 'calcFunc-subvec (calc-top-list-n 3))))) -) + (calc-enter-result 3 "svec" (cons 'calcFunc-subvec (calc-top-list-n 3)))))) (defun calc-reverse-vector (arg) (interactive "P") (calc-wrapper - (calc-unary-op "rev" 'calcFunc-rev arg)) -) + (calc-unary-op "rev" 'calcFunc-rev arg))) (defun calc-mask-vector (arg) (interactive "P") (calc-wrapper - (calc-binary-op "vmsk" 'calcFunc-vmask arg)) -) + (calc-binary-op "vmsk" 'calcFunc-vmask arg))) (defun calc-expand-vector (arg) (interactive "P") (calc-wrapper (if (calc-is-hyperbolic) (calc-enter-result 3 "vexp" (cons 'calcFunc-vexp (calc-top-list-n 3))) - (calc-binary-op "vexp" 'calcFunc-vexp arg))) -) + (calc-binary-op "vexp" 'calcFunc-vexp arg)))) (defun calc-sort () (interactive) (calc-slow-wrapper (if (calc-is-inverse) (calc-enter-result 1 "rsrt" (list 'calcFunc-rsort (calc-top-n 1))) - (calc-enter-result 1 "sort" (list 'calcFunc-sort (calc-top-n 1))))) -) + (calc-enter-result 1 "sort" (list 'calcFunc-sort (calc-top-n 1)))))) (defun calc-grade () (interactive) (calc-slow-wrapper (if (calc-is-inverse) (calc-enter-result 1 "rgrd" (list 'calcFunc-rgrade (calc-top-n 1))) - (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1))))) -) + (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1)))))) (defun calc-histogram (n) (interactive "NNumber of bins: ") @@ -478,113 +455,95 @@ (prefix-numeric-value n))) (calc-enter-result 1 "hist" (list 'calcFunc-histogram (calc-top-n 1) - (prefix-numeric-value n))))) -) + (prefix-numeric-value n)))))) (defun calc-transpose (arg) (interactive "P") (calc-wrapper - (calc-unary-op "trn" 'calcFunc-trn arg)) -) + (calc-unary-op "trn" 'calcFunc-trn arg))) (defun calc-conj-transpose (arg) (interactive "P") (calc-wrapper - (calc-unary-op "ctrn" 'calcFunc-ctrn arg)) -) + (calc-unary-op "ctrn" 'calcFunc-ctrn arg))) (defun calc-cross (arg) (interactive "P") (calc-wrapper - (calc-binary-op "cros" 'calcFunc-cross arg)) -) + (calc-binary-op "cros" 'calcFunc-cross arg))) (defun calc-remove-duplicates (arg) (interactive "P") (calc-wrapper - (calc-unary-op "rdup" 'calcFunc-rdup arg)) -) + (calc-unary-op "rdup" 'calcFunc-rdup arg))) (defun calc-set-union (arg) (interactive "P") (calc-wrapper - (calc-binary-op "unio" 'calcFunc-vunion arg '(vec) 'calcFunc-rdup)) -) + (calc-binary-op "unio" 'calcFunc-vunion arg '(vec) 'calcFunc-rdup))) (defun calc-set-intersect (arg) (interactive "P") (calc-wrapper - (calc-binary-op "intr" 'calcFunc-vint arg '(vec) 'calcFunc-rdup)) -) + (calc-binary-op "intr" 'calcFunc-vint arg '(vec) 'calcFunc-rdup))) (defun calc-set-difference (arg) (interactive "P") (calc-wrapper - (calc-binary-op "diff" 'calcFunc-vdiff arg '(vec) 'calcFunc-rdup)) -) + (calc-binary-op "diff" 'calcFunc-vdiff arg '(vec) 'calcFunc-rdup))) (defun calc-set-xor (arg) (interactive "P") (calc-wrapper - (calc-binary-op "xor" 'calcFunc-vxor arg '(vec) 'calcFunc-rdup)) -) + (calc-binary-op "xor" 'calcFunc-vxor arg '(vec) 'calcFunc-rdup))) (defun calc-set-complement (arg) (interactive "P") (calc-wrapper - (calc-unary-op "cmpl" 'calcFunc-vcompl arg)) -) + (calc-unary-op "cmpl" 'calcFunc-vcompl arg))) (defun calc-set-floor (arg) (interactive "P") (calc-wrapper - (calc-unary-op "vflr" 'calcFunc-vfloor arg)) -) + (calc-unary-op "vflr" 'calcFunc-vfloor arg))) (defun calc-set-enumerate (arg) (interactive "P") (calc-wrapper - (calc-unary-op "enum" 'calcFunc-venum arg)) -) + (calc-unary-op "enum" 'calcFunc-venum arg))) (defun calc-set-span (arg) (interactive "P") (calc-wrapper - (calc-unary-op "span" 'calcFunc-vspan arg)) -) + (calc-unary-op "span" 'calcFunc-vspan arg))) (defun calc-set-cardinality (arg) (interactive "P") (calc-wrapper - (calc-unary-op "card" 'calcFunc-vcard arg)) -) + (calc-unary-op "card" 'calcFunc-vcard arg))) (defun calc-unpack-bits (arg) (interactive "P") (calc-wrapper (if (calc-is-inverse) (calc-unary-op "bpck" 'calcFunc-vpack arg) - (calc-unary-op "bupk" 'calcFunc-vunpack arg))) -) + (calc-unary-op "bupk" 'calcFunc-vunpack arg)))) (defun calc-pack-bits (arg) (interactive "P") (calc-invert-func) - (calc-unpack-bits arg) -) + (calc-unpack-bits arg)) (defun calc-rnorm (arg) (interactive "P") (calc-wrapper - (calc-unary-op "rnrm" 'calcFunc-rnorm arg)) -) + (calc-unary-op "rnrm" 'calcFunc-rnorm arg))) (defun calc-cnorm (arg) (interactive "P") (calc-wrapper - (calc-unary-op "cnrm" 'calcFunc-cnorm arg)) -) + (calc-unary-op "cnrm" 'calcFunc-cnorm arg))) (defun calc-mrow (n &optional nn) (interactive "NRow number: \nP") @@ -598,8 +557,7 @@ (calc-enter-result 1 "rrow" (list 'calcFunc-mrrow (calc-top-n 1) (- n))) (calc-enter-result 1 "mrow" (list 'calcFunc-mrow - (calc-top-n 1) n)))))) -) + (calc-top-n 1) n))))))) (defun calc-mcol (n &optional nn) (interactive "NColumn number: \nP") @@ -613,8 +571,7 @@ (calc-enter-result 1 "rcol" (list 'calcFunc-mrcol (calc-top-n 1) (- n))) (calc-enter-result 1 "mcol" (list 'calcFunc-mcol - (calc-top-n 1) n)))))) -) + (calc-top-n 1) n))))))) ;;;; Vectors. @@ -622,33 +579,28 @@ (defun calcFunc-mdims (m) (or (math-vectorp m) (math-reject-arg m 'vectorp)) - (cons 'vec (math-mat-dimens m)) -) + (cons 'vec (math-mat-dimens m))) ;;; Apply a function elementwise to vector A. [V X V; N X N] [Public] (defun math-map-vec (f a) (if (math-vectorp a) (cons 'vec (mapcar f (cdr a))) - (funcall f a)) -) + (funcall f a))) (defun math-dimension-error () (calc-record-why "*Dimension error") - (signal 'wrong-type-argument nil) -) + (signal 'wrong-type-argument nil)) ;;; Build a vector out of a list of objects. [Public] (defun calcFunc-vec (&rest objs) - (cons 'vec objs) -) + (cons 'vec objs)) ;;; Build a constant vector or matrix. [Public] (defun calcFunc-cvec (obj &rest dims) - (math-make-vec-dimen obj dims) -) + (math-make-vec-dimen obj dims)) (defun math-make-vec-dimen (obj dims) (if dims @@ -660,31 +612,27 @@ (math-make-vec-dimen obj (cdr dims))))) (cons 'vec (make-list (car dims) obj))) (math-reject-arg (car dims) 'fixnatnump)) - obj) -) + obj)) (defun calcFunc-head (vec) (if (and (Math-vectorp vec) (cdr vec)) (nth 1 vec) (calc-record-why 'vectorp vec) - (list 'calcFunc-head vec)) -) + (list 'calcFunc-head vec))) (defun calcFunc-tail (vec) (if (and (Math-vectorp vec) (cdr vec)) (cons 'vec (cdr (cdr vec))) (calc-record-why 'vectorp vec) - (list 'calcFunc-tail vec)) -) + (list 'calcFunc-tail vec))) (defun calcFunc-cons (head tail) (if (Math-vectorp tail) (cons 'vec (cons head (cdr tail))) (calc-record-why 'vectorp tail) - (list 'calcFunc-cons head tail)) -) + (list 'calcFunc-cons head tail))) (defun calcFunc-rhead (vec) (if (and (Math-vectorp vec) @@ -693,23 +641,20 @@ (setcdr (nthcdr (- (length vec) 2) vec) nil) vec) (calc-record-why 'vectorp vec) - (list 'calcFunc-rhead vec)) -) + (list 'calcFunc-rhead vec))) (defun calcFunc-rtail (vec) (if (and (Math-vectorp vec) (cdr vec)) (nth (1- (length vec)) vec) (calc-record-why 'vectorp vec) - (list 'calcFunc-rtail vec)) -) + (list 'calcFunc-rtail vec))) (defun calcFunc-rcons (head tail) (if (Math-vectorp head) (append head (list tail)) (calc-record-why 'vectorp head) - (list 'calcFunc-rcons head tail)) -) + (list 'calcFunc-rcons head tail))) @@ -733,8 +678,7 @@ (while (setq b (cdr b)) (setq v (cons (funcall f a (car b)) v))) (cons 'vec (nreverse v))) - (funcall f a b))) -) + (funcall f a b)))) @@ -747,21 +691,18 @@ (setq accum (funcall f accum (car a)))) accum) 0) - a) -) + a)) ;;; Reduce a function over the columns of matrix A. [V X V] [Public] (defun math-reduce-cols (f a) (if (math-matrixp a) (cons 'vec (math-reduce-cols-col-step f (cdr a) 1 (length (nth 1 a)))) - a) -) + a)) (defun math-reduce-cols-col-step (f a col cols) (and (< col cols) (cons (math-reduce-cols-row-step f (nth col (car a)) col (cdr a)) - (math-reduce-cols-col-step f a (1+ col) cols))) -) + (math-reduce-cols-col-step f a (1+ col) cols)))) (defun math-reduce-cols-row-step (f tot col a) (if a @@ -769,8 +710,7 @@ (funcall f tot (nth col (car a))) col (cdr a)) - tot) -) + tot)) @@ -780,8 +720,7 @@ (while (setq a (cdr a) b (cdr b)) (setq accum (math-add accum (math-mul (car a) (car b))))) accum) - 0) -) + 0)) ;;; Return the number of elements in vector V. [Public] @@ -790,8 +729,7 @@ (1- (length v)) (if (math-objectp v) 0 - (list 'calcFunc-vlen v))) -) + (list 'calcFunc-vlen v)))) ;;; Get the Nth row of a matrix. (defun calcFunc-mrow (mat n) ; [Public] @@ -807,8 +745,7 @@ (or (Math-vectorp mat) (math-reject-arg mat 'vectorp)) (or (nth n mat) - (math-reject-arg n "*Index out of range")))) -) + (math-reject-arg n "*Index out of range"))))) (defun calcFunc-subscr (mat n &optional m) (setq mat (calcFunc-mrow mat n)) @@ -816,13 +753,11 @@ (if (math-num-integerp n) (calcFunc-mrow mat m) (calcFunc-mcol mat m)) - mat) -) + mat)) ;;; 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 (function (lambda (x) (elt x n))) (cdr mat)))) (defun calcFunc-mcol (mat n) ; [Public] (if (Math-vectorp n) @@ -841,29 +776,25 @@ (and (< n (length (nth 1 mat))) (math-mat-col mat n)) (nth n mat)) - (math-reject-arg n "*Index out of range")))) -) + (math-reject-arg n "*Index out of range"))))) ;;; Remove the Nth row from a matrix. (defun math-mat-less-row (mat n) (if (<= n 0) (cdr mat) (cons (car mat) - (math-mat-less-row (cdr mat) (1- n)))) -) + (math-mat-less-row (cdr mat) (1- n))))) (defun calcFunc-mrrow (mat n) ; [Public] (and (integerp (setq n (math-check-integer n))) (> n 0) (< n (length mat)) - (math-mat-less-row mat n)) -) + (math-mat-less-row mat n))) ;;; 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))) - (cdr mat))) -) + (cdr mat)))) (defun calcFunc-mrcol (mat n) ; [Public] (and (integerp (setq n (math-check-integer n))) @@ -871,29 +802,25 @@ (if (math-matrixp mat) (and (< n (length (nth 1 mat))) (math-mat-less-col mat n)) - (math-mat-less-row mat n))) -) + (math-mat-less-row mat n)))) (defun calcFunc-getdiag (mat) ; [Public] (if (math-square-matrixp mat) (cons 'vec (math-get-diag-step (cdr mat) 1)) (calc-record-why 'square-matrixp mat) - (list 'calcFunc-getdiag mat)) -) + (list 'calcFunc-getdiag mat))) (defun math-get-diag-step (row n) (and row (cons (nth n (car row)) - (math-get-diag-step (cdr row) (1+ n)))) -) + (math-get-diag-step (cdr row) (1+ n))))) (defun math-transpose (mat) ; [Public] (let ((m nil) (col (length (nth 1 mat)))) (while (> (setq col (1- col)) 0) (setq m (cons (math-mat-col mat col) m))) - (cons 'vec m)) -) + (cons 'vec m))) (defun calcFunc-trn (mat) (if (math-vectorp mat) @@ -902,12 +829,10 @@ (math-col-matrix mat)) (if (math-numberp mat) mat - (math-reject-arg mat 'matrixp))) -) + (math-reject-arg mat 'matrixp)))) (defun calcFunc-ctrn (mat) - (calcFunc-conj (calcFunc-trn mat)) -) + (calcFunc-conj (calcFunc-trn mat))) (defun calcFunc-pack (mode els) (or (Math-vectorp els) (math-reject-arg els 'vectorp)) @@ -918,20 +843,17 @@ (if (= (calc-pack-size mode) (1- (length els))) (calc-pack-items mode (cdr els)) (math-reject-arg els "*Wrong number of elements")) - (error (math-reject-arg els (nth 1 err)))) -) + (error (math-reject-arg els (nth 1 err))))) (defun calcFunc-unpack (mode thing) (or (integerp mode) (math-reject-arg mode 'fixnump)) (condition-case err (cons 'vec (calc-unpack-item mode thing)) - (error (math-reject-arg thing (nth 1 err)))) -) + (error (math-reject-arg thing (nth 1 err))))) (defun calcFunc-unpackt (mode thing) (let ((calc-unpack-with-type 'pair)) - (calcFunc-unpack mode thing)) -) + (calcFunc-unpack mode thing))) (defun calcFunc-arrange (vec cols) ; [Public] (setq cols (math-check-fixnum cols t)) @@ -948,40 +870,33 @@ flat next)) (if flat (setq mat (nconc mat (list (cons 'vec flat))))) - mat))) -) + mat)))) (defun math-flatten-vector (vec) ; [L V] (if (math-vectorp vec) (apply 'append (mapcar 'math-flatten-vector (cdr vec))) - (list vec)) -) + (list vec))) (defun calcFunc-vconcat (a b) - (math-normalize (list '| a b)) -) + (math-normalize (list '| a b))) (defun calcFunc-vconcatrev (a b) - (math-normalize (list '| b a)) -) + (math-normalize (list '| b a))) (defun calcFunc-append (v1 v2) (if (and (math-vectorp v1) (math-vectorp v2)) (append v1 (cdr v2)) - (list 'calcFunc-append v1 v2)) -) + (list 'calcFunc-append v1 v2))) (defun calcFunc-appendrev (v1 v2) - (calcFunc-append v2 v1) -) + (calcFunc-append v2 v1)) ;;; Copy a matrix. [Public] (defun math-copy-matrix (m) (if (math-vectorp (nth 1 m)) (cons 'vec (mapcar 'copy-sequence (cdr m))) - (copy-sequence m)) -) + (copy-sequence m))) ;;; Convert a scalar or vector into an NxN diagonal matrix. [Public] (defun calcFunc-diag (a &optional n) @@ -997,8 +912,7 @@ (cons 'vec (math-diag-step (cdr a) 0 (1- (length a)))))) (if n (cons 'vec (math-diag-step (make-list n a) 0 n)) - (list 'calcFunc-diag a))) -) + (list 'calcFunc-diag a)))) (defun calcFunc-idn (a &optional n) (if n @@ -1007,8 +921,7 @@ (calcFunc-diag a n)) (if (integerp calc-matrix-mode) (calcFunc-idn a calc-matrix-mode) - (list 'calcFunc-idn a))) -) + (list 'calcFunc-idn a)))) (defun math-mimic-ident (a m) (if (math-square-matrixp m) @@ -1021,8 +934,7 @@ a))) (cdr m))) (math-dimension-error)) - (calcFunc-idn a))) -) + (calcFunc-idn a)))) (defun math-diag-step (a n m) (if (< n m) @@ -1031,8 +943,7 @@ (cons (car a) (make-list (1- (- m n)) 0)))) (math-diag-step (cdr a) (1+ n) m)) - nil) -) + nil)) ;;; Create a vector of consecutive integers. [Public] (defun calcFunc-index (n &optional start incr) @@ -1059,8 +970,7 @@ (while (>= i n) (setq vec (cons i vec) i (1- i)))))) - (cons 'vec vec))) -) + (cons 'vec vec)))) ;;; Find an element in a vector. (defun calcFunc-find (vec x &optional start) @@ -1071,8 +981,7 @@ (while (and vec (not (Math-equal x (car vec)))) (setq n (1+ n) vec (cdr vec))) - (if vec n 0)) -) + (if vec n 0))) ;;; Return a subvector of a vector. (defun calcFunc-subvec (vec start &optional end) @@ -1091,8 +1000,7 @@ (if (<= end len) (let ((chop (nthcdr (- end start 1) (setq vec (copy-sequence vec))))) (setcdr chop nil))) - (cons 'vec vec))) -) + (cons 'vec vec)))) ;;; Remove a subvector from a vector. (defun calcFunc-rsubvec (vec start &optional end) @@ -1110,15 +1018,13 @@ (let ((tail (nthcdr end vec)) (chop (nthcdr (1- start) (setq vec (copy-sequence vec))))) (setcdr chop nil) - (append vec tail)))) -) + (append vec tail))))) ;;; Reverse the order of the elements of a vector. (defun calcFunc-rev (vec) (if (math-vectorp vec) (cons 'vec (reverse (cdr vec))) - (math-reject-arg vec 'vectorp)) -) + (math-reject-arg vec 'vectorp))) ;;; Compress a vector according to a mask vector. (defun calcFunc-vmask (mask vec) @@ -1134,8 +1040,7 @@ (while (setq mask (cdr mask) vec (cdr vec)) (or (math-zerop (car mask)) (setq new (cons (car vec) new)))) - (cons 'vec (nreverse new)))) -) + (cons 'vec (nreverse new))))) ;;; Expand a vector according to a mask vector. (defun calcFunc-vexp (mask vec &optional filler) @@ -1152,8 +1057,7 @@ (car mask)) new)) (setq vec (cdr vec) new (cons (or (car vec) (car mask)) new)))) - (cons 'vec (nreverse new))) -) + (cons 'vec (nreverse new)))) ;;; Compute the row and column norms of a vector or matrix. [Public] @@ -1164,8 +1068,7 @@ (math-reduce-vec 'math-max (math-map-vec 'calcFunc-cnorm a)) (math-reduce-vec 'math-max (math-map-vec 'math-abs a))) (calc-record-why 'vectorp a) - (list 'calcFunc-rnorm a)) -) + (list 'calcFunc-rnorm a))) (defun calcFunc-cnorm (a) (if (and (Math-vectorp a) @@ -1175,45 +1078,38 @@ (math-reduce-cols 'math-add-abs a)) (math-reduce-vec 'math-add-abs a)) (calc-record-why 'vectorp a) - (list 'calcFunc-cnorm a)) -) + (list 'calcFunc-cnorm a))) (defun math-add-abs (a b) - (math-add (math-abs a) (math-abs b)) -) + (math-add (math-abs a) (math-abs b))) ;;; Sort the elements of a vector into increasing order. (defun calcFunc-sort (vec) ; [Public] (if (math-vectorp vec) (cons 'vec (sort (copy-sequence (cdr vec)) 'math-beforep)) - (math-reject-arg vec 'vectorp)) -) + (math-reject-arg vec 'vectorp))) (defun calcFunc-rsort (vec) ; [Public] (if (math-vectorp vec) (cons 'vec (nreverse (sort (copy-sequence (cdr vec)) 'math-beforep))) - (math-reject-arg vec 'vectorp)) -) + (math-reject-arg vec 'vectorp))) (defun calcFunc-grade (grade-vec) (if (math-vectorp grade-vec) (let* ((len (1- (length grade-vec)))) (cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep))) - (math-reject-arg grade-vec 'vectorp)) -) + (math-reject-arg grade-vec 'vectorp))) (defun calcFunc-rgrade (grade-vec) (if (math-vectorp grade-vec) (let* ((len (1- (length grade-vec)))) (cons 'vec (nreverse (sort (cdr (calcFunc-index len)) 'math-grade-beforep)))) - (math-reject-arg grade-vec 'vectorp)) -) + (math-reject-arg grade-vec 'vectorp))) (defun math-grade-beforep (i j) - (math-beforep (nth i grade-vec) (nth j grade-vec)) -) + (math-beforep (nth i grade-vec) (nth j grade-vec))) ;;; Compile a histogram of data from a vector. @@ -1239,8 +1135,7 @@ (< bin n) (aset res bin (math-add (aref res bin) (if wvec (car (setq wp (cdr wp))) wts))))) - (cons 'vec (append res nil))) -) + (cons 'vec (append res nil)))) ;;; Set operations. @@ -1253,8 +1148,7 @@ (setq b (list b)) (or (math-vectorp b) (math-reject-arg b 'vectorp)) (setq b (cdr b))) - (calcFunc-rdup (append a b)) -) + (calcFunc-rdup (append a b))) (defun calcFunc-vint (a b) (if (and (math-simple-set a) (math-simple-set b)) @@ -1271,8 +1165,7 @@ (setq b (cdr b)))) (nreverse vec))) (calcFunc-vcompl (calcFunc-vunion (calcFunc-vcompl a) - (calcFunc-vcompl b)))) -) + (calcFunc-vcompl b))))) (defun calcFunc-vdiff (a b) (if (and (math-simple-set a) (math-simple-set b)) @@ -1289,8 +1182,7 @@ (setq vec (cons (car a) vec) a (cdr a)))) (nreverse vec))) - (calcFunc-vcompl (calcFunc-vunion (calcFunc-vcompl a) b))) -) + (calcFunc-vcompl (calcFunc-vunion (calcFunc-vcompl a) b)))) (defun calcFunc-vxor (a b) (if (and (math-simple-set a) (math-simple-set b)) @@ -1312,8 +1204,7 @@ (let ((ca (calcFunc-vcompl a)) (cb (calcFunc-vcompl b))) (calcFunc-vunion (calcFunc-vcompl (calcFunc-vunion ca b)) - (calcFunc-vcompl (calcFunc-vunion a cb))))) -) + (calcFunc-vcompl (calcFunc-vunion a cb)))))) (defun calcFunc-vcompl (a) (setq a (math-prepare-set a)) @@ -1336,8 +1227,7 @@ (setq vec (cons (list 'intv (+ closed 1) prev '(var inf var-inf)) vec))) - (math-clean-set (nreverse vec))) -) + (math-clean-set (nreverse vec)))) (defun calcFunc-vspan (a) (setq a (math-prepare-set a)) @@ -1347,8 +1237,7 @@ (logand (nth 1 last) 1)) (nth 2 (nth 1 a)) (nth 3 last))) - '(intv 2 0 0)) -) + '(intv 2 0 0))) (defun calcFunc-vfloor (a &optional always-vec) (setq a (math-prepare-set a)) @@ -1374,8 +1263,7 @@ (or (Math-lessp b a) (setq vec (cons (setq prev (list 'intv mask a b)) vec))))) (setq vec (nreverse vec)) - (math-clean-set vec always-vec)) -) + (math-clean-set vec always-vec))) (defun calcFunc-vcard (a) (setq a (calcFunc-vfloor a t)) @@ -1386,8 +1274,7 @@ (setq count (math-add count (math-sub (nth 3 (car a)) (nth 2 (car a)))))) (setq count (math-add count 1))) - count) -) + count)) (defun calcFunc-venum (a) (setq a (calcFunc-vfloor a t)) @@ -1403,8 +1290,7 @@ (nth 2 (nth 1 p)))) (cdr (cdr p))))) (setq p next)) - a) -) + a)) (defun calcFunc-vpack (a) (setq a (calcFunc-vfloor a t)) @@ -1424,8 +1310,7 @@ (math-power-of-2 (1+ (nth 3 (car a)))) (math-power-of-2 (nth 2 (car a))))))) (setq accum (math-add accum (math-power-of-2 (car a)))))) - accum) -) + accum)) (defun calcFunc-vunpack (a &optional w) (or (math-num-integerp a) (math-reject-arg a 'integerp)) @@ -1456,8 +1341,7 @@ vec)))) (if neg (setq vec (cons (list 'intv 2 len '(var inf var-inf)) vec))) - (math-clean-set (nreverse vec))) -) + (math-clean-set (nreverse vec)))) (defun calcFunc-rdup (a) (if (math-simple-set a) @@ -1471,8 +1355,7 @@ (setcdr p (cdr (cdr p))) (setq p (cdr p))))) (cons 'vec a)) - (math-clean-set (math-prepare-set a))) -) + (math-clean-set (math-prepare-set a)))) (defun math-prepare-set (a) (if (Math-objectp a) @@ -1527,8 +1410,7 @@ (nth 3 (nth 1 p)) (nth 3 (nth 2 p)))) (cdr (cdr (cdr p)))))))) - a -) + a) (defun math-clean-set (a &optional always-vec) (let ((p a) res) @@ -1541,8 +1423,7 @@ (eq (car-safe (nth 1 a)) 'intv) (not always-vec)) (nth 1 a) - a)) -) + a))) (defun math-simple-set (a) (or (and (Math-objectp a) @@ -1551,8 +1432,7 @@ (progn (while (and (setq a (cdr a)) (not (eq (car-safe (car a)) 'intv)))) - (null a)))) -) + (null a))))) @@ -1571,8 +1451,7 @@ (math-sub (math-mul (nth 1 a) (nth 2 b)) (math-mul (nth 2 a) (nth 1 b)))) (math-reject-arg b "*Three-vector expected")) - (math-reject-arg a "*Three-vector expected")) -) + (math-reject-arg a "*Three-vector expected"))) @@ -1646,8 +1525,7 @@ (throw 'syntax "Expected `]'"))) (or (eq exp-token 'end) (math-read-token)) - vals)) -) + vals))) (defun math-check-for-commas (&optional balancing) (let ((count 0) @@ -1663,8 +1541,7 @@ (setq count (1- count))))) (if balancing pos - (and pos (= (aref exp-str pos) ?,)))) -) + (and pos (= (aref exp-str pos) ?,))))) (defun math-read-vector () (let* ((val (list (math-read-expr-level 0))) @@ -1684,8 +1561,7 @@ (let ((rest (list (math-read-expr-level 0)))) (setcdr last rest) (setq last rest))) - (cons 'vec val)) -) + (cons 'vec val))) (defun math-read-matrix (mat) (while (equal exp-data ";") @@ -1693,6 +1569,6 @@ (while (eq exp-token 'space) (math-read-token)) (setq mat (nconc mat (list (math-read-vector))))) - mat -) + mat) +;;; calc-vec.el ends here
--- a/lisp/calc/calc-yank.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc-yank.el Wed Nov 14 09:09:09 2001 +0000 @@ -55,28 +55,24 @@ (if (not no-delete) (calc-pop-stack n (- num n -1)))) (setq calc-last-kill (cons (car kill-ring) stuff))))) - (kill-line nn)) -) + (kill-line nn))) (defun calc-force-refresh () (if (or calc-executing-macro calc-display-dirty) (let ((calc-executing-macro nil)) - (calc-refresh))) -) + (calc-refresh)))) (defun calc-locate-cursor-element (pt) (save-excursion (goto-char (point-max)) - (calc-locate-cursor-scan (- calc-stack-top) calc-stack pt)) -) + (calc-locate-cursor-scan (- calc-stack-top) calc-stack pt))) (defun calc-locate-cursor-scan (n stack pt) (if (or (<= (point) pt) (null stack)) n (forward-line (- (nth 1 (car stack)))) - (calc-locate-cursor-scan (1+ n) (cdr stack) pt)) -) + (calc-locate-cursor-scan (1+ n) (cdr stack) pt))) (defun calc-kill-region (top bot &optional no-delete) (interactive "r") @@ -94,18 +90,15 @@ (calc-pop-stack num bot-num)))) (if no-delete (copy-region-as-kill top bot) - (kill-region top bot))) -) + (kill-region top bot)))) (defun calc-copy-as-kill (n) (interactive "P") - (calc-kill n t) -) + (calc-kill n t)) (defun calc-copy-region-as-kill (top bot) (interactive "r") - (calc-kill-region top bot t) -) + (calc-kill-region top bot t)) ;;; This function uses calc-last-kill if possible to get an exact result, ;;; otherwise it just parses the yanked string. @@ -128,8 +121,7 @@ (if (eq (car-safe val) 'error) (error "Bad format in yanked data") val)) - val))))))) -) + val)))))))) (defun calc-clean-newlines (s) (cond @@ -144,8 +136,7 @@ (calc-clean-newlines (concat (math-match-substring s 1) "," (math-match-substring s 2)))) - (t s)) -) + (t s))) (defun calc-do-grab-region (top bot arg) @@ -191,8 +182,7 @@ (forward-char (+ (nth 1 vals) (if single 0 1))) (error (nth 2 vals)))) (calc-slow-wrapper - (calc-enter-result 0 "grab" vals))) -) + (calc-enter-result 0 "grab" vals)))) (defun calc-do-grab-rectangle (top bot arg &optional reduce) @@ -273,8 +263,7 @@ (if reduce (calc-enter-result 0 "grb+" (list reduce '(var add var-add) (nreverse mat))) - (calc-enter-result 0 "grab" (nreverse mat))))) -) + (calc-enter-result 0 "grab" (nreverse mat)))))) (defun calc-copy-to-buffer (nn) @@ -354,8 +343,7 @@ (not thebuf) (progn (calc-quit t) - (switch-to-buffer newbuf)))) -) + (switch-to-buffer newbuf))))) (defun calc-overwrite-string (str eat-lnums) (if (string-match "\n\\'" str) @@ -379,8 +367,7 @@ (forward-char 1)) (if eat-lnums (setq i (+ i 4))))) (self-insert-command 1)) - (setq i (1+ i))))) -) + (setq i (1+ i)))))) ;;; First, require that buffer is visible and does not begin with "*" ;;; Second, require only that it not begin with "*Calc" @@ -392,8 +379,7 @@ (or (string-match "\\`\\*.*" (buffer-name (car buf))) (not (get-buffer-window (car buf)))))) (calc-find-writable-buffer (cdr buf) mode) - (car buf))) -) + (car buf)))) (defun calc-edit (n) @@ -418,16 +404,14 @@ (while list (insert (car list) "\n") (setq list (cdr list))))) - (calc-show-edit-buffer) -) + (calc-show-edit-buffer)) (defun calc-alg-edit (str) (calc-edit-mode '(calc-finish-stack-edit 0)) (calc-show-edit-buffer) (insert str "\n") (backward-char 1) - (calc-set-command-flag 'do-edit) -) + (calc-set-command-flag 'do-edit)) (defvar calc-edit-mode-map nil "Keymap for use by the calc-edit command.") (if calc-edit-mode-map @@ -435,8 +419,7 @@ (setq calc-edit-mode-map (make-sparse-keymap)) (define-key calc-edit-mode-map "\n" 'calc-edit-finish) (define-key calc-edit-mode-map "\r" 'calc-edit-return) - (define-key calc-edit-mode-map "\C-c\C-c" 'calc-edit-finish) -) + (define-key calc-edit-mode-map "\C-c\C-c" 'calc-edit-finish)) (defun calc-edit-mode (&optional handler allow-ret title) "Calculator editing mode. Press RET, LFD, or C-c C-c to finish. @@ -476,8 +459,7 @@ (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch) "M-# x" "C-x k RET") - " to cancel.\n")) -) + " to cancel.\n"))) (put 'calc-edit-mode 'mode-class 'special) (defun calc-show-edit-buffer () @@ -495,15 +477,13 @@ (delete-window win)))) (set-buffer-modified-p nil) (goto-char (point-min)) - (forward-line 1)) -) + (forward-line 1))) (defun calc-edit-return () (interactive) (if (and (boundp 'calc-allow-ret) calc-allow-ret) (newline) - (calc-edit-finish)) -) + (calc-edit-finish))) (defun calc-edit-finish (&optional keep) "Finish calc-edit mode. Parse buffer contents and push them on the stack." @@ -543,16 +523,14 @@ (if disp-trail (calc-wrapper (calc-trail-display 1 t))) - (message "")) -) + (message ""))) (defun calc-edit-cancel () "Cancel calc-edit mode. Ignore the Calc Edit buffer and don't change stack." (interactive) (let ((calc-edit-handler nil)) (calc-edit-finish)) - (message "(Cancelled)") -) + (message "(Cancelled)")) (defun calc-finish-stack-edit (num) (let ((buf (current-buffer)) @@ -585,9 +563,6 @@ calc-simplify-mode))) (if (>= num 0) (calc-enter-result num "edit" vals) - (calc-enter-result 1 "edit" vals (- num))))))))) -) + (calc-enter-result 1 "edit" vals (- num)))))))))) - - - +;;; calc-yank.el ends here
--- a/lisp/calc/calc.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calc.el Wed Nov 14 09:09:09 2001 +0000 @@ -922,7 +922,6 @@ report-calc-bug) )) - ) (calc-init-base) @@ -947,8 +946,7 @@ (define-key calc-dispatch-map (substring keys 0 1) nil)) (define-key calc-dispatch-map keys 'calc-same-interface)))) (error nil)) - (calc-do-dispatch arg) -) + (calc-do-dispatch arg)) (defun calc-do-dispatch (arg) (let ((key (calc-read-key-sequence @@ -963,8 +961,7 @@ (progn (or (commandp key) (calc-extensions)) (call-interactively key)) - (beep))) -) + (beep)))) (setq calc-dispatch-help nil) (defun calc-read-key-sequence (prompt map) @@ -984,8 +981,7 @@ (char-to-string (cdr key))))) "" prompt2))) (use-global-map glob) - (use-local-map loc)))) -) + (use-local-map loc))))) @@ -1065,8 +1061,7 @@ (eval (cons 'progn calc-defs)) (setq calc-defs nil) (calc-set-mode-line))) - (calc-check-defines) -) + (calc-check-defines)) (defun calc-check-defines () (if (symbol-plist 'calc-define) @@ -1084,8 +1079,7 @@ (setq plist (cdr (cdr plist)))) ;; See if this has added any more calc-define properties. (calc-check-defines)) - (setplist 'calc-define nil)))) -) + (setplist 'calc-define nil))))) (setq calc-check-defines 'calc-check-defines) ; suitable for run-hooks (defun calc-trail-mode (&optional buf) @@ -1115,8 +1109,7 @@ (let ((buffer-read-only nil)) (insert "Emacs Calculator v" calc-version " by Dave Gillespie, " "installed " calc-installed-date "\n"))) - (run-hooks 'calc-trail-mode-hook) -) + (run-hooks 'calc-trail-mode-hook)) (defun calc-create-buffer () (set-buffer (get-buffer-create "*Calculator*")) @@ -1128,8 +1121,7 @@ (if calc-language (progn (calc-extensions) - (calc-set-language calc-language calc-language-option t))) -) + (calc-set-language calc-language calc-language-option t)))) ;;;###autoload (defun calc (&optional arg full-display interactive) @@ -1191,15 +1183,13 @@ (progn (sit-for 2) (message ""))) - (setq calc-said-hello t)))) -) + (setq calc-said-hello t))))) ;;;###autoload (defun full-calc () "Invoke the Calculator and give it a full-sized window." (interactive) - (calc nil t (interactive-p)) -) + (calc nil t (interactive-p))) (defun calc-same-interface (arg) "Invoke the Calculator using the most recent interface (calc or calc-keypad)." @@ -1213,8 +1203,7 @@ (MacEdit-finish-edit) (if calc-was-keypad-mode (calc-keypad) - (calc arg calc-full-mode t))))) -) + (calc arg calc-full-mode t)))))) (defun calc-quit (&optional non-fatal) @@ -1253,23 +1242,20 @@ (delete-windows-on kbuf)) (bury-buffer buf) (bury-buffer calc-trail-buffer) - (and kbuf (bury-buffer kbuf)))))) -) + (and kbuf (bury-buffer kbuf))))))) ;;;###autoload (defun quick-calc () "Do a quick calculation in the minibuffer without invoking full Calculator." (interactive) - (calc-do-quick-calc) -) + (calc-do-quick-calc)) ;;;###autoload (defun calc-eval (str &optional separator &rest args) "Do a quick calculation and return the result as a string. Return value will either be the formatted result in string form, or a list containing a character position and an error message in string form." - (calc-do-calc-eval str separator args) -) + (calc-do-calc-eval str separator args)) ;;;###autoload (defun calc-keypad () @@ -1279,8 +1265,7 @@ Or, position the cursor manually and do M-x calc-keypad-press." (interactive) (calc-extensions) - (calc-do-keypad calc-full-mode (interactive-p)) -) + (calc-do-keypad calc-full-mode (interactive-p))) ;;;###autoload (defun full-calc-keypad () @@ -1288,8 +1273,7 @@ See calc-keypad for details." (interactive) (calc-extensions) - (calc-do-keypad t (interactive-p)) -) + (calc-do-keypad t (interactive-p))) ;;; Note that modifications to this function may break calc-pass-errors. @@ -1367,15 +1351,14 @@ (calc-set-mode-line) (and calc-embedded-info (calc-embedded-finish-command)))) - (identity nil) ; allow a GC after timing is done -) + (identity nil)) ; allow a GC after timing is done + (setq calc-aborted-prefix nil) (setq calc-start-time nil) (defun calc-set-command-flag (f) (if (not (memq f calc-command-flags)) - (setq calc-command-flags (cons f calc-command-flags))) -) + (setq calc-command-flags (cons f calc-command-flags)))) (defun calc-select-buffer () (or (eq major-mode 'calc-mode) @@ -1384,17 +1367,14 @@ (let ((buf (get-buffer "*Calculator*"))) (if buf (set-buffer buf) - (error "Calculator buffer not available"))))) -) + (error "Calculator buffer not available")))))) (defun calc-cursor-stack-index (&optional index) (goto-char (point-max)) - (forward-line (- (calc-substack-height (or index 1)))) -) + (forward-line (- (calc-substack-height (or index 1))))) (defun calc-stack-size () - (- (length calc-stack) calc-stack-top) -) + (- (length calc-stack) calc-stack-top)) (defun calc-substack-height (n) (let ((sum 0) @@ -1404,8 +1384,7 @@ (setq sum (+ sum (nth 1 (car stack))) n (1- n) stack (cdr stack))) - sum) -) + sum)) (defun calc-set-mode-line () (save-excursion @@ -1510,8 +1489,7 @@ nil (setq mode-line-buffer-identification new-mode-string) (set-buffer-modified-p (buffer-modified-p)) - (and calc-embedded-info (calc-embedded-mode-line-change))))) -) + (and calc-embedded-info (calc-embedded-mode-line-change)))))) (defun calc-align-stack-window () (if (eq major-mode 'calc-mode) @@ -1527,15 +1505,13 @@ (goto-char (1- (match-end 0))))) (save-excursion (calc-select-buffer) - (calc-align-stack-window))) -) + (calc-align-stack-window)))) (defun calc-check-stack (n) (if (> n (calc-stack-size)) (error "Too few elements on stack")) (if (< n 0) - (error "Invalid argument")) -) + (error "Invalid argument"))) (defun calc-push-list (vals &optional m sels) (while vals @@ -1556,15 +1532,13 @@ (calc-record-undo (list 'push mm)) (calc-set-command-flag 'renum-stack)))) (setq vals (cdr vals) - sels (cdr sels))) -) + sels (cdr sels)))) (defun calc-pop-push-list (n vals &optional m sels) (if (and calc-any-selections (null sels)) (calc-replace-selections n vals m) (calc-pop-stack n m sels) - (calc-push-list vals m sels)) -) + (calc-push-list vals m sels))) (defun calc-pop-push-record-list (n prefix vals &optional m sels) (or (and (consp vals) @@ -1577,8 +1551,7 @@ (if (cdr vals) (calc-record-list vals prefix) (calc-record (car vals) prefix))) - (calc-pop-push-list n vals m sels) -) + (calc-pop-push-list n vals m sels)) (defun calc-enter-result (n prefix vals &optional m) (setq calc-aborted-prefix prefix) @@ -1594,20 +1567,17 @@ (if (equal vals '((nil))) (setq vals nil)) (calc-pop-push-record-list n prefix vals m) - (calc-handle-whys) -) + (calc-handle-whys)) (defun calc-normalize (val) (if (memq calc-simplify-mode '(nil none num)) (math-normalize val) (calc-extensions) - (calc-normalize-fancy val)) -) + (calc-normalize-fancy val))) (defun calc-handle-whys () (if calc-next-why - (calc-do-handle-whys)) -) + (calc-do-handle-whys))) (defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack. @@ -1635,8 +1605,7 @@ (calc-cursor-stack-index n) (setq calc-stack (nthcdr n calc-stack)) (delete-region (point) (point-max)))) - (calc-set-command-flag 'renum-stack))))) -) + (calc-set-command-flag 'renum-stack)))))) (defun calc-get-stack-element (x) (cond ((eq sel-mode 'entry) @@ -1649,19 +1618,16 @@ (car x)) (sel-mode (calc-sel-error)) - (t (nth 2 x))) -) + (t (nth 2 x)))) ;; Get the Nth element of the stack (N=1 is the top element). (defun calc-top (&optional n sel-mode) (or n (setq n 1)) (calc-check-stack n) - (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)) -) + (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack))) (defun calc-top-n (&optional n sel-mode) ; in case precision has changed - (math-check-complete (calc-normalize (calc-top n sel-mode))) -) + (math-check-complete (calc-normalize (calc-top n sel-mode)))) (defun calc-top-list (&optional n m sel-mode) (or n (setq n 1)) @@ -1671,13 +1637,11 @@ (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) calc-stack)))) (setcdr (nthcdr (1- n) top) nil) - (nreverse (mapcar 'calc-get-stack-element top)))) -) + (nreverse (mapcar 'calc-get-stack-element 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 'calc-normalize (calc-top-list n m sel-mode)))) (defun calc-renumber-stack () @@ -1709,8 +1673,7 @@ (beginning-of-line) (setq lnum (1+ lnum) stack (cdr stack)))))) - (and calc-embedded-info (calc-embedded-stack-change)) -) + (and calc-embedded-info (calc-embedded-stack-change))) (defun calc-refresh (&optional align) (interactive) @@ -1743,8 +1706,7 @@ (save-excursion (set-buffer (aref calc-embedded-info 1)) (calc-refresh align))) - (setq calc-refresh-count (1+ calc-refresh-count)) -) + (setq calc-refresh-count (1+ calc-refresh-count))) (defun calc-x-paste-text (arg) @@ -1763,8 +1725,7 @@ (if (eq (car-safe val) 'error) (error "%s in yanked data" (nth 2 val))))) (calc-enter-result 0 "Xynk" val)))) - (x-paste-text arg)) -) + (x-paste-text arg))) @@ -1774,8 +1735,7 @@ (save-excursion (let ((win (get-buffer-window (current-buffer)))) (and win - (pos-visible-in-window-p (1- (point-max)) win)))) -) + (pos-visible-in-window-p (1- (point-max)) win))))) (defun calc-trail-buffer () (and (or (null calc-trail-buffer) @@ -1794,8 +1754,7 @@ (set-buffer calc-trail-buffer) (goto-line 2) (setq calc-trail-pointer (point-marker)))) - calc-trail-buffer -) + calc-trail-buffer) (defun calc-record (val &optional prefix) (setq calc-aborted-prefix nil) @@ -1825,8 +1784,7 @@ (if (and aligned win (not (memq 'hold-trail calc-command-flags))) (calc-trail-here)) (goto-char (1- (point-max)))))))) - val -) + val) (defun calc-trail-display (flag &optional no-refresh) @@ -1855,8 +1813,7 @@ (if (interactive-p) (calc-do-refresh) (calc-refresh)))))))) - calc-trail-buffer -) + calc-trail-buffer) (defun calc-trail-here () (interactive) @@ -1886,8 +1843,7 @@ (set-buffer calc-main-buffer) (setq overlay-arrow-string calc-trail-overlay overlay-arrow-position calc-trail-pointer)))))) - (error "Not in Calc Trail buffer")) -) + (error "Not in Calc Trail buffer"))) @@ -1901,8 +1857,7 @@ (cdr calc-undo-list))) (setq calc-undo-list (cons (list rec) calc-undo-list) calc-redo-list nil) - (calc-set-command-flag 'undo))) -) + (calc-set-command-flag 'undo)))) @@ -1916,8 +1871,7 @@ (mapcar 'math-check-complete (calc-top-list 2)))) (calc-extensions) - (calc-binary-op-fancy name func arg ident unary)) -) + (calc-binary-op-fancy name func arg ident unary))) (defun calc-unary-op (name func arg &optional func2) (setq calc-aborted-prefix name) @@ -1925,40 +1879,34 @@ (calc-enter-result 1 name (list (or func2 func) (math-check-complete (calc-top 1)))) (calc-extensions) - (calc-unary-op-fancy name func arg)) -) + (calc-unary-op-fancy name func arg))) (defun calc-plus (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "+" 'calcFunc-add arg 0 nil '+)) -) + (calc-binary-op "+" 'calcFunc-add arg 0 nil '+))) (defun calc-minus (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-)) -) + (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-))) (defun calc-times (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*)) -) + (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*))) (defun calc-divide (arg) (interactive "P") (calc-slow-wrapper - (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/)) -) + (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))) (defun calc-change-sign (arg) (interactive "P") (calc-wrapper - (calc-unary-op "chs" 'neg arg)) -) + (calc-unary-op "chs" 'neg arg))) @@ -1972,8 +1920,7 @@ ((= n 0) (calc-push-list (calc-top-list (calc-stack-size)))) (t - (calc-push-list (calc-top-list n))))) -) + (calc-push-list (calc-top-list n)))))) (defun calc-pop (n) @@ -1999,8 +1946,7 @@ (= nn 1) (calc-top-selected 1 1)) (calc-delete-selection 1) - (calc-pop-stack nn)))))) -) + (calc-pop-stack nn))))))) @@ -2042,8 +1988,7 @@ (if (eq calc-prev-char 'dots) (progn (calc-extensions) - (calc-dots)))))) -) + (calc-dots))))))) (defsubst calc-minibuffer-size () (- (point-max) (minibuffer-prompt-end))) @@ -2067,15 +2012,13 @@ (>= last-input-char 128)) last-input-char nil)))) - (exit-minibuffer)) -) + (exit-minibuffer))) (defun calc-minibuffer-contains (rex) (save-excursion (goto-char (minibuffer-prompt-end)) - (looking-at rex)) -) + (looking-at rex))) (defun calcDigit-key () (interactive) @@ -2174,8 +2117,7 @@ (beep) (calc-temp-minibuffer-message " [Bad format]")))))) (setq calc-prev-prev-char calc-prev-char - calc-prev-char last-command-char) -) + calc-prev-char last-command-char)) (defun calcDigit-backspace () @@ -2193,8 +2135,7 @@ (if (= (calc-minibuffer-size) 0) (progn (setq last-command-char 13) - (calcDigit-nondigit))) -) + (calcDigit-nondigit)))) @@ -2401,8 +2342,7 @@ (calc-record-why "*Variable is void" (nth 1 err))))) (if (consp (car a)) (math-dimension-error) - (cons (car a) args))))))) -) + (cons (car a) args)))))))) @@ -2414,8 +2354,7 @@ (math-floatp (nth 2 a)) (and (eq (car a) 'intv) (math-floatp (nth 3 a))))) ((eq (car-safe a) 'date) - (math-floatp (nth 1 a)))) -) + (math-floatp (nth 1 a))))) @@ -2425,8 +2364,7 @@ ((eq (car-safe a) 'incomplete) (calc-incomplete-error a)) ((consp a) a) - (t (error "Invalid data object encountered"))) -) + (t (error "Invalid data object encountered")))) @@ -2434,14 +2372,12 @@ (defun math-bignum (a) (if (>= a 0) (cons 'bigpos (math-bignum-big a)) - (cons 'bigneg (math-bignum-big (- a)))) -) + (cons 'bigneg (math-bignum-big (- a))))) (defun math-bignum-big (a) ; [L s] (if (= a 0) nil - (cons (% a 1000) (math-bignum-big (/ a 1000)))) -) + (cons (% a 1000) (math-bignum-big (/ a 1000))))) ;;; Build a normalized floating-point number. [F I S] @@ -2472,15 +2408,13 @@ (if (and (>= exp 3000000) (>= (+ exp (math-numdigs mant) -1) 4000000)) (signal 'math-overflow nil) - (list 'float mant exp)))) -) + (list 'float mant exp))))) (defun math-div10-bignum (a) ; [l l] (if (cdr a) (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100)) (math-div10-bignum (cdr a))) - (list (/ (car a) 10))) -) + (list (/ (car a) 10)))) ;;; Coerce A to be a float. [F N; V V] [Public] (defun math-float (a) @@ -2489,8 +2423,7 @@ ((eq (car a) 'float) a) ((memq (car a) '(cplx polar vec hms date sdev mod)) (cons (car a) (mapcar 'math-float (cdr a)))) - (t (math-float-fancy a))) -) + (t (math-float-fancy a)))) (defun math-neg (a) @@ -2501,8 +2434,7 @@ (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)))) - (t (math-neg-fancy a))) -) + (t (math-neg-fancy a)))) ;;; Compute the number of decimal digits in integer A. [S I] @@ -2519,15 +2451,13 @@ ((= a 0) 0) ((> a -10) 1) ((> a -100) 2) - (t (math-numdigs (- a))))) -) + (t (math-numdigs (- a)))))) ;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S] (defun math-scale-int (a n) (cond ((= n 0) a) ((> n 0) (math-scale-left a n)) - (t (math-normalize (math-scale-right a (- n))))) -) + (t (math-normalize (math-scale-right a (- n)))))) (defun math-scale-left (a n) ; [I I S] (if (= n 0) @@ -2544,8 +2474,7 @@ (* a 100)) (if (or (>= a 100000) (<= a -100000)) (math-scale-left (math-bignum a) 1) - (* a 10)))))) -) + (* a 10))))))) (defun math-scale-left-bignum (a n) (if (>= n 3) @@ -2553,8 +2482,7 @@ n (- n 3)) 3))) (if (> n 0) (math-mul-bignum-digit a (if (= n 2) 100 10) 0) - a) -) + a)) (defun math-scale-right (a n) ; [i i S] (if (= n 0) @@ -2572,8 +2500,7 @@ (/ a 100) (if (= n 1) (/ a 10) - a))))) -) + a)))))) (defun math-scale-right-bignum (a n) ; [L L S; l l S] (if (>= n 3) @@ -2581,8 +2508,7 @@ n (% n 3))) (if (> n 0) (cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0)) - a) -) + a)) ;;; Multiply (with rounding) the integer A by 10^N. [I i S] (defun math-scale-rounding (a n) @@ -2610,8 +2536,7 @@ (- (math-scale-rounding (- a) n)) (if (= n -1) (/ (+ a 5) 10) - (/ (+ (math-scale-right a (- -1 n)) 5) 10))))) -) + (/ (+ (math-scale-right a (- -1 n)) 5) 10)))))) ;;; Compute the sum of A and B. [O O O] [Public] @@ -2661,8 +2586,7 @@ (and (calc-extensions) (math-add-objects-fancy a b)))) (and (calc-extensions) - (math-add-symb-fancy a b))) -) + (math-add-symb-fancy a b)))) (defun math-add-bignum (a b) ; [L L L; l l l] (if a @@ -2696,8 +2620,7 @@ (nconc a b) a))) a) - b) -) + b)) (defun math-sub-bignum (a b) ; [l l l] (if b @@ -2735,8 +2658,7 @@ (setq b (cdr b))) (and b 'neg)) - a) -) + a)) (defun math-add-float (a b) ; [F F F] (let ((ediff (- (nth 2 a) (nth 2 b)))) @@ -2753,8 +2675,7 @@ b (math-make-float (math-add (nth 1 a) (math-scale-left (nth 1 b) ediff)) - (nth 2 a))))) -) + (nth 2 a)))))) ;;; Compute the difference of A and B. [O O O] [Public] (defun math-sub (a b) @@ -2763,8 +2684,7 @@ (setq a (- a b)) (if (or (<= a -1000000) (>= a 1000000)) (math-bignum a) - a)) -) + a))) (defun math-sub-float (a b) ; [F F F] (let ((ediff (- (nth 2 a) (nth 2 b)))) @@ -2782,8 +2702,7 @@ (math-make-float (math-add (nth 1 a) (Math-integer-neg (math-scale-left (nth 1 b) ediff))) - (nth 2 a))))) -) + (nth 2 a)))))) ;;; Compute the product of A and B. [O O O] [Public] @@ -2829,8 +2748,7 @@ (and (calc-extensions) (math-mul-objects-fancy a b)))) (and (calc-extensions) - (math-mul-symb-fancy a b))) -) + (math-mul-symb-fancy a b)))) (defun math-infinitep (a &optional undir) (while (and (consp a) (memq (car a) '(* / neg))) @@ -2842,8 +2760,7 @@ (memq (nth 2 a) '(var-inf var-uinf var-nan)) (if (and undir (eq (nth 2 a) 'var-inf)) '(var uinf var-uinf) - a)) -) + a))) ;;; Multiply digit lists A and B. [L L L; l l l] (defun math-mul-bignum (a b) @@ -2869,8 +2786,7 @@ (if (cdr ss) (setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss)))) (setcdr ss (list (/ prod 1000)))))) - sum)) -) + sum))) ;;; Multiply digit list A by digit D. [L L D D; l l D D] (defun math-mul-bignum-digit (a d c) @@ -2887,8 +2803,7 @@ (setcdr aa (list (/ prod 1000)))) a)) (and (> c 0) - (list c))) -) + (list c)))) ;;; Compute the integer (quotient . remainder) of A and B, which may be @@ -2910,8 +2825,7 @@ (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) (car res))) (math-normalize (cons (car a) (cdr res)))))) - (cons (/ a b) (% a b))) -) + (cons (/ a b) (% a b)))) (defun math-quotient (a b) ; [I I I] [Public] (if (and (not (consp a)) (not (consp b))) @@ -2932,8 +2846,7 @@ (math-mul-bignum-digit (cdr b) d 0) alen blen))) (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) - (car res)))))) -) + (car res))))))) ;;; Divide a bignum digit list by another. [l.l l L] @@ -2951,8 +2864,7 @@ (cons (car res) (car (math-div-bignum-digit (cdr res) d))))) (let ((res (math-div-bignum-digit a (car b)))) - (cons (car res) (list (cdr res))))) -) + (cons (car res) (list (cdr res)))))) ;;; Divide a bignum digit list by a digit. [l.D l D] (defun math-div-bignum-digit (a b) @@ -2962,8 +2874,7 @@ (cons (cons (/ num b) (car res)) (% num b))) - '(nil . 0)) -) + '(nil . 0))) (defun math-div-bignum-big (a b alen blen) ; [l.l l L] (if (< alen blen) @@ -2973,22 +2884,19 @@ (res2 (math-div-bignum-part num b blen))) (cons (cons (car res2) (car res)) - (cdr res2)))) -) + (cdr res2))))) (defun math-div-bignum-part (a b blen) ; a < b*1000 [D.l l L] (let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0))) (den (nth (1- blen) b)) (guess (min (/ num den) 999))) - (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)) -) + (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess))) (defun math-div-bignum-try (a b c guess) ; [D.l l l D] (let ((rem (math-sub-bignum a c))) (if (eq rem 'neg) (math-div-bignum-try a b (math-sub-bignum c b) (1- guess)) - (cons guess rem))) -) + (cons guess rem)))) ;;; Compute the quotient of A and B. [O O N] [Public] @@ -3027,16 +2935,14 @@ (and (calc-extensions) (math-div-objects-fancy a b)))) (and (calc-extensions) - (math-div-symb-fancy a b))) -) + (math-div-symb-fancy a b)))) (defun math-div-float (a b) ; [F F F] (let ((ldiff (max (- (1+ calc-internal-prec) (- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b)))) 0))) (math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b)) - (- (- (nth 2 a) (nth 2 b)) ldiff))) -) + (- (- (nth 2 a) (nth 2 b)) ldiff)))) @@ -3100,8 +3006,7 @@ (aset s 0 ?1) (aset s 1 ?:)))) (setcar (cdr entry) (calc-count-lines s)) - s) -) + s)) (defun math-stack-value-offset (c) (let* ((num (if calc-line-numbering 4 0)) @@ -3115,8 +3020,7 @@ (if (integerp calc-line-breaking) (setq wid calc-line-breaking))) (cons (max (- off (length calc-left-label)) 0) - (+ wid num))) -) + (+ wid num)))) (defun calc-count-lines (s) (let ((pos 0) @@ -3124,8 +3028,7 @@ (while (setq newpos (string-match "\n" s pos)) (setq pos (1+ newpos) num (1+ num))) - num) -) + num)) (defun math-format-value (a &optional w) (if (and (Math-scalarp a) @@ -3133,22 +3036,19 @@ (math-format-number a) (calc-extensions) (let ((calc-line-breaking nil)) - (math-composition-to-string (math-compose-expr a 0) w))) -) + (math-composition-to-string (math-compose-expr a 0) w)))) (defun calc-window-width () (if calc-embedded-info (let ((win (get-buffer-window (aref calc-embedded-info 0)))) (1- (if win (window-width win) (frame-width)))) (- (window-width (get-buffer-window (current-buffer))) - (if calc-line-numbering 5 1))) -) + (if calc-line-numbering 5 1)))) (defun math-comp-concat (c1 c2) (if (and (stringp c1) (stringp c2)) (concat c1 c2) - (list 'horiz c1 c2)) -) + (list 'horiz c1 c2))) @@ -3171,8 +3071,7 @@ (math-format-number a))) (t (calc-extensions) - (math-format-flat-expr-fancy a prec))) -) + (math-format-flat-expr-fancy a prec)))) @@ -3282,8 +3181,7 @@ str))) (t (calc-extensions) - (math-format-number-fancy a prec))) -) + (math-format-number-fancy a prec)))) (defun math-format-bignum (a) ; [X L] (if (and (= calc-number-radix 10) @@ -3291,8 +3189,7 @@ (not calc-group-digits)) (math-format-bignum-decimal a) (calc-extensions) - (math-format-bignum-fancy a)) -) + (math-format-bignum-fancy a))) (defun math-format-bignum-decimal (a) ; [X L] (if a @@ -3301,8 +3198,7 @@ (setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s) a (cdr (cdr a)))) (concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s)) - "0") -) + "0")) @@ -3362,21 +3258,18 @@ (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) ;; Syntax error! - (t nil))) -) + (t nil)))) (defun math-match-substring (s n) (if (match-beginning n) (substring s (match-beginning n) (match-end n)) - "") -) + "")) (defun math-read-bignum (s) ; [l X] (if (> (length s) 3) (cons (string-to-int (substring s -3)) (math-read-bignum (substring s 0 -3))) - (list (string-to-int s))) -) + (list (string-to-int s)))) (defconst math-tex-ignore-words @@ -3449,30 +3342,26 @@ "Parse the region as a vector of numbers and push it on the Calculator stack." (interactive "r\nP") (calc-extensions) - (calc-do-grab-region top bot arg) -) + (calc-do-grab-region top bot arg)) ;;;###autoload (defun calc-grab-rectangle (top bot arg) "Parse a rectangle as a matrix of numbers and push it on the Calculator stack." (interactive "r\nP") (calc-extensions) - (calc-do-grab-rectangle top bot arg) -) + (calc-do-grab-rectangle top bot arg)) (defun calc-grab-sum-down (top bot arg) "Parse a rectangle as a matrix of numbers and sum its columns." (interactive "r\nP") (calc-extensions) - (calc-do-grab-rectangle top bot arg 'calcFunc-reduced) -) + (calc-do-grab-rectangle top bot arg 'calcFunc-reduced)) (defun calc-grab-sum-across (top bot arg) "Parse a rectangle as a matrix of numbers and sum its rows." (interactive "r\nP") (calc-extensions) - (calc-do-grab-rectangle top bot arg 'calcFunc-reducea) -) + (calc-do-grab-rectangle top bot arg 'calcFunc-reducea)) ;;;###autoload @@ -3480,24 +3369,21 @@ "Start Calc Embedded mode on the formula surrounding point." (interactive "P") (calc-extensions) - (calc-do-embedded arg end obeg oend) -) + (calc-do-embedded arg end obeg oend)) ;;;###autoload (defun calc-embedded-activate (&optional arg cbuf) "Scan the current editing buffer for all embedded := and => formulas. Also looks for the equivalent TeX words, \\gets and \\evalto." (interactive "P") - (calc-do-embedded-activate arg cbuf) -) + (calc-do-embedded-activate arg cbuf)) (defun calc-user-invocation () (interactive) (or (stringp calc-invocation-macro) (error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro")) - (execute-kbd-macro calc-invocation-macro nil) -) + (execute-kbd-macro calc-invocation-macro nil)) @@ -3507,8 +3393,7 @@ ;;;###autoload (defmacro defmath (func args &rest body) ; [Public] (calc-extensions) - (math-do-defmath func args body) -) + (math-do-defmath func args body)) ;;; Functions needed for Lucid Emacs support. @@ -3524,8 +3409,7 @@ (cons key key))) (t (let ((key (read-char))) - (cons key key)))) -) + (cons key key))))) (defun calc-unread-command (&optional input) (if (featurep 'xemacs) @@ -3542,10 +3426,9 @@ (if calc-always-load-extensions (progn (calc-extensions) - (calc-load-everything)) -) + (calc-load-everything))) (run-hooks 'calc-load-hook) - +;;; calc.el ends here
--- a/lisp/calc/calcalg2.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calcalg2.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-alg-2.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -46,8 +46,7 @@ expr (calc-top-n 1))) (while (>= (setq num (1- num)) 0) (setq expr (list func expr var))) - (calc-enter-result n "derv" expr))) -) + (calc-enter-result n "derv" expr)))) (defun calc-integral (var) (interactive "sIntegration variable: ") @@ -61,38 +60,32 @@ (error "Bad format in expression: %s" (nth 1 var))) (calc-enter-result 1 "intg" (list 'calcFunc-integ (calc-top-n 1) - var))))) -) + var)))))) (defun calc-num-integral (&optional varname lowname highname) (interactive "sIntegration variable: ") (calc-tabular-command 'calcFunc-ninteg "Integration" "nint" - nil varname lowname highname) -) + nil varname lowname highname)) (defun calc-summation (arg &optional varname lowname highname) (interactive "P\nsSummation variable: ") (calc-tabular-command 'calcFunc-sum "Summation" "sum" - arg varname lowname highname) -) + arg varname lowname highname)) (defun calc-alt-summation (arg &optional varname lowname highname) (interactive "P\nsSummation variable: ") (calc-tabular-command 'calcFunc-asum "Summation" "asum" - arg varname lowname highname) -) + arg varname lowname highname)) (defun calc-product (arg &optional varname lowname highname) (interactive "P\nsIndex variable: ") (calc-tabular-command 'calcFunc-prod "Index" "prod" - arg varname lowname highname) -) + arg varname lowname highname)) (defun calc-tabulate (arg &optional varname lowname highname) (interactive "P\nsIndex variable: ") (calc-tabular-command 'calcFunc-table "Index" "tabl" - arg varname lowname highname) -) + arg varname lowname highname)) (defun calc-tabular-command (func prompt prefix arg varname lowname highname) (calc-slow-wrapper @@ -150,8 +143,7 @@ (setq step (prefix-numeric-value arg))))) (setq expr (calc-top-n num)) (calc-enter-result num prefix (append (list func expr var low high) - (and step (list step)))))) -) + (and step (list step))))))) (defun calc-solve-for (var) (interactive "sVariable to solve for: ") @@ -171,8 +163,7 @@ (error "Bad format in expression: %s" (nth 1 var))) (calc-enter-result 1 "solv" (list func (calc-top-n 1) - var)))))) -) + var))))))) (defun calc-poly-roots (var) (interactive "sVariable to solve for: ") @@ -189,8 +180,7 @@ (error "Bad format in expression: %s" (nth 1 var))) (calc-enter-result 1 "prts" (list 'calcFunc-roots (calc-top-n 1) - var))))) -) + var)))))) (defun calc-taylor (var nterms) (interactive "sTaylor expansion variable: \nNNumber of terms: ") @@ -201,8 +191,7 @@ (calc-enter-result 1 "tylr" (list 'calcFunc-taylor (calc-top-n 1) var - (prefix-numeric-value nterms))))) -) + (prefix-numeric-value nterms)))))) (defun math-derivative (expr) ; uses global values: deriv-var, deriv-total. @@ -332,8 +321,7 @@ (throw 'math-deriv nil) (cons func (cdr expr)))))))))) (setq n (1+ n))) - accum))))) -) + accum)))))) (defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb) (let* ((deriv-total nil) @@ -344,8 +332,7 @@ (and res (if deriv-value (math-expr-subst res deriv-var deriv-value) - res))) -) + res)))) (defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb) (math-setup-declarations) @@ -357,8 +344,7 @@ (and res (if deriv-value (math-expr-subst res deriv-var deriv-value) - res))) -) + res)))) (put 'calcFunc-inv\' 'math-derivative-1 (function (lambda (u) (math-neg (math-div 1 (math-sqr u)))))) @@ -492,8 +478,7 @@ (defun math-deriv-gamma (a x scale) (math-mul scale (math-mul (math-pow x (math-add a -1)) - (list 'calcFunc-exp (math-neg x)))) -) + (list 'calcFunc-exp (math-neg x))))) (put 'calcFunc-betaB\' 'math-derivative-3 (function (lambda (x a b) (math-deriv-beta x a b 1)))) @@ -507,8 +492,7 @@ (defun math-deriv-beta (x a b scale) (math-mul (math-mul (math-pow x (math-add a -1)) (math-pow (math-sub 1 x) (math-add b -1))) - scale) -) + scale)) (put 'calcFunc-erf\' 'math-derivative-1 (function (lambda (x) (math-div 2 @@ -632,8 +616,7 @@ ;;(list 'condition-case 'err (cons 'insert parts) ;; '(error (insert (prin1-to-string err)))) - '(sit-for 0))) -) + '(sit-for 0)))) ;;; The following wrapper caches results and avoids infinite recursion. ;;; Each cache entry is: ( A B ) Integral of A is B; @@ -724,8 +707,7 @@ " is " (math-format-value val 1000) "\n") - val) -) + val)) (defvar math-integral-cache nil) (defvar math-integral-cache-state nil) @@ -736,8 +718,7 @@ (listp (nth 2 expr))) (while (and (setq expr (cdr expr)) (not (math-integral-contains-parts (car expr))))) - expr) -) + expr)) (defun math-replace-integral-parts (expr) (or (Math-primp expr) @@ -751,8 +732,7 @@ (setcar expr (nth 1 (nth 2 (car expr)))) (math-replace-integral-parts (cons 'foo expr))) (setcar (cdr cur-record) 'cancelled))) - (math-replace-integral-parts (car expr)))))) -) + (math-replace-integral-parts (car expr))))))) (defun math-do-integral (expr) (let (t1 t2) @@ -974,8 +954,7 @@ ;; Try expanding the function's definition. (let ((res (math-expand-formula expr))) (and res - (math-integral res))))) -) + (math-integral res)))))) (defun math-sub-integration (expr &rest rest) (or (if (or (not rest) @@ -986,8 +965,7 @@ (and (or (= math-integ-level math-integral-limit) (not (math-expr-calls res 'calcFunc-integ))) res))) - (list 'calcFunc-integfailed expr)) -) + (list 'calcFunc-integfailed expr))) (defun math-do-integral-methods (expr) (let ((so-far math-integ-var-list-list) @@ -1074,8 +1052,7 @@ (math-integ-try-parts expr) ;; Give up. - nil)) -) + nil))) (defun math-integ-parts-easy (expr) (cond ((Math-primp expr) t) @@ -1090,8 +1067,7 @@ (math-integ-parts-easy (nth 1 expr)))) ((eq (car expr) 'neg) (math-integ-parts-easy (nth 1 expr))) - (t t)) -) + (t t))) (defun math-integ-try-parts (expr &optional math-good-parts) ;; Integration by parts: @@ -1117,8 +1093,7 @@ (and (eq (car expr) '^) (math-integrate-by-parts (math-pow (nth 1 expr) (math-sub (nth 2 expr) 1)) - (nth 1 expr)))) -) + (nth 1 expr))))) (defun math-integrate-by-parts (u vprime) (let ((math-integ-level (if (or math-good-parts @@ -1149,16 +1124,14 @@ (math-solve-for (math-sub v temp) 0 v nil))) (and temp (not (integerp temp)) (math-simplify-extended temp))))) - (setcar (cdr cur-record) 'busy)))) -) + (setcar (cdr cur-record) 'busy))))) ;;; This tries two different formulations, hoping the algebraic simplifier ;;; will be strong enough to handle at least one. (defun math-integrate-by-substitution (expr u &optional user uinv uinvprime) (and (> math-integ-level 0) (let ((math-integ-level (max (- math-integ-level 2) 0))) - (math-integrate-by-good-substitution expr u user uinv uinvprime))) -) + (math-integrate-by-good-substitution expr u user uinv uinvprime)))) (defun math-integrate-by-good-substitution (expr u &optional user uinv uinvprime) @@ -1208,8 +1181,7 @@ deriv) 'yes))))) (math-simplify-extended - (math-expr-subst temp math-integ-var u)))) -) + (math-expr-subst temp math-integ-var u))))) ;;; Look for substitutions of the form u = a x + b. (defun math-integ-try-linear-substitutions (sub-expr) @@ -1234,8 +1206,7 @@ (while (and (setq sub-expr (cdr sub-expr)) (not (setq res (math-integ-try-linear-substitutions (car sub-expr)))))) - res))) -) + res)))) ;;; Recursively try different substitutions based on various sub-expressions. (defun math-integ-try-substitutions (sub-expr &optional allow-rat) @@ -1260,14 +1231,12 @@ (while (and (setq sub-expr (cdr sub-expr)) (not (setq res (math-integ-try-substitutions (car sub-expr) allow-rat))))) - res))) -) + res)))) (defun math-expr-rational-in (expr) (let ((parts nil)) (math-expr-rational-in-rec expr) - (mapcar 'car parts)) -) + (mapcar 'car parts))) (defun math-expr-rational-in-rec (expr) (cond ((Math-primp expr) @@ -1284,8 +1253,7 @@ (t (and (not (assoc expr parts)) (math-expr-contains expr math-integ-var) - (setq parts (cons (list expr) parts))))) -) + (setq parts (cons (list expr) parts)))))) (defun math-expr-calls (expr funcs &optional arg-contains) (if (consp expr) @@ -1300,8 +1268,7 @@ (while (and (setq expr (cdr expr)) (not (setq res (math-expr-calls (car expr) funcs arg-contains))))) - res)))) -) + res))))) (defun math-fix-const-terms (expr except-vars) (cond ((not (math-expr-depends expr except-vars)) 0) @@ -1312,8 +1279,7 @@ ((eq (car expr) '-) (math-sub (math-fix-const-terms (nth 1 expr) except-vars) (math-fix-const-terms (nth 2 expr) except-vars))) - (t expr)) -) + (t expr))) ;; Command for debugging the Calculator's symbolic integrator. (defun calc-dump-integral-cache (&optional arg) @@ -1336,8 +1302,7 @@ "\n") (setq p (cdr p))) (goto-char (point-min))) - (set-buffer buf))) -) + (set-buffer buf)))) (defun math-try-integral (expr) (let ((math-integ-level math-integral-limit) @@ -1355,8 +1320,7 @@ (and (> math-max-integral-limit math-integral-limit) (setq math-integral-limit math-max-integral-limit math-integ-level math-integral-limit) - (math-integral expr 'yes)))) -) + (math-integral expr 'yes))))) (defun calcFunc-integ (expr var &optional low high) (cond @@ -1468,8 +1432,7 @@ (math-expr-subst res math-integ-var var))))) (append (list 'calcFunc-integ expr var) (and low (list low)) - (and high (list high))))))) -) + (and high (list high)))))))) (math-defintegral calcFunc-inv @@ -1682,8 +1645,7 @@ (math-mul n (math-mul q (math-pow v n))))) (math-mul-thru (math-div (math-mul b (1- (* 2 n))) (math-mul n q)) - (math-integral-q02 a b c v n))))))) -) + (math-integral-q02 a b c v n)))))))) (defun math-integral-q02 (a b c v vpow) (let (q rq part) @@ -1722,8 +1684,7 @@ (math-div (math-mul 2 (math-to-radians-2 (list 'calcFunc-arctan (math-div part rq)))) - rq)))) -) + rq))))) (math-defintegral calcFunc-erf @@ -1798,8 +1759,7 @@ (and (not (and (equal low '(neg (var inf var-inf))) (equal high '(var inf var-inf)))) (list low high)) - (and step (list step))))) -) + (and step (list step)))))) (setq math-tabulate-initial nil) (setq math-tabulate-function nil) @@ -1822,8 +1782,7 @@ high (math-min high (math-floor high-val))))) (t (while (setq x (cdr x)) - (math-scan-for-limits (car x))))) -) + (math-scan-for-limits (car x)))))) (defun calcFunc-sum (expr var &optional low high step) @@ -1831,8 +1790,7 @@ (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2))) (math-sum-rec expr var low high step))) (math-disable-sums t)) - (math-normalize res)) -) + (math-normalize res))) (setq math-disable-sums nil) (defun math-sum-rec (expr var &optional low high step) @@ -1937,8 +1895,7 @@ (or val (let* ((math-tabulate-initial 0) (math-tabulate-function 'calcFunc-sum)) - (calcFunc-table expr var low high)))) -) + (calcFunc-table expr var low high))))) (defun calcFunc-asum (expr var low &optional high step no-mul-flag) (or high (setq high low low 1)) @@ -1960,8 +1917,7 @@ (math-simplify (math-div (math-sub high low) step)))))) (math-mul (if no-mul-flag 1 (math-pow -1 low)) - (calcFunc-sum (math-mul (math-pow -1 var) expr) var low high))) -) + (calcFunc-sum (math-mul (math-pow -1 var) expr) var low high)))) (defun math-sum-const-factors (expr var) (let ((const nil) @@ -1983,8 +1939,7 @@ (let ((temp (or (car not-const) 1))) (while (setq not-const (cdr not-const)) (setq temp (list '* (car not-const) temp))) - temp)))) -) + temp))))) ;; Following is from CRC Math Tables, 27th ed, pp. 52-53. (defun math-sum-integer-power (pow) @@ -2007,8 +1962,7 @@ (setq math-sum-int-pow-cache (nconc math-sum-int-pow-cache (list (nreverse new))) n (1+ n)))) - (nth pow math-sum-int-pow-cache)) -) + (nth pow math-sum-int-pow-cache))) (setq math-sum-int-pow-cache (list '(0 1))) (defun math-to-exponentials (expr) @@ -2046,8 +2000,7 @@ (list '^ '(var e var-e) x) (list '^ '(var e var-e) (list 'neg x))) 2)) - (t nil)))) -) + (t nil))))) (defun math-to-exps (expr) (cond (calc-symbolic-mode expr) @@ -2057,8 +2010,7 @@ (equal (nth 1 expr) '(var e var-e))) (list 'calcFunc-exp (nth 2 expr))) (t - (cons (car expr) (mapcar 'math-to-exps (cdr expr))))) -) + (cons (car expr) (mapcar 'math-to-exps (cdr expr)))))) (defun calcFunc-prod (expr var &optional low high step) @@ -2066,8 +2018,7 @@ (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2))) (math-prod-rec expr var low high step))) (math-disable-prods t)) - (math-normalize res)) -) + (math-normalize res))) (setq math-disable-prods nil) (defun math-prod-rec (expr var &optional low high step) @@ -2209,8 +2160,7 @@ (or val (let* ((math-tabulate-initial 1) (math-tabulate-function 'calcFunc-prod)) - (calcFunc-table expr var low high)))) -) + (calcFunc-table expr var low high))))) @@ -2359,8 +2309,7 @@ (math-try-solve-for t1 rhs sign)) (t (calc-record-why "*No inverse known" lhs) - nil))) -) + nil)))) (setq math-solve-ranges nil) @@ -2470,8 +2419,7 @@ (and sign (math-oddp (nth 2 lhs)) (math-solve-sign sign (nth 2 lhs))))))))) - (t nil)) -) + (t nil))) (defun math-solve-prod (lsoln rsoln) (cond ((null lsoln) @@ -2485,8 +2433,7 @@ (list 'calcFunc-gt (math-solve-get-sign 1) 0) lsoln rsoln)) - (t lsoln)) -) + (t lsoln))) ;;; This deals with negative, fractional, and symbolic powers of "x". (defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2" @@ -2503,8 +2450,7 @@ (setq t2 (math-mul (or math-poly-mult-powers 1) (let ((calc-prefer-frac t)) (math-div 1 math-poly-frac-powers))) - t1 (math-is-polynomial (math-simplify (calcFunc-expand t1)) b 50))) -) + t1 (math-is-polynomial (math-simplify (calcFunc-expand t1)) b 50)))) ;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2". (defun math-solve-crunch-poly (max-degree) ; uses "t1", "t3" @@ -2533,8 +2479,7 @@ t1 new-t1)))) (setq scale (1- scale))) (setq t3 (list (math-mul (car t3) t2) (math-mul count t2))) - (<= (1- (length t1)) max-degree)))) -) + (<= (1- (length t1)) max-degree))))) (defun calcFunc-poly (expr var &optional degree) (if degree @@ -2545,8 +2490,7 @@ (if (equal p '(0)) (list 'vec) (cons 'vec p)) - (math-reject-arg expr "Expected a polynomial"))) -) + (math-reject-arg expr "Expected a polynomial")))) (defun calcFunc-gpoly (expr var &optional degree) (if degree @@ -2556,8 +2500,7 @@ (d (math-decompose-poly expr var degree nil))) (if d (cons 'vec d) - (math-reject-arg expr "Expected a polynomial"))) -) + (math-reject-arg expr "Expected a polynomial")))) (defun math-decompose-poly (lhs solve-var degree sub-rhs) (let ((rhs (or sub-rhs 1)) @@ -2589,15 +2532,13 @@ (cons 'vec t1) (if sub-rhs (math-pow t2 (nth 1 t3)) - (math-div (math-pow t2 (nth 1 t3)) rhs))))) -) + (math-div (math-pow t2 (nth 1 t3)) rhs)))))) (defun math-solve-linear (var sign b a) (math-try-solve-for var (math-div (math-neg b) a) (math-solve-sign sign a) - t) -) + t)) (defun math-solve-quadratic (var c b a) (math-try-solve-for @@ -2622,8 +2563,7 @@ (math-add (math-sqr b) (math-mul 4 (math-mul (math-neg c) a))))))) (math-mul 2 a))) - nil t) -) + nil t)) (defun math-solve-cubic (var d c b a) (let* ((p (math-div b a)) @@ -2665,8 +2605,7 @@ calc-symbolic-mode)))) 3)))) (math-div p 3)) - nil t)))) -) + nil t))))) (defun math-solve-quartic (var d c b a aa) (setq a (math-div a aa)) @@ -2715,8 +2654,7 @@ (math-sub (math-add (math-mul sign1 (math-div r 2)) (math-solve-get-sign (math-div de 2))) (math-div a 4)))) - nil t) -) + nil t)) (defun math-poly-all-roots (var p &optional math-factoring) (catch 'ouch @@ -2811,8 +2749,7 @@ (list 'calcFunc-subscr vec (math-solve-get-int 1 (1- (length orig-p)) 1)) - vec))))) -) + vec)))))) (setq math-symbolic-solve nil) (defun math-lcm-denoms (&rest fracs) @@ -2821,8 +2758,7 @@ (if (eq (car-safe (car fracs)) 'frac) (setq den (calcFunc-lcm den (nth 2 (car fracs))))) (setq fracs (cdr fracs))) - den) -) + den)) (defun math-poly-any-root (p x polish) ; p is a reverse poly coeff list (let* ((newt (if (math-zerop x) @@ -2838,8 +2774,7 @@ (math-poly-laguerre-root p x polish))))) (and math-symbolic-solve (math-floatp res) (throw 'ouch nil)) - res) -) + res)) (defun math-poly-newton-root (p x iters) (let* ((calc-prefer-frac nil) @@ -2869,8 +2804,7 @@ (math-nearly-zerop dx (math-abs-approx x)))) (progn (setq dx 0) nil))))) (cons x (if (math-zerop x) - 1 (math-div (math-abs-approx dx) (math-abs-approx x))))) -) + 1 (math-div (math-abs-approx dx) (math-abs-approx x)))))) (defun math-poly-integer-root (x) (and (math-lessp (calcFunc-xpon (math-abs-approx x)) calc-internal-prec) @@ -2935,8 +2869,7 @@ (let ((calc-symbolic-mode math-symbolic-solve)) (math-mul (math-sqrt (math-sub (math-sqr aa) rnd0)) - (if (math-negp xim) -1 1)))))))))) -) + (if (math-negp xim) -1 1))))))))))) (setq math-int-coefs nil) ;;; The following routine is from Numerical Recipes, section 9.5. @@ -3018,8 +2951,7 @@ dxold)))) (or (and (math-floatp x) (math-poly-integer-root x)) - x)) -) + x))) (defun math-solve-above-dummy (x) (and (not (Math-primp x)) @@ -3029,8 +2961,7 @@ (let ((res nil)) (while (and (setq x (cdr x)) (not (setq res (math-solve-above-dummy (car x)))))) - res))) -) + res)))) (defun math-solve-find-root-term (x neg) ; sets "t2", "t3" (if (math-solve-find-root-in-prod x) @@ -3039,8 +2970,7 @@ (and (memq (car-safe x) '(+ -)) (or (math-solve-find-root-term (nth 1 x) neg) (math-solve-find-root-term (nth 2 x) - (if (eq (car x) '-) (not neg) neg))))) -) + (if (eq (car x) '-) (not neg) neg)))))) (defun math-solve-find-root-in-prod (x) (and (consp x) @@ -3057,8 +2987,7 @@ (or (and (not (math-expr-contains (nth 1 x) solve-var)) (math-solve-find-root-in-prod (nth 2 x))) (and (not (math-expr-contains (nth 2 x) solve-var)) - (math-solve-find-root-in-prod (nth 1 x))))))) -) + (math-solve-find-root-in-prod (nth 1 x)))))))) (defun math-solve-system (exprs solve-vars solve-full) @@ -3071,8 +3000,7 @@ (or (let ((math-solve-simplifying nil)) (math-solve-system-rec exprs solve-vars nil)) (let ((math-solve-simplifying t)) - (math-solve-system-rec exprs solve-vars nil))) -) + (math-solve-system-rec exprs solve-vars nil)))) ;;; The following backtracking solver works by choosing a variable ;;; and equation, and trying to solve the equation for the variable. @@ -3167,8 +3095,7 @@ (cons 'vec (if solns (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns) - (mapcar 'car eqn-list)))))) -) + (mapcar 'car eqn-list))))))) (defun math-solve-system-subst (x) ; uses "res" and "v" (let ((accum nil) @@ -3184,8 +3111,7 @@ (car res2))) x (cdr x) res2 (cdr res2))) - accum) -) + accum)) (defun math-get-from-counter (name) @@ -3194,8 +3120,7 @@ (setcdr ctr (1+ (cdr ctr))) (setq ctr (cons name 1) calc-command-flags (cons ctr calc-command-flags))) - (cdr ctr)) -) + (cdr ctr))) (defun math-solve-get-sign (val) (setq val (math-simplify val)) @@ -3222,8 +3147,7 @@ math-solve-ranges))) (math-mul var2 val))) (calc-record-why "*Choosing positive solution") - val)) -) + val))) (defun math-solve-get-int (val &optional range first) (if solve-full @@ -3243,8 +3167,7 @@ math-solve-ranges))) (math-mul val var2))) (calc-record-why "*Choosing 0 for arbitrary integer in solution") - 0) -) + 0)) (defun math-solve-sign (sign expr) (and sign @@ -3252,15 +3175,13 @@ (cond ((memq s1 '(4 6)) sign) ((memq s1 '(1 3)) - (- sign))))) -) + (- sign)))))) (defun math-looks-evenp (expr) (if (Math-integerp expr) (math-evenp expr) (if (memq (car expr) '(* /)) - (math-looks-evenp (nth 1 expr)))) -) + (math-looks-evenp (nth 1 expr))))) (defun math-solve-for (lhs rhs solve-var solve-full &optional sign) (if (math-expr-contains rhs solve-var) @@ -3287,8 +3208,7 @@ (format "*Omitted %d complex solutions" (- old-len new-len))))))) - res)))) -) + res))))) (defun math-solve-eqn (expr var full) (if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt @@ -3308,51 +3228,44 @@ (list 'calcFunc-neq var res)))))) (let ((res (math-solve-for expr 0 var full))) (and res - (list 'calcFunc-eq var res)))) -) + (list 'calcFunc-eq var res))))) (defun math-reject-solution (expr var func) (if (math-expr-contains expr var) (or (equal (car calc-next-why) '(* "Unable to find a symbolic solution")) (calc-record-why "*Unable to find a solution"))) - (list func expr var) -) + (list func expr var)) (defun calcFunc-solve (expr var) (or (if (or (Math-vectorp expr) (Math-vectorp var)) (math-solve-system expr var nil) (math-solve-eqn expr var nil)) - (math-reject-solution expr var 'calcFunc-solve)) -) + (math-reject-solution expr var 'calcFunc-solve))) (defun calcFunc-fsolve (expr var) (or (if (or (Math-vectorp expr) (Math-vectorp var)) (math-solve-system expr var t) (math-solve-eqn expr var t)) - (math-reject-solution expr var 'calcFunc-fsolve)) -) + (math-reject-solution expr var 'calcFunc-fsolve))) (defun calcFunc-roots (expr var) (let ((math-solve-ranges nil)) (or (if (or (Math-vectorp expr) (Math-vectorp var)) (math-solve-system expr var 'all) (math-solve-for expr 0 var 'all)) - (math-reject-solution expr var 'calcFunc-roots))) -) + (math-reject-solution expr var 'calcFunc-roots)))) (defun calcFunc-finv (expr var) (let ((res (math-solve-for expr math-integ-var var nil))) (if res (math-normalize (math-expr-subst res math-integ-var var)) - (math-reject-solution expr var 'calcFunc-finv))) -) + (math-reject-solution expr var 'calcFunc-finv)))) (defun calcFunc-ffinv (expr var) (let ((res (math-solve-for expr math-integ-var var t))) (if res (math-normalize (math-expr-subst res math-integ-var var)) - (math-reject-solution expr var 'calcFunc-finv))) -) + (math-reject-solution expr var 'calcFunc-finv)))) (put 'calcFunc-inv 'math-inverse @@ -3499,9 +3412,6 @@ nfac)))) (and fprime (math-normalize accum)))) - (list 'calcFunc-taylor expr var num))) -) + (list 'calcFunc-taylor expr var num)))) - - - +;;; calcalg2.el ends here
--- a/lisp/calc/calcalg3.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calcalg3.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-alg-3.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -47,8 +47,7 @@ (calc-enter-result 1 "root" (list func (calc-top-n 2) var - (calc-top-n 1))))))) -) + (calc-top-n 1)))))))) (defun calc-find-minimum (var) (interactive "sVariable(s) to minimize over: ") @@ -73,14 +72,12 @@ (calc-enter-result 1 tag (list func (calc-top-n 2) var - (calc-top-n 1))))))) -) + (calc-top-n 1)))))))) (defun calc-find-maximum (var) (interactive "sVariable to maximize over: ") (calc-invert-func) - (calc-find-minimum var) -) + (calc-find-minimum var)) (defun calc-poly-interp (arg) @@ -94,8 +91,7 @@ (if (calc-is-hyperbolic) (calc-enter-result 1 "rati" (list 'calcFunc-ratint data (calc-top 1))) (calc-enter-result 1 "poli" (list 'calcFunc-polint data - (calc-top 1)))))) -) + (calc-top 1))))))) (defun calc-curve-fit (arg &optional model coefnames varnames) @@ -312,16 +308,13 @@ coefnames) data)) (if (consp calc-fit-to-trail) - (calc-record (calc-normalize calc-fit-to-trail) "parm"))))) -) + (calc-record (calc-normalize calc-fit-to-trail) "parm")))))) (defun calc-invent-independent-variables (n &optional but) - (calc-invent-variables n but '(x y z t) "x") -) + (calc-invent-variables n but '(x y z t) "x")) (defun calc-invent-parameter-variables (n &optional but) - (calc-invent-variables n but '(a b c d) "a") -) + (calc-invent-variables n but '(a b c d) "a")) (defun calc-invent-variables (num but names base) (let ((vars nil) @@ -337,8 +330,7 @@ (or (symbolp names) (setq names (cdr names)))) (if (= n 0) (nreverse vars) - (calc-invent-variables num but t base))) -) + (calc-invent-variables num but t base)))) (defun calc-get-fit-variables (nv nc &optional defv defc with-y homog) (or (= nv (if with-y (1+ nvars) nvars)) @@ -394,8 +386,7 @@ (if coefnames (setq model (math-multi-subst model (cdr coefnames) (cdr coefs)))) (setq varnames vars - coefnames coefs)) -) + coefnames coefs))) @@ -422,8 +413,7 @@ limit) (math-newton-root expr deriv next orig-guess limit) (math-reject-arg next "*Newton's method failed to converge")))) - (math-reject-arg next "*Newton's method encountered a singularity"))) -) + (math-reject-arg next "*Newton's method encountered a singularity")))) ;;; Inspired by "rtsafe" (defun math-newton-search-root (expr deriv guess vguess ostep oostep @@ -494,8 +484,7 @@ (and (Math-negp vlow) (Math-negp vhigh))) (math-search-root expr deriv low vlow high vhigh) (math-newton-search-root expr deriv nil nil nil ostep - low vlow high vhigh))))) -) + low vlow high vhigh)))))) ;;; Search for a root in an interval with no overt zero crossing. (defun math-search-root (expr deriv low vlow high vhigh) @@ -579,8 +568,7 @@ low vlow high vhigh) (math-bisect-root expr low vlow high vhigh)))) (math-reject-arg (list 'intv 3 low high) - "*Unable to find a sign change in this interval"))) -) + "*Unable to find a sign change in this interval")))) ;;; "rtbis" (but we should be using Brent's method) (defun math-bisect-root (expr low vlow high vhigh) @@ -602,8 +590,7 @@ vhigh vmid) (setq low mid vlow vmid))) - (list 'vec mid vmid)) -) + (list 'vec mid vmid))) ;;; "mnewt" (defun math-newton-multi (expr jacob n guess orig-guess limit) @@ -628,8 +615,7 @@ limit) (math-newton-multi expr jacob n next orig-guess limit) (math-reject-arg nil "*Newton's method failed to converge")) - (list 'vec next expr-val))) -) + (list 'vec next expr-val)))) (defvar math-root-vars [(var DUMMY var-DUMMY)]) @@ -746,16 +732,13 @@ (not (Math-numberp vlow)) (not (Math-numberp vhigh))) (math-search-root expr deriv low vlow high vhigh) - (math-bisect-root expr low vlow high vhigh))))))))) -) + (math-bisect-root expr low vlow high vhigh)))))))))) (defun calcFunc-root (expr var guess) - (math-find-root expr var guess nil) -) + (math-find-root expr var guess nil)) (defun calcFunc-wroot (expr var guess) - (math-find-root expr var guess t) -) + (math-find-root expr var guess t)) @@ -773,8 +756,7 @@ (math-float a) (if (eq (car a) 'float) a - (math-reject-arg a 'realp))) -) + (math-reject-arg a 'realp)))) ;;; A bracket for a minimum is a < b < c where f(b) < f(a) and f(b) < f(c). @@ -842,8 +824,7 @@ c u vc vu)) (if (math-lessp-float a c) (list a va b vb c vc) - (list c vc b vb a va))) -) + (list c vc b vb a va)))) (defun math-narrow-min (expr a c intv) (let ((xvals (list a c)) @@ -893,8 +874,7 @@ (and (not yvals) (list (nth 3 intv) min))))) (math-reject-arg nil (format "*Unable to find a %s in the interval" - math-min-or-max))))) -) + math-min-or-max)))))) ;;; "brent" (defun math-brent-min (expr prec a va x vx b vb) @@ -986,8 +966,7 @@ (setq v w vv vw w x vw vx x u vx vu))) - (list 'vec x vx)) -) + (list 'vec x vx))) ;;; "powell" (defun math-powell-min (expr n guesses prec) @@ -1047,8 +1026,7 @@ (while (<= (setq i (1+ i)) n) (setcar (nthcdr ibig (nth i xi)) (nth i (nth 1 res))))))) - (list 'vec p fret)) -) + (list 'vec p fret))) (defun math-line-min-func (expr n) (let ((m -1)) @@ -1059,8 +1037,7 @@ '(var DUMMY var-DUMMY) (list 'calcFunc-mrow '(var line-xi line-xi) (1+ m))) (list 'calcFunc-mrow '(var line-p line-p) (1+ m))))) - (math-evaluate-expr expr)) -) + (math-evaluate-expr expr))) (defun math-line-min (f1dim line-p line-xi n prec) (let* ((var-DUMMY nil) @@ -1068,8 +1045,7 @@ (params (math-widen-min expr '(float 0 0) '(float 1 0))) (res (apply 'math-brent-min expr prec params)) (xi (math-mul (nth 1 res) line-xi))) - (list (math-add line-p xi) xi (nth 2 res))) -) + (list (math-add line-p xi) xi (nth 2 res)))) (defvar math-min-vars [(var DUMMY var-DUMMY)]) @@ -1168,8 +1144,7 @@ (setq guesses (cdr guesses))) (if isvec (list 'vec vec (nth 2 res)) - (list 'vec (nth 1 vec) (nth 2 res)))))) -) + (list 'vec (nth 1 vec) (nth 2 res))))))) (setq math-min-or-max "minimum") (defun calcFunc-minimize (expr var guess) @@ -1177,16 +1152,14 @@ (math-min-or-max "minimum")) (math-find-minimum (math-normalize expr) (math-normalize var) - (math-normalize guess) nil)) -) + (math-normalize guess) nil))) (defun calcFunc-wminimize (expr var guess) (let ((calc-internal-prec (max (/ calc-internal-prec 2) 3)) (math-min-or-max "minimum")) (math-find-minimum (math-normalize expr) (math-normalize var) - (math-normalize guess) t)) -) + (math-normalize guess) t))) (defun calcFunc-maximize (expr var guess) (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3)) @@ -1194,8 +1167,7 @@ (res (math-find-minimum (math-normalize (math-neg expr)) (math-normalize var) (math-normalize guess) nil))) - (list 'vec (nth 1 res) (math-neg (nth 2 res)))) -) + (list 'vec (nth 1 res) (math-neg (nth 2 res))))) (defun calcFunc-wmaximize (expr var guess) (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3)) @@ -1203,8 +1175,7 @@ (res (math-find-minimum (math-normalize (math-neg expr)) (math-normalize var) (math-normalize guess) t))) - (list 'vec (nth 1 res) (math-neg (nth 2 res)))) -) + (list 'vec (nth 1 res) (math-neg (nth 2 res))))) @@ -1223,8 +1194,7 @@ (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) (math-with-extra-prec 2 (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x - nil)))) -) + nil))))) (put 'calcFunc-polint 'math-expandable t) @@ -1240,8 +1210,7 @@ (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) (math-with-extra-prec 2 (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x - (cdr (cdr (cdr (nth 1 data)))))))) -) + (cdr (cdr (cdr (nth 1 data))))))))) (put 'calcFunc-ratint 'math-expandable t) @@ -1295,8 +1264,7 @@ (setq ns (1- ns) dy (nth ns d))) (setq y (math-add y dy))) - (list y dy))) -) + (list y dy)))) @@ -1335,8 +1303,7 @@ (math-ninteg-romberg 'math-ninteg-midpoint expr (math-float lo) (math-float hi) nil)))) - sum)) -) + sum))) ;;; Open Romberg method; "qromo" in section 4.4. @@ -1365,8 +1332,7 @@ h (cdr h))) (setq curh (math-div-float curh '(float 9 0)))) ss - (math-reject-arg nil (format "*Integral failed to converge"))))) -) + (math-reject-arg nil (format "*Integral failed to converge")))))) (defun math-ninteg-evaluate (expr x mode) @@ -1378,8 +1344,7 @@ (math-reject-arg res "*Integrand does not evaluate to a number")) (if (eq mode 'inf) (setq res (math-mul res (math-sqr x)))) - res) -) + res)) (defun math-ninteg-midpoint (expr lo hi mode) ; uses "integ-temp" @@ -1417,8 +1382,7 @@ expr (math-mul (math-add lo hi) '(float 5 -1)) mode))))) - (nth 1 integ-temp) -) + (nth 1 integ-temp)) @@ -1437,28 +1401,24 @@ (set (nth 2 (aref math-dummy-vars math-dummy-counter)) nil) (prog1 (aref math-dummy-vars math-dummy-counter) - (setq math-dummy-counter (1+ math-dummy-counter))) -) + (setq math-dummy-counter (1+ math-dummy-counter)))) (defun calcFunc-fit (expr vars &optional coefs data) (let ((math-in-fit 10)) (math-with-extra-prec 2 - (math-general-fit expr vars coefs data nil))) -) + (math-general-fit expr vars coefs data nil)))) (defun calcFunc-efit (expr vars &optional coefs data) (let ((math-in-fit 10)) (math-with-extra-prec 2 - (math-general-fit expr vars coefs data 'sdev))) -) + (math-general-fit expr vars coefs data 'sdev)))) (defun calcFunc-xfit (expr vars &optional coefs data) (let ((math-in-fit 10)) (math-with-extra-prec 2 - (math-general-fit expr vars coefs data 'full))) -) + (math-general-fit expr vars coefs data 'full)))) (defun math-general-fit (expr vars coefs data mode) (let ((calc-simplify-mode nil) @@ -1746,8 +1706,7 @@ (if (and have-sdevs (> n mm)) (list 'calcFunc-utpc chisq (- n mm)) '(var nan var-nan))) - expr))) -) + expr)))) (setq math-in-fit 0) (setq calc-fit-to-trail nil) @@ -1757,38 +1716,33 @@ (progn (setq x (aref math-dummy-vars (+ first-var x -1))) (or (calc-var-value (nth 2 x)) x)) - (math-reject-arg x)) -) + (math-reject-arg x))) (defun calcFunc-fitparam (x) (if (>= math-in-fit 2) (progn (setq x (aref math-dummy-vars (+ first-coef x -1))) (or (calc-var-value (nth 2 x)) x)) - (math-reject-arg x)) -) + (math-reject-arg x))) (defun calcFunc-fitdummy (x) (if (= math-in-fit 3) (nth x new-coefs) - (math-reject-arg x)) -) + (math-reject-arg x))) (defun calcFunc-hasfitvars (expr) (if (Math-primp expr) 0 (if (eq (car expr) 'calcFunc-fitvar) (nth 1 expr) - (apply 'max (mapcar 'calcFunc-hasfitvars (cdr expr))))) -) + (apply 'max (mapcar 'calcFunc-hasfitvars (cdr expr)))))) (defun calcFunc-hasfitparams (expr) (if (Math-primp expr) 0 (if (eq (car expr) 'calcFunc-fitparam) (nth 1 expr) - (apply 'max (mapcar 'calcFunc-hasfitparams (cdr expr))))) -) + (apply 'max (mapcar 'calcFunc-hasfitparams (cdr expr)))))) (defun math-all-vars-but (expr but) @@ -1798,15 +1752,13 @@ (setq vars (delq (assoc (car-safe p) vars) vars) p (cdr p))) (sort (mapcar 'car vars) - (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))) -) + (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))) (defun math-all-vars-in (expr) (let ((vars nil) found) (math-all-vars-rec expr) - vars) -) + vars)) (defun math-all-vars-rec (expr) (if (Math-primp expr) @@ -1816,9 +1768,6 @@ (setcdr found (1+ (cdr found))) (setq vars (cons (cons expr 1) vars))))) (while (setq expr (cdr expr)) - (math-all-vars-rec (car expr)))) -) + (math-all-vars-rec (car expr))))) - - - +;;; calcalg3.el ends here
--- a/lisp/calc/calccomp.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calccomp.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-comp.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -878,8 +878,7 @@ (if (eq calc-language 'eqn) " , " ", ") 0) - right)))))))) -) + right))))))))) (defconst math-eqn-special-funcs '( calcFunc-log @@ -894,14 +893,12 @@ (defun math-prod-first-term (x) (while (eq (car-safe x) '*) (setq x (nth 1 x))) - x -) + x) (defun math-prod-last-term (x) (while (eq (car-safe x) '*) (setq x (nth 2 x))) - x -) + x) (defun math-compose-vector (a sep prec) (if a @@ -918,13 +915,11 @@ (cons (list 'break math-compose-level) (cons sep c))))) (nreverse c)))) - "") -) + "")) (defun math-vector-no-parens (a) (or (cdr (cdr a)) - (not (eq (car-safe (nth 1 a)) '*))) -) + (not (eq (car-safe (nth 1 a)) '*)))) (defun math-compose-matrix (a col cols base) (let ((col 0) @@ -943,8 +938,7 @@ (concat comma-spc " "))))) a))) res))) - (nreverse res)) -) + (nreverse res))) (defun math-compose-rows (a count first) (if (cdr a) @@ -962,16 +956,14 @@ (list (list 'horiz (if first (concat left-bracket " ") " ") (math-compose-expr (car a) vector-prec) - (concat " " right-bracket)))) -) + (concat " " right-bracket))))) (defun math-compose-tex-matrix (a) (if (cdr a) (cons (math-compose-vector (cdr (car a)) " & " 0) (cons " \\\\ " (math-compose-tex-matrix (cdr a)))) - (list (math-compose-vector (cdr (car a)) " & " 0))) -) + (list (math-compose-vector (cdr (car a)) " & " 0)))) (defun math-compose-eqn-matrix (a) (if a @@ -989,8 +981,7 @@ (cons " } " (math-compose-eqn-matrix (cdr a))))))) - nil) -) + nil)) (defun math-vector-is-string (a) (while (and (setq a (cdr a)) @@ -1000,8 +991,7 @@ (natnump (nth 1 (car a))) (eq (nth 2 (car a)) 0) (<= (nth 1 (car a)) 255))))) - (null a) -) + (null a)) (defun math-vector-to-string (a &optional quoted) (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x))) @@ -1024,8 +1014,7 @@ p (+ p 2)))))) (if quoted (concat "\"" a "\"") - a) -) + a)) (defconst math-vector-to-string-chars '( ( ?\" . "\\\"" ) ( ?\\ . "\\\\" ) ( ?\a . "\\a" ) @@ -1042,8 +1031,7 @@ (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x) (math-to-underscores (concat (math-match-substring x 1) "_" (math-match-substring x 2))) - x) -) + x)) (defun math-tex-expr-is-flat (a) (or (Math-integerp a) @@ -1054,8 +1042,7 @@ (math-tex-expr-is-flat (car a)))) (null a))) (and (memq (car a) '(^ calcFunc-subscr)) - (math-tex-expr-is-flat (nth 1 a)))) -) + (math-tex-expr-is-flat (nth 1 a))))) (put 'calcFunc-log 'math-compose-big 'math-compose-log) (defun math-compose-log (a prec) @@ -1066,8 +1053,7 @@ (math-compose-expr (nth 2 a) 1000))) "(" (math-compose-expr (nth 1 a) 1000) - ")")) -) + ")"))) (put 'calcFunc-log10 'math-compose-big 'math-compose-log10) (defun math-compose-log10 (a prec) @@ -1076,8 +1062,7 @@ (list 'subscr "log" "10") "(" (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) @@ -1092,8 +1077,7 @@ (list 'vec '(calcFunc-string (vec ?d)) (nth 2 a)))) - prec)) -) + prec))) (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt) (defun math-compose-sqrt (a prec) @@ -1114,8 +1098,7 @@ (make-list (1- h) " |") '("\\|"))) " " - c)))) -) + c))))) (put 'calcFunc-choose 'math-compose-big 'math-compose-choose) (defun math-compose-choose (a prec) @@ -1126,8 +1109,7 @@ (list 'vcent (math-comp-height a1) a1 " " a2) - ")")) -) + ")"))) (put 'calcFunc-integ 'math-compose-big 'math-compose-integ) (defun math-compose-integ (a prec) @@ -1164,8 +1146,7 @@ (if over "" (list 'horiz " d" var)) - (if parens ")" "")))) -) + (if parens ")" ""))))) (put 'calcFunc-sum 'math-compose-big 'math-compose-sum) (defun math-compose-sum (a prec) @@ -1190,8 +1171,7 @@ (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod)) " " "") expr - (if (memq prec '(180 201)) ")" "")))) -) + (if (memq prec '(180 201)) ")" ""))))) (put 'calcFunc-prod 'math-compose-big 'math-compose-prod) (defun math-compose-prod (a prec) @@ -1215,8 +1195,7 @@ (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod)) " " "") expr - (if (memq prec '(196 201)) ")" "")))) -) + (if (memq prec '(196 201)) ")" ""))))) (defun math-stack-value-offset-fancy () @@ -1251,8 +1230,7 @@ (or (< off 0) (and calc-display-origin (> calc-line-breaking calc-display-origin))) - (setq wid calc-line-breaking))) -) + (setq wid calc-line-breaking)))) @@ -1265,8 +1243,7 @@ (if (math-comp-is-flat c) (math-comp-to-string-flat c width) (math-vert-comp-to-string - (math-comp-simplify c width)))) -) + (math-comp-simplify c width))))) (defun math-comp-is-flat (c) ; check if c's height is 1. (cond ((not (consp c)) t) @@ -1281,8 +1258,7 @@ (math-comp-is-flat (nth 2 c)))) ((eq (car c) 'tag) (math-comp-is-flat (nth 2 c))) - (t nil)) -) + (t nil))) ;;; Convert a one-line composition to a string. Break into multiple @@ -1315,8 +1291,7 @@ (aset comp-buf (1+ k) ?\n) (setq prefix " ")) (setq prefix "\n")))) - (concat comp-buf prefix str)))) -) + (concat comp-buf prefix str))))) (setq math-comp-buf-string (make-vector 10 "")) (setq math-comp-buf-margin (make-vector 10 0)) (setq math-comp-buf-level (make-vector 10 0)) @@ -1415,8 +1390,7 @@ (math-comp-to-string-flat-term (nth 2 c)))) (t (math-comp-to-string-flat-term (nth 2 c))))) - (t (math-comp-to-string-flat-term (nth 2 c)))) -) + (t (math-comp-to-string-flat-term (nth 2 c))))) (defun math-comp-highlight-string (s) (setq s (copy-sequence s)) @@ -1424,8 +1398,7 @@ (while (>= (setq i (1- i)) 0) (or (memq (aref s i) '(32 ?\n)) (aset s i (if calc-show-selections ?\. ?\#))))) - s -) + s) (defun math-comp-sel-flat-term (c) (cond ((not (consp c)) @@ -1442,8 +1415,7 @@ (setq math-comp-sel-tag c math-comp-sel-cpos 1000000))) (math-comp-sel-flat-term (nth 2 c)))) - (t (math-comp-sel-flat-term (nth 2 c)))) -) + (t (math-comp-sel-flat-term (nth 2 c))))) ;;; Simplify a composition to a canonical form consisting of @@ -1459,8 +1431,7 @@ (comp-highlight (and math-comp-selected calc-show-selections)) (comp-tag nil)) (math-comp-simplify-term c) - (cons 'vleft (cons comp-base comp-buf))) -) + (cons 'vleft (cons comp-base comp-buf)))) (defun math-comp-add-string (s h v) (and (> (length s) 0) @@ -1481,8 +1452,7 @@ (make-string (- h (length (car str))) 32) (if comp-highlight (math-comp-highlight-string s) - s))))))) -) + s)))))))) (defun math-comp-add-string-sel (x y w h) (if (and (<= y math-comp-sel-vpos) @@ -1490,8 +1460,7 @@ (<= x math-comp-sel-hpos) (> (+ x w) math-comp-sel-hpos)) (setq math-comp-sel-tag comp-tag - math-comp-sel-vpos 10000)) -) + math-comp-sel-vpos 10000))) (defun math-comp-simplify-term (c) (cond ((stringp c) @@ -1561,8 +1530,7 @@ (let ((comp-highlight nil)) (math-comp-simplify-term (nth 2 c)))) (t (let ((comp-tag c)) - (math-comp-simplify-term (nth 2 c))))))) -) + (math-comp-simplify-term (nth 2 c)))))))) ;;; Measuring a composition. @@ -1576,8 +1544,7 @@ (math-comp-is-null (car c)))) (and c (math-comp-first-char (car c)))) ((eq (car c) 'tag) - (math-comp-first-char (nth 2 c)))) -) + (math-comp-first-char (nth 2 c))))) (defun math-comp-first-string (c) (cond ((stringp c) @@ -1588,8 +1555,7 @@ (math-comp-is-null (car c)))) (and c (math-comp-first-string (car c)))) ((eq (car c) 'tag) - (math-comp-first-string (nth 2 c)))) -) + (math-comp-first-string (nth 2 c))))) (defun math-comp-last-char (c) (cond ((stringp c) @@ -1601,8 +1567,7 @@ (setq c (cdr c))) (and c (math-comp-last-char (car c))))) ((eq (car c) 'tag) - (math-comp-last-char (nth 2 c)))) -) + (math-comp-last-char (nth 2 c))))) (defun math-comp-is-null (c) (cond ((stringp c) (= (length c) 0)) @@ -1612,8 +1577,7 @@ (null c)) ((eq (car c) 'tag) (math-comp-is-null (nth 2 c))) - ((memq (car c) '(set break)) t)) -) + ((memq (car c) '(set break)) t))) (defun math-comp-width (c) (cond ((not (consp c)) (length c)) @@ -1630,14 +1594,12 @@ accum)) ((eq (car c) 'tag) (math-comp-width (nth 2 c))) - (t 0)) -) + (t 0))) (defun math-comp-height (c) (if (stringp c) 1 - (+ (math-comp-ascent c) (math-comp-descent c))) -) + (+ (math-comp-ascent c) (math-comp-descent c)))) (defun math-comp-ascent (c) (cond ((not (consp c)) 1) @@ -1654,8 +1616,7 @@ (math-comp-ascent (nth 1 c))) ((eq (car c) 'tag) (math-comp-ascent (nth 2 c))) - (t 1)) -) + (t 1))) (defun math-comp-descent (c) (cond ((not (consp c)) 0) @@ -1676,13 +1637,11 @@ (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c)))) ((eq (car c) 'tag) (math-comp-descent (nth 2 c))) - (t 0)) -) + (t 0))) (defun calcFunc-cwidth (a &optional prec) (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump)) - (math-comp-width (math-compose-expr a (or prec 0))) -) + (math-comp-width (math-compose-expr a (or prec 0)))) (defun calcFunc-cheight (a &optional prec) (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump)) @@ -1690,8 +1649,7 @@ (memq (length a) '(2 3)) (eq (nth 1 a) 0)) 0 - (math-comp-height (math-compose-expr a (or prec 0)))) -) + (math-comp-height (math-compose-expr a (or prec 0))))) (defun calcFunc-cascent (a &optional prec) (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump)) @@ -1699,13 +1657,11 @@ (memq (length a) '(2 3)) (eq (nth 1 a) 0)) 0 - (math-comp-ascent (math-compose-expr a (or prec 0)))) -) + (math-comp-ascent (math-compose-expr a (or prec 0))))) (defun calcFunc-cdescent (a &optional prec) (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump)) - (math-comp-descent (math-compose-expr a (or prec 0))) -) + (math-comp-descent (math-compose-expr a (or prec 0)))) ;;; Convert a simplified composition into string form. @@ -1713,14 +1669,12 @@ (defun math-vert-comp-to-string (c) (if (stringp c) c - (math-vert-comp-to-string-step (cdr (cdr c)))) -) + (math-vert-comp-to-string-step (cdr (cdr c))))) (defun math-vert-comp-to-string-step (c) (if (cdr c) (concat (car c) "\n" (math-vert-comp-to-string-step (cdr c))) - (car c)) -) + (car c))) ;;; Convert a composition to a string in "raw" form (for debugging). @@ -1738,8 +1692,7 @@ (math-comp-to-string-raw (nth 1 c) next-indent) (math-comp-to-string-raw-step (cdr (cdr c)) next-indent) - ")")))) -) + ")"))))) (defun math-comp-to-string-raw-step (cl indent) (if cl @@ -1747,9 +1700,6 @@ (make-string indent 32) (math-comp-to-string-raw (car cl) indent) (math-comp-to-string-raw-step (cdr cl) indent)) - "") -) + "")) - - - +;;; calccomp.el ends here
--- a/lisp/calc/calcsel2.el Wed Nov 14 09:08:03 2001 +0000 +++ b/lisp/calc/calcsel2.el Wed Nov 14 09:09:09 2001 +0000 @@ -1,5 +1,5 @@ ;; Calculator for GNU Emacs, part II [calc-sel-2.el] -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; This file is part of GNU Emacs. @@ -109,8 +109,7 @@ (list (calc-replace-sub-formula expr parent new)) num (list (and (or (not (eq arg 0)) reselect) - sel))))))))) -) + sel)))))))))) (defun calc-commute-right (arg) (interactive "p") @@ -193,8 +192,7 @@ (list (calc-replace-sub-formula expr parent new)) num (list (and (or (not (eq arg 0)) reselect) - sel))))))))) -) + sel)))))))))) (defun calc-build-assoc-term (op lhs rhs) (cond ((and (eq op '+) (or (math-looks-negp rhs) @@ -215,8 +213,7 @@ (or (math-equal-int (nth 1 rhs) 1) (equal (nth 1 rhs) '(cplx 1 0))))) (list '/ lhs (nth 2 rhs))) - (t (list op lhs rhs))) -) + (t (list op lhs rhs)))) (defun calc-sel-unpack () (interactive) @@ -234,8 +231,7 @@ (list (calc-replace-sub-formula expr sel (nth 1 sel))) num - (list (and reselect (nth 1 sel)))))) -) + (list (and reselect (nth 1 sel))))))) (defun calc-sel-isolate () (interactive) @@ -266,38 +262,32 @@ expr eqn soln)) num (list (and reselect sel))) - (calc-handle-whys))) -) + (calc-handle-whys)))) (defun calc-sel-commute (many) (interactive "P") (let ((calc-assoc-selections nil)) (calc-rewrite-selection "CommuteRules" many "cmut")) - (calc-set-mode-line) -) + (calc-set-mode-line)) (defun calc-sel-jump-equals (many) (interactive "P") - (calc-rewrite-selection "JumpRules" many "jump") -) + (calc-rewrite-selection "JumpRules" many "jump")) (defun calc-sel-distribute (many) (interactive "P") - (calc-rewrite-selection "DistribRules" many "dist") -) + (calc-rewrite-selection "DistribRules" many "dist")) (defun calc-sel-merge (many) (interactive "P") - (calc-rewrite-selection "MergeRules" many "merg") -) + (calc-rewrite-selection "MergeRules" many "merg")) (defun calc-sel-negate (many) (interactive "P") - (calc-rewrite-selection "NegateRules" many "jneg") -) + (calc-rewrite-selection "NegateRules" many "jneg")) (defun calc-sel-invert (many) (interactive "P") - (calc-rewrite-selection "InvertRules" many "jinv") -) + (calc-rewrite-selection "InvertRules" many "jinv")) +;;; calcsel2.el ends here