From bacchus.pa.dec.com!decwrl!uunet!allbery Sat Aug 11 12:19:59 PDT 1990 Article 1772 of comp.sources.misc: Path: bacchus.pa.dec.com!decwrl!uunet!allbery From: daveg@csvax.cs.caltech.edu (David Gillespie) Newsgroups: comp.sources.misc Subject: v14i051: Patch for GNU Emacs Calc, version 1.03 -> 1.04, part 2/2 Message-ID: <100622@uunet.UU.NET> Date: 10 Aug 90 00:45:08 GMT Sender: allbery@uunet.UU.NET Lines: 2011 Approved: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Posting-number: Volume 14, Issue 51 Submitted-by: daveg@csvax.cs.caltech.edu (David Gillespie) Archive-name: gmcalc/patch04 The following patches convert Calc version 1.03 into Calc version 1.04. To apply them automatically with Patch v2.0, first cd into your Calc distribution directory, then execute "patch -p0 n 0) (calc-cursor-stack-index n) (setq top (point)) ! (calc-cursor-stack-index (1- n)) (setq bot (point))) ((< n 0) (calc-cursor-stack-index (- n)) --- 1628,1634 ---- ((> n 0) (calc-cursor-stack-index n) (setq top (point)) ! (calc-cursor-stack-index 0) (setq bot (point))) ((< n 0) (calc-cursor-stack-index (- n)) *************** *** 1675,1682 **** (switch-to-buffer (get-buffer-create "*Calc Edit*")) (if (and (< (window-width) (screen-width)) calc-display-trail) ! (let* ((trail (get-buffer-create "*Calc Trail*")) ! (win (get-buffer-window trail))) (if win (delete-window win)))) (set-buffer-modified-p nil) --- 1729,1735 ---- (switch-to-buffer (get-buffer-create "*Calc Edit*")) (if (and (< (window-width) (screen-width)) calc-display-trail) ! (let ((win (get-buffer-window (calc-trail-buffer)))) (if win (delete-window win)))) (set-buffer-modified-p nil) *************** *** 1732,1737 **** --- 1785,1792 ---- + ;;;; [calc-ext.el] + ;;; Algebra commands. (defun calc-a-prefix-help () *************** *** 1739,1748 **** (calc-do-prefix-help '("Simplify, Extended-simplify; eXpand, Collect" "Derivative, Integral, Taylor; suBstitute; Rewrite" ! "SHIFT + Solve; Integral-limit") "algebra" ?a) ) (defun calc-simplify () "Simplify the formula on top of the stack." (interactive) --- 1794,1807 ---- (calc-do-prefix-help '("Simplify, Extended-simplify; eXpand, Collect" "Derivative, Integral, Taylor; suBstitute; Rewrite" ! "SHIFT + Solve; Integral-limit" ! "relations: =, # (not =), <, >, [ (< or =), ] (> or =)" ! "logical: & (and), | (or), ! (not); misc: { (in-set)") "algebra" ?a) ) + ;;;; [calc-alg.el] + (defun calc-simplify () "Simplify the formula on top of the stack." (interactive) *************** *** 1859,1864 **** --- 1918,1925 ---- (calc-enter-result n "rwrt" (math-rewrite expr rules many)))) ) + ;;;; [calc-alg-2.el] + (defun calc-derivative (var) "Differentiate the formula on top of the stack with respect to a variable. If you enter a blank line, top of stack is the variable, next-to-top is expr. *************** *** 1951,1956 **** --- 2012,2019 ---- ) + ;;;; [calc-prog.el] + (defun calc-equal-to (arg) "Return 1 if numbers are equal, 0 if they are unequal." (interactive "P") *************** *** 2025,2030 **** --- 2088,2095 ---- + ;;;; [calc-ext.el] + ;;; b-prefix binary commands. (defun calc-b-prefix-help () *************** *** 2031,2040 **** (interactive) (calc-do-prefix-help '("And, Or, Xor, Diff, Not; Wordsize, Clip" ! "Lshift, Rshift-logical, rShift-arith; SHIFT + Rotate") "binary" ?b) ) (defun calc-and (n) "Compute the bitwise binary AND of the top two elements on the stack." (interactive "P") --- 2096,2107 ---- (interactive) (calc-do-prefix-help '("And, Or, Xor, Diff, Not; Wordsize, Clip" ! "Lshift, Rshift, roTate; SHIFT + signed Lshift, Rshift") "binary" ?b) ) + ;;;; [calc-bin.el] + (defun calc-and (n) "Compute the bitwise binary AND of the top two elements on the stack." (interactive "P") *************** *** 2087,2105 **** (and n (list (prefix-numeric-value n)))))) ) - (defun calc-shift-binary (n) - "Shift the top element on the stack one bit right in binary (arithmetically). - With a numeric prefix argument, shift N bits left. - With a negative prefix argument, arithmetically shift -N bits right. - The result is clipped to the current word size." - (interactive "P") - (calc-slow-wrapper - (calc-enter-result 1 "ash" - (append '(calcFunc-ash) - (calc-top-list-n 1) - (and n (list (prefix-numeric-value n)))))) - ) - (defun calc-lshift-binary (n) "Shift the top element on the stack one bit left in binary. With a numeric prefix argument, shift N bits left. --- 2154,2159 ---- *************** *** 2114,2120 **** ) (defun calc-rshift-binary (n) ! "Shift the top element on the Calculator stack one bit right in binary. With a numeric prefix argument, logically shift N bits right. With a negative prefix argument, shift -N bits left. The result is clipped to the current word size." --- 2168,2174 ---- ) (defun calc-rshift-binary (n) ! "Shift the top element on the stack one bit right in binary (logically). With a numeric prefix argument, logically shift N bits right. With a negative prefix argument, shift -N bits left. The result is clipped to the current word size." *************** *** 2126,2131 **** --- 2180,2211 ---- (and n (list (prefix-numeric-value n)))))) ) + (defun calc-lshift-arith (n) + "Shift the top element on the stack one bit left in binary. + With a numeric prefix argument, shift N bits left. + With a negative prefix argument, arithmetically shift -N bits right. + The result is clipped to the current word size." + (interactive "P") + (calc-slow-wrapper + (calc-enter-result 1 "ash" + (append '(calcFunc-ash) + (calc-top-list-n 1) + (and n (list (prefix-numeric-value n)))))) + ) + + (defun calc-rshift-arith (n) + "Shift the top element on the stack one bit right in binary (arithmetically). + With a numeric prefix argument, arithmetically shift N bits right. + With a negative prefix argument, shift -N bits left. + The result is clipped to the current word size." + (interactive "P") + (calc-slow-wrapper + (calc-enter-result 1 "rash" + (append '(calcFunc-rash) + (calc-top-list-n 1) + (and n (list (prefix-numeric-value n)))))) + ) + (defun calc-rotate-binary (n) "Rotate the top element on the Calculator stack one bit left in binary. With a numeric prefix argument, rotate N bits left. *************** *** 2173,2178 **** --- 2253,2260 ---- + ;;;; [calc-ext.el] + ;;; Conversions. (defun calc-c-prefix-help () *************** *** 2226,2231 **** --- 2308,2315 ---- (calc-unary-op "flt" 'calcFunc-float arg)) ) + ;;;; [calc-frac.el] + (defun calc-fraction (arg) "Convert the top element of the Calculator stack to fractional form. For floating-point arguments, the fraction is exactly equivalent within *************** *** 2249,2254 **** --- 2333,2340 ---- (prefix-numeric-value (or arg 0)))))) ) + ;;;; [calc-forms.el] + (defun calc-to-hms (arg) "Convert the top element of the stack to hours-minutes-seconds form. Number is interpreted as degrees or radians according to current mode." *************** *** 2268,2273 **** --- 2354,2361 ---- (calc-to-hms arg) ) + ;;;; [calc-math.el] + (defun calc-to-degrees (arg) "Convert the top element of the stack from radians or HMS to degrees." (interactive "P") *************** *** 2282,2287 **** --- 2370,2377 ---- (calc-unary-op ">rad" 'calcFunc-rad arg)) ) + ;;;; [calc-cplx.el] + (defun calc-polar () "Convert the top element of the stack to polar complex form." (interactive) *************** *** 2295,2300 **** --- 2385,2392 ---- + ;;;; [calc-ext.el] + ;;; d-prefix mode commands. (defun calc-d-prefix-help () *************** *** 2309,2314 **** --- 2401,2408 ---- "display" ?d) ) + ;;;; [calc-bin.el] + (defun calc-radix (n) "Set the display radix for integers and rationals to N, from 2 to 36." (interactive "NDisplay radix (2-36): ") *************** *** 2355,2360 **** --- 2449,2456 ---- (calc-refresh)) ) + ;;;; [calc-mode.el] + (defun calc-line-numbering (n) "Toggle display of line numbers in the Calculator stack. With positive numeric prefix, turn mode on. *************** *** 2526,2531 **** --- 2622,2629 ---- (calc-refresh)) ) + ;;;; [calc-cplx.el] + (defun calc-complex-notation () "Set (x,y) notation for display of complex numbers." (interactive) *************** *** 2550,2555 **** --- 2648,2655 ---- (calc-refresh)) ) + ;;;; [calc-frac.el] + (defun calc-over-notation (fmt) "Set notation used for fractions. Argument should be one of :, ::, /, //, :/. \(During numeric entry, the : key is always used.)" *************** *** 2569,2574 **** --- 2669,2676 ---- (setq calc-frac-format (if n "//" "/"))) ) + ;;;; [calc-forms.el] + (defun calc-hms-notation (fmt) "Set notation used for hours-minutes-seconds values. Argument should be something like: hms, deg m s, o'\". *************** *** 2587,2592 **** --- 2689,2696 ---- (calc-refresh)) ) + ;;;; [calc-mode.el] + (defun calc-truncate-stack (n &optional rel) "Treat cursor line as \"top of stack\" for all further operations. Objects below this line are frozen, but still displayed." *************** *** 2651,2656 **** --- 2755,2762 ---- + ;;;; [calc-lang.el] + ;;; Alternate entry/display languages. (defun calc-set-language (lang &optional option no-refresh) *************** *** 2961,2966 **** --- 3067,3073 ---- ( If . calcFunc-if ) ( Im . calcFunc-im ) ( Inverse . calcFunc-inv ) + ( Integrate . calcFunc-integ ) ( Join . calcFunc-vconcat ) ( LCM . calcFunc-lcm ) ( Log . calcFunc-ln ) *************** *** 2998,3003 **** --- 3105,3112 ---- + ;;;; [calc-ext.el] + ;;; Combinatorics (defun calc-k-prefix-help () *************** *** 3009,3014 **** --- 3118,3125 ---- "combinatorics" ?k) ) + ;;;; [calc-comb.el] + (defun calc-gcd (arg) "Compute the GCD of the top two elements of the Calculator stack." (interactive "P") *************** *** 3202,3207 **** --- 3313,3320 ---- + ;;;; [calc-ext.el] + ;;; Mode commands. (defun calc-m-prefix-help () *************** *** 3213,3218 **** --- 3326,3333 ---- "mode" ?m) ) + ;;;; [calc-mode.el] + (defun calc-save-modes () "Save all mode variables' values in your .emacs file." (interactive) *************** *** 3361,3366 **** --- 3476,3483 ---- (message "Loading extensions package on demand only."))) ) + ;;;; [calc-math.el] + (defun calc-degrees-mode () "Set Calculator to use degrees for all angles." (interactive) *************** *** 3377,3382 **** --- 3494,3501 ---- (message "Angles measured in radians.")) ) + ;;;; [calc-forms.el] + (defun calc-hms-mode () "Set Calculator to use degrees-minutes-seconds for all angles." (interactive) *************** *** 3385,3390 **** --- 3504,3511 ---- (message "Angles measured in degrees-minutes-seconds.")) ) + ;;;; [calc-cplx.el] + (defun calc-polar-mode (n) "Toggle mode complex number preference between rectangular and polar forms." (interactive "P") *************** *** 3399,3404 **** --- 3520,3527 ---- (message "Preferred complex form is rectangular."))) ) + ;;;; [calc-frac.el] + (defun calc-frac-mode (n) "Toggle mode in which Calculator prefers fractions over floats. With positive prefix argument, sets mode on (fractions). *************** *** 3418,3423 **** --- 3541,3548 ---- + ;;;; [calc-ext.el] + ;;; Trail commands. (defun calc-t-prefix-help () *************** *** 3428,3433 **** --- 3553,3560 ---- "trail" ?t) ) + ;;;; [calc-trail.el] + (defun calc-trail-in () "Switch to the Calc Trail window." (interactive) *************** *** 3451,3458 **** (unwind-protect (, (append '(progn (set-buffer (calc-trail-display t)) - (or (eq major-mode 'calc-trail-mode) - (error "Calc Trail buffer is not usable")) (goto-char calc-trail-pointer)) body)) (set-buffer save-buf)))) --- 3578,3583 ---- *************** *** 3607,3612 **** --- 3732,3739 ---- + ;;;; [calc-ext.el] + ;;; Units commands. (defun calc-u-prefix-help () *************** *** 3618,3623 **** --- 3745,3752 ---- "units" ?u) ) + ;;;; [calc-units.el] + (defun calc-base-units () "Convert the value on the stack into \"base\" units, like m, g, and s." (interactive) *************** *** 3938,3943 **** --- 4067,4074 ---- + ;;;; [calc-ext.el] + ;;; Vector commands. (defun calc-v-prefix-help () *************** *** 3960,3965 **** --- 4091,4098 ---- (calc-binary-op "|" 'calcFunc-vconcat arg '(vec))) ) + ;;;; [calc-mode.el] + (defun calc-matrix-left-justify () "Left-justify elements of matrices." (interactive) *************** *** 4019,4024 **** --- 4152,4159 ---- (calc-refresh)) ) + ;;;; [calc-vec.el] + (defun calc-pack (n) "Pack the top two numbers on the Calculator stack into a complex number. Given a numeric prefix, pack the top N numbers into a vector. *************** *** 4087,4093 **** (interactive) (calc-wrapper (let ((num (calc-top))) ! (if (or (and (not (memq (car-safe num) '(cplx polar vec hms sdev mod))) (math-objvecp num)) (eq (car-safe num) 'var)) (error "Argument must be a vector, complex number, or HMS, error, or modulo form")) --- 4222,4229 ---- (interactive) (calc-wrapper (let ((num (calc-top))) ! (if (or (and (not (memq (car-safe num) '(frac float cplx polar vec hms ! sdev mod))) (math-objvecp num)) (eq (car-safe num) 'var)) (error "Argument must be a vector, complex number, or HMS, error, or modulo form")) *************** *** 4195,4200 **** --- 4331,4338 ---- (calc-binary-op "cros" 'calcFunc-cross arg)) ) + ;;;; [calc-mat.el] + (defun calc-mdet (arg) "Compute the determinant of the square matrix on the top of the stack." (interactive "P") *************** *** 4217,4222 **** --- 4355,4362 ---- (calc-unary-op "mlud" 'calcFunc-lud arg)) ) + ;;;; [calc-vec.el] + (defun calc-rnorm (arg) "Compute the row norm of the vector or matrix on the top of the stack. This is the maximum row-absolute-value-sum of the matrix. *************** *** 4267,4272 **** --- 4407,4414 ---- (calc-enter-result 1 "mcol" (list 'calcFunc-mcol (calc-top-n 1) n))))) ) + ;;;; [calc-map.el] + (defun calc-apply (&optional oper) "Apply an operator to the elements of a vector. For example, applying f to [1, 2, 3] produces f(1, 2, 3)." *************** *** 4509,4514 **** --- 4651,4661 ---- ( ?d 2 calcFunc-diff ) ( ?n 1 calcFunc-not ) ( ?c 1 calcFunc-clip ) + ( ?l 2 calcFunc-lsh ) + ( ?r 2 calcFunc-rsh ) + ( ?L 2 calcFunc-ash ) + ( ?R 2 calcFunc-rash ) + ( ?t 2 calcFunc-rot ) )) (defconst calc-c-oper-keys '( ( ?d 1 calcFunc-deg ) ( ?r 1 calcFunc-rad ) *************** *** 4554,4559 **** --- 4701,4708 ---- + ;;;; [calc-ext.el] + ;;; User menu. (defun calc-user-key-map () *************** *** 4639,4644 **** --- 4788,4795 ---- "user" ?Z) ) + ;;;; [calc-prog.el] + (defun calc-user-define () "Bind a Calculator command to a key sequence using the z prefix." (interactive) *************** *** 4911,4918 **** (progn (if (and (< (window-width) (screen-width)) calc-display-trail) ! (let* ((trail (get-buffer-create "*Calc Trail*")) ! (win (get-buffer-window trail))) (if win (delete-window win)))) (edit-kbd-macro (cdr def) prefix nil --- 5062,5068 ---- (progn (if (and (< (window-width) (screen-width)) calc-display-trail) ! (let ((win (get-buffer-window (calc-trail-buffer)))) (if win (delete-window win)))) (edit-kbd-macro (cdr def) prefix nil *************** *** 5633,5638 **** --- 5783,5790 ---- + ;;;; [calc-ext.el] + ;;;; Caches. (defmacro math-defcache (name init form) *************** *** 6031,6036 **** --- 6183,6190 ---- ) + ;;;; [calc-map.el] + ;;; Convert a variable name (as a formula) into a like-looking function name. (defun math-var-to-calcFunc (f) (if (eq (car-safe f) 'var) *************** *** 6085,6090 **** --- 6239,6246 ---- + ;;;; [calc-vec.el] + ;;;; Vectors. ;;; Return the dimensions of a matrix as a list. [l x] [Public] *************** *** 6138,6143 **** --- 6294,6301 ---- ) + ;;;; [calc-mat.el] + ;;; Coerce row vector A to be a matrix. [V V] (defun math-row-matrix (a) (if (and (Math-vectorp a) *************** *** 6155,6160 **** --- 6313,6320 ---- ) + ;;;; [calc-ext.el] + (defun calc-binary-op-fancy (name func arg ident unary) (let ((n (prefix-numeric-value arg))) (cond ((> n 1) *************** *** 6195,6200 **** --- 6355,6362 ---- ) + ;;;; [calc-vec.el] + ;;; Apply a function elementwise to vectors A and B. [O X O O] [Public] (defun math-map-vec-2 (f a b) (if (math-vectorp a) *************** *** 6227,6232 **** --- 6389,6396 ---- ) + ;;;; [calc-map.el] + ;;; Map a function over a vector symbolically. [Public] (defun math-symb-map (f mode args) (let* ((func (math-var-to-calcFunc f)) *************** *** 6307,6312 **** --- 6471,6478 ---- ) + ;;;; [calc-vec.el] + ;;; "Reduce" a function over a vector (left-associatively). [O X V] [Public] (defun math-reduce-vec (f a) (if (math-vectorp a) *************** *** 6347,6352 **** --- 6513,6520 ---- ) + ;;;; [calc-map.el] + ;;; Reduce a function over a vector symbolically. [Public] (defun calcFunc-reduce (func vec) (if (math-matrixp vec) *************** *** 6399,6404 **** --- 6567,6574 ---- ) + ;;;; [calc-mat.el] + ;;; Multiply matrix vector element lists A and B. [L L L] (defun math-mul-mats (a b) (and a *************** *** 6432,6437 **** --- 6602,6609 ---- ) + ;;;; [calc-vec.el] + ;;; Return the number of elements in vector V. [Public] (defun math-vec-length (v) (if (math-vectorp v) *************** *** 6680,6685 **** --- 6852,6859 ---- (fset 'calcFunc-histogram (symbol-function 'math-histogram)) + ;;;; [calc-mat.el] + (defun math-matrix-trace (mat) ; [Public] (if (math-square-matrixp mat) (math-matrix-trace-step 2 (1- (length mat)) mat (nth 1 (nth 1 mat))) *************** *** 6978,6983 **** --- 7152,7159 ---- (math-reject-arg m 'square-matrixp)) ) + ;;;; [calc-vec.el] + ;;; Compute a right-handed vector cross product. [O O O] [Public] (defun math-cross (a b) (if (and (eq (car-safe a) 'vec) *************** *** 6999,7004 **** --- 7175,7182 ---- + ;;;; [calc-forms.el] + ;;;; Hours-minutes-seconds forms. (defun math-normalize-hms (a) *************** *** 7092,7097 **** --- 7270,7277 ---- + ;;;; [calc-cplx.el] + ;;;; Complex numbers. (defun math-normalize-polar (a) *************** *** 7149,7154 **** --- 7329,7337 ---- ) + + ;;;; [calc-forms.el] + ;;;; Error forms. ;;; Build a standard deviation form. [X X X] *************** *** 7231,7236 **** --- 7414,7421 ---- + ;;;; [calc-arith.el] + ;;;; Arithmetic. (defun math-neg-fancy (a) *************** *** 7499,7504 **** --- 7684,7691 ---- (+ (nth 2 a) (nth 2 a))) ) + ;;;; [calc-forms.el] + (defun math-combine-intervals (a am b bm c cm d dm) (let (res) (if (= (setq res (math-compare a c)) 1) *************** *** 7512,7517 **** --- 7699,7706 ---- (math-make-intv (+ (if am 2 0) (if bm 1 0)) a b)) ) + ;;;; [calc-arith.el] + (defun math-mul-symb-fancy (a b) (or (and (Math-equal-int a 1) b) *************** *** 7574,7579 **** --- 7763,7770 ---- (list '* a b)) ) + ;;;; [calc-cplx.el] + (defun math-want-polar (a b) (cond ((eq (car-safe a) 'polar) (if (eq (car-safe b) 'cplx) *************** *** 7615,7620 **** --- 7806,7812 ---- (math-fix-circular (math-add a (math-two-pi)) 1))))) ) + ;;;; [calc-arith.el] (defun math-div-objects-fancy (a b) (cond ((and (Math-numberp a) (Math-numberp b)) *************** *** 7796,7801 **** --- 7988,7995 ---- (list '/ a b)) ) + ;;;; [calc-forms.el] + (defun math-div-mod (a b m) ; [R R R R] (Returns nil if no solution) (and (Math-integerp a) (Math-integerp b) (Math-integerp m) (let ((u1 1) (u3 b) (v1 0) (v3 m)) *************** *** 7823,7828 **** --- 8017,8024 ---- (math-make-intv 2 0 b)))) ) + ;;;; [calc-arith.el] + (defun math-pow-fancy (a b) (cond ((and (Math-numberp a) (Math-numberp b)) (cond ((and (eq (car-safe b) 'frac) *************** *** 7973,7978 **** --- 8169,8176 ---- val) ) + ;;;; [calc-bin.el] + (defvar math-power-of-2-cache (list 1 2 4 8 16 32 64 128 256 512 1024)) (defvar math-big-power-of-2-cache nil) (defun math-power-of-2 (n) ; [I I] [Public] *************** *** 8018,8023 **** --- 8216,8223 ---- + ;;;; [calc-math.el] + ;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public] ;;; This method takes advantage of the fact that Newton's method starting ;;; with an overestimate always works, even using truncating integer division! *************** *** 8085,8090 **** --- 8285,8292 ---- ) + ;;;; [calc-ext.el] + (defun math-inexact-result () (and calc-symbolic-mode (signal 'inexact-result nil)) *************** *** 8091,8096 **** --- 8293,8300 ---- ) + ;;;; [calc-math.el] + ;;; Compute the square root of a number. ;;; [T N] if possible, else [F N] if possible, else [C N]. [Public] (defun math-sqrt (a) *************** *** 8247,8252 **** --- 8451,8458 ---- + ;;;; [calc-arith.el] + ;;; Compute the minimum of two real numbers. [R R R] [Public] (defun math-min (a b) (if (and (consp a) (eq (car a) 'intv)) *************** *** 8382,8388 **** (t (math-reject-arg a 'numberp))) ) (defun calcFunc-ftrunc (a) ! (math-float (math-trunc a)) ) (defun math-floor-fancy (a) --- 8588,8596 ---- (t (math-reject-arg a 'numberp))) ) (defun calcFunc-ftrunc (a) ! (if (Math-messy-integerp a) ! a ! (math-float (math-trunc a))) ) (defun math-floor-fancy (a) *************** *** 8403,8409 **** (t (math-reject-arg a 'anglep))) ) (defun calcFunc-ffloor (a) ! (math-float (math-floor a)) ) ;;; Coerce A to be an integer (by truncation toward plus infinity). [I N] --- 8611,8619 ---- (t (math-reject-arg a 'anglep))) ) (defun calcFunc-ffloor (a) ! (if (Math-messy-integerp a) ! a ! (math-float (math-floor a))) ) ;;; Coerce A to be an integer (by truncation toward plus infinity). [I N] *************** *** 8432,8438 **** ) (fset 'calcFunc-ceil (symbol-function 'math-ceiling)) (defun calcFunc-fceil (a) ! (math-float (math-ceiling a)) ) ;;; Coerce A to be an integer (by rounding to nearest integer). [I N] [Public] --- 8642,8650 ---- ) (fset 'calcFunc-ceil (symbol-function 'math-ceiling)) (defun calcFunc-fceil (a) ! (if (Math-messy-integerp a) ! a ! (math-float (math-ceiling a))) ) ;;; Coerce A to be an integer (by rounding to nearest integer). [I N] [Public] *************** *** 8454,8463 **** ) (fset 'calcFunc-round (symbol-function 'math-round)) (defun calcFunc-fround (a) ! (math-float (math-round a)) ) ;;; Convert a real value to fractional form. [T R I; T R F] [Public] (defun math-to-fraction (a &optional tol) (or tol (setq tol 0)) --- 8666,8743 ---- ) (fset 'calcFunc-round (symbol-function 'math-round)) (defun calcFunc-fround (a) ! (if (Math-messy-integerp a) ! a ! (math-float (math-round a))) ) + ;;; Pull floating-point values apart into mantissa and exponent. + (defun math-mant-part (x) + (if (Math-realp x) + (if (or (Math-ratp x) + (eq (nth 1 x) 0)) + x + (list 'float (nth 1 x) (- 1 (math-numdigs (nth 1 x))))) + (calc-record-why 'realp x) + (list 'calcFunc-mant x)) + ) + (fset 'calcFunc-mant (symbol-function 'math-mant-part)) + + (defun math-xpon-part (x) + (if (Math-realp x) + (if (or (Math-ratp x) + (eq (nth 1 x) 0)) + 0 + (math-add (nth 2 x) (1- (math-numdigs (nth 1 x))))) + (calc-record-why 'realp x) + (list 'calcFunc-xpon x)) + ) + (fset 'calcFunc-xpon (symbol-function 'math-xpon-part)) + + (defun math-scale-float (x n) + (if (integerp n) + (cond ((= n 0) + x) + ((Math-integerp x) + (if (> n 0) + (math-scale-int x n) + (math-div x (math-scale-int 1 (- n))))) + ((eq (car x) 'frac) + (if (> n 0) + (math-make-frac (math-scale-int (nth 1 x) n) (nth 2 x)) + (math-make-frac (nth 1 x) (math-scale-int (nth 2 x) (- n))))) + ((eq (car x) 'float) + (math-make-float (nth 1 x) (+ (nth 2 x) n))) + ((memq (car x) '(cplx sdev)) + (math-normalize + (list (car x) + (math-scale-float (nth 1 x) n) + (math-scale-float (nth 2 x) n)))) + ((memq (car x) '(polar mod)) + (math-normalize + (list (car x) + (math-scale-float (nth 1 x) n) + (nth 2 x)))) + ((eq (car x) 'intv) + (math-normalize + (list (car x) + (nth 1 x) + (math-scale-float (nth 2 x) n) + (math-scale-float (nth 3 x) n)))) + (t + (calc-record-why 'realp x) + (list 'calcFunc-scf x n))) + (if (math-messy-integerp n) + (math-scale-float x (math-trunc n)) + (calc-record-why 'integerp n) + (list 'calcFunc-scf x n))) + ) + (fset 'calcFunc-scf (symbol-function 'math-scale-float)) + + + ;;;; [calc-frac.el] + ;;; Convert a real value to fractional form. [T R I; T R F] [Public] (defun math-to-fraction (a &optional tol) (or tol (setq tol 0)) *************** *** 8534,8539 **** --- 8814,8821 ---- ) + ;;;; [calc-ext.el] + (defun math-clean-number (a &optional prec) ; [X X S] [Public] (if prec (cond ((Math-messy-integerp prec) *************** *** 8565,8570 **** --- 8847,8854 ---- + ;;;; [calc-prog.el] + ;;;; Logical operations. (defun calcFunc-eq (a b) *************** *** 8762,8767 **** --- 9046,9053 ---- + ;;;; [calc-cplx.el] + ;;;; Complex numbers. (defun math-to-polar (a) ; [C N] [Public] *************** *** 8801,8806 **** --- 9087,9094 ---- ) (fset 'calcFunc-conj (symbol-function 'math-conj)) + ;;;; [calc-arith.el] + ;;; Compute the absolute value squared of A. [F N] [Public] (defun math-abssqr (a) (cond ((Math-realp a) *************** *** 8818,8823 **** --- 9106,9113 ---- ) (fset 'calcFunc-abssqr (symbol-function 'math-abssqr)) + ;;;; [calc-cplx.el] + ;;; Compute the complex argument of A. [F N] [Public] (defun math-cplx-arg (a) (cond ((Math-anglep a) *************** *** 8866,8871 **** --- 9156,9163 ---- + ;;;; [calc-math.el] + ;;;; Transcendental functions. ;;; All of these functions are defined on the complex plane. *************** *** 9744,9749 **** --- 10036,10043 ---- + ;;;; [calc-arith.el] + ;;;; Number theory. (defun calcFunc-idiv (a b) ; [I I I] [Public] *************** *** 9765,9770 **** --- 10059,10066 ---- (t (math-reject-arg a 'anglep))) ) + ;;;; [calc-frac.el] + (defun calcFunc-fdiv (a b) ; [R I I] [Public] (if (Math-num-integerp a) (if (Math-num-integerp b) *************** *** 9775,9780 **** --- 10071,10078 ---- (math-reject-arg a 'integerp)) ) + ;;;; [calc-comb.el] + (defun math-lcm (a b) (let ((g (math-gcd a b))) (if (Math-numberp g) *************** *** 10380,10385 **** --- 10678,10685 ---- + ;;;; [calc-bin.el] + ;;; Bitwise operations. (defun math-and (a b &optional w) ; [I I I] [Public] *************** *** 10601,10607 **** ) (fset 'calcFunc-rsh (symbol-function 'math-rshift-binary)) ! (defun math-shift-binary (a &optional n w) ; [I I] [Public] (if (or (null n) (not (Math-negp n))) (math-lshift-binary a n w) --- 10901,10907 ---- ) (fset 'calcFunc-rsh (symbol-function 'math-rshift-binary)) ! (defun math-lshift-arith (a &optional n w) ; [I I] [Public] (if (or (null n) (not (Math-negp n))) (math-lshift-binary a n w) *************** *** 10608,10614 **** (setq a (math-trunc a) n (if n (math-trunc n) 1)) (if (eq (car-safe a) 'mod) ! (math-binary-modulo-args 'math-shift-binary a n w) (setq w (if w (math-trunc w) calc-word-size)) (or (integerp w) (math-reject-arg w 'integerp)) --- 10908,10914 ---- (setq a (math-trunc a) n (if n (math-trunc n) 1)) (if (eq (car-safe a) 'mod) ! (math-binary-modulo-args 'math-lshift-arith a n w) (setq w (if w (math-trunc w) calc-word-size)) (or (integerp w) (math-reject-arg w 'integerp)) *************** *** 10617,10623 **** (or (Math-integerp n) (math-reject-arg n 'integerp)) (if (< w 0) ! (math-clip (math-shift-binary a n (- w)) w) (if (Math-integer-negp a) (setq a (math-clip a w))) (let ((two-to-sizem1 (math-power-of-2 (1- w))) --- 10917,10923 ---- (or (Math-integerp n) (math-reject-arg n 'integerp)) (if (< w 0) ! (math-clip (math-lshift-arith a n (- w)) w) (if (Math-integer-negp a) (setq a (math-clip a w))) (let ((two-to-sizem1 (math-power-of-2 (1- w))) *************** *** 10631,10638 **** (+ w n) w) sh)))))))) ) ! (fset 'calcFunc-ash (symbol-function 'math-shift-binary)) (defun math-rotate-binary (a &optional n w) ; [I I] [Public] (setq a (math-trunc a) n (if n (math-trunc n) 1)) --- 10931,10943 ---- (+ w n) w) sh)))))))) ) ! (fset 'calcFunc-ash (symbol-function 'math-lshift-arith)) + (defun math-rshift-arith (a &optional n w) ; [I I] [Public] + (math-lshift-arith a (math-neg (or n 1)) w) + ) + (fset 'calcFunc-rash (symbol-function 'math-rshift-arith)) + (defun math-rotate-binary (a &optional n w) ; [I I] [Public] (setq a (math-trunc a) n (if n (math-trunc n) 1)) *************** *** 10699,10704 **** --- 11004,11011 ---- + ;;;; [calc-ext.el] + ;;;; Algebra. ;;; Evaluate variables in an expression. *************** *** 10780,10785 **** --- 11087,11095 ---- ;;; The following is expanded out four ways for speed. (defun math-combine-prod (a b inva invb scalar-okay) (cond + ((or (and inva (Math-zerop a)) + (and invb (Math-zerop b))) + nil) ((and scalar-okay (Math-objvecp a) (Math-objvecp b)) (math-mul-or-div a b inva invb)) ((and (eq (car-safe a) '^) *************** *** 10863,10868 **** --- 11173,11180 ---- + ;;;; [calc-alg.el] + (setq math-living-dangerously nil) ; true if unsafe simplifications are okay. (defun math-simplify-extended (a) *************** *** 10900,10905 **** --- 11212,11219 ---- aa)) ) + ;;;; [calc-ext.el] + (defmacro math-defsimplify (funcs &rest code) "Define a simplification rule for the specified function. If FUNCS is a list of functions, the same rule is applied for each function. *************** *** 10922,10927 **** --- 11236,11243 ---- ) (put 'math-defsimplify 'lisp-indent-hook 1) + ;;;; [calc-alg.el] + (math-defsimplify (+ -) (math-simplify-plus)) *************** *** 11386,11391 **** --- 11702,11709 ---- (cons (car expr) (mapcar 'math-replace-variables (cdr expr)))) ) + ;;;; [calc-ext.el] + (defun math-is-true (expr) (and (Math-realp expr) (not (Math-zerop expr))) *************** *** 11394,11399 **** --- 11712,11719 ---- + ;;;; [calc-alg-2.el] + (defun math-derivative (expr) ; uses global values: deriv-var, deriv-total. (cond ((equal expr deriv-var) 1) *************** *** 12069,12074 **** --- 12389,12396 ---- (and high (list high))))) ) + ;;;; [calc-ext.el] + (defmacro math-defintegral (funcs &rest code) "Define an integration rule for the specified function. If FUNCS is a list of functions, the same rule is applied for each function. *************** *** 12112,12117 **** --- 12434,12441 ---- ) (put 'math-defintegral-2 'lisp-indent-hook 1) + ;;;; [calc-alg-2.el] + (math-defintegral calcFunc-inv (math-integral (math-div 1 u))) *************** *** 12624,12629 **** --- 12948,12955 ---- + ;;;; [calc-alg.el] + ;;; Simple operations on expressions. ;;; Return number of ocurrences of thing in expr, or nil if none. *************** *** 12863,12868 **** --- 13189,13196 ---- + ;;;; [calc-units.el] + ;;; Units operations. (defvar math-standard-units *************** *** 12873,12880 **** ( yd "3 ft" "Yard" ) ( mi "5280 ft" "Mile" ) ( au "1.495979e11 m" "Astronomical Unit" ) ! ( lyr "9.46052e15 m" "Light Year" ) ! ( pc "3.08568e16 m" "Parsec" ) ( nmi "1852 m" "Nautical Mile" ) ( fath "6 ft" "Fathom" ) ( u "1 um" "Micron" ) --- 13201,13208 ---- ( yd "3 ft" "Yard" ) ( mi "5280 ft" "Mile" ) ( au "1.495979e11 m" "Astronomical Unit" ) ! ( lyr "9460536207068016 m" "Light Year" ) ! ( pc "206264.80625 au" "Parsec" ) ( nmi "1852 m" "Nautical Mile" ) ( fath "6 ft" "Fathom" ) ( u "1 um" "Micron" ) *************** *** 12896,12902 **** ( cup "8 ozfl" "Cup" ) ( ozfl "2 tbsp" "Fluid Ounce" ) ( tbsp "3 tsp" "Tablespoon" ) ! ( tsp "4.92892 ml" "Teaspoon" ) ( galC "4.54609 l" "Canadian Gallon" ) ( galUK "4.546092 l" "UK Gallon" ) --- 13224,13230 ---- ( cup "8 ozfl" "Cup" ) ( ozfl "2 tbsp" "Fluid Ounce" ) ( tbsp "3 tsp" "Tablespoon" ) ! ( tsp "4.92892159375 ml" "Teaspoon" ) ( galC "4.54609 l" "Canadian Gallon" ) ( galUK "4.546092 l" "UK Gallon" ) *************** *** 13423,13428 **** --- 13751,13758 ---- (list '^ (math-to-standard-units a nil) pow)))) ) + ;;;; [calc-alg.el] + (defun math-to-simple-fraction (f) (or (and (eq (car-safe f) 'float) (or (and (>= (nth 2 f) 0) *************** *** 13435,13440 **** --- 13765,13772 ---- f) ) + ;;;; [calc-units.el] + (defun math-units-are-multiple (u n) (setq u (nth 4 u)) (while (and u (= (% (cdr (car u)) n) 0)) *************** *** 13592,13597 **** --- 13924,13931 ---- + ;;;; [calc-prog.el] + ;;;; User-programmability. ;;; Compiling Lisp-like forms to use the math library. *************** *** 13765,13771 **** '( (~= . math-nearly-equal) (% . math-mod) (lsh . math-lshift-binary) ! (ash . math-shift-binary) (logand . math-and) (logandc2 . math-diff) (logior . math-or) --- 14099,14105 ---- '( (~= . math-nearly-equal) (% . math-mod) (lsh . math-lshift-binary) ! (ash . math-lshift-arith) (logand . math-and) (logandc2 . math-diff) (logior . math-or) *************** *** 14174,14179 **** --- 14508,14515 ---- + ;;;; [calc-ext.el] + ;;; Nontrivial number parsing. (defun math-read-number-fancy (s) *************** *** 14322,14327 **** --- 14658,14665 ---- (list 'error exp-old-pos "Syntax error"))))) ) + ;;;; [calc-vec.el] + (defun math-read-brackets (space-sep close) (and space-sep (setq space-sep (not (math-check-for-commas)))) (math-read-token) *************** *** 14401,14406 **** --- 14739,14746 ---- mat ) + ;;;; [calc-ext.el] + (defun math-read-string () (let ((str (read-from-string (concat exp-data "\"")))) (or (and (= (cdr str) (1+ (length exp-data))) *************** *** 14538,14543 **** --- 14878,14885 ---- str)) ) + ;;;; [calc-bin.el] + (defvar math-max-digits-cache nil) (defun math-compute-max-digits (w r) (let* ((pair (+ (* r 100000) w)) *************** *** 14567,14590 **** log))) ) - (defun math-group-float (str) ; [X X] - (let* ((pt (or (string-match "[^0-9]" str) (length str))) - (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3)) - (i pt)) - (if (and (integerp calc-group-digits) (< calc-group-digits 0)) - (while (< (setq i (+ (1+ i) g)) (length str)) - (setq str (concat (substring str 0 i) - calc-group-char - (substring str i))))) - (setq i pt) - (while (> i g) - (setq i (- i g) - str (concat (substring str 0 i) - calc-group-char - (substring str i)))) - str) - ) - (defconst math-radix-digits ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" --- 14909,14914 ---- *************** *** 14665,14675 **** --- 14989,15021 ---- (math-format-radix-digit (% (cdr q) 16)))))) ) + ;;;; [calc-ext.el] + + (defun math-group-float (str) ; [X X] + (let* ((pt (or (string-match "[^0-9]" str) (length str))) + (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3)) + (i pt)) + (if (and (integerp calc-group-digits) (< calc-group-digits 0)) + (while (< (setq i (+ (1+ i) g)) (length str)) + (setq str (concat (substring str 0 i) + calc-group-char + (substring str i))))) + (setq i pt) + (while (> i g) + (setq i (- i g) + str (concat (substring str 0 i) + calc-group-char + (substring str i)))) + str) + ) + + + ;;;; [calc-comp.el] ;;; A "composition" has one of the following forms: ;;; *************** *** 15335,15340 **** --- 15681,15810 ---- ) + + + + + ;;;; [end] + + + ;;;; Splitting calc-ext.el into smaller parts. [Suggested by Juha Sarlin.] + + (defun calc-split (directory no-save) + "Split the file \"calc-ext.el\" into smaller parts for faster loading. + This should be done during installation of Calc only." + (interactive "DDirectory for resulting files: \nP") + (or (string-match "calc-ext.el" (buffer-file-name)) + (error "This command is for Calc installers only. (Refer to the documentation.)")) + (or (equal directory "") + (setq directory (file-name-as-directory (expand-file-name directory)))) + (and (or (get-buffer "calc-incom.el") + (file-exists-p (concat directory "calc-incom.el"))) + (error "calc-split has already been used!")) + (let (copyright-point + autoload-point + (start (point-marker)) + filename + (dest-buffer nil) + (done nil) + (func-list nil) + (cmd-list nil) + (file-list nil)) + (goto-char (point-min)) + (search-forward ";;;; (Autoloads here)\n") + (setq autoload-point (point-marker)) + (goto-char (point-min)) + (search-forward ";;;;") + (forward-char -4) + (setq copyright-point (point)) + (copy-file (buffer-file-name) "calc-old.el" t) + (while (not done) + (re-search-forward "^;;;; \\[\\(.*\\)\\]\n\\|^(defun \\|^(fset '") + (if (equal (buffer-substring (match-beginning 0) + (1+ (match-beginning 0))) + ";") + (progn + (setq filename (buffer-substring (match-beginning 1) + (match-end 1))) + (and dest-buffer + (progn + (append-to-buffer dest-buffer + start (match-beginning 0)) + (delete-region start (match-beginning 0)))) + (if (equal filename "end") + (progn + (delete-region (point) (point-max)) + (setq done t)) + (set-marker start (point)) + (setq dest-buffer (and (not (equal filename "calc-ext.el")) + (find-file-noselect + (concat directory filename)))) + (message "Splitting to %s..." filename) + (and dest-buffer + (save-excursion + (set-buffer dest-buffer) + (= (buffer-size) 0)) + (save-excursion + (append-to-buffer dest-buffer + (point-min) copyright-point) + (set-buffer dest-buffer) + (goto-char (point-min)) + (end-of-line) + (insert " [" filename "]") + (goto-char (point-max)) + (insert "\n" + ";; This file is autoloaded from calc-ext, which in turn is loaded from calc.\n" + "(require 'calc-ext)\n\n"))))) + (and dest-buffer + (let* ((name (progn + (looking-at "[^ \n]*") + (buffer-substring (match-beginning 0) + (match-end 0)))) + (interactive (and (not (string-match + "calcFunc-\\|math-" name)) + (save-excursion + (re-search-forward "^ *(") + (looking-at "interactive")))) + (which (if interactive 'cmd-list 'func-list)) + (small-filename (substring filename 0 -3)) + (found (or (assoc small-filename (symbol-value which)) + (car (set which + (cons (list small-filename) + (symbol-value which))))))) + (or (assoc filename file-list) + (setq file-list (cons (list filename) file-list))) + (setcdr found (cons (intern name) (cdr found))))))) + (goto-char autoload-point) + (insert " (let ((dir \"" directory "\"))\n" + " (mapcar (function (lambda (x)\n" + " (let ((file (concat dir (car x))))\n" + " (mapcar (function (lambda (func)\n" + " (autoload func file))) (cdr x)))))\n" + " '" (prin1-to-string func-list) ")\n" + " (mapcar (function (lambda (x)\n" + " (let ((file (concat dir (car x))))\n" + " (mapcar (function (lambda (cmd)\n" + " (autoload cmd file nil t))) (cdr x)))))\n" + " '" (prin1-to-string cmd-list) "))\n") + (fill-region autoload-point (point)) + (goto-char (point-min)) + (or no-save + (progn + (save-some-buffers t) + (if (y-or-n-p "Byte-compile all files? ") + (progn + (require 'calc) + (byte-compile-file "calc-ext.el") + (load-file "calc-ext.elc") + (mapcar (function + (lambda (x) + (byte-compile-file + (concat directory (car x))))) + file-list))))) + (message "Done.")) + ) + + ;;; Type C-x C-e at the beginning of this line before running calc-split.