daveg@near.cs.caltech.edu (Dave Gillespie) (08/07/90)
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 <calc.patch", where "calc.patch" is the name of this file.
You will want to re-byte-compile both parts, and re-format the
manual, as explained in the calc-INSTALL file.
This is part 2 of 2 patches. You must apply both in order to
complete the upgrade to version 1.04.
These patches do not cover the README file, but the interesting
part of that file (the revision history) is now present near the
top of calc.el. The INSTALL file is now being included in the
patches under the name calc-INSTALL.
Note that some patches will add to the list of "autoload" commands
recommended in the calc-INSTALL file.
Patches and complete tar files are also available from anonymous FTP
on csvax.cs.caltech.edu [131.215.131.131], in the "pub" subdirectory.
Enjoy!
-- Dave
Dave Gillespie
256-80 Caltech, Pasadena CA 91125
daveg@csvax.cs.caltech.edu, ...!cit-vax!daveg
*** calc-ext.el Tue Jun 26 20:53:30 1990
--- ../dist/calc-ext.el Mon Aug 6 14:54:45 1990
***************
*** 1,4 ****
! ;; Calculator for GNU Emacs version 1.03, part II
;; Copyright (C) 1990 Dave Gillespie
;; This file is part of GNU Emacs.
--- 1,4 ----
! ;; Calculator for GNU Emacs version 1.04, part II
;; Copyright (C) 1990 Dave Gillespie
;; This file is part of GNU Emacs.
***************
*** 19,24 ****
--- 19,25 ----
;; and this notice must be preserved on all copies.
+ ;;;; [calc-ext.el]
(provide 'calc-ext)
***************
*** 41,47 ****
! (progn
(define-key calc-mode-map ":" 'calc-fdiv)
(define-key calc-mode-map "\\" 'calc-idiv)
(define-key calc-mode-map "|" 'calc-concat)
--- 42,50 ----
! ;;; The following was made a function so that it could be byte-compiled.
! (defun calc-init-extensions ()
!
(define-key calc-mode-map ":" 'calc-fdiv)
(define-key calc-mode-map "\\" 'calc-idiv)
(define-key calc-mode-map "|" 'calc-concat)
***************
*** 120,130 ****
(define-key calc-mode-map "bc" 'calc-clip)
(define-key calc-mode-map "bd" 'calc-diff)
(define-key calc-mode-map "bl" 'calc-lshift-binary)
(define-key calc-mode-map "bn" 'calc-not)
(define-key calc-mode-map "bo" 'calc-or)
(define-key calc-mode-map "br" 'calc-rshift-binary)
! (define-key calc-mode-map "bR" 'calc-rotate-binary)
! (define-key calc-mode-map "bs" 'calc-shift-binary)
(define-key calc-mode-map "bw" 'calc-word-size)
(define-key calc-mode-map "bx" 'calc-xor)
--- 123,134 ----
(define-key calc-mode-map "bc" 'calc-clip)
(define-key calc-mode-map "bd" 'calc-diff)
(define-key calc-mode-map "bl" 'calc-lshift-binary)
+ (define-key calc-mode-map "bL" 'calc-lshift-arith)
(define-key calc-mode-map "bn" 'calc-not)
(define-key calc-mode-map "bo" 'calc-or)
(define-key calc-mode-map "br" 'calc-rshift-binary)
! (define-key calc-mode-map "bR" 'calc-rshift-arith)
! (define-key calc-mode-map "bt" 'calc-rotate-binary)
(define-key calc-mode-map "bw" 'calc-word-size)
(define-key calc-mode-map "bx" 'calc-xor)
***************
*** 320,330 ****
--- 324,338 ----
(define-key calc-mode-map "Z=" 'calc-kbd-report)
(define-key calc-mode-map "Z#" 'calc-kbd-query)
+ ;;;; (Autoloads here)
+
)
+ (calc-init-extensions)
+
;;;; Miscellaneous.
(defun calc-record-message (tag &rest args)
***************
*** 501,506 ****
--- 509,517 ----
)
+
+ ;;;; [calc-forms.el]
+
(defun calc-time ()
"Push the current time of day on the stack as an HMS form.
\(Why? Why not!)"
***************
*** 518,523 ****
--- 529,536 ----
+ ;;;; [calc-incom.el]
+
;;; Incomplete forms.
(defun calc-begin-complex ()
***************
*** 698,703 ****
--- 711,718 ----
+ ;;;; [calc-undo.el]
+
;;; Undo.
(defun calc-undo (n)
***************
*** 832,837 ****
--- 847,854 ----
+ ;;;; [calc-arith.el]
+
;;; Arithmetic.
(defun calc-min (arg)
***************
*** 855,860 ****
--- 872,879 ----
(calc-unary-op "abs" 'calcFunc-abs arg))
)
+ ;;;; [calc-math.el]
+
(defun calc-sqrt (arg)
"Take the square root of the top element of the Calculator stack."
(interactive "P")
***************
*** 864,869 ****
--- 883,890 ----
(calc-unary-op "sqrt" 'calcFunc-sqrt arg)))
)
+ ;;;; [calc-arith.el]
+
(defun calc-idiv (arg)
"Compute the integer quotient of the top two elements of the stack."
(interactive "P")
***************
*** 871,876 ****
--- 892,899 ----
(calc-binary-op "\\" 'calcFunc-idiv arg 1))
)
+ ;;;; [calc-frac.el]
+
(defun calc-fdiv (arg)
"Compute the quotient (in fraction form) of the top two elements of the stack."
(interactive "P")
***************
*** 878,883 ****
--- 901,908 ----
(calc-binary-op ":" 'calcFunc-fdiv arg 1))
)
+ ;;;; [calc-arith.el]
+
(defun calc-floor (arg)
"Truncate to an integer (toward minus infinity) the top element of the stack.
With Inverse flag, truncates toward plus infinity.
***************
*** 922,927 ****
--- 947,973 ----
(calc-round arg)
)
+ (defun calc-mant-part (arg)
+ "Extract the mantissa part of a floating-point number."
+ (interactive "P")
+ (calc-slow-wrapper
+ (calc-unary-op "mant" 'calcFunc-mant arg))
+ )
+
+ (defun calc-xpon-part (arg)
+ "Extract the exponent part of a floating-point number."
+ (interactive "P")
+ (calc-slow-wrapper
+ (calc-unary-op "xpon" 'calcFunc-xpon arg))
+ )
+
+ (defun calc-scale-float (arg)
+ "Scale a floating-point number by an integer power of ten."
+ (interactive "P")
+ (calc-slow-wrapper
+ (calc-binary-op "scal" 'calcFunc-scf arg))
+ )
+
(defun calc-abssqr (arg)
"Compute the absolute value squared of the top element of the stack."
(interactive "P")
***************
*** 929,934 ****
--- 975,982 ----
(calc-unary-op "absq" 'calcFunc-abssqr arg))
)
+ ;;;; [calc-cplx.el]
+
(defun calc-argument (arg)
"Compute the complex argument of the top element of the Calculator stack."
(interactive "P")
***************
*** 950,955 ****
--- 998,1005 ----
(calc-unary-op "im" 'calcFunc-im arg))
)
+ ;;;; [calc-math.el]
+
(defun calc-hypot (arg)
"Take the square root of sum of squares of the top two elements of the stack."
(interactive "P")
***************
*** 1174,1179 ****
--- 1224,1231 ----
+ ;;;; [calc-store.el]
+
;;; Memory commands.
(defun calc-store (n &optional var oper)
***************
*** 1340,1345 ****
--- 1392,1399 ----
+ ;;;; [calc-yank.el]
+
;;; Kill ring commands.
(defun calc-kill (nn &optional no-delete)
***************
*** 1574,1580 ****
((> 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.
--
Dave Gillespie
256-80 Caltech Pasadena CA USA 91125
daveg@csvax.cs.caltech.edu, ...!cit-vax!daveg