daveg@csvax.cs.caltech.edu (David Gillespie) (10/15/90)
Posting-number: Volume 15, Issue 31
Submitted-by: daveg@csvax.cs.caltech.edu (David Gillespie)
Archive-name: calc-1.05/part04
#!/bin/sh
# this is part 4 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc.patch continued
#
CurArch=4
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
exit 1; fi
( read Scheck
if test "$Scheck" != $CurArch
then echo "Please unpack part $Scheck next!"
exit 1;
else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> calc.patch
X*** 265,293 ****
X (define-key calc-mode-map "vb" 'calc-build-vector)
X (define-key calc-mode-map "vc" 'calc-mcol)
X (define-key calc-mode-map "vd" 'calc-diag)
X! (define-key calc-mode-map "vh" 'calc-histogram)
X (define-key calc-mode-map "vi" 'calc-ident)
X (define-key calc-mode-map "vl" 'calc-vlength)
X (define-key calc-mode-map "vn" 'calc-rnorm)
X (define-key calc-mode-map "vp" 'calc-pack)
X (define-key calc-mode-map "vr" 'calc-mrow)
X! (define-key calc-mode-map "vs" 'calc-sort)
X (define-key calc-mode-map "vt" 'calc-transpose)
X (define-key calc-mode-map "vu" 'calc-unpack)
X (define-key calc-mode-map "vx" 'calc-index)
X (define-key calc-mode-map "vA" 'calc-apply)
X (define-key calc-mode-map "vC" 'calc-cross)
X (define-key calc-mode-map "vD" 'calc-mdet)
X! (define-key calc-mode-map "vI" 'calc-inv)
X (define-key calc-mode-map "vJ" 'calc-conj-transpose)
X (define-key calc-mode-map "vL" 'calc-mlud)
X (define-key calc-mode-map "vM" 'calc-map)
X (define-key calc-mode-map "vN" 'calc-cnorm)
X (define-key calc-mode-map "vR" 'calc-reduce)
X (define-key calc-mode-map "vT" 'calc-mtrace)
X (define-key calc-mode-map "v<" 'calc-matrix-left-justify)
X (define-key calc-mode-map "v=" 'calc-matrix-center-justify)
X (define-key calc-mode-map "v>" 'calc-matrix-right-justify)
X (define-key calc-mode-map "v," 'calc-vector-commas)
X (define-key calc-mode-map "v[" 'calc-vector-brackets)
X (define-key calc-mode-map "v{" 'calc-vector-braces)
X--- 387,425 ----
X (define-key calc-mode-map "vb" 'calc-build-vector)
X (define-key calc-mode-map "vc" 'calc-mcol)
X (define-key calc-mode-map "vd" 'calc-diag)
X! (define-key calc-mode-map "ve" 'calc-expand-vector)
X! (define-key calc-mode-map "vf" 'calc-vector-find)
X (define-key calc-mode-map "vi" 'calc-ident)
X (define-key calc-mode-map "vl" 'calc-vlength)
X+ (define-key calc-mode-map "vm" 'calc-mask-vector)
X (define-key calc-mode-map "vn" 'calc-rnorm)
X (define-key calc-mode-map "vp" 'calc-pack)
X (define-key calc-mode-map "vr" 'calc-mrow)
X! (define-key calc-mode-map "vs" 'calc-subvector)
X (define-key calc-mode-map "vt" 'calc-transpose)
X (define-key calc-mode-map "vu" 'calc-unpack)
X+ (define-key calc-mode-map "vv" 'calc-reverse-vector)
X (define-key calc-mode-map "vx" 'calc-index)
X (define-key calc-mode-map "vA" 'calc-apply)
X (define-key calc-mode-map "vC" 'calc-cross)
X (define-key calc-mode-map "vD" 'calc-mdet)
X! (define-key calc-mode-map "vG" 'calc-grade)
X! (define-key calc-mode-map "vH" 'calc-histogram)
X! (define-key calc-mode-map "vI" 'calc-inner-product)
X (define-key calc-mode-map "vJ" 'calc-conj-transpose)
X (define-key calc-mode-map "vL" 'calc-mlud)
X (define-key calc-mode-map "vM" 'calc-map)
X (define-key calc-mode-map "vN" 'calc-cnorm)
X+ (define-key calc-mode-map "vO" 'calc-outer-product)
X (define-key calc-mode-map "vR" 'calc-reduce)
X+ (define-key calc-mode-map "vS" 'calc-sort)
X (define-key calc-mode-map "vT" 'calc-mtrace)
X+ (define-key calc-mode-map "v&" 'calc-inv)
X (define-key calc-mode-map "v<" 'calc-matrix-left-justify)
X (define-key calc-mode-map "v=" 'calc-matrix-center-justify)
X (define-key calc-mode-map "v>" 'calc-matrix-right-justify)
X+ (define-key calc-mode-map "v." 'calc-full-vectors)
X+ (define-key calc-mode-map "v/" 'calc-break-vectors)
X (define-key calc-mode-map "v," 'calc-vector-commas)
X (define-key calc-mode-map "v[" 'calc-vector-brackets)
X (define-key calc-mode-map "v{" 'calc-vector-braces)
X***************
X*** 324,333 ****
X--- 456,494 ----
X (define-key calc-mode-map "Z=" 'calc-kbd-report)
X (define-key calc-mode-map "Z#" 'calc-kbd-query)
X
X+ (calc-init-prefixes)
X+
X+ (mapcar (function
X+ (lambda (x)
X+ (define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
X+ (define-key calc-mode-map (format "g%c" x) 'calc-select-part)))
X+ "123456789")
X+
X ;;;; (Autoloads here)
X
X )
X
X+ (defun calc-init-prefixes ()
X+ (if calc-shift-prefix
X+ (progn
X+ (aset calc-mode-map ?A (aref calc-mode-map ?a))
X+ (aset calc-mode-map ?B (aref calc-mode-map ?b))
X+ (aset calc-mode-map ?D (aref calc-mode-map ?d))
X+ (aset calc-mode-map ?F (aref calc-mode-map ?f))
X+ (aset calc-mode-map ?G (aref calc-mode-map ?g))
X+ (aset calc-mode-map ?J (aref calc-mode-map ?j))
X+ (aset calc-mode-map ?K (aref calc-mode-map ?k))
X+ (aset calc-mode-map ?M (aref calc-mode-map ?m)))
X+ (define-key calc-mode-map "A" 'calc-abs)
X+ (define-key calc-mode-map "B" 'calc-log)
X+ (define-key calc-mode-map "D" 'calc-redo)
X+ (define-key calc-mode-map "F" 'calc-floor)
X+ (define-key calc-mode-map "G" 'calc-argument)
X+ (define-key calc-mode-map "J" 'calc-conj)
X+ (define-key calc-mode-map "K" 'calc-call-last-kbd-macro)
X+ (define-key calc-mode-map "M" 'calc-more-recursion-depth))
X+ )
X+
X (calc-init-extensions)
X
X
X***************
X*** 335,340 ****
X--- 496,506 ----
X
X ;;;; Miscellaneous.
X
X+ (defun calc-clear-command-flag (f)
X+ (setq calc-command-flags (delq f calc-command-flags))
X+ )
X+
X+
X (defun calc-record-message (tag &rest args)
X (let ((msg (apply 'format args)))
X (message "%s" msg)
X***************
X*** 343,378 ****
X )
X
X
X (defun calc-do-prefix-help (msgs group key)
X! (if (cdr msgs)
X! (progn
X! (setq calc-prefix-help-phase
X! (if (eq this-command last-command)
X! (% (1+ calc-prefix-help-phase) (1+ (length msgs)))
X! 0))
X! (let ((msg (nth calc-prefix-help-phase msgs)))
X! (message "%s" (if msg
X! (concat group ": " msg ":"
X! (make-string
X! (- (apply 'max (mapcar 'length msgs))
X! (length msg)) 32)
X! " [MORE]"
X! (if key
X! (concat " " (char-to-string key) "-")
X! ""))
X! (format "%c-" key)))))
X! (setq calc-prefix-help-phase 0)
X! (if key
X! (if msgs
X! (message (concat group ": " (car msgs) ": "
X! (char-to-string key) "-"))
X! (message (concat group ": (none) " (char-to-string key) "-")))
X! (message (concat group ": " (car msgs)))))
X! (and key
X! (setq unread-command-char key))
X )
X (defvar calc-prefix-help-phase 0)
X
X
X
X
X--- 509,645 ----
X )
X
X
X+ (defun calc-normalize-fancy (val)
X+ (cond ((eq calc-simplify-mode 'binary)
X+ (let ((s (math-normalize val)))
X+ (if (math-realp s)
X+ (math-clip (math-round s))
X+ s)))
X+ ((eq calc-simplify-mode 'alg)
X+ (math-simplify val))
X+ ((eq calc-simplify-mode 'ext)
X+ (math-simplify-extended val))
X+ ((eq calc-simplify-mode 'units)
X+ (math-simplify-units val)))
X+ )
X+
X+
X (defun calc-do-prefix-help (msgs group key)
X! (if calc-full-help-flag
X! (list msgs group key)
X! (if (cdr msgs)
X! (progn
X! (setq calc-prefix-help-phase
X! (if (eq this-command last-command)
X! (% (1+ calc-prefix-help-phase) (1+ (length msgs)))
X! 0))
X! (let ((msg (nth calc-prefix-help-phase msgs)))
X! (message "%s" (if msg
X! (concat group ": " msg ":"
X! (make-string
X! (- (apply 'max (mapcar 'length msgs))
X! (length msg)) 32)
X! " [MORE]"
X! (if key
X! (concat " " (char-to-string key)
X! "-")
X! ""))
X! (if key (format "%c-" key) "")))))
X! (setq calc-prefix-help-phase 0)
X! (if key
X! (if msgs
X! (message (concat group ": " (car msgs) ": "
X! (char-to-string key) "-"))
X! (message (concat group ": (none) " (char-to-string key) "-")))
X! (message (concat group ": " (car msgs)))))
X! (and key
X! (setq unread-command-char key)))
X )
X (defvar calc-prefix-help-phase 0)
X
X+ ;;;; [calc-stuff.el]
X+
X+ (defun calc-full-help ()
X+ "Display all the `?' responses at once in the *Help* buffer."
X+ (interactive)
X+ (with-output-to-temp-buffer "*Help*"
X+ (let ((comma (1+ (string-match ", " calc-version))))
X+ (princ (format "%s\n %s.\n\n" (substring calc-version 0 comma)
X+ (substring calc-version comma))))
X+ (princ (substitute-command-keys "Type `\\[describe-mode]' for more detail.\n"))
X+ (princ "Or press `i' to read the full Calc manual on-line.\n\n")
X+ (princ "Basic keys:\n")
X+ (let* ((calc-full-help-flag t))
X+ (mapcar (function (lambda (x) (princ (format " %s\n" x)))) (calc-help))
X+ (mapcar (function (lambda (prefix)
X+ (let ((msgs (funcall prefix)))
X+ (princ (if (eq (nth 2 msgs) ?v)
X+ "\n`v' or `V' prefix (vector/matrix) keys: \n"
X+ (if (nth 2 msgs)
X+ (format "\n`%c' prefix (%s) keys:\n"
X+ (nth 2 msgs) (nth 1 msgs))
X+ (format "\n%s-modified keys:\n"
X+ (capitalize (nth 1 msgs))))))
X+ (mapcar (function (lambda (x)
X+ (princ (format " %s\n" x))))
X+ (car msgs)))))
X+ '(calc-inverse-prefix-help
X+ calc-hyperbolic-prefix-help
X+ calc-inv-hyp-prefix-help
X+ calc-a-prefix-help
X+ calc-b-prefix-help
X+ calc-c-prefix-help
X+ calc-d-prefix-help
X+ calc-f-prefix-help
X+ calc-g-prefix-help
X+ calc-j-prefix-help
X+ calc-k-prefix-help
X+ calc-m-prefix-help
X+ calc-t-prefix-help
X+ calc-u-prefix-help
X+ calc-v-prefix-help
X+ calc-shift-Z-prefix-help
X+ calc-z-prefix-help)))
X+ (print-help-return-message))
X+ )
X+
X+ (defun calc-inverse-prefix-help ()
X+ (interactive)
X+ (calc-do-prefix-help
X+ '("I + S (arcsin), C (arccos), T (arctan); Q (square)"
X+ "I + E (ln), L (exp), B (alog: B^X); f E (lnp1), f L (expm1)"
X+ "I + F (ceiling), R (truncate); a S (invert func)"
X+ "I + a m (match-not); c h (from-hms); k n (prev prime)"
X+ "I + f G (gamma-Q); f e (erfc); k B (etc., lower-tail dists)"
X+ "I + V S (reverse sort); V G (reverse grade)")
X+ "inverse" nil)
X+ )
X+
X+ (defun calc-hyperbolic-prefix-help ()
X+ (interactive)
X+ (calc-do-prefix-help
X+ '("H + S (sinh), C (cosh), T (tanh); E (exp10), L (log10)"
X+ "H + F (float floor), R (float round); P (constant \"e\")"
X+ "H + a d (total derivative); k c (permutations)"
X+ "H + k b (bern-poly), k e (euler-poly); k s (stirling-2)"
X+ "H + f G (gamma-g), f B (beta-B); V R (accumulate)"
X+ "H + v e (expand w/filler); V H (weighted histogram)"
X+ "H + a S (general solve eqn), j I (general isolate)"
X+ "H + a R (widen/root)")
X+ "hyperbolic" nil)
X+ )
X+
X+ (defun calc-inv-hyp-prefix-help ()
X+ (interactive)
X+ (calc-do-prefix-help
X+ '("I H + S (arcsinh), C (arccosh), T (arctanh)"
X+ "I H + E (log10), L (exp10); f G (gamma-G)"
X+ "I H + F (float ceiling), R (float truncate)"
X+ "I H + a S (general invert func)")
X+ "inverse-hyperbolic" nil)
X+ )
X+
X+ ;;;; [calc-ext.el]
X
X
X
X***************
X*** 381,391 ****
X--- 648,684 ----
X
X ;;; General.
X
X+ (defun calc-scroll-left (n)
X+ "Horizontally scroll one half-screen to the left."
X+ (interactive "P")
X+ (scroll-left (or n (/ (window-width) 2)))
X+ )
X+
X+ (defun calc-scroll-right (n)
X+ "Horizontally scroll one half-screen to the right."
X+ (interactive "P")
X+ (scroll-right (or n (/ (window-width) 2)))
X+ )
X+
X+
X+ (defun calc-precision (n)
X+ "Set current float precision for Calculator to N digits."
X+ (interactive "NPrecision: ")
X+ (calc-wrapper
X+ (if (< (prefix-numeric-value n) 3)
X+ (error "Precision must be at least 3 digits.")
X+ (setq calc-internal-prec (prefix-numeric-value n))
X+ (calc-record calc-internal-prec "prec"))
X+ (message "Floating-point precision is %d digits." calc-internal-prec))
X+ )
X+
X+
X (defun calc-inverse (&optional n)
X "Next Calculator operation is inverse."
X (interactive "P")
X (calc-wrapper
X (calc-set-command-flag 'keep-flags)
X+ (calc-set-command-flag 'no-align)
X (setq calc-inverse-flag (not calc-inverse-flag)
X prefix-arg n)
X (message (if calc-inverse-flag "Inverse..." "")))
X***************
X*** 406,411 ****
X--- 699,705 ----
X (interactive "P")
X (calc-wrapper
X (calc-set-command-flag 'keep-flags)
X+ (calc-set-command-flag 'no-align)
X (setq calc-hyperbolic-flag (not calc-hyperbolic-flag)
X prefix-arg n)
X (message (if calc-hyperbolic-flag "Hyperbolic..." "")))
X***************
X*** 422,427 ****
X--- 716,742 ----
X )
X
X
X+ (defmacro calc-with-default-simplification (body)
X+ (list 'let
X+ '((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num)))
X+ calc-simplify-mode)))
X+ body)
X+ )
X+
X+
X+ (defun calc-push (&rest vals)
X+ (calc-push-list vals)
X+ )
X+
X+ (defun calc-pop-push (n &rest vals)
X+ (calc-pop-push-list n vals)
X+ )
X+
X+ (defun calc-pop-push-record (n prefix &rest vals)
X+ (calc-pop-push-record-list n prefix vals)
X+ )
X+
X+
X (defun calc-evaluate (n)
X "Evaluate all variables in the expression on the top of the stack.
X With a numeric prefix argument, evaluate each of the top N stack elements."
X***************
X*** 465,470 ****
X--- 780,801 ----
X )
X
X
X+ (defun calc-realign (&optional num)
X+ "Realign Calc window with cursor and top-of-stack at the bottom."
X+ (interactive "P")
X+ (if num
X+ (progn
X+ (calc-check-stack num)
X+ (calc-cursor-stack-index num)
X+ (and calc-line-numbering
X+ (not calc-display-just)
X+ (forward-char 4)))
X+ (calc-wrapper))
X+ )
X+
X+
X+ ;;;; [calc-stuff.el]
X+
X (defun calc-num-prefix (n)
X "Use the number at the top of stack as the numeric prefix for the next command.
X With a prefix, push that prefix as a number onto the stack."
X***************
X*** 477,483 ****
X (setq num (math-trunc num)))
X (or (integerp num)
X (error "Argument must be a small integer"))
X! (calc-pop 1)
X (setq prefix-arg num)
X (message "%d-" num)))) ; a (lame) simulation of the real thing...
X )
X--- 808,814 ----
X (setq num (math-trunc num)))
X (or (integerp num)
X (error "Argument must be a small integer"))
X! (calc-pop-stack 1)
X (setq prefix-arg num)
X (message "%d-" num)))) ; a (lame) simulation of the real thing...
X )
X***************
X*** 509,514 ****
X--- 840,918 ----
X )
X
X
X+ (defun calc-explain-why (why)
X+ (let* ((pred (car why))
X+ (msg (cond ((not pred) "Wrong type of argument")
X+ ((stringp pred) pred)
X+ ((eq pred 'integerp) "Integer expected")
X+ ((eq pred 'natnump) "Nonnegative integer expected")
X+ ((eq pred 'fixnump) "Small integer expected")
X+ ((eq pred 'posp) "Positive number expected")
X+ ((eq pred 'negp) "Negative number expected")
X+ ((eq pred 'nonzerop) "Nonzero number expected")
X+ ((eq pred 'realp) "Real number expected")
X+ ((eq pred 'anglep) "Real number expected")
X+ ((eq pred 'hmsp) "HMS form expected")
X+ ((eq pred 'numberp) "Number expected")
X+ ((eq pred 'scalarp) "Number expected")
X+ ((eq pred 'vectorp) "Vector or matrix expected")
X+ ((eq pred 'numvecp) "Number or vector expected")
X+ ((eq pred 'square-matrixp) "Square matrix expected")
X+ ((eq pred 'objectp) "Number expected")
X+ ((eq pred 'constp) "Constant expected")
X+ ((eq pred 'range) "Argument out of range")
X+ (t (format "%s expected" pred))))
X+ (punc ": ")
X+ (calc-can-abbrev-vectors t))
X+ (while (setq why (cdr why))
X+ (and (car why)
X+ (setq msg (concat msg punc (if (stringp (car why))
X+ (car why)
X+ (math-format-flat-expr (car why) 0)))
X+ punc ", ")))
X+ (message "%s" msg))
X+ )
X+
X+ (defun calc-why ()
X+ "Explain why the last result was unusual."
X+ (interactive)
X+ (if (not (eq this-command last-command))
X+ (setq calc-which-why calc-why))
X+ (if calc-which-why
X+ (progn
X+ (calc-explain-why (car calc-which-why))
X+ (setq calc-which-why (cdr calc-which-why)))
X+ (if calc-why
X+ (progn
X+ (message "(No further explanations available)")
X+ (setq calc-which-why calc-why))
X+ (message "No explanations available")))
X+ )
X+ (setq calc-which-why nil)
X+
X+
X+ (defun calc-flush-caches ()
X+ "Clear all caches used internally by the Calculator, such as the values of
X+ pi and e. These values will be recomputed next time they are requested."
X+ (interactive)
X+ (calc-wrapper
X+ (setq math-lud-cache nil
X+ math-log2-cache nil
X+ math-max-digits-cache nil
X+ math-checked-rewrites nil
X+ math-integral-cache nil
X+ math-units-table nil
X+ math-graph-var-cache nil
X+ math-graph-data-cache nil)
X+ (mapcar (function (lambda (x) (set x -100))) math-cache-list)
X+ (message "All internal calculator caches have been reset."))
X+ )
X+
X+ ;;;; [calc-ext.el]
X+
X+ (setq math-cache-list nil)
X+
X+
X
X ;;;; [calc-forms.el]
X
X***************
X*** 537,543 ****
X "Begin entering a complex number in the Calculator."
X (interactive)
X (calc-wrapper
X! (if calc-algebraic-mode
X (calc-alg-entry "(")
X (calc-push (list 'incomplete calc-complex-mode))))
X )
X--- 941,947 ----
X "Begin entering a complex number in the Calculator."
X (interactive)
X (calc-wrapper
X! (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
X (calc-alg-entry "(")
X (calc-push (list 'incomplete calc-complex-mode))))
X )
X***************
X*** 569,575 ****
X "Begin entering a vector in the Calculator."
X (interactive)
X (calc-wrapper
X! (if calc-algebraic-mode
X (calc-alg-entry "[")
X (calc-push '(incomplete vec))))
X )
X--- 973,979 ----
X "Begin entering a vector in the Calculator."
X (interactive)
X (calc-wrapper
X! (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
X (calc-alg-entry "[")
X (calc-push '(incomplete vec))))
X )
X***************
X*** 613,623 ****
X '(0)
X (nthcdr (1- (length new)) new)))))
X (or allow-polar
X! (if (eq (nth 1 inc) 'polar)
X! (setq inc (append '(incomplete cplx) (cdr (cdr inc))))
X! (if (eq (nth 1 inc) 'intv)
X! (setq inc (append '(incomplete cplx)
X! (cdr (cdr (cdr inc))))))))
X (if (and (memq (nth 1 new) '(cplx polar))
X (> (length new) 4))
X (error "Too many components in complex number"))
X--- 1017,1027 ----
X '(0)
X (nthcdr (1- (length new)) new)))))
X (or allow-polar
X! (if (eq (nth 1 new) 'polar)
X! (setq new (append '(incomplete cplx) (cdr (cdr new))))
X! (if (eq (nth 1 new) 'intv)
X! (setq new (append '(incomplete cplx)
X! (cdr (cdr (cdr new))))))))
X (if (and (memq (nth 1 new) '(cplx polar))
X (> (length new) 4))
X (error "Too many components in complex number"))
X***************
X*** 658,664 ****
X calc-stack))) 'incomplete)
X (calc-end-vector)
X (calc-comma)
X! (let ((calc-algebraic-mode nil))
X (calc-begin-vector)))
X ((or (= (length inc) 2)
X (math-vectorp (nth 2 inc)))
X--- 1062,1069 ----
X calc-stack))) 'incomplete)
X (calc-end-vector)
X (calc-comma)
X! (let ((calc-algebraic-mode nil)
X! (calc-incomplete-algebraic-mode nil))
X (calc-begin-vector)))
X ((or (= (length inc) 2)
X (math-vectorp (nth 2 inc)))
X***************
X*** 672,677 ****
X--- 1077,1098 ----
X (list 'incomplete 'vec)))))))
X )
X
X+ (defun calc-digit-dots ()
X+ (if (eq calc-prev-char ?.)
X+ (progn
X+ (delete-backward-char 1)
X+ (if (calc-minibuffer-contains ".*\\.\\'")
X+ (delete-backward-char 1))
X+ (setq calc-prev-char 'dots
X+ last-command-char 32)
X+ (if calc-prev-prev-char
X+ (calcDigit-nondigit)
X+ (setq calc-digit-value nil)
X+ (exit-minibuffer)))
X+ ;; just ignore extra decimal point, anticipating ".."
X+ (delete-backward-char 1))
X+ )
X+
X (defun calc-dots ()
X "Separate parts of an interval form during entry with a \"..\" symbol."
X (interactive)
X***************
X*** 708,713 ****
X--- 1129,1143 ----
X (calc-find-first-incomplete (cdr stack) (1+ n))))
X )
X
X+ (defun calc-incomplete-error (a)
X+ (cond ((memq (nth 1 a) '(cplx polar))
X+ (error "Complex number is incomplete"))
X+ ((eq (nth 1 a) 'vec)
X+ (error "Vector is incomplete"))
X+ ((eq (nth 1 a) 'intv)
X+ (error "Interval form is incomplete"))
X+ (t (error "Object is incomplete")))
X+ )
X
X
X
X***************
X*** 755,761 ****
X (let ((action (car list)))
X (cond
X ((eq (car action) 'push)
X! (calc-pop-stack 1 (nth 1 action)))
X ((eq (car action) 'pop)
X (calc-push-list (nth 2 action) (nth 1 action)))
X ((eq (car action) 'set)
X--- 1185,1191 ----
X (let ((action (car list)))
X (cond
X ((eq (car action) 'push)
X! (calc-pop-stack 1 (nth 1 action) t))
X ((eq (car action) 'pop)
X (calc-push-list (nth 2 action) (nth 1 action)))
X ((eq (car action) 'set)
X***************
X*** 847,856 ****
X
X
X
X! ;;;; [calc-arith.el]
X
X ;;; Arithmetic.
X
X (defun calc-min (arg)
X "Compute the minimum of the top two elements of the Calculator stack."
X (interactive "P")
X--- 1277,1299 ----
X
X
X
X! ;;;; [calc-ext.el]
X
X ;;; Arithmetic.
X
X+ (defun calc-f-prefix-help ()
X+ (interactive)
X+ (calc-do-prefix-help
X+ '("miN, maX; Hypot; Im, Re; Sign; [, ] (incr/decr)"
X+ "Gamma, Beta, Erf, besselJ, besselY"
X+ "SHIFT + int-sQrt; Int-log, Exp(x)-1, Ln(x+1); arcTan2"
X+ "SHIFT + Abssqr; Mantissa, eXponent, Scale"
X+ "SHIFT + incomplete: Gamma-P, Beta-I")
X+ "functions" ?f)
X+ )
X+
X+ ;;;; [calc-arith.el]
X+
X (defun calc-min (arg)
X "Compute the minimum of the top two elements of the Calculator stack."
X (interactive "P")
X***************
X*** 883,888 ****
X--- 1326,1341 ----
X (calc-unary-op "sqrt" 'calcFunc-sqrt arg)))
X )
X
X+ (defun calc-isqrt (arg)
X+ "Take the integer square root of the top element of the Calculator stack.
X+ This is the floor of the square root of the number, which must be an integer."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (if (calc-is-inverse)
X+ (calc-unary-op "^2" 'calcFunc-sqr arg)
X+ (calc-unary-op "isqt" 'calcFunc-isqrt arg)))
X+ )
X+
X ;;;; [calc-arith.el]
X
X (defun calc-idiv (arg)
X***************
X*** 975,980 ****
X--- 1428,1454 ----
X (calc-unary-op "absq" 'calcFunc-abssqr arg))
X )
X
X+ (defun calc-sign (arg)
X+ "Compute the sign of a number, either +1, -1, or 0."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (calc-unary-op "sign" 'calcFunc-sign arg))
X+ )
X+
X+ (defun calc-increment (arg)
X+ "Increment an integer, or increase a float by one unit in the last place."
X+ (interactive "p")
X+ (calc-wrapper
X+ (calc-enter-result 1 "incr" (list 'calcFunc-incr (calc-top-n 1) arg)))
X+ )
X+
X+ (defun calc-decrement (arg)
X+ "Decrement an integer, or decrease a float by one unit in the last place."
X+ (interactive "p")
X+ (calc-wrapper
X+ (calc-enter-result 1 "decr" (list 'calcFunc-decr (calc-top-n 1) arg)))
X+ )
X+
X ;;;; [calc-cplx.el]
X
X (defun calc-argument (arg)
X***************
X*** 1025,1039 ****
X )
X
X (defun calc-log (arg)
X! "Take the logarithm base B of X. B is top-of-stack, X is second-to-top.
X With Inverse flag, computes B^X. (Note that \"^\" would compute X^B.)"
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-inverse)
X! (calc-binary-op "Ilog" 'calcFunc-ilog arg)
X (calc-binary-op "log" 'calcFunc-log arg)))
X )
X
X (defun calc-lnp1 (arg)
X "Take the logarithm (ln(x+1)) of one plus the top element of the stack."
X (interactive "P")
X--- 1499,1523 ----
X )
X
X (defun calc-log (arg)
X! "Take the logarithm of X to base B. B is top-of-stack, X is second-to-top.
X With Inverse flag, computes B^X. (Note that \"^\" would compute X^B.)"
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-inverse)
X! (calc-binary-op "alog" 'calcFunc-alog arg)
X (calc-binary-op "log" 'calcFunc-log arg)))
X )
X
X+ (defun calc-ilog (arg)
X+ "Take the integer logarithm of X to base B. B is top-of-stack, X is second.
X+ The integer logarithm is the floor of the logarithm; X and B must be integers."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (if (calc-is-inverse)
X+ (calc-binary-op "alog" 'calcFunc-alog arg)
X+ (calc-binary-op "ilog" 'calcFunc-ilog arg)))
X+ )
X+
X (defun calc-lnp1 (arg)
X "Take the logarithm (ln(x+1)) of one plus the top element of the stack."
X (interactive "P")
X***************
X*** 1223,1228 ****
X--- 1707,1892 ----
X )
X
X
X+ ;;;; [calc-funcs.el]
X+
X+ (defun calc-inc-gamma (arg)
X+ "Compute the incomplete gamma function, gammaP(a,x).
X+ This is the definition for which P(a,0) = 0, P(a,infinity) = 1.
X+ With Inverse flag, compute the complement gammaQ(a,x) = 1 - gammaP(a,x).
X+ With Hyperbolic flag, unnormalized gammag(a,x) = gammaP(a,x) * gamma(a).
X+ With both flags, unnormalized gammaG(a,x) = gammaQ(a,x) * gamma(a)."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (if (calc-is-inverse)
X+ (if (calc-is-hyperbolic)
X+ (calc-binary-op "gamG" 'calcFunc-gammaG arg)
X+ (calc-binary-op "gamQ" 'calcFunc-gammaQ arg))
X+ (if (calc-is-hyperbolic)
X+ (calc-binary-op "gamg" 'calcFunc-gammag arg)
X+ (calc-binary-op "gamP" 'calcFunc-gammaP arg))))
X+ )
X+
X+ (defun calc-erf (arg)
X+ "Compute the error function, erf(x).
X+ With the Inverse flag, compute the complement erfc(x) = 1 - erf(x)."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (if (calc-is-inverse)
X+ (calc-unary-op "erfc" 'calcFunc-erfc arg)
X+ (calc-unary-op "erf" 'calcFunc-erf arg)))
X+ )
X+
X+ (defun calc-erfc (arg)
X+ "Compute the complementary error function, erfc(x)."
X+ (interactive "P")
X+ (calc-invert-func)
X+ (calc-erf arg)
X+ )
X+
X+ (defun calc-beta (arg)
X+ "Compute the beta function beta(a,b)."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (calc-binary-op "beta" 'calcFunc-beta arg))
X+ )
X+
X+ (defun calc-inc-beta ()
X+ "Compute the incomplete beta function betaI(x,a,b).
X+ With the Hyperbolic flag, unnormalized betaB(x,a,b) = betaI(x,a,b) beta(a,b)."
X+ (interactive)
X+ (calc-slow-wrapper
X+ (if (calc-is-hyperbolic)
X+ (calc-enter-result 3 "betB" (cons 'calcFunc-betaB (calc-top-list-n 3)))
X+ (calc-enter-result 3 "betI" (cons 'calcFunc-betaI (calc-top-list-n 3)))))
X+ )
X+
X+ (defun calc-bessel-J (arg)
X+ "Compute the Bessel function of the first kind J_n(x).
X+ Note that N can be any real, and X can be any complex number."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (calc-binary-op "besJ" 'calcFunc-besJ arg))
X+ )
X+
X+ (defun calc-bessel-Y (arg)
X+ "Compute the Bessel function of the second kind Y_n(x).
X+ Note that N can be any real, and X can be any complex number."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (calc-binary-op "besY" 'calcFunc-besY arg))
X+ )
X+
X+ (defun calc-bernoulli-number (arg)
X+ "Compute the Nth Bernoulli number.
X+ With Hyperbolic flag, top-of-stack is X, next-to-top is N; compute
X+ the Nth Bernoulli polynomial."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (if (calc-is-hyperbolic)
X+ (calc-binary-op "bern" 'calcFunc-bern arg)
X+ (calc-unary-op "bern" 'calcFunc-bern arg)))
X+ )
X+
X+ (defun calc-euler-number (arg)
X+ "Compute the Nth Euler number.
X+ With Hyperbolic flag, top-of-stack is X, next-to-top is N; compute
X+ the Nth Euler polynomial."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (if (calc-is-hyperbolic)
X+ (calc-binary-op "eulr" 'calcFunc-euler arg)
X+ (calc-unary-op "eulr" 'calcFunc-euler arg)))
X+ )
X+
X+ (defun calc-stirling-number (arg)
X+ "Compute the Stirling number of the first kind S(n,m).
X+ N and M are integers, with 0 <= M <= N.
X+ With Hyperbolic flag, compute the stirling number of the second kind."
X+ (interactive "P")
X+ (calc-slow-wrapper
X+ (if (calc-is-hyperbolic)
X+ (calc-binary-op "str2" 'calcFunc-stir2 arg)
X+ (calc-binary-op "str1" 'calcFunc-stir1 arg)))
X+ )
X+
X+ (defun calc-utpb ()
X+ "Compute the upper tail binomial probability distribution.
X+ This is the probability that a binomial random variable for N trails with
X+ probability P per trial greater than or equal to X. X is in top-of-stack;
X+ P is in next-to-top; N is at third level.
X+ The algebraic functional form is utpb(X,N,P).
X+ With Inverse flag, computes the lower tail distribution instead."
X+ (interactive)
X+ (calc-prob-dist "b" 3)
X+ )
X+
X+ (defun calc-utpc ()
X+ "Compute the upper tail Chi-square probability distribution.
X+ This is the probability that a Chi-square random variable with V degrees of
X+ freedom will be greater than X. X is in top-of-stack; V is in next-to-top.
X+ The algebraic functional form is utpc(X,V).
X+ With Inverse flag, computes the lower tail distribution instead."
X+ (interactive)
X+ (calc-prob-dist "c" 2)
X+ )
X+
X+ (defun calc-utpf ()
X+ "Compute the upper tail \"F\" probability distribution.
X+ This is the probability that an F-distributed random variable with V1 degrees
X+ of freedom in the numerator and V2 degrees of freedom in the denominator will
X+ be greater than X. X is in top-of-stack; V2 is in next-to-top; V1 is
X+ in level three.
X+ The algebraic functional form is utpf(X,V1,V2).
X+ With Inverse flag, computes the lower tail distribution instead."
X+ (interactive)
X+ (calc-prob-dist "f" 3)
X+ )
X+
X+ (defun calc-utpn ()
X+ "Compute the upper tail normal (Gaussian) probability distribution.
X+ This is the probability that a normal random variable with mean M and
X+ standard deviation S will be greater than X. X is in top-of-stack;
X+ S is in next-to-top; M is in level three.
X+ The algebraic functional form is utpn(X,M,S).
X+ With Inverse flag, computes the lower tail distribution instead."
X+ (interactive)
X+ (calc-prob-dist "n" 3)
X+ )
X+
X+ (defun calc-utpp ()
X+ "Compute the upper tail Poisson probability distribution.
X+ This is the probability that a Poisson random variable with mean M will
X+ be greater than X. X is in top-of-stack; M is in next-to-top.
X+ The algebraic functional form is utpb(X,M).
X+ With Inverse flag, computes the lower tail distribution instead."
X+ (interactive)
X+ (calc-prob-dist "p" 2)
X+ )
X+
X+ (defun calc-utpt ()
X+ "Compute the upper tail Student's \"t\" probability distribution.
X+ This is the probability that a Student's random variable with V degrees of
X+ freedom will be greater than T. T is in top-of-stack; V is in next-to-top.
X+ The algebraic functional form is utpb(T,V).
X+ With Inverse flag, computes the lower tail distribution instead."
X+ (interactive)
X+ (calc-prob-dist "t" 2)
X+ )
X+
X+ (defun calc-prob-dist (letter nargs)
X+ (calc-slow-wrapper
X+ (if (calc-is-inverse)
X+ (calc-enter-result nargs (concat "ltp" letter)
X+ (append (list (intern (concat "calcFunc-ltp" letter))
X+ (calc-top-n 1))
X+ (calc-top-list-n (1- nargs) 2)))
X+ (calc-enter-result nargs (concat "utp" letter)
X+ (append (list (intern (concat "calcFunc-utp" letter))
X+ (calc-top-n 1))
X+ (calc-top-list-n (1- nargs) 2)))))
X+ )
X+
X+
X
X ;;;; [calc-store.el]
X
X***************
X*** 1261,1267 ****
X (if (equal var "")
X ()
X (let* ((ivar (intern var))
X! (ival (if (boundp ivar) (symbol-value ivar) nil)))
X (if (null oper)
X (set ivar (calc-top 1))
X (if (null ival)
X--- 1925,1931 ----
X (if (equal var "")
X ()
X (let* ((ivar (intern var))
X! (ival (calc-var-value ivar)))
X (if (null oper)
X (set ivar (calc-top 1))
X (if (null ival)
X***************
X*** 1347,1355 ****
X (if (equal var "")
X ()
X (setq ivar (intern var))
X! (if (not (and (boundp ivar) ivar))
X! (error "No such variable"))
X! (let ((ival (symbol-value ivar)))
X (if (stringp ival)
X (setq ival (math-read-expr ival)))
X (if (eq (car-safe ival) 'error)
X--- 2011,2019 ----
X (if (equal var "")
X ()
X (setq ivar (intern var))
X! (let ((ival (calc-var-value ivar)))
X! (or ival
X! (error "No such variable"))
X (if (stringp ival)
X (setq ival (math-read-expr ival)))
X (if (eq (car-safe ival) 'error)
X***************
X*** 1389,1394 ****
X--- 2053,2068 ----
X (makunbound ivar)))))))
X )
X
X+ ;;;; [calc-ext.el]
X+
X+ (defun calc-var-value (v)
X+ (and (boundp v)
X+ (symbol-value v)
X+ (if (symbolp (symbol-value v))
X+ (set v (funcall (symbol-value v)))
X+ (symbol-value v)))
X+ )
X+
X
X
X
X***************
X*** 1508,1513 ****
X--- 2182,2189 ----
X (t s))
X )
X
X+ ;;;; [calc-ext.el]
X+
X (defun calc-grab-region (top bot arg)
X "Parse the region as a matrix of numbers and push it on the Calculator stack.
X This is intended to be used in a non-Calculator buffer!
X***************
X*** 1529,1551 ****
X brackets. If a stack-style line number (as in \"23: \") is present it is
X first removed."
X (interactive "r\nP")
X (and (memq major-mode '(calc-mode calc-trail-mode))
X (error "This command works only in a regular text buffer."))
X (let* ((col1 (save-excursion (goto-char top) (current-column)))
X (col2 (save-excursion (goto-char bot) (current-column)))
X (from-buffer (current-buffer))
X data mat vals lnum pt pos)
X! (if (= col1 col2)
X! (save-excursion
X! (or (= col1 0)
X! (error "Point and mark must be at beginning of line, or define a rectangle"))
X! (goto-char top)
X! (while (< (point) bot)
X! (setq pt (point))
X! (forward-line 1)
X! (setq data (cons (buffer-substring pt (1- (point))) data)))
X! (setq data (nreverse data)))
X! (setq data (extract-rectangle top bot)))
X (calc)
X (setq mat (list 'vec)
X lnum 0)
X--- 2205,2237 ----
X brackets. If a stack-style line number (as in \"23: \") is present it is
X first removed."
X (interactive "r\nP")
X+ (calc-do-grab-region top bot arg)
X+ )
X+
X+ ;;;; [calc-yank.el]
X+
X+ (defun calc-do-grab-region (top bot arg)
X (and (memq major-mode '(calc-mode calc-trail-mode))
X (error "This command works only in a regular text buffer."))
X (let* ((col1 (save-excursion (goto-char top) (current-column)))
X (col2 (save-excursion (goto-char bot) (current-column)))
X (from-buffer (current-buffer))
X+ (linear (consp arg))
X data mat vals lnum pt pos)
X! (if linear
X! (setq data (list (buffer-substring top bot))
X! arg -1)
X! (if (= col1 col2)
X! (save-excursion
X! (or (= col1 0)
X! (error "Point and mark must be at beginning of line, or define a rectangle"))
X! (goto-char top)
X! (while (< (point) bot)
X! (setq pt (point))
X! (forward-line 1)
X! (setq data (cons (buffer-substring pt (1- (point))) data)))
X! (setq data (nreverse data)))
X! (setq data (extract-rectangle top bot))))
X (calc)
X (setq mat (list 'vec)
X lnum 0)
X***************
X*** 1594,1600 ****
X data (cdr data)
X lnum (1+ lnum)))
X (calc-wrapper
X! (calc-enter-result 0 "grab" (nreverse mat))))
X )
X
X (defun calc-copy-to-buffer (nn)
X--- 2280,2286 ----
X data (cdr data)
X lnum (1+ lnum)))
X (calc-wrapper
X! (calc-enter-result 0 "grab" (if linear (car mat) (nreverse mat)))))
X )
X
X (defun calc-copy-to-buffer (nn)
X***************
X*** 1675,1688 ****
X With a zero prefix, edit all stack elements.
X Type RET or LFD or C-c C-c to finish editing."
X (interactive "p")
X! (calc-wrapper
X! (if (= n 0)
X (setq n (calc-stack-size)))
X! (if (< n 0)
X! (error "Argument must be positive or zero"))
X! (let ((list (mapcar (function (lambda (x) (math-format-flat-expr x 0)))
X! (calc-top-list n))))
X! (calc-edit-mode (list 'calc-finish-stack-edit n))
X (while list
X (insert (car list) "\n")
X (setq list (cdr list)))))
X--- 2361,2389 ----
X With a zero prefix, edit all stack elements.
X Type RET or LFD or C-c C-c to finish editing."
X (interactive "p")
X! (calc-slow-wrapper
X! (if (eq n 0)
X (setq n (calc-stack-size)))
X! (let* ((flag nil)
X! (list (mapcar (if (> n 1)
X! (function (lambda (x) (math-format-flat-expr x 0)))
X! (function
X! (lambda (x)
X! (math-format-nice-expr
X! (if (and (eq (car-safe x) 'var)
X! (calc-var-value (nth 2 x))
X! (not (eq (car-safe (calc-var-value
X! (nth 2 x)))
X! 'special-const)))
X! (progn
X! (setq flag (list 'quote (nth 2 x)))
X! (calc-var-value (nth 2 x)))
X! x)
X! (screen-width)))))
X! (if (> n 0)
X! (calc-top-list n)
X! (calc-top-list 1 (- n))))))
X! (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)))
X (while list
X (insert (car list) "\n")
X (setq list (cdr list)))))
X***************
X*** 1689,1704 ****
X (calc-show-edit-buffer)
X )
X
X (defvar calc-edit-mode-map nil "Keymap for use by the calc-edit command.")
X (if calc-edit-mode-map
X ()
X (setq calc-edit-mode-map (make-sparse-keymap))
X (define-key calc-edit-mode-map "\n" 'calc-edit-finish)
X! (define-key calc-edit-mode-map "\r" 'calc-edit-finish)
X (define-key calc-edit-mode-map "\C-c\C-c" 'calc-edit-finish)
X )
X
X! (defun calc-edit-mode (&optional handler)
X "Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
X To cancel the edit, simply kill the *Calc Edit* buffer."
X (interactive)
X--- 2390,2413 ----
X (calc-show-edit-buffer)
X )
X
X+ (defun calc-alg-edit (str)
X+ (calc-edit-mode '(calc-finish-stack-edit 0))
X+ (calc-show-edit-buffer)
X+ (insert str "\n")
X+ (backward-char 1)
X+ (calc-set-command-flag 'do-edit)
X+ )
X+
X (defvar calc-edit-mode-map nil "Keymap for use by the calc-edit command.")
X (if calc-edit-mode-map
X ()
X (setq calc-edit-mode-map (make-sparse-keymap))
X (define-key calc-edit-mode-map "\n" 'calc-edit-finish)
X! (define-key calc-edit-mode-map "\r" 'calc-edit-return)
X (define-key calc-edit-mode-map "\C-c\C-c" 'calc-edit-finish)
X )
X
X! (defun calc-edit-mode (&optional handler allow-ret)
X "Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
X To cancel the edit, simply kill the *Calc Edit* buffer."
X (interactive)
X***************
X*** 1720,1727 ****
X (setq calc-edit-handler handler)
X (make-local-variable 'calc-restore-trail)
X (setq calc-restore-trail calc-display-trail)
X (erase-buffer)
X! (insert "Calc Edit Mode. Press RET to finish. Press C-x k RET to cancel.\n"))
X )
X (put 'calc-edit-mode 'mode-class 'special)
X
X--- 2429,2440 ----
X (setq calc-edit-handler handler)
X (make-local-variable 'calc-restore-trail)
X (setq calc-restore-trail calc-display-trail)
X+ (make-local-variable 'calc-allow-ret)
X+ (setq calc-allow-ret allow-ret)
X (erase-buffer)
X! (insert "Calc Edit Mode. Press "
X! (if allow-ret "C-c C-c" "RET")
X! " to finish. Press C-x k RET to cancel.\n"))
X )
X (put 'calc-edit-mode 'mode-class 'special)
X
X***************
X*** 1737,1742 ****
X--- 2450,2462 ----
X (forward-line 1)
X )
X
X+ (defun calc-edit-return ()
X+ (interactive)
X+ (if (and (boundp 'calc-allow-ret) calc-allow-ret)
X+ (newline)
X+ (calc-edit-finish))
X+ )
X+
X (defun calc-edit-finish ()
X "Finish calc-edit mode. Parse buffer contents and push them on the stack."
X (interactive)
X***************
X*** 1749,1756 ****
X (original calc-original-buffer)
X (disp-trail calc-restore-trail))
X (save-excursion
X! (set-buffer original)
X! (if (not (eq major-mode 'calc-mode))
X (error "Original calculator buffer has been corrupted.")))
X (goto-char (point-min))
X (if (looking-at "Calc Edit")
X--- 2469,2478 ----
X (original calc-original-buffer)
X (disp-trail calc-restore-trail))
X (save-excursion
X! (if (or (null (buffer-name original))
X! (progn
X! (set-buffer original)
X! (not (eq major-mode 'calc-mode))))
X (error "Original calculator buffer has been corrupted.")))
X (goto-char (point-min))
X (if (looking-at "Calc Edit")
X***************
X*** 1759,1766 ****
X (eval calc-edit-handler))
X (switch-to-buffer original)
X (kill-buffer buf)
X! (calc-wrapper
X! (if disp-trail
X (calc-trail-display 1 t))))
X )
X
X--- 2481,2488 ----
X (eval calc-edit-handler))
X (switch-to-buffer original)
X (kill-buffer buf)
X! (if disp-trail
X! (calc-wrapper
X (calc-trail-display 1 t))))
X )
X
X***************
X*** 1770,1807 ****
X (start (point))
X pos)
X (while (setq pos (string-match "\n." str))
X! (aset str pos ?\,))
X! (set-buffer calc-original-buffer)
X (let ((vals (math-read-exprs str)))
X (if (eq (car-safe vals) 'error)
X (progn
X! (set-buffer buf)
X (goto-char (+ start (nth 1 vals)))
X (error (nth 2 vals))))
X! (calc-wrapper
X! (calc-enter-result num "edit" vals))))
X )
X
X
X
X
X ;;;; [calc-ext.el]
X
X ;;; Algebra commands.
X
X (defun calc-a-prefix-help ()
X (interactive)
X (calc-do-prefix-help
X! '("Simplify, Extended-simplify; eXpand, Collect"
X! "Derivative, Integral, Taylor; suBstitute; Rewrite"
X! "SHIFT + Solve; Integral-limit"
X "relations: =, # (not =), <, >, [ (< or =), ] (> or =)"
X! "logical: & (and), | (or), ! (not); misc: { (in-set)")
X "algebra" ?a)
X )
X
X ;;;; [calc-alg.el]
X
X (defun calc-simplify ()
X "Simplify the formula on top of the stack."
X (interactive)
X--- 2492,4052 ----
X (start (point))
X pos)
X (while (setq pos (string-match "\n." str))
X! (aset str pos (if (and (integerp num) (> num 1)) ?\, ? )))
X! (switch-to-buffer calc-original-buffer)
X (let ((vals (math-read-exprs str)))
X (if (eq (car-safe vals) 'error)
X (progn
X! (switch-to-buffer buf)
X (goto-char (+ start (nth 1 vals)))
X (error (nth 2 vals))))
X! (if (symbolp num)
X! (set num (car vals))
X! (calc-wrapper
X! (if disp-trail
X! (calc-trail-display 1 t))
X! (if (>= num 0)
X! (calc-enter-result num "edit" vals)
X! (calc-enter-result 1 "edit" vals (- num)))))))
X! )
X!
X!
X!
X!
X! ;;;; [calc-ext.el]
X!
X! ;;; Selection commands.
X!
X! (defun calc-j-prefix-help ()
X! (interactive)
X! (calc-do-prefix-help
X! '("Select, Additional, Once; eVal; Rewrite"
X! "More, Less, 1-9, Next, Previous"
X! "Unselect, Clear; Display; Enable; Breakable"
X! "' (replace), ` (edit), +, -, *, /, RET (grab), DEL"
X! "SHIFT + swap: Left, Right; maybe: Select, Once"
X! "SHIFT + Commute, Merge, Distrib, jump-Eqn, Isolate"
X! "SHIFT + Negate, & (invert); Unpack")
X! "select" ?j)
X! )
X!
X! ;;; True if A is an object not composed of sub-formulas . [P x] [Public]
X! (defun math-primp (a)
X! (or (integerp a)
X! (memq (car-safe a) '(bigpos bigneg frac float cplx polar
X! hms mod var)))
X! )
X! (defmacro Math-primp (a)
X! (` (or (not (consp (, a)))
X! (memq (car (, a)) '(bigpos bigneg frac float cplx polar
X! hms mod var))))
X! )
X!
X! ;;;; [calc-sel.el]
X!
X! (defun calc-select-here (num &optional once keep)
X! "Select the smallest sub-formula surrounding point, or whole formula.
X! With a prefix argument, select Nth-larger-than-smallest sub-formula."
X! (interactive "P")
X! (calc-wrapper
X! (calc-prepare-selection)
X! (let ((found (calc-find-selected-part))
X! (entry calc-selection-cache-entry))
X! (or (and keep (nth 2 entry))
X! (progn
X! (if once (progn
X! (setq calc-keep-selection nil)
X! (message "(Selection will apply to next command only)")))
X! (calc-change-current-selection
X! (if found
X! (if (and num (> (setq num (prefix-numeric-value num)) 0))
X! (progn
X! (while (and (>= (setq num (1- num)) 0)
X! (not (eq found (car entry))))
X! (setq found (calc-find-assoc-parent-formula
X! (car entry) found)))
X! found)
X! (calc-grow-assoc-formula (car entry) found))
X! (car entry)))))))
X! )
X!
X! (defun calc-select-once (num)
X! "Like calc-select-here, but the selection applies only to the next command."
X! (interactive "P")
X! (calc-select-here num t)
X! )
X!
X! (defun calc-select-here-maybe (num)
X! "Like calc-select-here, but keep existing selection if any."
X! (interactive "P")
X! (calc-select-here num nil t)
X! )
X!
X! (defun calc-select-once-maybe (num)
X! "Like calc-select-once, but keeps existing selection if any."
X! (interactive "P")
X! (calc-select-once num t t)
X! )
X!
X! (defun calc-select-additional ()
X! "Enlarge current selection to contain current point."
X! (interactive)
X! (calc-wrapper
X! (let (calc-keep-selection)
X! (calc-prepare-selection))
X! (let ((found (calc-find-selected-part))
X! (entry calc-selection-cache-entry))
X! (calc-change-current-selection
X! (if found
X! (let ((sel (nth 2 entry)))
X! (if sel
X! (progn
X! (while (not (or (eq sel (car entry))
X! (calc-find-sub-formula sel found)))
X! (setq sel (calc-find-assoc-parent-formula
X! (car entry) sel)))
X! sel)
X! (calc-grow-assoc-formula (car entry) found)))
X! (car entry)))))
X! )
X!
X! (defun calc-select-more (num)
X! "Enlarge the current selection by N levels.
X! If there is no current selection, same as calc-select-here."
X! (interactive "P")
X! (calc-wrapper
X! (calc-prepare-selection)
X! (let ((entry calc-selection-cache-entry))
X! (if (nth 2 entry)
X! (let ((sel (nth 2 entry)))
X! (while (and (not (eq sel (car entry)))
X! (>= (setq num (1- (prefix-numeric-value num))) 0))
X! (setq sel (calc-find-assoc-parent-formula (car entry) sel)))
X! (calc-change-current-selection sel))
X! (calc-select-here num))))
X! )
X!
X! (defun calc-select-less (num)
X! "Reduce the current selection by N levels around point."
X! (interactive "p")
X! (calc-wrapper
X! (calc-prepare-selection)
X! (let ((found (calc-find-selected-part))
X! (entry calc-selection-cache-entry))
X! (calc-change-current-selection
X! (and found
X! (let ((sel (nth 2 entry))
X! old index op)
X! (while (and sel
X! (not (eq sel found))
X! (>= (setq num (1- num)) 0))
X! (setq old sel
X! index (calc-find-sub-formula sel found))
X! (and (setq sel (and index (nth index old)))
X! calc-assoc-selections
X! (setq op (assq (car-safe sel) calc-assoc-ops))
X! (memq (car old) (nth index op))
X! (setq num (1+ num))))
X! sel)))))
X! )
X!
X! (defun calc-select-part (num)
X! "Reduce the current selection to the Nth immediate sub-formula."
X! (interactive "P")
X! (or num (setq num (- last-command-char ?0)))
X! (calc-wrapper
X! (calc-prepare-selection)
X! (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry)
X! (car calc-selection-cache-entry))
X! num)))
X! (if sel
X! (calc-change-current-selection sel)
X! (error "%d is not a valid sub-formula index" num))))
X! )
X!
X! (defun calc-find-nth-part (expr num)
X! (if (and calc-assoc-selections
X! (assq (car-safe expr) calc-assoc-ops))
X! (let (op)
X! (calc-find-nth-part-rec expr))
X! (if (eq (car-safe expr) 'intv)
X! (and (>= num 1) (<= num 2) (nth (1+ num) expr))
X! (and (not (Math-primp expr)) (>= num 1) (< num (length expr))
X! (nth num expr))))
X! )
X!
X! (defun calc-find-nth-part-rec (expr) ; uses num, op
X! (or (if (and (setq op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
X! (memq (car expr) (nth 1 op)))
X! (calc-find-nth-part-rec (nth 1 expr))
X! (and (= (setq num (1- num)) 0)
X! (nth 1 expr)))
X! (if (and (setq op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
X! (memq (car expr) (nth 2 op)))
X! (calc-find-nth-part-rec (nth 2 expr))
X! (and (= (setq num (1- num)) 0)
X! (nth 2 expr))))
X! )
X!
X! (defun calc-select-next (num)
X! "Advance selection to Nth next sub-formula."
X! (interactive "p")
X! (if (< num 0)
X! (calc-select-previous (- num))
X! (calc-wrapper
X! (calc-prepare-selection)
X! (let* ((entry calc-selection-cache-entry)
X! (sel (nth 2 entry)))
X! (if sel
X! (progn
X! (while (>= (setq num (1- num)) 0)
X! (let* ((parent (calc-find-parent-formula (car entry) sel))
X! (p parent)
X! op)
X! (and (eq p t) (setq p nil))
X! (while (and (setq p (cdr p))
X! (not (eq (car p) sel))))
X! (if (cdr p)
X! (setq sel (or (and calc-assoc-selections
X! (setq op (assq (car-safe (nth 1 p))
X! calc-assoc-ops))
X! (memq (car parent) (nth 2 op))
X! (nth 1 (nth 1 p)))
X! (nth 1 p)))
X! (if (and calc-assoc-selections
X! (setq op (assq (car-safe parent) calc-assoc-ops))
X! (consp (setq p (calc-find-parent-formula
X! (car entry) parent)))
X! (eq (nth 1 p) parent)
X! (memq (car p) (nth 1 op)))
X! (setq sel (nth 2 p))
X! (error "No \"next\" sub-formula")))))
X! (calc-change-current-selection sel))
X! (if (Math-primp (car entry))
X! (calc-change-current-selection (car entry))
X! (calc-select-part num))))))
X! )
X!
X! (defun calc-select-previous (num)
X! "Move selection back to Nth previous sub-formula."
X! (interactive "p")
X! (if (< num 0)
X! (calc-select-next (- num))
X! (calc-wrapper
X! (calc-prepare-selection)
X! (let* ((entry calc-selection-cache-entry)
X! (sel (nth 2 entry)))
X! (if sel
X! (progn
X! (while (>= (setq num (1- num)) 0)
X! (let* ((parent (calc-find-parent-formula (car entry) sel))
X! (p (cdr-safe parent))
X! (prev nil)
X! op)
X! (if (eq (car-safe parent) 'intv) (setq p (cdr p)))
X! (while (and (not (eq (car p) sel))
X! (setq prev (car p)
X! p (cdr p))))
X! (if prev
X! (setq sel (or (and calc-assoc-selections
X! (setq op (assq (car-safe prev)
X! calc-assoc-ops))
X! (memq (car parent) (nth 1 op))
X! (nth 2 prev))
X! prev))
X! (if (and calc-assoc-selections
X! (setq op (assq (car-safe parent) calc-assoc-ops))
X! (consp (setq p (calc-find-parent-formula
X! (car entry) parent)))
X! (eq (nth 2 p) parent)
X! (memq (car p) (nth 2 op)))
X! (setq sel (nth 1 p))
X! (error "No \"previous\" sub-formula")))))
X! (calc-change-current-selection sel))
X! (if (Math-primp (car entry))
X! (calc-change-current-selection (car entry))
X! (let ((len (if (and calc-assoc-selections
X! (assq (car (car entry)) calc-assoc-ops))
X! (let (op (num 0))
X! (calc-find-nth-part-rec (car entry))
X! (- 1 num))
X! (length (car entry)))))
X! (calc-select-part (- len num))))))))
X! )
X!
X! (defun calc-find-parent-formula (expr part)
X! (cond ((eq expr part) t)
X! ((Math-primp expr) nil)
X! (t
X! (let ((p expr) res)
X! (while (and (setq p (cdr p))
X! (not (setq res (calc-find-parent-formula
X! (car p) part)))))
X! (and p
X! (if (eq res t) expr res)))))
X! )
X!
X! ;;; In the following table, ( OP LOPS ROPS ) means that if an OP
X! ;;; term appears as the first argument to any LOPS term, or as the
X! ;;; second argument to any ROPS term, then they should be treated
X! ;;; as one large term for purposes of associative selection.
X! (defconst calc-assoc-ops '( ( + ( + - ) ( + ) )
X! ( - ( + - ) ( + ) )
X! ( * ( * ) ( * ) )
X! ( / ( / ) ( ) )
X! ( | ( | ) ( | ) )
X! ( calcFunc-land ( calcFunc-land )
X! ( calcFunc-land ) )
X! ( calcFunc-lor ( calcFunc-lor )
X! ( calcFunc-lor ) ) ))
X!
X! (defun calc-find-assoc-parent-formula (expr part)
X! (calc-grow-assoc-formula expr (calc-find-parent-formula expr part))
X! )
X!
X! (defun calc-grow-assoc-formula (expr part)
X! (if calc-assoc-selections
X! (let ((op (assq (car-safe part) calc-assoc-ops)))
X! (if op
X! (let (new)
X! (while (and (consp (setq new (calc-find-parent-formula
X! expr part)))
X! (memq (car new)
X! (nth (calc-find-sub-formula new part) op)))
X! (setq part new))))
X! part)
X! part)
X! )
X!
X! (defun calc-find-sub-formula (expr part)
X! (cond ((eq expr part) t)
X! ((Math-primp expr) nil)
X! (t
X! (let ((num 1))
X! (while (and (setq expr (cdr expr))
X! (not (calc-find-sub-formula (car expr) part)))
X! (setq num (1+ num)))
X! (and expr num))))
X! )
X!
X! (defun calc-unselect (num)
X! "Deselect any current sub-formula selection for this formula.
X! With a prefix argument, deselect Nth stack entry, else use entry at cursor."
X! (interactive "P")
X! (calc-wrapper
X! (calc-prepare-selection num)
X! (calc-change-current-selection nil))
X! )
X!
X! (defun calc-clear-selections ()
X! "Deselect all selected sub-formulas on the stack."
X! (interactive)
X! (calc-wrapper
X! (let ((limit (calc-stack-size))
X! (n 1))
X! (while (<= n limit)
X! (if (calc-top n 'sel)
X! (progn
X! (calc-prepare-selection n)
X! (calc-change-current-selection nil)))
X! (setq n (1+ n))))
X! (calc-clear-command-flag 'position-point))
X! )
X!
X! (defun calc-show-selections (arg)
X! "Toggle between showing selected or non-selected portions of a formula."
X! (interactive "P")
X! (calc-wrapper
X! (calc-preserve-point)
X! (setq calc-show-selections (if arg
X! (> (prefix-numeric-value arg) 0)
X! (not calc-show-selections)))
X! (let ((p calc-stack))
X! (while (and p
X! (or (null (nth 2 (car p)))
X! (equal (car p) calc-selection-cache-entry)))
X! (setq p (cdr p)))
X! (if p
X! (let ((calc-selection-cache-default-entry calc-selection-cache-entry))
X! (calc-refresh))
X! (and calc-selection-cache-entry
X! (let ((sel (nth 2 calc-selection-cache-entry)))
X! (setcar (nthcdr 2 calc-selection-cache-entry) nil)
X! (calc-change-current-selection sel)))))
X! (message (if calc-show-selections
X! "Displaying only selected part of formulas"
X! "Displaying all but selected part of formulas")))
X! )
X!
X! (defun calc-preserve-point ()
X! (or (looking-at "\\.\n+\\'")
X! (progn
X! (setq calc-final-point-line (+ (count-lines (point-min) (point))
X! (if (bolp) 1 0))
X! calc-final-point-column (current-column))
X! (calc-set-command-flag 'position-point)))
X! )
X!
X! (defun calc-enable-selections (arg)
X! "Toggle whether selections affect stack operations."
X! (interactive "P")
X! (calc-wrapper
X! (calc-preserve-point)
X! (setq calc-use-selections (if arg
X! (> (prefix-numeric-value arg) 0)
X! (not calc-use-selections)))
SHAR_EOF
echo "End of part 4, continue with part 5"
echo "5" > s2_seq_.tmp
exit 0