daveg@csvax.caltech.edu (David Gillespie) (06/06/90)
Posting-number: Volume 13, Issue 30
Submitted-by: daveg@csvax.caltech.edu (David Gillespie)
Archive-name: gmcalc/part04
---- Cut Here and unpack ----
#!/bin/sh
# this is part 4 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc-ext.el 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
echo "x - Continuing file calc-ext.el"
sed 's/^X//' << 'SHAR_EOF' >> calc-ext.el
X)
X
X(defun calc-ceiling (arg)
X "Truncate to an integer (toward plus infinity) the top element of the stack."
X (interactive "P")
X (calc-invert-func)
X (calc-floor arg)
X)
X
X(defun calc-round (arg)
X "Round to the nearest integer the top element of the Calculator stack.
XWith Inverse flag, truncate (toward zero) to an integer.
XWith Hyperbolic flag, represent result in floating-point."
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-inverse)
X (if (calc-is-hyperbolic)
X (calc-unary-op "trnc" 'calcFunc-ftrunc arg)
X (calc-unary-op "trnc" 'calcFunc-trunc arg))
X (if (calc-is-hyperbolic)
X (calc-unary-op "rond" 'calcFunc-fround arg)
X (calc-unary-op "rond" 'calcFunc-round arg))))
X)
X
X(defun calc-trunc (arg)
X "Truncate to an integer (toward zero) the top element of the Calculator stack."
X (interactive "P")
X (calc-invert-func)
X (calc-round arg)
X)
X
X(defun calc-abssqr (arg)
X "Compute the absolute value squared of the top element of the stack."
X (interactive "P")
X (calc-slow-wrapper
X (calc-unary-op "absq" 'calcFunc-abssqr arg))
X)
X
X(defun calc-argument (arg)
X "Compute the complex argument of the top element of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X (calc-unary-op "arg" 'calcFunc-arg arg))
X)
X
X(defun calc-re (arg)
X "Replace the top element of the Calculator stack with its real part."
X (interactive "P")
X (calc-slow-wrapper
X (calc-unary-op "re" 'calcFunc-re arg))
X)
X
X(defun calc-im (arg)
X "Replace the top element of the Calculator stack with its imaginary part."
X (interactive "P")
X (calc-slow-wrapper
X (calc-unary-op "im" 'calcFunc-im arg))
X)
X
X(defun calc-hypot (arg)
X "Take the square root of sum of squares of the top two elements of the stack."
X (interactive "P")
X (calc-slow-wrapper
X (calc-binary-op "hypt" 'calcFunc-hypot arg))
X)
X
X(defun calc-ln (arg)
X "Take the natural logarithm of the top element of the Calculator stack.
XWith Inverse flag or negative prefix arg, computes e^x.
XWith Hyperbolic flag or even prefix arg, computes log_10 or 10^x."
X (interactive "P")
X (calc-invert-func)
X (calc-exp arg)
X)
X
X(defun calc-log10 (arg)
X "Take the logarithm (base 10) of the top element of the Calculator stack.
XWith Inverse flag or negative prefix arg, computes 10^x."
X (interactive "P")
X (calc-hyperbolic-func)
X (calc-ln arg)
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.
XWith 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 (calc-invert-func)
X (calc-expm1 arg)
X)
X
X(defun calc-exp (arg)
X "Take the exponential (e^x) of the top element of the Calculator stack.
XWith Inverse flag or negative prefix arg, takes the natural logarithm.
XWith Hyperbolic flag or even prefix arg, computes 10^x or log_10."
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-hyperbolic)
X (if (calc-is-inverse)
X (calc-unary-op "lg10" 'calcFunc-log10 arg)
X (calc-unary-op "10^" 'calcFunc-pow10 arg))
X (if (calc-is-inverse)
X (calc-unary-op "ln" 'calcFunc-ln arg)
X (calc-unary-op "exp" 'calcFunc-exp arg))))
X)
X
X(defun calc-expm1 (arg)
X "Take the exponential minus one (e^x - 1) of the top element of the stack."
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-inverse)
X (calc-unary-op "ln+1" 'calcFunc-lnp1 arg)
X (calc-unary-op "ex-1" 'calcFunc-expm1 arg)))
X)
X
X(defun calc-pi ()
X "Push Pi (at the current precision) on the Calculator stack.
XWith Hyperbolic flag, pushes `e' (the base of natural logarithms)."
X (interactive)
X (calc-slow-wrapper
X (if (calc-is-hyperbolic)
X (if calc-symbolic-mode
X (calc-pop-push-record 0 "e" '(var e var-e))
X (calc-pop-push-record 0 "e" (math-e)))
X (if calc-symbolic-mode
X (calc-pop-push-record 0 "pi" '(var pi var-pi))
X (calc-pop-push-record 0 "pi" (math-pi)))))
X)
X
X(defun calc-sin (arg)
X "Take the sine of the top element of the Calculator stack.
XWith Inverse flag or negative prefix arg, takes the inverse sine.
XWith Hyperbolic flag or even prefix arg, computes sinh or arcsinh."
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-hyperbolic)
X (if (calc-is-inverse)
X (calc-unary-op "asnh" 'calcFunc-arcsinh arg)
X (calc-unary-op "sinh" 'calcFunc-sinh arg))
X (if (calc-is-inverse)
X (calc-unary-op "asin" 'calcFunc-arcsin arg)
X (calc-unary-op "sin" 'calcFunc-sin arg))))
X)
X
X(defun calc-arcsin (arg)
X "Take the inverse sine of the top element of the Calculator stack."
X (interactive "P")
X (calc-invert-func)
X (calc-sin arg)
X)
X
X(defun calc-sinh (arg)
X "Take the hyperbolic sine of the top element of the Calculator stack."
X (interactive "P")
X (calc-hyperbolic-func)
X (calc-sin arg)
X)
X
X(defun calc-arcsinh (arg)
X "Take the inverse hyperbolic sine of the top element of the Calculator stack."
X (interactive "P")
X (calc-invert-func)
X (calc-hyperbolic-func)
X (calc-sin arg)
X)
X
X(defun calc-cos (arg)
X "Take the cosine of the top element of the Calculator stack.
XWith Inverse flag or negative prefix arg, takes the inverse cosine.
XWith Hyperbolic flag or even prefix arg, computes cosh or arccosh."
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-hyperbolic)
X (if (calc-is-inverse)
X (calc-unary-op "acsh" 'calcFunc-arccosh arg)
X (calc-unary-op "cosh" 'calcFunc-cosh arg))
X (if (calc-is-inverse)
X (calc-unary-op "acos" 'calcFunc-arccos arg)
X (calc-unary-op "cos" 'calcFunc-cos arg))))
X)
X
X(defun calc-arccos (arg)
X "Take the inverse cosine of the top element of the Calculator stack."
X (interactive "P")
X (calc-invert-func)
X (calc-cos arg)
X)
X
X(defun calc-cosh (arg)
X "Take the hyperbolic cosine of the top element of the Calculator stack."
X (interactive "P")
X (calc-hyperbolic-func)
X (calc-cos arg)
X)
X
X(defun calc-arccosh (arg)
X "Take the inverse hyperbolic cosine of the top element of the Calculator stack."
X (interactive "P")
X (calc-invert-func)
X (calc-hyperbolic-func)
X (calc-cos arg)
X)
X
X(defun calc-sincos ()
X "Compute the sine and cosine of the top element of the Calculator stack.
XResult is a vector [cos(x), sin(x)].
XInverse and Hyperbolic flags are not recognized."
X (interactive)
X (calc-slow-wrapper
X (if (calc-is-inverse)
X (calc-enter-result 1 "asnc" (list 'calcFunc-arcsincos (calc-top-n 1)))
X (calc-enter-result 1 "sncs" (list 'calcFunc-sincos (calc-top-n 1)))))
X)
X
X(defun calc-tan (arg)
X "Take the tangent of the top element of the Calculator stack.
XWith Inverse flag or negative prefix arg, takes the inverse tangent.
XWith Hyperbolic flag or even prefix arg, computes tanh or arctanh."
X (interactive "P")
X (calc-slow-wrapper
X (if (calc-is-hyperbolic)
X (if (calc-is-inverse)
X (calc-unary-op "atnh" 'calcFunc-arctanh arg)
X (calc-unary-op "tanh" 'calcFunc-tanh arg))
X (if (calc-is-inverse)
X (calc-unary-op "atan" 'calcFunc-arctan arg)
X (calc-unary-op "tan" 'calcFunc-tan arg))))
X)
X
X(defun calc-arctan (arg)
X "Take the inverse tangent of the top element of the Calculator stack."
X (interactive "P")
X (calc-invert-func)
X (calc-tan arg)
X)
X
X(defun calc-tanh (arg)
X "Take the hyperbolic tangent of the top element of the Calculator stack."
X (interactive "P")
X (calc-hyperbolic-func)
X (calc-tan arg)
X)
X
X(defun calc-arctanh (arg)
X "Take the inverse hyperbolic tangent of the top element of the stack."
X (interactive "P")
X (calc-invert-func)
X (calc-hyperbolic-func)
X (calc-tan arg)
X)
X
X(defun calc-arctan2 ()
X "Compute the full-circle arc tangent of the ratio of two numbers."
X (interactive)
X (calc-slow-wrapper
X (calc-enter-result 2 "atn2" (cons 'calcFunc-arctan2 (calc-top-list-n 2))))
X)
X
X(defun calc-conj (arg)
X "Compute the complex conjugate of the top element of the Calculator stack."
X (interactive "P")
X (calc-wrapper
X (calc-unary-op "conj" 'calcFunc-conj arg))
X)
X
X(defun calc-imaginary ()
X "Multiply the top element of the Calculator stack by complex \"i\"."
X (interactive)
X (calc-slow-wrapper
X (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1))))
X)
X
X
X
X;;; Memory commands.
X
X(defun calc-store (n &optional var oper)
X "Store the value at the top of the Calculator stack in variable VAR.
XIf VAR is of the form +V, -V, *V, /V, ^V, or |V, top of stack is combined
Xinto V with the appropriate operation.
XWith any numeric prefix argument, unsets the specified variable."
X (interactive "P")
X (calc-wrapper
X (if n
X (progn
X (or var
X (setq var (let ((minibuffer-completion-table obarray)
X (minibuffer-completion-predicate 'boundp)
X (minibuffer-completion-confirm t)
X (oper "r"))
X (read-from-minibuffer
X "Unstore: " "var-" calc-store-var-map nil))))
X (if (equal var "")
X ()
X (makunbound (intern var))))
X (while (or (null var) (equal var "")
X (string-match "\\`[-+*/^|].*" var))
X (if (and var (> (length var) 0))
X (setq oper (substring var 0 1)
X var (substring var 1))
X (setq var (let ((minibuffer-completion-table obarray)
X (minibuffer-completion-predicate 'boundp)
X (minibuffer-completion-confirm t))
X (read-from-minibuffer
X (if oper (format "Store %s: " oper) "Store: ")
X "var-" calc-store-var-map nil)))))
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 (error "No such variable"))
X (setq ival (calc-normalize ival))
X (cond ((equal oper "+")
X (set ivar (calc-normalize
X (list '+ ival (calc-top-n 1)))))
X ((equal oper "-")
X (set ivar (calc-normalize
X (list '- ival (calc-top-n 1)))))
X ((equal oper "*")
X (set ivar (calc-normalize
X (list '* ival (calc-top-n 1)))))
X ((equal oper "/")
X (set ivar (calc-normalize
X (list '/ ival (calc-top-n 1)))))
X ((equal oper "^")
X (set ivar (calc-normalize
X (list '^ ival (calc-top-n 1)))))
X ((equal oper "|")
X (set ivar (calc-normalize
X (list '| ival (calc-top-n 1)))))))
X (calc-record-undo (list 'store var ival))
X (calc-record (symbol-value ivar)
X (concat ">" (or oper "")
X (if (string-match "\\`var-.+\\'" var)
X (substring var 4) var)))))))
X)
X
X(defun calc-unstore (&optional var oper)
X (interactive)
X (calc-store -1 var oper)
X)
X
X(defvar calc-store-var-map nil "Keymap for use by the calc-store command.")
X(if calc-store-var-map
X ()
X (setq calc-store-var-map (copy-keymap minibuffer-local-completion-map))
X (mapcar (function
X (lambda (x)
X (define-key calc-store-var-map (char-to-string x)
X 'calcVar-digit)))
X "0123456789")
X (mapcar (function
X (lambda (x)
X (define-key calc-store-var-map (char-to-string x)
X 'calcVar-oper)))
X "+-*/^|")
X)
X
X(defun calcVar-digit ()
X (interactive)
X (if (calc-minibuffer-contains "var-\\'")
X (self-insert-and-exit)
X (self-insert-command 1))
X)
X
X(defun calcVar-oper ()
X (interactive)
X (if (calc-minibuffer-contains "var-\\'")
X (if (null oper)
X (progn
X (erase-buffer)
X (self-insert-and-exit))
X (beep))
X (self-insert-command 1))
X)
X
X(defun calc-recall (&optional var)
X "Recall the value of variable VAR into the Calculator stack."
X (interactive)
X (calc-wrapper
X (or var
X (setq var (let ((minibuffer-completion-table obarray)
X (minibuffer-completion-predicate 'boundp)
X (minibuffer-completion-confirm t)
X (oper "r"))
X (read-from-minibuffer
X "Recall: " "var-" calc-store-var-map nil))))
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 (setq ival (calc-normalize ival))
X (calc-record ival (concat "<"
X (if (string-match "\\`var-.+\\'" var)
X (substring var 4) var)))
X (calc-push ival))))
X)
X
X(defun calc-let (&optional var)
X "Evaluate second-in-stack where variable VAR equals top of stack."
X (interactive)
X (calc-wrapper
X (or var
X (setq var (let ((minibuffer-completion-table obarray)
X (minibuffer-completion-predicate 'boundp)
X (minibuffer-completion-confirm t)
X (oper "r"))
X (read-from-minibuffer
X "Let variable: " "var-" calc-store-var-map nil))))
X (if (equal var "")
X ()
X (setq ivar (intern var))
X (calc-pop-push-record
X 2 (concat "="
X (if (string-match "\\`var-.+\\'" var)
X (substring var 4) var))
X (let ((saved-val (and (boundp ivar) (symbol-value ivar))))
X (unwind-protect
X (progn
X (set ivar (calc-top-n 1))
X (math-evaluate-expr (calc-top-n 2)))
X (if saved-val
X (set ivar saved-val)
X (makunbound ivar)))))))
X)
X
X
X
X
X;;; Kill ring commands.
X
X(defun calc-kill (nn &optional no-delete)
X "Kill the Calculator stack element containing the cursor.
XWith numeric prefix argument N, kill the N stack elements at+below cursor."
X (interactive "P")
X (calc-wrapper
X (calc-force-refresh)
X (calc-set-command-flag 'no-align)
X (let ((num (max (calc-locate-cursor-element (point)) 1))
X (n (prefix-numeric-value nn)))
X (if (< n 0)
X (progn
X (if (eobp)
X (setq num (1- num)))
X (setq num (- num n)
X n (- n))))
X (let ((stuff (calc-top-list n (- num n -1))))
X (calc-cursor-stack-index num)
X (let ((first (point)))
X (calc-cursor-stack-index (- num n))
X (if (null nn)
X (backward-char 1)) ; don't include newline for raw C-k
X (copy-region-as-kill first (point))
X (if (not no-delete)
X (calc-pop-stack n (- num n -1))))
X (setq calc-last-kill (cons (car kill-ring) stuff)))))
X)
X
X(defun calc-force-refresh ()
X (if calc-executing-macro
X (let ((calc-executing-macro nil))
X (calc-refresh)))
X)
X
X(defun calc-locate-cursor-element (pt)
X (save-excursion
X (goto-char (point-max))
X (calc-locate-cursor-scan (- calc-stack-top) calc-stack pt))
X)
X
X(defun calc-locate-cursor-scan (n stack pt)
X (if (or (<= (point) pt)
X (null stack))
X n
X (forward-line (- (nth 1 (car stack))))
X (calc-locate-cursor-scan (1+ n) (cdr stack) pt))
X)
X
X(defun calc-kill-region (top bot &optional no-delete)
X "Kill the Calculator stack elements between Point and Mark."
X (interactive "r")
X (calc-wrapper
X (calc-force-refresh)
X (calc-set-command-flag 'no-align)
X (let* ((top-num (calc-locate-cursor-element top))
X (bot-num (calc-locate-cursor-element (1- bot)))
X (num (- top-num bot-num -1)))
X (copy-region-as-kill top bot)
X (setq calc-last-kill (cons (car kill-ring) (calc-top-list num bot-num)))
X (if (not no-delete)
X (calc-pop-stack num bot-num))))
X)
X
X(defun calc-copy-as-kill (n)
X "Copy the Calculator stack element containing the cursor into the Kill Ring.
XThe stack element is not deleted. With numeric prefix argument N, copy the
XN stack elements at+below cursor."
X (interactive "P")
X (calc-kill n t)
X)
X
X(defun calc-copy-region-as-kill (top bot)
X "Copy the Calculator stack elements between Point and Mark into the Kill Ring.
XThe stack elements are not deleted."
X (interactive "r")
X (calc-kill-region top bot t)
X)
X
X;;; This function uses calc-last-kill if possible to get an exact result,
X;;; otherwise it just parses the yanked string.
X(defun calc-yank ()
X "Enter the contents of the last Killed text into the Calculator stack.
XThis text must be formatted as a number or list of numbers."
X (interactive)
X (calc-wrapper
X (calc-pop-push-record-list
X 0 "yank"
X (if (eq (car-safe calc-last-kill) (car kill-ring-yank-pointer))
X (cdr calc-last-kill)
X (if (stringp (car kill-ring-yank-pointer))
X (let ((val (math-read-exprs
X (calc-clean-newlines (car kill-ring-yank-pointer)))))
X (if (eq (car-safe val) 'error)
X (error "Bad format in yanked data")
X val))))))
X)
X
X(defun calc-clean-newlines (s)
X (cond
X
X ;; Omit leading/trailing whitespace
X ((or (string-match "\\`[ \n\r]+\\([^\001]*\\)\\'" s)
X (string-match "\\`\\([^\001]*\\)[ \n\r]+\\'" s))
X (calc-clean-newlines (math-match-substring s 1)))
X
X ;; Convert newlines to commas
X ((string-match "\\`\\(.*\\)[\n\r]+\\([^\001]*\\)\\'" s)
X (calc-clean-newlines (concat (math-match-substring s 1) ","
X (math-match-substring s 2))))
X
X (t s))
X)
X
X(defun calc-grab-region (top bot)
X "Parse the region as a matrix of numbers and push it on the Calculator stack.
XThis is intended to be used in a non-Calculator buffer!
XIf the start and the end of the region are in column zero, the contained lines
Xare parsed into rows of the matrix. Otherwise, point and mark define a
Xrectangle which is parsed into a matrix."
X (interactive "r")
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 (while data
X (if (string-match "[[{][^][{}]*[]}]" (car data))
X (setq pos (match-beginning 0)
X vals (math-read-expr (math-match-substring (car data) 0)))
X (if (string-match "\\`\\([0-9]+:[ \t]\\)?\\(.*[^, \t]\\)[, \t]*\\'" (car data))
X (setq pos -1
X vals (math-read-expr (concat "["
X (math-match-substring
X (car data) 2)
X "]")))
X (setq pos -1
X vals (math-read-expr (concat "[" (car data) "]")))))
X (if (eq (car-safe vals) 'error)
X (progn
X (calc-quit)
X (switch-to-buffer from-buffer)
X (goto-char top)
X (next-line lnum)
X (forward-char (+ (nth 1 vals) pos))
X (error (nth 2 vals))))
X (setq mat (cons vals mat)
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 "Copy the top of stack into the most recently used editing buffer.
XWith a positive numeric prefix argument, copy the top N lines.
XWith a negative argument, copy the Nth line.
XWith an argument of zero, copy the entire stack.
XWith plain \"C-u\" as an argument, replaces region in other buffer."
X (interactive "P")
X (let (oldbuf newbuf)
X (calc-wrapper
X (save-excursion
X (calc-force-refresh)
X (let ((n (prefix-numeric-value nn))
X top bot)
X (setq oldbuf (current-buffer)
X newbuf (or (calc-find-writable-buffer (buffer-list) 0)
X (calc-find-writable-buffer (buffer-list) 1)
X (error "No other buffer")))
X (cond ((and (or (null nn)
X (consp nn))
X (= (calc-substack-height 0)
X (1- (calc-substack-height 1))))
X (calc-cursor-stack-index 1)
X (if (looking-at
X (if calc-line-numbering "[0-9]+: *[^ \n]" " *[^ \n]"))
X (goto-char (1- (match-end 0))))
X (setq top (point))
X (calc-cursor-stack-index 0)
X (setq bot (1- (point))))
X ((> n 0)
X (calc-cursor-stack-index n)
X (setq top (point))
X (calc-cursor-stack-index (1- n))
X (setq bot (point)))
X ((< n 0)
X (calc-cursor-stack-index (- n))
X (setq top (point))
X (calc-cursor-stack-index (1- (- n)))
X (setq bot (point)))
X (t
X (goto-char (point-min))
X (forward-line 1)
X (setq top (point))
X (calc-cursor-stack-index 0)
X (setq bot (point))))
X (save-excursion
X (set-buffer newbuf)
X (if (consp nn)
X (kill-region (region-beginning) (region-end)))
X (push-mark (point) t)
X (insert-buffer-substring oldbuf top bot)
X (if (get-buffer-window (current-buffer))
X (set-window-point (get-buffer-window (current-buffer))
X (point)))))))
X (if (consp nn)
X (progn
X (calc-quit)
X (switch-to-buffer newbuf))))
X)
X
X;;; First, require that buffer is visible and does not begin with "*"
X;;; Second, require only that it not begin with "*Calc"
X(defun calc-find-writable-buffer (buf mode)
X (and buf
X (if (or (string-match "\\`\\( .*\\|\\*Calc.*\\)"
X (buffer-name (car buf)))
X (and (= mode 0)
X (or (string-match "\\`\\*.*" (buffer-name (car buf)))
X (not (get-buffer-window (car buf))))))
X (calc-find-writable-buffer (cdr buf) mode)
X (car buf)))
X)
X
X(defun calc-edit (n)
X "Edit the top entry on the stack using normal Emacs editing commands.
XWith a positive numeric prefix, edit the top N elements of the stack.
XWith a zero prefix, edit all stack elements.
XType 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 (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.
XTo cancel the edit, simply kill the *Calc Edit* buffer."
X (interactive)
X (or handler
X (error "This command can be used only indirectly through calc-edit."))
X (let ((oldbuf (current-buffer))
X (buf (get-buffer-create "*Calc Edit*")))
X (set-buffer buf)
X (kill-all-local-variables)
X (use-local-map calc-edit-mode-map)
X (setq buffer-read-only nil)
X (setq truncate-lines nil)
X (setq major-mode 'calc-edit-mode)
X (setq mode-name "Calc Edit")
X (run-hooks 'calc-edit-mode-hook)
X (make-local-variable 'calc-original-buffer)
X (setq calc-original-buffer oldbuf)
X (make-local-variable 'calc-edit-handler)
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(defun calc-show-edit-buffer ()
X (switch-to-buffer (get-buffer-create "*Calc Edit*"))
X (if (and (< (window-width) (screen-width))
X calc-display-trail)
X (let* ((trail (get-buffer-create "*Calc Trail*"))
X (win (get-buffer-window trail)))
X (if win
X (delete-window win))))
X (set-buffer-modified-p nil)
X (goto-char (point-min))
X (forward-line 1)
X)
X
X(defun calc-edit-finish ()
X "Finish calc-edit mode. Parse buffer contents and push them on the stack."
X (interactive)
X (or (and (boundp 'calc-original-buffer)
X (boundp 'calc-edit-handler)
X (boundp 'calc-restore-trail)
X (eq major-mode 'calc-edit-mode))
X (error "This command is valid only in buffers created by calc-edit."))
X (let ((buf (current-buffer))
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 (forward-line 1))
X (if (buffer-modified-p)
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(defun calc-finish-stack-edit (num)
X (let ((buf (current-buffer))
X (str (buffer-substring (point) (point-max)))
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;;; 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 "algebra" ?a)
X)
X
X(defun calc-simplify ()
X "Simplify the formula on top of the stack."
X (interactive)
X (calc-slow-wrapper
X (calc-with-default-simplification
X (calc-enter-result 1 "simp" (math-simplify (calc-top-n 1)))))
X)
X
X(defun calc-simplify-extended ()
X "Simplify the formula on top of the stack.
XThis allows some \"dangerous\" simplifications, such as \"(a^b)^c -> a^(b c)\"
Xeven if c is a non-integer, and \"arcsin(sin(x)) -> x\"."
X (interactive)
X (calc-slow-wrapper
X (calc-with-default-simplification
X (calc-enter-result 1 "esmp" (math-simplify-extended (calc-top-n 1)))))
X)
X
X(defun calc-expand (n)
X "Expand the formula on top of the stack using the distributive law.
XWith a numeric prefix argument, expand only that many times, then stop.
XWith a negative prefix, expand only that many nesting-levels down."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 1 "expa" (math-expand-tree
X (calc-top-n 1)
X (and n (prefix-numeric-value n)))))
X)
X
X(defun calc-collect (var)
X "Collect terms involving a given variable (or sub-expression).
XThe result will be expressed like a polynomial.
XIf you enter a blank line, top of stack is the variable, next-to-top is expr."
X (interactive "sCollect terms involving: ")
X (calc-slow-wrapper
X (if (equal var "")
X (calc-enter-result 2 "clct" (math-collect-terms (calc-top-n 2)
X (calc-top-n 1)))
X (let ((var (math-read-expr var)))
X (if (eq (car-safe var) 'error)
X (error "Bad format in expression: %s" (nth 1 var)))
X (calc-enter-result 1 "clct" (math-collect-terms (calc-top-n 1)
X var)))))
X)
X
X(defun calc-substitute (&optional oldname newname)
X "Substitute all occurrences of a given sub-expression with another.
XIf you enter a blank line for \"old\", top of stack is the new expr,
Xnext-to-top is the old expr, and third is the target expr.
XIf you enter a blank line for \"new\" only, top of stack is the new
Xexpr and next-to-top is the target expr."
X (interactive "sSubstitute old: ")
X (calc-slow-wrapper
X (let (old new (num 1) expr)
X (if (or (equal oldname "") (null oldname))
X (setq new (calc-top-n 1)
X old (calc-top-n 2)
X expr (calc-top-n 3)
X num 3)
X (or newname
X (setq newname (read-string (concat "Substitute old: "
X oldname
X ", new: ")
X oldname)))
X (if (or (equal newname "") (null newname))
X (setq new (calc-top-n 1)
X expr (calc-top-n 2)
X num 2)
X (setq new (if (stringp newname) (math-read-expr newname) newname))
X (if (eq (car-safe new) 'error)
X (error "Bad format in expression: %s" (nth 1 new)))
X (setq expr (calc-top-n 1)))
X (setq old (if (stringp oldname) (math-read-expr oldname) oldname))
X (if (eq (car-safe old) 'error)
X (error "Bad format in expression: %s" (nth 1 old)))
X (or (math-expr-contains expr old)
X (error "No occurrences found.")))
X (calc-enter-result num "sbst" (math-expr-subst expr old new))))
X)
X
X(defun calc-rewrite (rules many)
X "Perform substitutions in an expression using pattern-based rewrite rules.
XThis command prompts for the rule(s) to use, which should be either a
Xvector of the form [LHS, RHS] or [LHS, RHS, COND], or a vector of such
Xvectors, or a variable which contains a rules vector. If you enter a
Xblank line, the rules are taken from top-of-stack, expr from next-to-top.
XIn each rule, LHS is a formula in which each unique variable name stands
Xfor any sub-expression, RHS is a formula typically also containing these
Xvariables, and COND is an optional formula which specifies a condition.
XA rule applies to an expression if the LHS is the same as the expression
Xwhere each variable in LHS corresponds to some sub-expression, and if COND
Xevaluates to a non-zero real number (under those assignments of the
Xvariables). If so, the expression is replaced by RHS with any variables
Xthat occur in LHS expanded.
XBy default, the rules are applied once to the any part of the expression
Xwhich matches (but preferably to the whole expression). With a positive
Xnumeric prefix argument, the rules are applied up to that many times, or
Xuntil no further changes can be made. With a negative prefix argument,
Xthe rules are applied that many times but only at the top level of the
Xexpression."
X (interactive "sRewrite rule(s): \np")
X (calc-slow-wrapper
X (let (n expr)
X (if (or (null rules) (equal rules ""))
X (setq expr (calc-top-n 2)
X rules (calc-top-n 1)
X n 2)
X (setq rules (if (stringp rules) (math-read-expr rules) rules))
X (if (eq (car-safe rules) 'error)
X (error "Bad format in expression: %s" (nth 1 rules)))
X (setq expr (calc-top-n 1)
X n 1))
X (and (eq many 0) (setq many 25))
X (calc-enter-result n "rwrt" (math-rewrite expr rules many))))
X)
X
X(defun calc-derivative (var)
X "Differentiate the formula on top of the stack with respect to a variable.
XIf you enter a blank line, top of stack is the variable, next-to-top is expr.
XWith Hyperbolic flag, performs a total derivative: all variables are
Xconsidered to be inter-dependent. Otherwise, all variables except VAR
Xare treated as constant."
X (interactive "sDifferentiate with respect to: ")
X (calc-slow-wrapper
X (let ((func (if (calc-is-hyperbolic) 'calcFunc-tderiv 'calcFunc-deriv)))
X (if (equal var "")
X (calc-enter-result 2 "derv" (list func
X (calc-top-n 2)
X (calc-top-n 1)))
X (let ((var (math-read-expr var)))
X (if (eq (car-safe var) 'error)
X (error "Bad format in expression: %s" (nth 1 var)))
X (calc-enter-result 1 "derv" (list func
X (calc-top-n 1)
X var))))))
X)
X
X(defun calc-integral (var)
X "Integrate the formula on top of the stack with respect to a variable.
XThis computes an indefinite integral.
XIf you enter a blank line, top of stack is the variable, next-to-top is expr."
X (interactive "sIntegration variable: ")
X (calc-slow-wrapper
X (if (equal var "")
X (calc-enter-result 2 "intg" (list 'calcFunc-integ
X (calc-top-n 2)
X (calc-top-n 1)))
X (let ((var (math-read-expr var)))
X (if (eq (car-safe var) 'error)
X (error "Bad format in expression: %s" (nth 1 var)))
X (calc-enter-result 1 "intg" (list 'calcFunc-integ
X (calc-top-n 1)
X var)))))
X)
X
X(defun calc-integral-limit (n)
X "Display current integral limit, or set the limit to N levels."
X (interactive "P")
X (calc-wrapper
X (if (consp n)
X (calc-pop-push-record 0 "prec" calc-integral-limit)
X (if (and (integerp n) (> n 0))
X (progn
X (setq calc-integral-limit (prefix-numeric-value n))
X (calc-record calc-integral-limit "ilim")))
X (message "Integration nesting limit is %d levels." calc-integral-limit)))
X)
X
X(defun calc-solve-for (var)
X "Solve an equation for a given variable.
XIf the top-of-stack is not of the form A = B, it is treated as A = 0.
XIf you enter a blank line, top of stack is the variable, next-to-top is eqn.
XWith Hyperbolic flag, finds a fully general solution in which n1, n2, ...
Xrepresent independent arbitrary integers and s1, s2, ... are independent
Xarbitrary signs.
XWith Inverse flag, computes the inverse of the expression, written in terms
Xof the original variable."
X (interactive "sVariable to solve for: ")
X (calc-slow-wrapper
X (let ((func (if (calc-is-inverse)
X (if (calc-is-hyperbolic) 'calcFunc-ffinv 'calcFunc-finv)
X (if (calc-is-hyperbolic) 'calcFunc-fsolve 'calcFunc-solve))))
X (if (equal var "")
X (calc-enter-result 2 "solv" (list func
X (calc-top-n 2)
X (calc-top-n 1)))
X (let ((var (math-read-expr var)))
X (if (eq (car-safe var) 'error)
X (error "Bad format in expression: %s" (nth 1 var)))
X (calc-enter-result 1 "solv" (list func
X (calc-top-n 1)
X var))))))
X)
X
X(defun calc-taylor (var nterms)
X "Compute the Taylor expansion of a formula."
X (interactive "sTaylor expansion variable: \nNNumber of terms: ")
X (calc-slow-wrapper
X (let ((var (math-read-expr var)))
X (if (eq (car-safe var) 'error)
X (error "Bad format in expression: %s" (nth 1 var)))
X (calc-enter-result 1 "tylr" (list 'calcFunc-taylor
X (calc-top-n 1)
X var
X nterms))))
X)
X
X
X(defun calc-equal-to (arg)
X "Return 1 if numbers are equal, 0 if they are unequal."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "eq" 'calcFunc-eq arg))
X)
X
X(defun calc-not-equal-to (arg)
X "Return 1 if numbers are unequal, 0 if they are equal."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "neq" 'calcFunc-neq arg))
X)
X
X(defun calc-less-than (arg)
X "Return 1 if numbers are less, 0 if they are not less."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "lt" 'calcFunc-lt arg))
X)
X
X(defun calc-greater-than (arg)
X "Return 1 if numbers are greater, 0 if they are not greater."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "gt" 'calcFunc-gt arg))
X)
X
X(defun calc-less-equal (arg)
X "Return 1 if numbers are less than or equal to, 0 if they are not leq."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "leq" 'calcFunc-leq arg))
X)
X
X(defun calc-greater-equal (arg)
X "Return 1 if numbers are greater than or equal to, 0 if they are not geq."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "geq" 'calcFunc-geq arg))
X)
X
X(defun calc-in-set (arg)
X "Return 1 if a number is in the set specified by a vector or interval.
XReturn 0 if it is not in the set."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "in" 'calcFunc-in arg))
X)
X
X(defun calc-logical-and (arg)
X "Return 1 if both numbers are non-zero, 0 if either is zero."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "land" 'calcFunc-land arg 1))
X)
X
X(defun calc-logical-or (arg)
X "Return 1 if either number is non-zero, 0 if both are zero."
X (interactive "P")
X (calc-wrapper
X (calc-binary-op "lor" 'calcFunc-lor arg 0))
X)
X
X(defun calc-logical-not (arg)
X "Return 1 if a number is zero, 0 if it is non-zero."
X (interactive "P")
X (calc-wrapper
X (calc-unary-op "lnot" 'calcFunc-lnot arg))
X)
X
X
X
X
X;;; b-prefix binary commands.
X
X(defun calc-b-prefix-help ()
X (interactive)
X (calc-do-prefix-help
X '("And, Or, Xor, Diff, Not; Wordsize, Clip"
X "Lshift, Rshift-logical, rShift-arith; SHIFT + Rotate")
X "binary" ?b)
X)
X
X(defun calc-and (n)
X "Compute the bitwise binary AND of the top two elements on the stack."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 2 "and"
X (append '(calcFunc-and)
X (calc-top-list-n 2)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-or (n)
X "Compute the bitwise binary OR of the top two elements on the stack."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 2 "or"
X (append '(calcFunc-or)
X (calc-top-list-n 2)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-xor (n)
X "Compute the bitwise binary XOR of the top two elements on the stack."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 2 "xor"
X (append '(calcFunc-xor)
X (calc-top-list-n 2)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-diff (n)
X "Compute the bitwise binary AND-NOT of the top two elements on the stack."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 2 "diff"
X (append '(calcFunc-diff)
X (calc-top-list-n 2)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-not (n)
X "Compute the bitwise binary NOT of the top element on the stack.
XA prefix argument specifies word size to use for this operation (instead of
Xthe default). The result is clipped to fit in the word size."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 1 "not"
X (append '(calcFunc-not)
X (calc-top-list-n 1)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-shift-binary (n)
X "Shift the top element on the stack one bit right in binary (arithmetically).
XWith a numeric prefix argument, shift N bits left.
XWith a negative prefix argument, arithmetically shift -N bits right.
XThe result is clipped to the current word size."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 1 "ash"
X (append '(calcFunc-ash)
X (calc-top-list-n 1)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-lshift-binary (n)
X "Shift the top element on the stack one bit left in binary.
XWith a numeric prefix argument, shift N bits left.
XWith a negative prefix argument, logically shift -N bits right.
XThe result is clipped to the current word size."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 1 "lsh"
X (append '(calcFunc-lsh)
X (calc-top-list-n 1)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-rshift-binary (n)
X "Shift the top element on the Calculator stack one bit right in binary.
XWith a numeric prefix argument, logically shift N bits right.
XWith a negative prefix argument, shift -N bits left.
XThe result is clipped to the current word size."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 1 "rsh"
X (append '(calcFunc-rsh)
X (calc-top-list-n 1)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-rotate-binary (n)
X "Rotate the top element on the Calculator stack one bit left in binary.
XWith a numeric prefix argument, rotate N bits left.
XWith a negative prefix argument, rotate -N bits right.
XThe result is clipped to the current word size."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 1 "rot"
X (append '(calcFunc-rot)
X (calc-top-list-n 1)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-clip (n)
X "Clip the integer at the top of the stack to the current binary word size.
XA prefix argument specifies an alternate word size to use."
X (interactive "P")
X (calc-slow-wrapper
X (calc-enter-result 1 "clip"
X (append '(calcFunc-clip)
X (calc-top-list-n 1)
X (and n (list (prefix-numeric-value n))))))
X)
X
X(defun calc-word-size (n)
X "Display current word size for Calculator binary operations, or set to N bits.
X\(All other bitwise operations accept a prefix argument to override this
Xdefault size.)
XIf N is negative, use |N|-bit, 2's complement arithmetic."
X (interactive "P")
X (calc-wrapper
X (if n
X (progn
X (setq calc-word-size (prefix-numeric-value n)
X calc-previous-modulo (math-power-of-2
X (math-abs calc-word-size)))
X (if calc-leading-zeros
X (calc-refresh))))
X (if (< calc-word-size 0)
X (message "Binary word size is %d bits (2's complement)."
X (- calc-word-size))
X (message "Binary word size is %d bits." calc-word-size)))
X)
X
X
X
X
X;;; Conversions.
X
X(defun calc-c-prefix-help ()
X (interactive)
X (calc-do-prefix-help
X '("Deg, Rad, HMS; Float; Polar; Clean, 1, 2, 3"
X "SHIFT + Fraction")
X "convert" ?c)
X)
X
X(defun calc-clean (n)
X "Clean up the number at the top of the Calculator stack.
XRe-round to current precision, or to that specified by a prefix argument.
XThis temporarily cancels no-simplify mode, if necessary."
X (interactive "P")
X (calc-slow-wrapper
X (calc-with-default-simplification
X (calc-enter-result 1 "cln"
X (if n
X (let ((n (prefix-numeric-value n)))
X (list 'calcFunc-clean
X (calc-top-n 1)
X (if (< n 0)
X (+ n calc-internal-prec)
X n)))
X (list 'calcFunc-clean (calc-top-n 1))))))
X)
X
X(defun calc-clean-1 ()
X "Clean up the number on the top of the stack by rounding off one digit."
X (interactive)
X (calc-clean -1)
X)
X
X(defun calc-clean-2 ()
X "Clean up the number on the top of the stack by rounding off two digits."
X (interactive)
X (calc-clean -2)
X)
X
X(defun calc-clean-3 ()
X "Clean up the number on the top of the stack by rounding off three digits."
X (interactive)
X (calc-clean -3)
X)
X
X(defun calc-float (arg)
X "Convert the top element of the Calculator stack to floating-point form."
X (interactive "P")
X (calc-slow-wrapper
X (calc-unary-op "flt" 'calcFunc-float arg))
X)
X
X(defun calc-fraction (arg)
X "Convert the top element of the Calculator stack to fractional form.
XFor floating-point arguments, the fraction is exactly equivalent within
Xthe limits of the current precision.
XIf a numeric prefix N is supplied, it is used as a tolerance value.
XIf N is zero, top-of-stack contains a tolerance value.
XIf the tolerance is a positive integer, the fraction will be accurate to
Xwithin that many significant figures.
XIf the tolerance is a non-positive integer, the fraction will be accurate to
Xwithin that many figures less than the current precision.
XIf the tolerance is a floating-point number, the fraction will be accurate
Xto within that absolute value."
X (interactive "P")
X (calc-slow-wrapper
X (if (eq arg 0)
X (calc-enter-result 2 "frac" (list 'calcFunc-frac
X (calc-top-n 2)
X (calc-top-n 1)))
X (calc-enter-result 1 "frac" (list 'calcFunc-frac
X (calc-top-n 1)
X (prefix-numeric-value (or arg 0))))))
X)
X
X(defun calc-to-hms (arg)
X "Convert the top element of the stack to hours-minutes-seconds form.
XNumber is interpreted as degrees or radians according to current mode."
X (interactive "P")
X (calc-wrapper
X (if (calc-is-inverse)
X (if (eq calc-angle-mode 'rad)
X (calc-unary-op ">rad" 'calcFunc-rad arg)
X (calc-unary-op ">deg" 'calcFunc-deg arg))
X (calc-unary-op ">hms" 'calcFunc-hms arg)))
X)
X
X(defun calc-from-hms (arg)
X "Convert the top element of the stack from hours-minutes-seconds form."
X (interactive "P")
X (calc-invert-func)
X (calc-to-hms arg)
X)
X
X(defun calc-to-degrees (arg)
X "Convert the top element of the stack from radians or HMS to degrees."
X (interactive "P")
X (calc-wrapper
X (calc-unary-op ">deg" 'calcFunc-deg arg))
X)
X
X(defun calc-to-radians (arg)
X "Convert the top element of the stack from degrees or HMS to radians."
X (interactive "P")
X (calc-wrapper
X (calc-unary-op ">rad" 'calcFunc-rad arg))
X)
X
X(defun calc-polar ()
X "Convert the top element of the stack to polar complex form."
X (interactive)
X (calc-slow-wrapper
X (let ((arg (calc-top-n 1)))
X (if (or (calc-is-inverse)
X (eq (car-safe arg) 'polar))
X (calc-enter-result 1 "p-r" (list 'calcFunc-rect arg))
X (calc-enter-result 1 "r-p" (list 'calcFunc-polar arg)))))
X)
X
X
X
X;;; d-prefix mode commands.
X
X(defun calc-d-prefix-help ()
X (interactive)
X (calc-do-prefix-help
X '("Group, \",\"; Normal, Fix, Sci, Eng, \".\""
X "Radix, Zeros, 2, 8, 0, 6; Over; Hms; Complex, I, J"
X "Why; Line-nums, line-Breaks; <, =, > (justify)"
X "Truncate, [, ]; ` (align); ~ (refresh)"
X "SHIFT + language: Normal, One-line, Big, Unformatted"
X "SHIFT + language: C, Pascal, Fortran, TeX, Mathematica")
X "display" ?d)
X)
X
X(defun calc-radix (n)
X "Set the display radix for integers and rationals to N, from 2 to 36."
X (interactive "NDisplay radix (2-36): ")
X (calc-wrapper
X (if (and (>= n 2) (<= n 36))
X (progn
X (setq calc-number-radix n)
X (setq-default calc-number-radix n))) ; so minibuffer sees it
X (calc-refresh)
X (message "Number radix is %d." calc-number-radix))
X)
X
X(defun calc-decimal-radix ()
X "Set the display radix for integers and rationals to decimal."
X (interactive)
X (calc-radix 10)
X)
X
X(defun calc-binary-radix ()
X "Set the display radix for integers and rationals to binary."
X (interactive)
X (calc-radix 2)
X)
X
X(defun calc-octal-radix ()
X "Set the display radix for integers and rationals to octal."
X (interactive)
X (calc-radix 8)
X)
X
X(defun calc-hex-radix ()
X "Set the display radix for integers and rationals to hex."
X (interactive)
X (calc-radix 16)
X)
X
X(defun calc-leading-zeros (n)
X "Toggle display of leading zeros in integers."
X (interactive "P")
X (calc-wrapper
X (setq calc-leading-zeros (if n
X (> (prefix-numeric-value n) 0)
X (not calc-leading-zeros)))
X (calc-refresh))
X)
X
X(defun calc-line-numbering (n)
X "Toggle display of line numbers in the Calculator stack.
XWith positive numeric prefix, turn mode on.
XWith 0 or negative prefix, turn mode off."
X (interactive "P")
X (calc-wrapper
X (setq calc-line-numbering (if n
X (> (prefix-numeric-value n) 0)
X (not calc-line-numbering)))
X (calc-refresh))
X)
X
X(defun calc-line-breaking (n)
X "Toggle breaking of long values across multiple lines in Calculator stack.
XWith positive numeric prefix, turn mode on.
XWith 0 or negative prefix, turn mode off."
X (interactive "P")
X (calc-wrapper
X (setq calc-line-breaking (if n
X (> (prefix-numeric-value n) 0)
X (not calc-line-breaking)))
X (calc-refresh))
X)
X
X(defun calc-display-strings (n)
X "Toggle display of vectors of byte-sized integers as strings.
XWith positive numeric prefix, turn mode on.
XWith 0 or negative prefix, turn mode off."
X (interactive "P")
X (calc-wrapper
X (setq calc-display-strings (if n
X (> (prefix-numeric-value n) 0)
X (not calc-display-strings)))
X (calc-refresh))
X)
X
X(defun calc-left-justify ()
X "Display stack entries left-justified in the window."
X (interactive)
X (calc-wrapper
X (setq calc-display-just nil)
X (calc-refresh))
X)
X
X(defun calc-center-justify ()
X "Display stack entries centered in the window."
X (interactive)
X (calc-wrapper
X (setq calc-display-just 'center)
X (calc-refresh))
X)
X
X(defun calc-right-justify ()
X "Display stack entries right-justified in the window."
X (interactive)
X (calc-wrapper
X (setq calc-display-just 'right)
X (calc-refresh))
X)
X
X(defun calc-auto-why (n)
X "Toggle automatic explanations of why results were left in symbolic form.
XThis can always be requested explicitly with the calc-why command.
XWith positive numeric prefix, turn mode on.
XWith 0 or negative prefix, turn mode off."
X (interactive "P")
X (calc-wrapper
X (setq calc-auto-why (if n
X (> (prefix-numeric-value n) 0)
X (not calc-auto-why)))
X (if calc-auto-why
X (message "Automatically executing a \"why\" command when appropriate.")
X (message "User must execute a \"why\" command to explain unsimplified results.")))
X)
X
X(defun calc-group-digits (n)
X "Toggle grouping of digits, or set group size to N digits.
XWith numeric prefix 0, display current setting.
XWith numeric prefix -1, disable grouping.
XWith other negative prefix, group after decimal point as well as before."
X (interactive "P")
X (calc-wrapper
X (if (consp n)
X (calc-pop-push-record 0 "grp" (cond ((null calc-group-digits) -1)
X ((eq calc-group-digits t)
X (if (memq calc-number-radix
X '(2 16)) 4 3))
X (t calc-group-digits)))
X (if n
X (let ((n (prefix-numeric-value n)))
X (cond ((or (> n 0) (< n -1))
X (setq calc-group-digits n))
X ((= n -1)
X (setq calc-group-digits nil))))
X (setq calc-group-digits (not calc-group-digits)))
X (calc-refresh)
X (cond ((null calc-group-digits)
X (message "Grouping is off."))
X ((integerp calc-group-digits)
X (message "Grouping every %d digits." (math-abs calc-group-digits)))
X (t
X (message "Grouping is on.")))))
X)
X
X(defun calc-group-char (ch)
X "Set the character to be used for grouping digits in calc-group-digits mode."
X (interactive "cGrouping character: ")
X (calc-wrapper
X (or (>= ch 32)
X (error "Control characters not allowed for grouping"))
X (setq calc-group-char (char-to-string ch))
X (if calc-group-digits
X (calc-refresh)))
X)
X
X(defun calc-point-char (ch)
X "Set the character to be used as the decimal point."
X (interactive "cCharacter to use as decimal point: ")
X (calc-wrapper
X (or (>= ch 32)
X (error "Control characters not allowed as decimal point"))
X (setq calc-point-char (char-to-string ch))
X (calc-refresh))
X)
X
X(defun calc-normal-notation (n)
X "Set normal (floating) notation for floating-point numbers.
XWith argument N > 0, round to N significant digits.
XWith argument -N < 0, round to current precision - N significant digits."
X (interactive "P")
X (calc-wrapper
X (setq calc-float-format (list 'float
X (if n (prefix-numeric-value n) 0)))
X (setq calc-full-float-format (list 'float 0))
X (calc-refresh))
X)
X
X(defun calc-fix-notation (n)
X "Set fixed-point notation for floating-point numbers."
X (interactive "NDigits after decimal point: ")
X (calc-wrapper
X (let ((n (prefix-numeric-value n)))
X (setq calc-float-format (list 'fix n)))
X (setq calc-full-float-format (list 'float 0))
X (calc-refresh))
X)
X
X(defun calc-sci-notation (n)
X "Set scientific notation for floating-point numbers.
XWith argument N > 0, round to N significant digits.
XWith argument -N < 0, round to current precision - N significant digits."
X (interactive "P")
X (calc-wrapper
X (let ((n (if n (prefix-numeric-value n) 0)))
X (setq calc-float-format (list 'sci n))) ; (if (> n 0) (1+ n) n)
X (setq calc-full-float-format (list 'sci 0))
X (calc-refresh))
X)
X
X(defun calc-eng-notation (n)
X "Set engineering notation for floating-point numbers.
XWith argument N > 0, round to N significant digits.
XWith argument -N < 0, round to current precision - N significant digits."
X (interactive "P")
X (calc-wrapper
X (let ((n (if n (prefix-numeric-value n) 0)))
X (setq calc-float-format (list 'eng n)))
X (setq calc-full-float-format (list 'eng 0))
X (calc-refresh))
X)
X
X(defun calc-complex-notation ()
X "Set (x,y) notation for display of complex numbers."
X (interactive)
X (calc-wrapper
X (setq calc-complex-format nil)
X (calc-refresh))
X)
X
X(defun calc-i-notation ()
X "Set x+yi notation for display of complex numbers."
X (interactive)
X (calc-wrapper
X (setq calc-complex-format 'i)
X (calc-refresh))
X)
X
X(defun calc-j-notation ()
X "Set x+yj notation for display of complex numbers."
X (interactive)
X (calc-wrapper
X (setq calc-complex-format 'j)
X (calc-refresh))
X)
X
X(defun calc-over-notation (fmt)
X "Set notation used for fractions. Argument should be one of :, ::, /, //, :/.
X\(During numeric entry, the : key is always used.)"
X (interactive "sFraction separator (:, ::, /, //, :/): ")
X (calc-wrapper
X (if (string-match "\\`[^ ][^ ]?\\'" fmt)
X (setq calc-frac-format fmt)
X (error "Bad fraction separator format."))
X (calc-refresh))
X)
X
X(defun calc-slash-notation (n)
X "Set \"a/b\" notation for fractions.
XWith a prefix argument, set \"a/b/c\" notation."
X (interactive "P")
X (calc-wrapper
X (setq calc-frac-format (if n "//" "/")))
X)
X
X(defun calc-hms-notation (fmt)
X "Set notation used for hours-minutes-seconds values.
XArgument should be something like: hms, deg m s, o'\".
X\(During numeric entry, @ ' \", o ' \", or h ' \" format must be used.)"
X (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ")
X (calc-wrapper
X (if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,; ]*\\)\\([^,; ]\\)\\'" fmt)
X (progn
X (setq calc-hms-format (concat "%s" (math-match-substring fmt 1)
X (math-match-substring fmt 2)
X "%s" (math-match-substring fmt 3)
X (math-match-substring fmt 4)
X "%s" (math-match-substring fmt 5)))
X (setq-default calc-hms-format calc-hms-format)) ; for minibuffer
X (error "Bad hours-minutes-seconds format."))
X (calc-refresh))
X)
X
X(defun calc-truncate-stack (n &optional rel)
X "Treat cursor line as \"top of stack\" for all further operations.
XObjects below this line are frozen, but still displayed."
X (interactive "P")
X (calc-wrapper
X (let ((oldtop calc-stack-top)
X (newtop calc-stack-top))
X (calc-record-undo (list 'set 'saved-stack-top calc-stack-top))
X (let ((calc-stack-top 0)
X (nn (prefix-numeric-value n)))
X (setq newtop
X (if n
X (progn
X (if rel
X (setq nn (+ oldtop nn))
X (if (< nn 0)
X (setq nn (+ nn (calc-stack-size)))
X (setq nn (1+ nn))))
X (if (< nn 1)
X 1
X (if (> nn (calc-stack-size))
X (calc-stack-size)
X nn)))
X (max 1 (calc-locate-cursor-element (point)))))
X (if (= newtop oldtop)
X ()
X (calc-pop-stack 1 oldtop)
X (calc-push-list '(top-of-stack) newtop)
X (if calc-line-numbering
X (calc-refresh))))
X (calc-record-undo (list 'set 'saved-stack-top 0))
X (setq calc-stack-top newtop)))
X)
X
X(defun calc-truncate-up (n)
X (interactive "p")
X (calc-truncate-stack n t)
X)
X
X(defun calc-truncate-down (n)
X (interactive "p")
X (calc-truncate-stack (- n) t)
X)
X
X(defun calc-display-raw ()
X (interactive)
X (calc-wrapper
X (setq calc-display-raw (not (eq calc-display-raw t)))
X (calc-refresh)
X (if calc-display-raw
X (message "Press d ' again to cancel \"raw\" display mode.")))
X)
X
X(defun calc-display-unformatted ()
X (interactive)
X (calc-wrapper
X (setq calc-display-raw (if (eq calc-display-raw 0) nil 0))
X (calc-refresh)
X (if calc-display-raw
X (message "Press d \" again to cancel \"unformatted\" display mode.")))
X)
X
X
X
X;;; Alternate entry/display languages.
X
X(defun calc-set-language (lang &optional option no-refresh)
X (setq calc-language lang
X calc-language-option (and option (prefix-numeric-value option))
X math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
X math-expr-function-mapping (get lang 'math-function-table)
X math-expr-variable-mapping (get lang 'math-variable-table)
X calc-language-input-filter (get lang 'math-input-filter)
X calc-language-output-filter (get lang 'math-output-filter)
X calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
X calc-complex-format (get lang 'math-complex-format)
X calc-radix-formatter (get lang 'math-radix-formatter)
X calc-function-open (or (get lang 'math-function-open) "(")
X calc-function-close (or (get lang 'math-function-close) ")"))
X (or no-refresh
X (calc-refresh))
X)
X
X(defun calc-normal-language ()
X "Set normal entry and display notation."
X (interactive)
X (calc-wrapper
X (calc-set-language nil))
X)
X
X(defun calc-flat-language ()
X "Set normal entry and display notation, with one-line display of matrices."
X (interactive)
X (calc-wrapper
X (calc-set-language 'flat))
X)
X
X(defun calc-big-language ()
X "Set big-format display notation."
X (interactive)
X (calc-wrapper
X (calc-set-language 'big))
X)
X
X(defun calc-unformatted-language ()
X "Set normal entry and display notation with no operators: add(a, mul(b,c))."
X (interactive)
X (calc-wrapper
X (calc-set-language 'unform))
X)
X
X
X(defun calc-c-language ()
X "Set C-language entry and display notation."
X (interactive)
X (calc-wrapper
X (calc-set-language 'c))
X)
X
X(put 'c 'math-oper-table
X '( ( "u+" ident -1 1000 )
X ( "u-" neg -1 1000 )
X ( "u!" calcFunc-lnot -1 1000 )
X ( "~" calcFunc-not -1 1000 )
X ( "*" * 190 191 )
X ( "/" / 190 191 )
X ( "%" % 190 191 )
X ( "+" + 180 181 )
X ( "-" - 180 181 )
X ( "<<" calcFunc-lsh 170 171 )
X ( ">>" calcFunc-rsh 170 171 )
X ( "<" calcFunc-lt 160 161 )
X ( ">" calcFunc-gt 160 161 )
X ( "<=" calcFunc-leq 160 161 )
X ( ">=" calcFunc-geq 160 161 )
X ( "==" calcFunc-eq 150 151 )
X ( "!=" calcFunc-neq 150 151 )
X ( "&" calcFunc-and 140 141 )
X ( "^" calcFunc-xor 131 130 )
X ( "|" calcFunc-or 120 121 )
X ( "&&" calcFunc-land 110 111 )
X ( "||" calcFunc-lor 100 101 )
X ( "?" calcFunc-if 91 90 )
X ( "=" calcFunc-assign 81 80 )
X)) ; should support full assignments
X
X(put 'c 'math-function-table
X '( ( acos . calcFunc-arccos )
X ( acosh . calcFunc-arccosh )
X ( asin . calcFunc-arcsin )
X ( asinh . calcFunc-arcsinh )
SHAR_EOF
echo "End of part 4"
echo "File calc-ext.el is continued in part 5"
echo "5" > s2_seq_.tmp
exit 0