From bf77c646a591144c34d7dca5eaf6141c38393903 Mon Sep 17 00:00:00 2001 From: Colin Walters Date: Wed, 14 Nov 2001 09:09:09 +0000 Subject: Style cleanup; don't put closing parens on their own line, add "foo.el ends here" to each file, and update copyright date. --- lisp/calc/calc-comb.el | 173 ++++++++-------------- lisp/calc/calc-cplx.el | 68 +++------ lisp/calc/calc-embed.el | 119 +++++---------- lisp/calc/calc-fin.el | 122 +++++----------- lisp/calc/calc-forms.el | 266 +++++++++++----------------------- lisp/calc/calc-frac.el | 42 ++---- lisp/calc/calc-funcs.el | 188 ++++++++---------------- lisp/calc/calc-graph.el | 190 ++++++++---------------- lisp/calc/calc-help.el | 109 +++++--------- lisp/calc/calc-incom.el | 35 ++--- lisp/calc/calc-keypd.el | 49 +++---- lisp/calc/calc-lang.el | 126 ++++++---------- lisp/calc/calc-macs.el | 102 +++++-------- lisp/calc/calc-maint.el | 39 ++--- lisp/calc/calc-map.el | 142 ++++++------------ lisp/calc/calc-mode.el | 154 +++++++------------- lisp/calc/calc-mtx.el | 57 +++----- lisp/calc/calc-poly.el | 179 ++++++++--------------- lisp/calc/calc-prog.el | 349 +++++++++++++++----------------------------- lisp/calc/calc-rewr.el | 172 ++++++++-------------- lisp/calc/calc-rules.el | 33 ++--- lisp/calc/calc-sel.el | 142 ++++++------------ lisp/calc/calc-stat.el | 138 ++++++------------ lisp/calc/calc-store.el | 155 +++++++------------- lisp/calc/calc-stuff.el | 48 ++---- lisp/calc/calc-trail.el | 50 +++---- lisp/calc/calc-undo.el | 32 ++-- lisp/calc/calc-vec.el | 378 ++++++++++++++++-------------------------------- lisp/calc/calc-yank.el | 73 +++------- lisp/calc/calc.el | 355 +++++++++++++++------------------------------ lisp/calc/calcalg2.el | 270 ++++++++++++---------------------- lisp/calc/calcalg3.el | 153 +++++++------------- lisp/calc/calccomp.el | 150 +++++++------------ lisp/calc/calcsel2.el | 36 ++--- 34 files changed, 1577 insertions(+), 3117 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index f80bce9459..91dfd40515 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -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 diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index b24e2a1807..df0ebffc74 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -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 diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index ecfa5e1397..b07df1eda0 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -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 @@ This is not required to be present for user-written mode annotations.") (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 @@ This is not required to be present for user-written mode annotations.") (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 @@ This is not required to be present for user-written mode annotations.") (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 @@ This is not required to be present for user-written mode annotations.") (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 @@ This is not required to be present for user-written mode annotations.") (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 @@ This is not required to be present for user-written mode annotations.") (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 @@ This is not required to be present for user-written mode annotations.") (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 @@ This is not required to be present for user-written mode annotations.") (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 @@ With any prefix argument, marks only the formula itself." (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 @@ With any prefix argument, marks only the formula itself." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." 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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." 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 @@ The command \\[yank] can retrieve it from there." (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 @@ The command \\[yank] can retrieve it from there." "(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 diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el index 70d8dcd84f..85c9700f55 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -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 diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index d0b86ec462..0c3029b598 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -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 @@ and ends on the last Sunday of October at 2 a.m." ((= (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." ((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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (throw 'syntax (nth 2 res))) (setq exp-pos (1+ last)) (math-read-token) - res) -) + res)) +;;; calc-forms.el ends here diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index dc5bf6e2d2..b1a391fe1a 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -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 diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index 90b4761a8a..d31d1892c0 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -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 diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 60a46a6a50..a7ab6843f6 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." " " (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." 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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." 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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (or calc-gnuplot-display "")) (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." 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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (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 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (eq (char-after (1- (point-max))) ?\n) (progn (goto-char (point-max)) - (insert "\n"))))) -) + (insert "\n")))))) +;;; calc-graph.el ends here diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index ad3fbe4e90..ed66d65c2e 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." 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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "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 @@ C-w Describe how there is no warranty for Calc." "SHIFT + sets: : (span), # (card), + (rdup)" "<, =, > (justification); , (commas); [, {, ( (brackets)" "} (matrix brackets); . (abbreviate); / (multi-lines)") - "vec/mat" ?v) -) + "vec/mat" ?v)) +;;; calc-help.el ends here diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index 07d6d93b9d..2c7a95339b 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -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 diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index 0d84309a85..550ba4e7f5 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -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 diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 4b897fa53f..03dd4d2981 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -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 diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index efe37cf49f..12ece3a994 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -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 diff --git a/lisp/calc/calc-maint.el b/lisp/calc/calc-maint.el index 7bf4748169..a5d92c969b 100644 --- a/lisp/calc/calc-maint.el +++ b/lisp/calc/calc-maint.el @@ -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 @@ Unix usage: (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 @@ Unix usage: (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 @@ Unix usage: (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 @@ Unix usage: (setq end (point-max)))) (apply old-write-region start end filename append 'quietly rest) (message "Wrote %s" filename) - nil -) + nil) @@ -241,8 +237,7 @@ Usage: C-x C-f calc.texinfo RET (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 @@ Usage: C-x C-f calc.texinfo RET (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 @@ Usage: C-x C-f calc.texinfo RET "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 @@ global-set-key commands for Calc." (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 @@ global-set-key commands for Calc." (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 commands for Calc." \(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 diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 7265be641c..17ea4f2b82 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -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 diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index 5bbb984844..ef860d8290 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -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 diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index b9dc2aa6d0..0031ca7c8b 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -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 diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index eba14b7d62..c2dfd71f69 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -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 diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index ac195027b1..cf2fc0cc5a 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -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 diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 4250533f62..a1c26159d9 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -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 diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index b6b3d3c094..cdeebba55b 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -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(plain(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) ]") -) +select(a >= b) := select(b <= a) ]")) (defun calc-JumpRules () "JumpRules" @@ -87,8 +85,7 @@ plain(y = a ^ select(2)) := select(sqrt(y)) = a, 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 @@ tanh(select(a + b)) := (tanh(select(a)) + tanh(b)) / 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 @@ select(log(a,x)) / log(b,x) := select(log(a, b)), 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), 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), 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 @@ thecoefs(x, [z, 0, c]) := thefactors(x, [rz + rc x, rz - rc x]) :: 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 @@ thecoefs(x, [z, 0, c]) := thefactors(x, [rz + rc x, rz - rc x]) 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 @@ fitsystem(y, xv, pv, 0) := fitsystem(y, xv, cons(fvh,fvt)) :: 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 diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index 16e7fe9cc9..139440e248 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -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 diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index 155be891c5..dc37922ccc 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -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 diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index 425cad4750..c087ff38a8 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -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 diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index e2a42d9282..bbf520dcae 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -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 @@ With a prefix, push that prefix as a number onto the stack." (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 @@ With a prefix, push that prefix as a number onto the stack." (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 @@ With a prefix, push that prefix as a number onto the stack." (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 @@ With a prefix, push that prefix as a number onto the stack." (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 @@ With a prefix, push that prefix as a number onto the stack." (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 @@ With a prefix, push that prefix as a number onto the stack." 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 @@ With a prefix, push that prefix as a number onto the stack." (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 @@ With a prefix, push that prefix as a number onto the stack." (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 @@ With a prefix, push that prefix as a number onto the stack." 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 @@ With a prefix, push that prefix as a number onto the stack." (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 diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index e208140f99..8111424460 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -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 diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index 52ef7d48cd..5f545a51fa 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -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 diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index bd6ab2e667..772004c42f 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -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 diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index c08f875fcf..e6d4b86ad1 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -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 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (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 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (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 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (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 @@ To cancel the edit, simply kill the *Calc Edit* buffer." 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 diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index a489274d13..839cc25fee 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -922,7 +922,6 @@ calc-shift-Y-prefix-help calc-tutorial calcDigit-letter report-calc-bug) )) - ) (calc-init-base) @@ -947,8 +946,7 @@ report-calc-bug) (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 @@ report-calc-bug) (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 @@ report-calc-bug) (char-to-string (cdr key))))) "" prompt2))) (use-global-map glob) - (use-local-map loc)))) -) + (use-local-map loc))))) @@ -1065,8 +1061,7 @@ Notations: 3.14e6 3.14 * 10^6 (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 @@ Notations: 3.14e6 3.14 * 10^6 (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 @@ commands given here will actually operate on the *Calculator* stack." (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 @@ commands given here will actually operate on the *Calculator* stack." (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 @@ commands given here will actually operate on the *Calculator* stack." (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 @@ commands given here will actually operate on the *Calculator* stack." (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 @@ commands given here will actually operate on the *Calculator* stack." (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 @@ In this mode, click on the Calc \"buttons\" using the left mouse button. 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 @@ Or, position the cursor manually and do M-x calc-keypad-press." 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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." 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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 @@ See calc-keypad for details." (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 mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 mouse is pressed in Calc window, push cut buffer contents onto the stack." (if (interactive-p) (calc-do-refresh) (calc-refresh)))))))) - calc-trail-buffer -) + calc-trail-buffer) (defun calc-trail-here () (interactive) @@ -1886,8 +1843,7 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." ((= 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (= nn 1) (calc-top-selected 1 1)) (calc-delete-selection 1) - (calc-pop-stack nn)))))) -) + (calc-pop-stack nn))))))) @@ -2042,8 +1988,7 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (>= 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 mouse is pressed in Calc window, push cut buffer contents onto the stack." (if (= (calc-minibuffer-size) 0) (progn (setq last-command-char 13) - (calcDigit-nondigit))) -) + (calcDigit-nondigit)))) @@ -2401,8 +2342,7 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." ((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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." ((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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." ((= 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (* 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (/ 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (- (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (nconc a b) a))) a) - b) -) + b)) (defun math-sub-bignum (a b) ; [l l l] (if b @@ -2735,8 +2658,7 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." 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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." "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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." "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 @@ Also looks for the equivalent TeX words, \\gets and \\evalto." ;;;###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 @@ Also looks for the equivalent TeX words, \\gets and \\evalto." (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 @@ Also looks for the equivalent TeX words, \\gets and \\evalto." (if calc-always-load-extensions (progn (calc-extensions) - (calc-load-everything)) -) + (calc-load-everything))) (run-hooks 'calc-load-hook) - +;;; calc.el ends here diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index d748c98fe1..c7957feb3d 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -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 diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index bb04ef900f..1b2b2b8f34 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -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 diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 7d24794c85..3d5cc6ab74 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -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 diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index d1e92ab680..84733b8152 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -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 -- cgit v1.2.3