v15i029: Patch for GNU Emacs Calc, version 1.04 -> 1.05, part 02/20
David Gillespie
daveg at csvax.cs.caltech.edu
Mon Oct 15 11:15:19 AEST 1990
Posting-number: Volume 15, Issue 29
Submitted-by: daveg at csvax.cs.caltech.edu (David Gillespie)
Archive-name: calc-1.05/part02
#!/bin/sh
# this is part 2 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc.patch continued
#
CurArch=2
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 (let* ((calc-command-flags nil)
X***************
X*** 894,906 ****
X (while res
X (setq buf (concat buf
X (and buf (or separator ", "))
X! (if calc-extensions-loaded
X! (math-format-value (car res) 1000)
X! (math-format-flat-expr (car res) 0)))
X res (cdr res)))
X buf)))
X )
X
X (defun calc-summary (&optional full)
X (interactive)
X (if full
X--- 1036,1048 ----
X (while res
X (setq buf (concat buf
X (and buf (or separator ", "))
X! (math-format-value (car res) 1000))
X res (cdr res)))
X buf)))
X )
X
X+ ;;;; [calc.el]
X+
X (defun calc-summary (&optional full)
X (interactive)
X (if full
X***************
X*** 908,913 ****
X--- 1050,1057 ----
X (message "Welcome to the GNU Emacs Calculator! Press `?' or `i' for help, `q' to quit."))
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calc-info ()
X "Run the Emacs Info system on the Calculator documentation."
X (interactive)
X***************
X*** 928,974 ****
X "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
X "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
X "Other keys: ' (alg-entry), = (evaluate), ` (edit)"
X! "Other keys: RET (enter), DEL (drop), TAB (swap), M-TAB (roll)"
X! "Other keys: [ ] (vector), ( ) (complex); < > (hscroll)"
X! "Prefix keys: Algebra, Binary, Convert, Display, Kombinatorics"
X! "Prefix keys: Modes, Trail, Units, Vectors"
X "Prefix keys: Z (user), SHIFT + Z (define-user)"
X "Prefix keys: prefix + ? gives further help for that prefix"
X! " Copyright (C) 1990 Dave Gillespie, daveg at csvax.caltech.edu")))
X! (setq calc-help-phase
X! (if (eq this-command last-command)
X! (% (1+ calc-help-phase) (1+ (length msgs)))
X! 0))
X! (let ((msg (nth calc-help-phase msgs)))
X! (message "%s" (if msg
X! (concat msg ":"
X! (make-string (- (apply 'max
X! (mapcar 'length msgs))
X! (length msg)) 32)
X! " [?=MORE]")
X! ""))))
X! )
X! (setq calc-help-phase 0)
X!
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! (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--- 1072,1106 ----
X "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
X "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
X "Other keys: ' (alg-entry), = (evaluate), ` (edit)"
X! "Other keys: SPC/RET (enter/dup), LFD (over), DEL (drop)"
X! "Other keys: TAB (swap/roll-dn), M-TAB (roll-up); < > (hscroll)"
X! "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
X! "Prefix keys: Algebra, Binary, Convert, Display, Functions, Graph"
X! "Prefix keys: J (select), Komb/stat, Modes, Trail, Units, Vectors"
X "Prefix keys: Z (user), SHIFT + Z (define-user)"
X "Prefix keys: prefix + ? gives further help for that prefix"
X! " Copyright (C) 1990 Dave Gillespie, daveg at csvax.cs.caltech.edu")))
X! (if calc-full-help-flag
X! msgs
X! (if (or calc-inverse-flag calc-hyperbolic-flag)
X! (if calc-inverse-flag
X! (if calc-hyperbolic-flag
X! (calc-inv-hyp-prefix-help)
X! (calc-inverse-prefix-help))
X! (calc-hyperbolic-prefix-help))
X! (setq calc-help-phase
X! (if (eq this-command last-command)
X! (% (1+ calc-help-phase) (1+ (length msgs)))
X! 0))
X! (let ((msg (nth calc-help-phase msgs)))
X! (message "%s" (if msg
X! (concat msg ":"
X! (make-string (- (apply 'max
X! (mapcar 'length
X! msgs))
X! (length msg)) 32)
X! " [?=MORE]")
X! ""))))))
X )
X
X
X***************
X*** 976,1000 ****
X
X ;;;; Stack and buffer management.
X
X (defmacro calc-wrapper (&rest body)
X! (` (let ((calc-command-flags nil))
X! (unwind-protect
X! (progn
X! (, (append '(save-excursion (calc-select-buffer))
X! body
X! '((calc-finish-command)))))
X! (calc-cleanup-command))))
X )
X
X (defmacro calc-slow-wrapper (&rest body)
X! (` (let ((calc-command-flags (list 'clear-message)))
X! (if calc-display-working-message (message "Working..."))
X! (unwind-protect
X (progn
X! (, (append '(save-excursion (calc-select-buffer))
X! body
X! '((calc-finish-command)))))
X! (calc-cleanup-command))))
X )
X
X (defun calc-set-command-flag (f)
X--- 1108,1153 ----
X
X ;;;; Stack and buffer management.
X
X+ ;;;; [calc-macs.el]
X+
X (defmacro calc-wrapper (&rest body)
X! (list 'calc-do (list 'function (append (list 'lambda ()) body)))
X )
X
X+ ;; We use "point" here to generate slightly smaller byte-code than "t".
X (defmacro calc-slow-wrapper (&rest body)
X! (list 'calc-do (list 'function (append (list 'lambda ()) body)) (point))
X! )
X!
X! ;;;; [calc.el]
X!
X! (defun calc-do (do-body &optional do-slow)
X! (let ((calc-command-flags nil))
X! (unwind-protect
X! (save-excursion
X! (calc-select-buffer)
X! (and do-slow calc-display-working-message
X! (progn
X! (message "Working...")
X! (calc-set-command-flag 'clear-message)))
X! (funcall do-body)
X! (and (memq 'renum-stack calc-command-flags)
X! (calc-renumber-stack))
X! (and (memq 'clear-message calc-command-flags)
X! (message "")))
X! (or (memq 'no-align calc-command-flags)
X! (eq major-mode 'calc-trail-mode)
X! (calc-align-stack-window))
X! (and (memq 'position-point calc-command-flags)
X (progn
X! (goto-line calc-final-point-line)
X! (move-to-column calc-final-point-column)))
X! (or (memq 'keep-flags calc-command-flags)
X! (setq calc-inverse-flag nil
X! calc-hyperbolic-flag nil))
X! (and (memq 'do-edit calc-command-flags)
X! (switch-to-buffer (get-buffer-create "*Calc Edit*")))
X! (calc-set-mode-line)))
X )
X
X (defun calc-set-command-flag (f)
X***************
X*** 1002,1011 ****
X (setq calc-command-flags (cons f calc-command-flags)))
X )
X
X- (defun calc-clear-command-flag (f)
X- (setq calc-command-flags (delq f calc-command-flags))
X- )
X-
X (defun calc-select-buffer ()
X (if (not (eq major-mode 'calc-mode))
X (if calc-main-buffer
X--- 1155,1160 ----
X***************
X*** 1016,1037 ****
X (error "Calculator buffer not available")))))
X )
X
X- (defun calc-finish-command ()
X- (and (memq 'renum-stack calc-command-flags)
X- (calc-renumber-stack))
X- (and (memq 'clear-message calc-command-flags)
X- (message ""))
X- )
X-
X- (defun calc-cleanup-command ()
X- (or (memq 'no-align calc-command-flags)
X- (calc-align-stack-window))
X- (or (memq 'keep-flags calc-command-flags)
X- (setq calc-inverse-flag nil
X- calc-hyperbolic-flag nil))
X- (calc-set-mode-line)
X- )
X-
X (defun calc-cursor-stack-index (&optional index)
X (goto-char (point-max))
X (forward-line (- (calc-substack-height (or index 1))))
X--- 1165,1170 ----
X***************
X*** 1072,1078 ****
X ((= calc-number-radix 8) "Oct ")
X ((= calc-number-radix 16) "Hex ")
X (t (format "Radix%d " calc-number-radix)))
X! (if calc-algebraic-mode "Alg " "")
X (if calc-symbolic-mode "Symb " "")
X (cond ((eq calc-simplify-mode 'none) "NoSimp ")
X ((eq calc-simplify-mode 'num) "NumSimp ")
X--- 1205,1212 ----
X ((= calc-number-radix 8) "Oct ")
X ((= calc-number-radix 16) "Hex ")
X (t (format "Radix%d " calc-number-radix)))
X! (if calc-algebraic-mode "Alg "
X! (if calc-incomplete-algebraic-mode "IncAlg " ""))
X (if calc-symbolic-mode "Symb " "")
X (cond ((eq calc-simplify-mode 'none) "NoSimp ")
X ((eq calc-simplify-mode 'num) "NumSimp ")
X***************
X*** 1095,1100 ****
X--- 1229,1237 ----
X (if (zerop figs) "Sci " (format "Sci%d " figs)))
X ((eq fmt 'eng)
X (if (zerop figs) "Eng " (format "Eng%d " figs))))
X+ (if calc-assoc-selections "" "Break ")
X+ (if (and (fboundp 'calc-gnuplot-alive)
X+ (calc-gnuplot-alive)) "Graph " "")
X (if calc-inverse-flag "Inv " "")
X (if calc-hyperbolic-flag "Hyp " "")
X (if (/= calc-stack-top 1) "Narrow " "")
X***************
X*** 1124,1149 ****
X (error "Invalid argument"))
X )
X
X! (defun calc-push (&rest vals)
X! (if (memq nil vals)
X! (error "Invalid operation")
X! (calc-push-list vals))
X! )
X!
X! (defun calc-push-list (vals &optional m)
X (while vals
X (if calc-executing-macro
X! (let ((entry (list (car vals) 1))
X! (mm (+ (or m 1) calc-stack-top)))
X! (if (> mm 1)
X! (setcdr (nthcdr (- mm 2) calc-stack)
X! (cons entry (nthcdr (1- mm) calc-stack)))
X! (setq calc-stack (cons entry calc-stack))))
X (save-excursion
X (calc-select-buffer)
X (let* ((val (car vals))
X! (fmt (math-format-stack-value val))
X! (entry (list val (calc-count-lines fmt)))
X (mm (+ (or m 1) calc-stack-top)))
X (calc-cursor-stack-index (1- (or m 1)))
X (if (> mm 1)
X--- 1261,1274 ----
X (error "Invalid argument"))
X )
X
X! (defun calc-push-list (vals &optional m sels)
X (while vals
X (if calc-executing-macro
X! (calc-push-list-in-macro vals m sels)
X (save-excursion
X (calc-select-buffer)
X (let* ((val (car vals))
X! (entry (list val 1 (car sels)))
X (mm (+ (or m 1) calc-stack-top)))
X (calc-cursor-stack-index (1- (or m 1)))
X (if (> mm 1)
X***************
X*** 1151,1198 ****
X (cons entry (nthcdr (1- mm) calc-stack)))
X (setq calc-stack (cons entry calc-stack)))
X (let ((buffer-read-only nil))
X! (insert fmt "\n"))
X (calc-record-undo (list 'push mm))
X (calc-set-command-flag 'renum-stack))))
X! (setq vals (cdr vals)))
X! )
X!
X! (defun calc-count-lines (s)
X! (let ((pos 0)
X! (num 1))
X! (while (setq newpos (string-match "\n" s pos))
X! (setq pos (1+ newpos)
X! num (1+ num)))
X! num)
X )
X
X! (defun calc-pop-push-list (n vals)
X! (if (memq nil vals)
X! (error "Invalid operation"))
X! (calc-pop-stack n)
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-list (n prefix vals)
X! (if (and (consp vals)
X (or (integerp (car vals))
X (consp (car vals))))
X! (if (memq nil vals)
X! (error "Invalid operation"))
X! (and vals (setq vals (list vals))))
X! (calc-check-stack n)
X (if prefix
X! (if vals
X (calc-record-list vals prefix)
X! (calc-record nil prefix)))
X! (calc-pop-push-list n vals)
X )
X
X! (defun calc-enter-result (n prefix vals)
X (if (and (consp vals)
X (or (integerp (car vals))
X (consp (car vals))))
X--- 1276,1310 ----
X (cons entry (nthcdr (1- mm) calc-stack)))
X (setq calc-stack (cons entry calc-stack)))
X (let ((buffer-read-only nil))
X! (insert (math-format-stack-value entry) "\n"))
X (calc-record-undo (list 'push mm))
X (calc-set-command-flag 'renum-stack))))
X! (setq vals (cdr vals)
X! sels (cdr sels)))
X )
X
X! (defun calc-pop-push-list (n vals &optional m sels)
X! (if (and calc-any-selections (null sels))
X! (calc-replace-selections n vals m)
X! (calc-pop-stack n m sels)
X! (calc-push-list vals m sels))
X )
X
X! (defun calc-pop-push-record-list (n prefix vals &optional m sels)
X! (or (and (consp vals)
X (or (integerp (car vals))
X (consp (car vals))))
X! (and vals (setq vals (list vals)
X! sels (and sels (list sels)))))
X! (calc-check-stack (+ n (or m 1) -1))
X (if prefix
X! (if (cdr vals)
X (calc-record-list vals prefix)
X! (calc-record (car vals) prefix)))
X! (calc-pop-push-list n vals m sels)
X )
X
X! (defun calc-enter-result (n prefix vals &optional m)
X (if (and (consp vals)
X (or (integerp (car vals))
X (consp (car vals))))
X***************
X*** 1204,1210 ****
X (setq vals (list vals)))
X (if (equal vals '((nil)))
X (setq vals nil))
X! (calc-pop-push-record-list n prefix vals)
X (calc-handle-whys)
X )
X
X--- 1316,1322 ----
X (setq vals (list vals)))
X (if (equal vals '((nil)))
X (setq vals nil))
X! (calc-pop-push-record-list n prefix vals m)
X (calc-handle-whys)
X )
X
X***************
X*** 1212,1228 ****
X (if (memq calc-simplify-mode '(nil none num))
X (math-normalize val)
X (calc-extensions)
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 (defun calc-handle-whys ()
X--- 1324,1330 ----
X (if (memq calc-simplify-mode '(nil none num))
X (math-normalize val)
X (calc-extensions)
X! (calc-normalize-fancy val))
X )
X
X (defun calc-handle-whys ()
X***************
X*** 1230,1268 ****
X calc-next-why nil)
X (if (and calc-why calc-auto-why)
X (progn
X (calc-explain-why (car calc-why))
X (calc-clear-command-flag 'clear-message)))
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 '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! (while (setq why (cdr 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-record-why (&rest stuff)
X (setq calc-next-why (cons stuff calc-next-why))
X--- 1332,1343 ----
X calc-next-why nil)
X (if (and calc-why calc-auto-why)
X (progn
X+ (calc-extensions)
X (calc-explain-why (car calc-why))
X (calc-clear-command-flag 'clear-message)))
X )
X
X! ;;;; [calc-misc.el]
X
X (defun calc-record-why (&rest stuff)
X (setq calc-next-why (cons stuff calc-next-why))
X***************
X*** 1269,1288 ****
X nil
X )
X
X! (defun calc-pop-push-record (n prefix &rest vals)
X! (calc-pop-push-record-list n prefix vals)
X! )
X
X! (defun calc-pop-stack (&optional n m) ; pop N objects at level M of stack.
X (or n (setq n 1))
X (or m (setq m 1))
X (let ((mm (+ m calc-stack-top)))
X (if calc-executing-macro
X! (if (> mm 1)
X! (setcdr (nthcdr (- mm 2) calc-stack)
X! (nthcdr (+ n mm -1) calc-stack))
X! (setq calc-stack (nthcdr n calc-stack)))
X! (calc-record-undo (list 'pop mm (calc-top-list n m)))
X (save-excursion
X (calc-select-buffer)
X (let ((buffer-read-only nil))
X--- 1344,1361 ----
X nil
X )
X
X! ;;;; [calc.el]
X
X! (defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack.
X (or n (setq n 1))
X (or m (setq m 1))
X (let ((mm (+ m calc-stack-top)))
X+ (if (and calc-any-selections (not sel-ok)
X+ (calc-top-selected n m))
X+ (calc-sel-error))
X (if calc-executing-macro
X! (calc-pop-stack-in-macro n mm)
X! (calc-record-undo (list 'pop mm (calc-top-list n m 'full)))
X (save-excursion
X (calc-select-buffer)
X (let ((buffer-read-only nil))
X***************
X*** 1300,1317 ****
X (calc-set-command-flag 'renum-stack)))))
X )
X
X! (defun calc-top (&optional n)
X! "Get the Nth element of the stack (N=1 is the top element)."
X (or n (setq n 1))
X (calc-check-stack n)
X! (car-safe (nth (+ n calc-stack-top -1) calc-stack))
X )
X
X! (defun calc-top-n (&optional n) ; in case precision has changed
X! (math-check-complete (calc-normalize (calc-top n)))
X )
X
X! (defun calc-top-list (&optional n m)
X (or n (setq n 1))
X (or m (setq m 1))
X (calc-check-stack (+ n m -1))
X--- 1373,1404 ----
X (calc-set-command-flag 'renum-stack)))))
X )
X
X! (defun calc-get-stack-element (x)
X! (cond ((eq sel-mode 'entry)
X! x)
X! ((eq sel-mode 'sel)
X! (nth 2 x))
X! ((or (null (nth 2 x))
X! (eq sel-mode 'full)
X! (not calc-use-selections))
X! (car x))
X! (sel-mode
X! (calc-sel-error))
X! (t (nth 2 x)))
X! )
X!
X! ;; Get the Nth element of the stack (N=1 is the top element).
X! (defun calc-top (&optional n sel-mode)
X (or n (setq n 1))
X (calc-check-stack n)
X! (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack))
X )
X
X! (defun calc-top-n (&optional n sel-mode) ; in case precision has changed
X! (math-check-complete (calc-normalize (calc-top n sel-mode)))
X )
X
X! (defun calc-top-list (&optional n m sel-mode)
X (or n (setq n 1))
X (or m (setq m 1))
X (calc-check-stack (+ n m -1))
X***************
X*** 1319,1332 ****
X (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
X calc-stack))))
X (setcdr (nthcdr (1- n) top) nil)
X! (nreverse (mapcar 'car-safe top))))
X )
X
X! (defun calc-top-list-n (&optional n m)
X (mapcar 'math-check-complete
X! (mapcar 'calc-normalize (calc-top-list n m)))
X )
X
X (defun calc-roll-down-stack (n &optional m)
X (if (< n 0)
X (calc-roll-up-stack (- n) m)
X--- 1406,1421 ----
X (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
X calc-stack))))
X (setcdr (nthcdr (1- n) top) nil)
X! (nreverse (mapcar 'calc-get-stack-element top))))
X )
X
X! (defun calc-top-list-n (&optional n m sel-mode)
X (mapcar 'math-check-complete
X! (mapcar 'calc-normalize (calc-top-list n m sel-mode)))
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calc-roll-down-stack (n &optional m)
X (if (< n 0)
X (calc-roll-up-stack (- n) m)
X***************
X*** 1334,1342 ****
X (or m (setq m 1))
X (and (> n 1)
X (< m n)
X! (calc-pop-push-list n
X! (append (calc-top-list m 1)
X! (calc-top-list (- n m) (1+ m))))))
X )
X
X (defun calc-roll-up-stack (n &optional m)
X--- 1423,1434 ----
X (or m (setq m 1))
X (and (> n 1)
X (< m n)
X! (if (and calc-any-selections
X! (not calc-use-selections))
X! (calc-roll-down-with-selections n m)
X! (calc-pop-push-list n
X! (append (calc-top-list m 1)
X! (calc-top-list (- n m) (1+ m)))))))
X )
X
X (defun calc-roll-up-stack (n &optional m)
X***************
X*** 1346,1415 ****
X (or m (setq m 1))
X (and (> n 1)
X (< m n)
X! (calc-pop-push-list n
X! (append (calc-top-list (- n m) 1)
X! (calc-top-list m (- n m -1))))))
X )
X
X (defun calc-renumber-stack ()
X (if calc-line-numbering
X (save-excursion
X (calc-cursor-stack-index 0)
X (let ((lnum 1)
X! (buffer-read-only nil))
X! (if (re-search-forward "^[0-9]+:" nil t)
X (progn
X (beginning-of-line)
X! (while (re-search-forward "^[0-9]+:" nil t)
X (let ((buffer-read-only nil))
X (beginning-of-line)
X (delete-char 4)
X (insert " ")))
X (calc-cursor-stack-index 0)))
X! (while (re-search-backward "^[0-9]+:" nil t)
X (delete-char 4)
X (if (> lnum 999)
X! (insert (format "%03d:" (% lnum 1000)))
X (let ((prefix (int-to-string lnum)))
X! (insert prefix ":" (make-string (- 3 (length prefix)) 32))))
X (beginning-of-line)
X! (setq lnum (1+ lnum))))))
X )
X
X (defun calc-refresh (&optional align)
X "Refresh the contents of the Calculator buffer from memory."
X (interactive)
X! (if (and (eq major-mode 'calc-mode)
X! (not calc-executing-macro))
X! (let ((buffer-read-only nil)
X! (save-point (point))
X! (save-mark (mark))
X! (save-aligned (looking-at "\\.$"))
X! (thing calc-stack))
X! (erase-buffer)
X! (insert "--- Emacs Calculator Mode ---\n")
X! (while thing
X! (goto-char (point-min))
X! (forward-line 1)
X! (let ((fmt (math-format-stack-value (car (car thing)))))
X! (setcar (cdr (car thing)) (calc-count-lines fmt))
X! (insert fmt "\n"))
X! (setq thing (cdr thing)))
X! (calc-renumber-stack)
X! (if (or align save-aligned)
X! (calc-align-stack-window)
X! (goto-char save-point))
X! (set-mark save-mark)))
X (setq calc-refresh-count (1+ calc-refresh-count))
X )
X- (setq calc-refresh-count 0)
X
X- (defun calc-realign ()
X- "Realign Calc window with cursor and top-of-stack at the bottom."
X- (interactive)
X- (calc-wrapper)
X- )
X-
X (defun calc-x-paste-text (arg)
X "Move point to mouse position and insert window system cut buffer contents.
X If mouse is pressed in Calc window, push cut buffer contents onto the stack."
X--- 1438,1510 ----
X (or m (setq m 1))
X (and (> n 1)
X (< m n)
X! (if (and calc-any-selections
X! (not calc-use-selections))
X! (calc-roll-up-with-selections n m)
X! (calc-pop-push-list n
X! (append (calc-top-list (- n m) 1)
X! (calc-top-list m (- n m -1)))))))
X )
X
X+ ;;;; [calc.el]
X+
X (defun calc-renumber-stack ()
X (if calc-line-numbering
X (save-excursion
X (calc-cursor-stack-index 0)
X (let ((lnum 1)
X! (buffer-read-only nil)
X! (stack (nthcdr calc-stack-top calc-stack)))
X! (if (re-search-forward "^[0-9]+[:*]" nil t)
X (progn
X (beginning-of-line)
X! (while (re-search-forward "^[0-9]+[:*]" nil t)
X (let ((buffer-read-only nil))
X (beginning-of-line)
X (delete-char 4)
X (insert " ")))
X (calc-cursor-stack-index 0)))
X! (while (re-search-backward "^[0-9]+[:*]" nil t)
X (delete-char 4)
X (if (> lnum 999)
X! (insert (format "%03d%s" (% lnum 1000)
X! (if (and (nth 2 (car stack))
X! calc-use-selections) "*" ":")))
X (let ((prefix (int-to-string lnum)))
X! (insert prefix (if (and (nth 2 (car stack))
X! calc-use-selections) "*" ":")
X! (make-string (- 3 (length prefix)) 32))))
X (beginning-of-line)
X! (setq lnum (1+ lnum)
X! stack (cdr stack))))))
X )
X
X (defun calc-refresh (&optional align)
X "Refresh the contents of the Calculator buffer from memory."
X (interactive)
X! (and (eq major-mode 'calc-mode)
X! (not calc-executing-macro)
X! (let ((buffer-read-only nil)
X! (save-point (point))
X! (save-mark (mark))
X! (save-aligned (looking-at "\\.$"))
X! (thing calc-stack))
X! (setq calc-any-selections nil)
X! (erase-buffer)
X! (insert "--- Emacs Calculator Mode ---\n")
X! (while thing
X! (goto-char (point-min))
X! (forward-line 1)
X! (insert (math-format-stack-value (car thing)) "\n")
X! (setq thing (cdr thing)))
X! (calc-renumber-stack)
X! (if (or align save-aligned)
X! (calc-align-stack-window)
X! (goto-char save-point))
X! (set-mark save-mark)))
X (setq calc-refresh-count (1+ calc-refresh-count))
X )
X
X (defun calc-x-paste-text (arg)
X "Move point to mouse position and insert window system cut buffer contents.
X If mouse is pressed in Calc window, push cut buffer contents onto the stack."
X***************
X*** 1434,1444 ****
X (save-excursion
X (let ((win (get-buffer-window (current-buffer))))
X (and win
X! (pos-visible-in-window-p (1- (point-max)) win)
X! ; (not (pos-visible-in-window-p (point-max) win))
X! )))
X )
X
X (defmacro math-showing-full-precision (body)
X (list 'let
X '((calc-float-format calc-full-float-format))
X--- 1529,1539 ----
X (save-excursion
X (let ((win (get-buffer-window (current-buffer))))
X (and win
X! (pos-visible-in-window-p (1- (point-max)) win))))
X )
X
X+ ;;;; [calc-macs.el]
X+
X (defmacro math-showing-full-precision (body)
X (list 'let
X '((calc-float-format calc-full-float-format))
X***************
X*** 1445,1450 ****
X--- 1540,1547 ----
X body)
X )
X
X+ ;;;; [calc.el]
X+
X (defun calc-trail-buffer ()
X (and (or (null calc-trail-buffer)
X (null (buffer-name calc-trail-buffer)))
X***************
X*** 1453,1459 ****
X (let ((buf (current-buffer)))
X (set-buffer calc-trail-buffer)
X (or (eq major-mode 'calc-trail-mode)
X! (calc-trail-mode (current-buffer))))))
X calc-trail-buffer
X )
X
X--- 1550,1562 ----
X (let ((buf (current-buffer)))
X (set-buffer calc-trail-buffer)
X (or (eq major-mode 'calc-trail-mode)
X! (calc-trail-mode buf)))))
X! (or (and calc-trail-pointer
X! (eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
X! (save-excursion
X! (set-buffer calc-trail-buffer)
X! (goto-line 2)
X! (setq calc-trail-pointer (point-marker))))
X calc-trail-buffer
X )
X
X***************
X*** 1461,1467 ****
X (or calc-executing-macro
X (let* ((mainbuf (current-buffer))
X (buf (calc-trail-buffer))
X! (calc-display-raw (eq calc-display-raw t))
X (fval (if val
X (if (stringp val)
X val
X--- 1564,1571 ----
X (or calc-executing-macro
X (let* ((mainbuf (current-buffer))
X (buf (calc-trail-buffer))
X! (calc-display-raw nil)
X! (calc-can-abbrev-vectors t)
X (fval (if val
X (if (stringp val)
X val
X***************
X*** 1474,1490 ****
X (buffer-read-only nil))
X (goto-char (point-max))
X (cond ((null prefix) (insert " "))
X! ((> (length prefix) 5) (insert (substring prefix 0 5) " "))
X (t (insert (format "%4s " prefix))))
X (insert fval "\n")
X (let ((win (get-buffer-window buf)))
X (if (and aligned win (not (memq 'hold-trail calc-command-flags)))
X! (progn
X! (calc-trail-here))))
X! (goto-char (1- (point-max)))))))
X val
X )
X
X (defun calc-record-list (vals &optional prefix)
X (while vals
X (or (eq (car vals) 'top-of-stack)
X--- 1578,1597 ----
X (buffer-read-only nil))
X (goto-char (point-max))
X (cond ((null prefix) (insert " "))
X! ((and (> (length prefix) 4)
X! (string-match " " prefix 4))
X! (insert (substring prefix 0 4) " "))
X (t (insert (format "%4s " prefix))))
X (insert fval "\n")
X (let ((win (get-buffer-window buf)))
X (if (and aligned win (not (memq 'hold-trail calc-command-flags)))
X! (calc-trail-here))
X! (goto-char (1- (point-max))))))))
X val
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calc-record-list (vals &optional prefix)
X (while vals
X (or (eq (car vals) 'top-of-stack)
X***************
X*** 1494,1499 ****
X--- 1601,1608 ----
X (setq vals (cdr vals)))
X )
X
X+ ;;;; [calc.el]
X+
X (defun calc-trail-display (flag &optional no-refresh)
X "Turn the Trail display on or off.
X With prefix argument 1, turn it on; with argument 0, turn it off."
X***************
X*** 1508,1513 ****
X--- 1617,1624 ----
X (let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
X (set-window-buffer w calc-trail-buffer)))
X (calc-wrapper
X+ (setq overlay-arrow-string calc-trail-overlay
X+ overlay-arrow-position calc-trail-pointer)
X (or no-refresh
X (calc-refresh)))))
X (if win
X***************
X*** 1515,1524 ****
X (delete-window win)
X (calc-wrapper
X (or no-refresh
X! (calc-refresh)))))
X! (if (and (boundp 'overlay-arrow-position)
X! (eq overlay-arrow-position calc-trail-pointer))
X! (setq overlay-arrow-position nil))))
X calc-trail-buffer
X )
X
X--- 1626,1632 ----
X (delete-window win)
X (calc-wrapper
X (or no-refresh
X! (calc-refresh)))))))
X calc-trail-buffer
X )
X
X***************
X*** 1535,1543 ****
X (if (or (bobp) (eobp))
X (setq overlay-arrow-position nil) ; trail is empty
X (set-marker calc-trail-pointer (point) (current-buffer))
X! (setq overlay-arrow-string (concat (buffer-substring (point)
X! (+ (point) 4))
X! ">")
X overlay-arrow-position calc-trail-pointer)
X (forward-char 4)
X (let ((win (get-buffer-window (current-buffer))))
X--- 1643,1652 ----
X (if (or (bobp) (eobp))
X (setq overlay-arrow-position nil) ; trail is empty
X (set-marker calc-trail-pointer (point) (current-buffer))
X! (setq calc-trail-overlay (concat (buffer-substring (point)
X! (+ (point) 4))
X! ">")
X! overlay-arrow-string calc-trail-overlay
X overlay-arrow-position calc-trail-pointer)
X (forward-char 4)
X (let ((win (get-buffer-window (current-buffer))))
X***************
X*** 1546,1552 ****
X (forward-line (/ (window-height) 2))
X (forward-line (- 1 (window-height)))
X (set-window-start win (point))
X! (set-window-point win (+ calc-trail-pointer 4)))))))
X (error "Not in Calc Trail buffer"))
X )
X
X--- 1655,1664 ----
X (forward-line (/ (window-height) 2))
X (forward-line (- 1 (window-height)))
X (set-window-start win (point))
X! (set-window-point win (+ calc-trail-pointer 4))
X! (set-buffer calc-main-buffer)
X! (setq overlay-arrow-string calc-trail-overlay
X! overlay-arrow-position calc-trail-pointer))))))
X (error "Not in Calc Trail buffer"))
X )
X
X***************
X*** 1569,1584 ****
X
X ;;; Arithmetic commands.
X
X! (defun calc-binary-op (name func arg &optional ident unary)
X (if (null arg)
X! (calc-enter-result 2 name (cons func (calc-top-list-n 2)))
X (calc-extensions)
X (calc-binary-op-fancy name func arg ident unary))
X )
X
X! (defun calc-unary-op (name func arg)
X (if (null arg)
X! (calc-enter-result 1 name (list func (calc-top-n 1)))
X (calc-extensions)
X (calc-unary-op-fancy name func arg))
X )
X--- 1681,1696 ----
X
X ;;; Arithmetic commands.
X
X! (defun calc-binary-op (name func arg &optional ident unary func2)
X (if (null arg)
X! (calc-enter-result 2 name (cons (or func2 func) (calc-top-list-n 2)))
X (calc-extensions)
X (calc-binary-op-fancy name func arg ident unary))
X )
X
X! (defun calc-unary-op (name func arg &optional func2)
X (if (null arg)
X! (calc-enter-result 1 name (list (or func2 func) (calc-top-n 1)))
X (calc-extensions)
X (calc-unary-op-fancy name func arg))
X )
X***************
X*** 1588,1594 ****
X "Add the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "+" 'calcFunc-add arg 0))
X )
X
X (defun calc-minus (arg)
X--- 1700,1706 ----
X "Add the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "+" 'calcFunc-add arg 0 nil '+))
X )
X
X (defun calc-minus (arg)
X***************
X*** 1595,1601 ****
X "Subtract the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "-" 'calcFunc-sub arg 0 'calcFunc-neg))
X )
X
X (defun calc-times (arg)
X--- 1707,1713 ----
X "Subtract the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-))
X )
X
X (defun calc-times (arg)
X***************
X*** 1602,1608 ****
X "Multiply the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "*" 'calcFunc-mul arg 1))
X )
X
X (defun calc-divide (arg)
X--- 1714,1720 ----
X "Multiply the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*))
X )
X
X (defun calc-divide (arg)
X***************
X*** 1609,1622 ****
X "Divide the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv))
X )
X
X (defun calc-power (arg)
X! "Compute y^x for the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "^" 'calcFunc-pow arg))
X )
X
X (defun calc-mod (arg)
X--- 1721,1740 ----
X "Divide the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calc-power (arg)
X! "Compute y^x for the top two elements of the Calculator stack.
X! With Inverse flag, compute y^(1/x), i.e., the x'th root of y."
X (interactive "P")
X (calc-slow-wrapper
X! (if (and calc-extensions-loaded
X! (calc-is-inverse))
X! (calc-binary-op "root" 'calcFunc-nroot arg nil nil)
X! (calc-binary-op "^" 'calcFunc-pow arg nil nil '^)))
X )
X
X (defun calc-mod (arg)
X***************
X*** 1623,1629 ****
X "Compute the modulo of the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "%" 'calcFunc-mod arg))
X )
X
X (defun calc-inv (arg)
X--- 1741,1747 ----
X "Compute the modulo of the top two elements of the Calculator stack."
X (interactive "P")
X (calc-slow-wrapper
X! (calc-binary-op "%" 'calcFunc-mod arg nil nil '%))
X )
X
X (defun calc-inv (arg)
X***************
X*** 1633,1643 ****
X (calc-unary-op "inv" 'calcFunc-inv arg))
X )
X
X (defun calc-change-sign (arg)
X "Change the sign of the top element of the Calculator stack."
X (interactive "P")
X (calc-wrapper
X! (calc-unary-op "chs" 'calcFunc-neg arg))
X )
X
X
X--- 1751,1763 ----
X (calc-unary-op "inv" 'calcFunc-inv arg))
X )
X
X+ ;;;; [calc.el]
X+
X (defun calc-change-sign (arg)
X "Change the sign of the top element of the Calculator stack."
X (interactive "P")
X (calc-wrapper
X! (calc-unary-op "chs" 'neg arg))
X )
X
X
X***************
X*** 1650,1656 ****
X (interactive "p")
X (calc-wrapper
X (cond ((< n 0)
X! (calc-push (calc-top (- n))))
X ((= n 0)
X (calc-push-list (calc-top-list (calc-stack-size))))
X (t
X--- 1770,1776 ----
X (interactive "p")
X (calc-wrapper
X (cond ((< n 0)
X! (calc-push-list (calc-top-list 1 (- n))))
X ((= n 0)
X (calc-push-list (calc-top-list (calc-stack-size))))
X (t
X***************
X*** 1657,1662 ****
X--- 1777,1784 ----
X (calc-push-list (calc-top-list n)))))
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calc-over (n)
X "Duplicate the Nth element of the Calculator stack.
X With a negative argument -N, duplicate the top N elements of the stack."
X***************
X*** 1666,1671 ****
X--- 1788,1795 ----
X (calc-enter -2))
X )
X
X+ ;;;; [calc.el]
X+
X (defun calc-pop (n)
X "Pop (and discard) the top N elements of the stack.
X With a negative argument -N, remove the Nth element from the stack."
X***************
X*** 1676,1692 ****
X (cond ((and (null n)
X (eq (car-safe top) 'incomplete)
X (> (length top) (if (eq (nth 1 top) 'intv) 3 2)))
X! (calc-pop-push 1 (let ((tt (copy-sequence top)))
X! (setcdr (nthcdr (- (length tt) 2) tt) nil)
X! tt)))
X ((< nn 0)
X! (calc-pop-stack 1 (- nn)))
X ((= nn 0)
X! (calc-pop-stack (calc-stack-size)))
X (t
X! (calc-pop-stack nn)))))
X )
X
X (defun calc-roll-down (n)
X "Exchange the top two elements of the Calculator stack.
X With a numeric prefix, roll down the top N elements."
X--- 1800,1825 ----
X (cond ((and (null n)
X (eq (car-safe top) 'incomplete)
X (> (length top) (if (eq (nth 1 top) 'intv) 3 2)))
X! (calc-pop-push-list 1 (let ((tt (copy-sequence top)))
X! (setcdr (nthcdr (- (length tt) 2) tt) nil)
X! (list tt))))
X ((< nn 0)
X! (if (and calc-any-selections
X! (calc-top-selected 1 (- nn)))
X! (calc-delete-selection (- nn))
X! (calc-pop-stack 1 (- nn) t)))
X ((= nn 0)
X! (calc-pop-stack (calc-stack-size) 1 t))
X (t
X! (if (and calc-any-selections
X! (= nn 1)
X! (calc-top-selected 1 1))
X! (calc-delete-selection 1)
X! (calc-pop-stack nn))))))
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calc-roll-down (n)
X "Exchange the top two elements of the Calculator stack.
X With a numeric prefix, roll down the top N elements."
X***************
X*** 1726,1744 ****
X
X
X
X! ;;; Miscellaneous commands.
X
X! (defun calc-precision (n)
X! "Display current float precision for Calculator, or set precision 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-num-prefix-name (n)
X (cond ((eq n '-) "- ")
X--- 1859,1867 ----
X
X
X
X! ;;;; [calc-misc.el]
X
X! ;;; Other commands.
X
X (defun calc-num-prefix-name (n)
X (cond ((eq n '-) "- ")
X***************
X*** 1760,1798 ****
X prefix-arg n)
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- (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-integral-cache nil
X- math-units-table nil)
X- (mapcar (function (lambda (x) (set x -100))) math-cache-list)
X- (message "All internal calculator caches have been reset."))
X- )
X- (setq math-cache-list nil)
X
X
X
X ;;;; Reading an expression in algebraic form.
X
X--- 1883,1891 ----
X prefix-arg n)
X )
X
X
X
X+ ;;;; [calc-aent.el]
X
X ;;;; Reading an expression in algebraic form.
X
X***************
X*** 1800,1853 ****
X "Read an algebraic expression (e.g., 1+2*3) and push the result on the stack."
X (interactive)
X (calc-wrapper
X! (calc-alg-entry))
X! )
X!
X! (defun calc-auto-alg-entry ()
X! "Begin entering an algebraic expression with a '$' or '\"' character."
X! (interactive)
X! (calc-wrapper
X! (calc-alg-entry (char-to-string last-command-char)))
X )
X
X (defun calc-alg-entry (&optional initial prompt)
X! (let* ((calc-dollar-values (mapcar 'car-safe
X (nthcdr calc-stack-top calc-stack)))
X (calc-dollar-used 0)
X (alg-exp (calc-do-alg-entry initial prompt t)))
X! (let ((nvals (mapcar 'calc-normalize alg-exp)))
X! (while alg-exp
X! (calc-record (car alg-exp) "alg'")
X! (calc-pop-push-record calc-dollar-used "" (car nvals))
X! (setq alg-exp (cdr alg-exp)
X! nvals (cdr nvals)
X! calc-dollar-used 0)))
X! (calc-handle-whys))
X )
X
X (defun calc-do-alg-entry (&optional initial prompt no-normalize)
X! (let* ((alg-exp 'error)
X! (alg (read-from-minibuffer (or prompt "Algebraic: ")
X! (or initial "")
X! calc-alg-ent-map nil)))
X! (if (eq alg-exp 'error)
X! (if (eq (car (setq alg-exp (math-read-exprs alg)))
X! 'error)
X! (error "Error: %s" (or (nth 2 exp) "Bad format"))))
X! (or no-normalize
X! (setq alg-exp (mapcar 'calc-normalize alg-exp)))
X! alg-exp)
X! )
X!
X! (defvar calc-alg-ent-map nil "Keymap for use by the calc-algebraic-entry command.")
X! (if calc-alg-ent-map
X! ()
X! (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
X! (define-key calc-alg-ent-map "'" 'calcAlg-previous)
X! (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
X! (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
X! (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
X! (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
X )
X
X (defun calcAlg-plus-minus ()
X--- 1893,1951 ----
X "Read an algebraic expression (e.g., 1+2*3) and push the result on the stack."
X (interactive)
X (calc-wrapper
X! (calc-alg-entry (and (memq last-command-char '(?$ ?\"))
X! (char-to-string last-command-char))))
X )
X
X (defun calc-alg-entry (&optional initial prompt)
X! (let* ((sel-mode nil)
X! (calc-dollar-values (mapcar 'calc-get-stack-element
X (nthcdr calc-stack-top calc-stack)))
X (calc-dollar-used 0)
X+ (calc-plain-entry t)
X (alg-exp (calc-do-alg-entry initial prompt t)))
X! (if (stringp alg-exp)
X! (progn
X! (calc-extensions)
X! (calc-alg-edit alg-exp))
X! (let ((nvals (mapcar 'calc-normalize alg-exp)))
X! (while alg-exp
X! (calc-record (if calc-extensions-loaded (car alg-exp) (car nvals))
X! "alg'")
X! (calc-pop-push-record-list calc-dollar-used
X! (and (not (equal (car alg-exp)
X! (car nvals)))
X! calc-extensions-loaded
X! "")
X! (list (car nvals)))
X! (setq alg-exp (cdr alg-exp)
X! nvals (cdr nvals)
X! calc-dollar-used 0)))
X! (calc-handle-whys)))
X )
X
X (defun calc-do-alg-entry (&optional initial prompt no-normalize)
X! (let* ((calc-buffer (current-buffer))
X! (blink-paren-hook 'calcAlg-blink-matching-open)
X! (alg-exp 'error))
X! (if (boundp 'calc-alg-ent-map)
X! ()
X! (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
X! (define-key calc-alg-ent-map "'" 'calcAlg-previous)
X! (define-key calc-alg-ent-map "`" 'calcAlg-edit)
X! (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
X! (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
X! (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
X! (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter))
X! (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
X! (or initial "")
X! calc-alg-ent-map nil)))
X! (if (eq alg-exp 'error)
X! (if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
X! (setq alg-exp nil)))
X! (or no-normalize
X! (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
X! alg-exp))
X )
X
X (defun calcAlg-plus-minus ()
X***************
X*** 1877,1886 ****
X (insert "'"))
X )
X
X (defun calcAlg-enter ()
X (interactive)
X! (let ((exp (and (> (buffer-size) 0)
X! (math-read-exprs (buffer-string)))))
X (if (eq (car-safe exp) 'error)
X (progn
X (goto-char (point-min))
X--- 1975,1999 ----
X (insert "'"))
X )
X
X+ (defun calcAlg-edit ()
X+ (interactive)
X+ (if (or (not calc-plain-entry)
X+ (calc-minibuffer-contains
X+ "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
X+ (insert "`")
X+ (setq alg-exp (buffer-string))
X+ (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
X+ (exit-minibuffer))
X+ )
X+ (setq calc-plain-entry nil)
X+
X (defun calcAlg-enter ()
X (interactive)
X! (let* ((str (buffer-string))
X! (exp (and (> (length str) 0)
X! (save-excursion
X! (set-buffer calc-buffer)
X! (math-read-exprs str)))))
X (if (eq (car-safe exp) 'error)
X (progn
X (goto-char (point-min))
X***************
X*** 1891,1901 ****
X (setq unread-command-char -1))
X (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
X '((incomplete vec))
X! exp)
X! calc-previous-alg-entry (buffer-string))
X (exit-minibuffer)))
X )
X
X
X
X ;;;; Reading a number using the minibuffer.
X--- 2004,2043 ----
X (setq unread-command-char -1))
X (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
X '((incomplete vec))
X! exp))
X! (and (> (length str) 0) (setq calc-previous-alg-entry str))
X (exit-minibuffer)))
X )
X
X+ (defun calcAlg-blink-matching-open ()
X+ (let ((oldpos (point))
X+ (blinkpos nil))
X+ (save-excursion
X+ (condition-case ()
X+ (setq blinkpos (scan-sexps oldpos -1))
X+ (error nil)))
X+ (if (and blinkpos
X+ (> oldpos (1+ (point-min)))
X+ (or (and (= (char-after (1- oldpos)) ?\))
X+ (= (char-after blinkpos) ?\[))
X+ (and (= (char-after (1- oldpos)) ?\])
X+ (= (char-after blinkpos) ?\()))
X+ (save-excursion
X+ (goto-char blinkpos)
X+ (looking-at ".+\\.\\.")))
X+ (let ((saved (aref (syntax-table) (char-after blinkpos))))
X+ (unwind-protect
X+ (progn
X+ (aset (syntax-table) (char-after blinkpos)
X+ (+ (logand saved 255)
X+ (lsh (char-after (1- oldpos)) 8)))
X+ (blink-matching-open))
X+ (aset (syntax-table) (char-after blinkpos) saved)))
X+ (blink-matching-open)))
X+ )
X+
X+ ;;;; [calc.el]
X+
X
X
X ;;;; Reading a number using the minibuffer.
X***************
X*** 1905,1928 ****
X (interactive)
X (calc-wrapper
X (if calc-algebraic-mode
X! (cond ((eq last-command-char ?e) (calc-alg-entry "1e"))
X! ((eq last-command-char ?#) (calc-alg-entry
X! (format "%d#" calc-number-radix)))
X! ((eq last-command-char ?_) (calc-alg-entry "-"))
X! ((eq last-command-char ?@) (calc-alg-entry "0@ "))
X! (t (calc-alg-entry (char-to-string last-command-char))))
X! (let ((calc-digit-value 'yow)
X! (calc-prev-char nil)
X! (calc-prev-prev-char nil))
X! (setq unread-command-char last-command-char)
X! (let ((str (read-from-minibuffer "Calc: " ""
X! calc-digit-map)))
X! (if (eq calc-digit-value 'yow)
X! (setq calc-digit-value (math-read-number str))))
X (if (stringp calc-digit-value)
X (calc-alg-entry calc-digit-value)
X (if calc-digit-value
X! (calc-push (calc-record (calc-normalize calc-digit-value)))))
X (if (eq calc-prev-char 'dots)
X (progn
X (calc-extensions)
X--- 2047,2065 ----
X (interactive)
X (calc-wrapper
X (if calc-algebraic-mode
X! (calc-alg-digit-entry)
X! (setq unread-command-char last-command-char)
X! (let* ((calc-digit-value nil)
X! (calc-prev-char nil)
X! (calc-prev-prev-char nil)
X! (calc-buffer (current-buffer))
X! (buf (read-from-minibuffer "Calc: " "" calc-digit-map)))
X! (or calc-digit-value (setq calc-digit-value (math-read-number buf)))
X (if (stringp calc-digit-value)
X (calc-alg-entry calc-digit-value)
X (if calc-digit-value
X! (calc-push-list (list (calc-record (calc-normalize
X! calc-digit-value))))))
X (if (eq calc-prev-char 'dots)
X (progn
X (calc-extensions)
X***************
X*** 1931,1947 ****
X
X (defun calcDigit-nondigit ()
X (interactive)
X! (setq calc-digit-value (math-read-number (buffer-string)))
X (if (and (null calc-digit-value) (> (buffer-size) 0))
X (progn
X (beep)
X (calc-temp-minibuffer-message " [Bad format]"))
X! (or (memq last-command-char '(32 10 13))
X (setq prefix-arg current-prefix-arg
X unread-command-char last-command-char))
X (exit-minibuffer))
X )
X
X (defun calcDigit-algebraic ()
X (interactive)
X (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
X--- 2068,2098 ----
X
X (defun calcDigit-nondigit ()
X (interactive)
X! (let ((str (buffer-string)))
X! (setq calc-digit-value (save-excursion
X! (set-buffer calc-buffer)
X! (math-read-number str))))
X (if (and (null calc-digit-value) (> (buffer-size) 0))
X (progn
X (beep)
X (calc-temp-minibuffer-message " [Bad format]"))
X! (or (memq last-command-char '(32 13))
X (setq prefix-arg current-prefix-arg
X unread-command-char last-command-char))
X (exit-minibuffer))
X )
X
X+ ;;;; [calc-aent.el]
X+
X+ (defun calc-alg-digit-entry ()
X+ (calc-alg-entry
X+ (cond ((eq last-command-char ?e) "1e")
X+ ((eq last-command-char ?#) (format "%d#" calc-number-radix))
X+ ((eq last-command-char ?_) "-")
X+ ((eq last-command-char ?@) "0@ ")
X+ (t (char-to-string last-command-char))))
X+ )
X+
X (defun calcDigit-algebraic ()
X (interactive)
X (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
X***************
X*** 1950,1955 ****
X--- 2101,2115 ----
X (exit-minibuffer))
X )
X
X+ (defun calcDigit-edit ()
X+ (interactive)
X+ (setq unread-command-char last-command-char)
X+ (setq calc-digit-value (buffer-string))
X+ (exit-minibuffer)
X+ )
X+
X+ ;;;; [calc.el]
X+
X (defun calc-minibuffer-contains (rex)
X (save-excursion
X (goto-char (point-min))
X***************
X*** 2040,2058 ****
X (insert " "))
X (if (and (eq this-command last-command)
X (eq last-command-char ?.))
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 (delete-backward-char 1)
X (beep)
X (calc-temp-minibuffer-message " [Bad format]"))))))
X--- 2200,2208 ----
X (insert " "))
X (if (and (eq this-command last-command)
X (eq last-command-char ?.))
X! (progn
X! (calc-extensions)
X! (calc-digit-dots))
X (delete-backward-char 1)
X (beep)
X (calc-temp-minibuffer-message " [Bad format]"))))))
X***************
X*** 2060,2065 ****
X--- 2210,2217 ----
X calc-prev-char last-command-char)
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calcDigit-letter ()
X (interactive)
X (if (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*")
X***************
X*** 2069,2074 ****
X--- 2221,2228 ----
X (calcDigit-nondigit))
X )
X
X+ ;;;; [calc.el]
X+
X (defun calcDigit-backspace ()
X (interactive)
X (goto-char (point-max))
X***************
X*** 2078,2090 ****
X (backward-delete-char 5))
X ((calc-minibuffer-contains ".* \\'")
X (backward-delete-char 2))
X (t (backward-delete-char 1)))
X (if (= (buffer-size) 0)
X (progn
X! (setq last-command-char 10)
X (calcDigit-nondigit)))
X )
X
X (defun calc-temp-minibuffer-message (m)
X "A Lisp version of temp_minibuffer_message from minibuf.c."
X (let ((savemax (point-max)))
X--- 2232,2248 ----
X (backward-delete-char 5))
X ((calc-minibuffer-contains ".* \\'")
X (backward-delete-char 2))
X+ ((eq last-command 'calcDigit-start)
X+ (erase-buffer))
X (t (backward-delete-char 1)))
X (if (= (buffer-size) 0)
X (progn
X! (setq last-command-char 13)
X (calcDigit-nondigit)))
X )
X
X+ ;;;; [calc-misc.el]
X+
X (defun calc-temp-minibuffer-message (m)
X "A Lisp version of temp_minibuffer_message from minibuf.c."
X (let ((savemax (point-max)))
X***************
X*** 2099,2104 ****
X--- 2257,2263 ----
X unread-command-char 7))))
X )
X
X+ ;;;; [calc.el]
X
X
X
X***************
X*** 2224,2283 ****
X ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000))))
X ((cdr a) (- (nth 1 a)))
X (t 0))))
X- ((eq (car a) 'frac)
X- (math-make-frac (math-normalize (nth 1 a))
X- (math-normalize (nth 2 a))))
X ((eq (car a) 'float)
X (math-make-float (math-normalize (nth 1 a)) (nth 2 a)))
X! ((eq (car a) 'cplx)
X! (let ((real (math-normalize (nth 1 a)))
X! (imag (math-normalize (nth 2 a))))
X! (if (math-zerop imag) real (list 'cplx real imag))))
X! ((eq (car a) 'polar)
X! (calc-extensions)
X! (math-normalize-polar a))
X! ((eq (car a) 'hms)
X! (calc-extensions)
X! (math-normalize-hms a))
X! ((eq (car a) 'mod)
X! (calc-extensions)
X! (math-normalize-mod a))
X! ((eq (car a) 'sdev)
X! (calc-extensions)
X! (math-make-sdev (math-normalize (nth 1 a))
X! (math-normalize (nth 2 a))))
X! ((eq (car a) 'intv)
X! (calc-extensions)
X! (math-make-intv (nth 1 a)
X! (math-normalize (nth 2 a))
X! (math-normalize (nth 3 a))))
X! ((eq (car a) 'vec)
X! (cons 'vec (mapcar 'math-normalize (cdr a))))
X! ((memq (car a) '(quote special-const))
X! (math-normalize (nth 1 a)))
X! ((eq (car a) 'var)
X! a)
X! ((or (integerp (car a)) (and (consp (car a))
X! (not (eq (car (car a)) 'lambda))))
X! (if (null (cdr a))
X! (math-normalize (car a))
X! (error "Can't use multi-valued function in an expression")))
X! ((eq (car a) 'calcFunc-if)
X (calc-extensions)
X! (math-normalize-logical-op a))
X (t
X (let ((args (mapcar 'math-normalize (cdr a))))
X (or (and calc-simplify-mode
X! (symbolp (car a))
X! (or (eq calc-simplify-mode 'none)
X! (and (eq calc-simplify-mode 'num)
X! (let ((aptr args))
X! (while (and aptr (or (math-scalarp (car aptr))
X! (eq (car-safe (car aptr))
X! 'mod)))
X! (setq aptr (cdr aptr)))
X! aptr)))
X! (cons (car a) args))
X (condition-case err
X (let ((func (assq (car a) '( ( + . math-add )
X ( - . math-sub )
X--- 2383,2402 ----
X ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000))))
X ((cdr a) (- (nth 1 a)))
X (t 0))))
X ((eq (car a) 'float)
X (math-make-float (math-normalize (nth 1 a)) (nth 2 a)))
X! ((or (memq (car a) '(frac cplx polar hms mod sdev intv vec var quote
X! special-const calcFunc-if calcFunc-lambda
X! calcFunc-quote))
X! (integerp (car a))
X! (and (consp (car a)) (not (eq (car (car a)) 'lambda))))
X (calc-extensions)
X! (math-normalize-fancy a))
X (t
X (let ((args (mapcar 'math-normalize (cdr a))))
X (or (and calc-simplify-mode
X! (calc-extensions)
X! (math-normalize-nonstandard a))
X (condition-case err
X (let ((func (assq (car a) '( ( + . math-add )
X ( - . math-sub )
X***************
X*** 2309,2314 ****
SHAR_EOF
echo "End of part 2, continue with part 3"
echo "3" > s2_seq_.tmp
exit 0
More information about the Comp.sources.misc
mailing list