mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-04 11:00:45 -08:00
* calc/calc.el (calc, calc-refresh, calc-trail-buffer, calc-record)
(calcDigit-nondigit): * calc/calc-yank.el (calc-copy-to-buffer): * calc/calc-units.el (calc-invalidate-units-table): * calc/calc-trail.el (calc-trail-yank): * calc/calc-store.el (calc-insert-variables): * calc/calc-rewr.el (math-rewrite, math-rewrite-phase): * calc/calc-prog.el (calc-read-parse-table): * calc/calc-keypd.el (calc-do-keypad, calc-keypad-right-click): * calc/calc-help.el (calc-describe-bindings, calc-describe-key): * calc/calc-graph.el (calc-graph-delete, calc-graph-add-curve) (calc-graph-juggle, calc-graph-count-curves, calc-graph-plot) (calc-graph-plot, calc-graph-format-data, calc-graph-set-styles) (calc-graph-name, calc-graph-find-command, calc-graph-view) (calc-graph-view, calc-gnuplot-command, calc-graph-init): * calc/calc-ext.el (calc-realign): * calc/calc-embed.el (calc-do-embedded, calc-do-embedded) (calc-embedded-finish-edit, calc-embedded-make-info) (calc-embedded-finish-command, calc-embedded-stack-change): * calc/calc-aent.el (calcAlg-enter): Use with-current-buffer.
This commit is contained in:
Stefan Monnier
parent
6e3da0ae02
commit
6df9b6d78f
14 changed files with 250 additions and 273 deletions
|
|
@ -1,5 +1,26 @@
|
|||
2009-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* calc/calc.el (calc, calc-refresh, calc-trail-buffer, calc-record)
|
||||
(calcDigit-nondigit):
|
||||
* calc/calc-yank.el (calc-copy-to-buffer):
|
||||
* calc/calc-units.el (calc-invalidate-units-table):
|
||||
* calc/calc-trail.el (calc-trail-yank):
|
||||
* calc/calc-store.el (calc-insert-variables):
|
||||
* calc/calc-rewr.el (math-rewrite, math-rewrite-phase):
|
||||
* calc/calc-prog.el (calc-read-parse-table):
|
||||
* calc/calc-keypd.el (calc-do-keypad, calc-keypad-right-click):
|
||||
* calc/calc-help.el (calc-describe-bindings, calc-describe-key):
|
||||
* calc/calc-graph.el (calc-graph-delete, calc-graph-add-curve)
|
||||
(calc-graph-juggle, calc-graph-count-curves, calc-graph-plot)
|
||||
(calc-graph-plot, calc-graph-format-data, calc-graph-set-styles)
|
||||
(calc-graph-name, calc-graph-find-command, calc-graph-view)
|
||||
(calc-graph-view, calc-gnuplot-command, calc-graph-init):
|
||||
* calc/calc-ext.el (calc-realign):
|
||||
* calc/calc-embed.el (calc-do-embedded, calc-do-embedded)
|
||||
(calc-embedded-finish-edit, calc-embedded-make-info)
|
||||
(calc-embedded-finish-command, calc-embedded-stack-change):
|
||||
* calc/calc-aent.el (calcAlg-enter): Use with-current-buffer.
|
||||
|
||||
* cedet/mode-local.el (make-obsolete-overload): Add `when' argument.
|
||||
(overload-docstring-extension): Use that info.
|
||||
* cedet/semantic/fw.el (semantic-alias-obsolete): Pass the `when' info.
|
||||
|
|
|
|||
|
|
@ -414,8 +414,7 @@ The value t means abort and give an error message.")
|
|||
(interactive)
|
||||
(let* ((str (minibuffer-contents))
|
||||
(exp (and (> (length str) 0)
|
||||
(save-excursion
|
||||
(set-buffer calc-buffer)
|
||||
(with-current-buffer calc-buffer
|
||||
(math-read-exprs str)))))
|
||||
(if (eq (car-safe exp) 'error)
|
||||
(progn
|
||||
|
|
|
|||
|
|
@ -233,8 +233,7 @@
|
|||
(let* ((info calc-embedded-info)
|
||||
(mode calc-embedded-modes)
|
||||
(calcbuf (aref calc-embedded-info 1)))
|
||||
(save-excursion
|
||||
(set-buffer (aref info 1))
|
||||
(with-current-buffer (aref info 1)
|
||||
(if (and (> (calc-stack-size) 0)
|
||||
(equal (calc-top 1 'full) (aref info 8)))
|
||||
(let ((calc-no-refresh-evaltos t))
|
||||
|
|
@ -259,8 +258,7 @@
|
|||
|
||||
(t
|
||||
(if (buffer-name (aref calc-embedded-info 0))
|
||||
(save-excursion
|
||||
(set-buffer (aref calc-embedded-info 0))
|
||||
(with-current-buffer (aref calc-embedded-info 0)
|
||||
(or (y-or-n-p (format "Cancel Calc Embedded mode in buffer %s? "
|
||||
(buffer-name)))
|
||||
(keyboard-quit))
|
||||
|
|
@ -401,8 +399,7 @@
|
|||
(start (point))
|
||||
pos)
|
||||
(switch-to-buffer calc-original-buffer)
|
||||
(let ((val (save-excursion
|
||||
(set-buffer (aref info 1))
|
||||
(let ((val (with-current-buffer (aref info 1)
|
||||
(let ((calc-language nil)
|
||||
(math-expr-opers (math-standard-ops)))
|
||||
(math-read-expr str)))))
|
||||
|
|
@ -946,8 +943,7 @@ The command \\[yank] can retrieve it from there."
|
|||
(pref-len (length open-plain))
|
||||
(calc-embed-vars-used nil)
|
||||
suff-pos val temp)
|
||||
(save-excursion
|
||||
(set-buffer (aref info 1))
|
||||
(with-current-buffer (aref info 1)
|
||||
(calc-embedded-set-modes (aref info 15)
|
||||
(aref info 12) (aref info 14))
|
||||
(if (and (> (length str) pref-len)
|
||||
|
|
@ -1204,8 +1200,7 @@ The command \\[yank] can retrieve it from there."
|
|||
(defun calc-embedded-finish-command ()
|
||||
(let ((buf (current-buffer))
|
||||
horiz vert)
|
||||
(save-excursion
|
||||
(set-buffer (aref calc-embedded-info 1))
|
||||
(with-current-buffer (aref calc-embedded-info 1)
|
||||
(if (> (calc-stack-size) 0)
|
||||
(let ((pt (point))
|
||||
(col (current-column))
|
||||
|
|
@ -1233,8 +1228,7 @@ The command \\[yank] can retrieve it from there."
|
|||
|
||||
(defun calc-embedded-stack-change ()
|
||||
(or calc-executing-macro
|
||||
(save-excursion
|
||||
(set-buffer (aref calc-embedded-info 1))
|
||||
(with-current-buffer (aref calc-embedded-info 1)
|
||||
(let* ((info calc-embedded-info)
|
||||
(extra-line (if (eq calc-language 'big) 1 0))
|
||||
(the-point (point))
|
||||
|
|
|
|||
|
|
@ -1677,8 +1677,8 @@ calc-kill calc-kill-region calc-yank))))
|
|||
(eq (current-buffer) (aref calc-embedded-info 0)))
|
||||
(progn
|
||||
(goto-char (aref calc-embedded-info 2))
|
||||
(if (save-excursion (set-buffer (aref calc-embedded-info 1))
|
||||
calc-show-plain)
|
||||
(if (with-current-buffer (aref calc-embedded-info 1)
|
||||
calc-show-plain)
|
||||
(forward-line 1)))
|
||||
(calc-wrapper
|
||||
(if (get-buffer-window (current-buffer))
|
||||
|
|
|
|||
|
|
@ -85,8 +85,7 @@
|
|||
(interactive "P")
|
||||
(calc-wrapper
|
||||
(calc-graph-init)
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(and (calc-graph-find-plot t all)
|
||||
(progn
|
||||
(if (looking-at "s?plot")
|
||||
|
|
@ -187,8 +186,7 @@
|
|||
(let ((num (calc-graph-count-curves))
|
||||
(pstyle (calc-var-value 'var-PointStyles))
|
||||
(lstyle (calc-var-value 'var-LineStyles)))
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
|
||||
nil t)
|
||||
|
|
@ -239,8 +237,7 @@
|
|||
(defun calc-graph-juggle (arg)
|
||||
(interactive "p")
|
||||
(calc-graph-init)
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(if (< arg 0)
|
||||
(let ((num (calc-graph-count-curves)))
|
||||
(if (> num 0)
|
||||
|
|
@ -250,8 +247,7 @@
|
|||
(calc-graph-do-juggle))))
|
||||
|
||||
(defun calc-graph-count-curves ()
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(if (re-search-forward "^s?plot[ \t]" nil t)
|
||||
(let ((num 1))
|
||||
(goto-char (point-min))
|
||||
|
|
@ -438,8 +434,7 @@
|
|||
(forward-char -1))
|
||||
(if (eq (preceding-char) ?\,)
|
||||
(delete-backward-char 1))))
|
||||
(save-excursion
|
||||
(set-buffer calcbuf)
|
||||
(with-current-buffer calcbuf
|
||||
(setq cache-env (list calc-angle-mode
|
||||
calc-complex-mode
|
||||
calc-simplify-mode
|
||||
|
|
@ -474,8 +469,7 @@
|
|||
filename)
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(setq filename (calc-temp-file-name calc-graph-curve-num))
|
||||
(save-excursion
|
||||
(set-buffer calcbuf)
|
||||
(with-current-buffer calcbuf
|
||||
(let (tempbuftop
|
||||
(calc-graph-xp calc-graph-xvalue)
|
||||
(calc-graph-yp calc-graph-yvalue)
|
||||
|
|
@ -832,8 +826,7 @@
|
|||
(= (length calc-graph-yval) 4))
|
||||
(progn
|
||||
(or calc-graph-surprise-splot
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create "*Gnuplot Temp*"))
|
||||
(with-current-buffer (get-buffer-create "*Gnuplot Temp*")
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(re-search-backward "^plot[ \t]")
|
||||
|
|
@ -1072,8 +1065,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
|
||||
(defun calc-graph-set-styles (lines points &optional yerr)
|
||||
(calc-graph-init)
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(or (calc-graph-find-plot nil nil)
|
||||
(error "No data points have been set!"))
|
||||
(let ((base (point))
|
||||
|
|
@ -1161,8 +1153,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(defun calc-graph-name (name)
|
||||
(interactive "sTitle for current curve: ")
|
||||
(calc-graph-init)
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(or (calc-graph-find-plot nil nil)
|
||||
(error "No data points have been set!"))
|
||||
(let ((base (point))
|
||||
|
|
@ -1297,16 +1288,14 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
|
||||
(defun calc-graph-find-command (cmd)
|
||||
(calc-graph-init)
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
|
||||
(buffer-substring (match-beginning 1) (match-end 1)))))
|
||||
|
||||
(defun calc-graph-set-command (cmd &rest args)
|
||||
(calc-graph-init)
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
|
||||
(progn
|
||||
|
|
@ -1374,8 +1363,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(if (setq win (get-buffer-window buf))
|
||||
(or need
|
||||
(and (eq buf calc-gnuplot-buffer)
|
||||
(save-excursion
|
||||
(set-buffer buf)
|
||||
(with-current-buffer buf
|
||||
(not (pos-visible-in-window-p (point-max) win))))
|
||||
(progn
|
||||
(bury-buffer buf)
|
||||
|
|
@ -1391,8 +1379,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(not (window-full-height-p)))
|
||||
(display-buffer buf))
|
||||
(switch-to-buffer buf)))))
|
||||
(save-excursion
|
||||
(set-buffer buf)
|
||||
(with-current-buffer buf
|
||||
(if (and (eq buf calc-gnuplot-buffer)
|
||||
(setq win (get-buffer-window buf))
|
||||
(not (pos-visible-in-window-p (point-max) win)))
|
||||
|
|
@ -1419,8 +1406,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(let ((cmd (concat (mapconcat 'identity args " ") "\n")))
|
||||
(or (string= calc-gnuplot-name "pgnuplot")
|
||||
(accept-process-output))
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-buffer)
|
||||
(with-current-buffer calc-gnuplot-buffer
|
||||
(calc-gnuplot-check-for-errors)
|
||||
(goto-char (point-max))
|
||||
(setq calc-gnuplot-trail-mark (point))
|
||||
|
|
@ -1454,8 +1440,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(delete-process calc-gnuplot-process)
|
||||
(setq calc-gnuplot-process nil)))
|
||||
(calc-graph-init-buffers)
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-buffer)
|
||||
(with-current-buffer calc-gnuplot-buffer
|
||||
(insert "\nStarting gnuplot...\n")
|
||||
(setq origin (point)))
|
||||
(setq calc-graph-last-device nil)
|
||||
|
|
@ -1489,8 +1474,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(file-error
|
||||
(error "Sorry, can't find \"%s\" on your system"
|
||||
calc-gnuplot-name)))
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-buffer)
|
||||
(with-current-buffer calc-gnuplot-buffer
|
||||
(while (and (not (string= calc-gnuplot-name "pgnuplot"))
|
||||
(not (save-excursion
|
||||
(goto-char origin)
|
||||
|
|
@ -1510,8 +1494,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(match-end 1))))
|
||||
(setq calc-gnuplot-version 1)))
|
||||
(goto-char (point-max)))))
|
||||
(save-excursion
|
||||
(set-buffer calc-gnuplot-input)
|
||||
(with-current-buffer calc-gnuplot-input
|
||||
(if (= (buffer-size) 0)
|
||||
(insert "# Commands for running gnuplot\n\n\n")
|
||||
(or calc-graph-no-auto-view
|
||||
|
|
|
|||
|
|
@ -110,8 +110,7 @@ C-w Describe how there is no warranty for Calc."
|
|||
(defun calc-describe-bindings ()
|
||||
(interactive)
|
||||
(describe-bindings)
|
||||
(save-excursion
|
||||
(set-buffer "*Help*")
|
||||
(with-current-buffer "*Help*"
|
||||
(let ((inhibit-read-only t))
|
||||
(goto-char (point-min))
|
||||
(when (search-forward "Major Mode Bindings:" nil t)
|
||||
|
|
@ -178,8 +177,7 @@ C-w Describe how there is no warranty for Calc."
|
|||
(if (string-match "\\(DEL\\|\\LFD\\|RET\\|SPC\\|TAB\\)" desc)
|
||||
(setq desc (replace-match "<\\&>" nil nil desc)))
|
||||
(if briefly
|
||||
(let ((msg (save-excursion
|
||||
(set-buffer (get-buffer-create "*Calc Summary*"))
|
||||
(let ((msg (with-current-buffer (get-buffer-create "*Calc Summary*")
|
||||
(if (= (buffer-size) 0)
|
||||
(progn
|
||||
(message "Reading Calc summary from manual...")
|
||||
|
|
|
|||
|
|
@ -297,8 +297,7 @@
|
|||
(setq win (split-window win (+ width 7) t))
|
||||
(set-window-buffer win calcbuf))
|
||||
(if (or t ; left-side keypad not yet fully implemented
|
||||
(< (save-excursion
|
||||
(set-buffer (window-buffer old-win))
|
||||
(< (with-current-buffer (window-buffer old-win)
|
||||
(current-column))
|
||||
(/ (window-width) 2)))
|
||||
(setq win (split-window old-win (- (window-width old-win)
|
||||
|
|
@ -547,8 +546,7 @@
|
|||
(defun calc-keypad-right-click (event)
|
||||
"Handle a right-button mouse click in Calc Keypad window."
|
||||
(interactive "e")
|
||||
(save-excursion
|
||||
(set-buffer calc-keypad-buffer)
|
||||
(with-current-buffer calc-keypad-buffer
|
||||
(calc-keypad-menu)))
|
||||
|
||||
(defun calc-keypad-middle-click (event)
|
||||
|
|
|
|||
|
|
@ -568,8 +568,7 @@
|
|||
(let ((pos (point)))
|
||||
(end-of-line)
|
||||
(let* ((str (buffer-substring pos (point)))
|
||||
(exp (save-excursion
|
||||
(set-buffer calc-buf)
|
||||
(exp (with-current-buffer calc-buf
|
||||
(let ((calc-user-parse-tables nil)
|
||||
(calc-language nil)
|
||||
(math-expr-opers (math-standard-ops))
|
||||
|
|
|
|||
|
|
@ -190,15 +190,13 @@
|
|||
(if trace-buffer
|
||||
(let ((fmt (math-format-stack-value
|
||||
(list result nil nil))))
|
||||
(save-excursion
|
||||
(set-buffer trace-buffer)
|
||||
(with-current-buffer trace-buffer
|
||||
(insert "\nrewrite to\n" fmt "\n"))))
|
||||
(setq heads (math-rewrite-heads result heads t))))
|
||||
result)))))
|
||||
(if trace-buffer
|
||||
(let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
|
||||
(save-excursion
|
||||
(set-buffer trace-buffer)
|
||||
(with-current-buffer trace-buffer
|
||||
(setq truncate-lines t)
|
||||
(goto-char (point-max))
|
||||
(insert "\n\nBegin rewriting\n" fmt "\n"))))
|
||||
|
|
@ -209,8 +207,7 @@
|
|||
(math-rewrite-phase (nth 3 (car crules)))
|
||||
(if trace-buffer
|
||||
(let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
|
||||
(save-excursion
|
||||
(set-buffer trace-buffer)
|
||||
(with-current-buffer trace-buffer
|
||||
(insert "\nDone rewriting"
|
||||
(if (= math-mt-many 0) " (reached iteration limit)" "")
|
||||
":\n" fmt "\n"))))
|
||||
|
|
@ -229,15 +226,13 @@
|
|||
(if trace-buffer
|
||||
(let ((fmt (math-format-stack-value
|
||||
(list math-rewrite-whole-expr nil nil))))
|
||||
(save-excursion
|
||||
(set-buffer trace-buffer)
|
||||
(with-current-buffer trace-buffer
|
||||
(insert "\ncall "
|
||||
(substring (symbol-name (car sched)) 9)
|
||||
":\n" fmt "\n")))))
|
||||
(let ((math-rewrite-phase (car sched)))
|
||||
(if trace-buffer
|
||||
(save-excursion
|
||||
(set-buffer trace-buffer)
|
||||
(with-current-buffer trace-buffer
|
||||
(insert (format "\n(Phase %d)\n" math-rewrite-phase))))
|
||||
(while (let ((save-expr math-rewrite-whole-expr))
|
||||
(setq math-rewrite-whole-expr (math-normalize
|
||||
|
|
@ -289,179 +284,179 @@
|
|||
|
||||
|
||||
|
||||
;;; A compiled rule set is an a-list of entries whose cars are functors,
|
||||
;;; and whose cdrs are lists of rules. If there are rules with no
|
||||
;;; well-defined head functor, they are included on all lists and also
|
||||
;;; on an extra list whose car is nil.
|
||||
;;;
|
||||
;;; The first entry in the a-list is of the form (schedule A B C ...).
|
||||
;;;
|
||||
;;; Rule list entries take the form (regs prog head phases), where:
|
||||
;;;
|
||||
;;; regs is a vector of match registers.
|
||||
;;;
|
||||
;;; prog is a match program (see below).
|
||||
;;;
|
||||
;;; head is a rare function name appearing in the rule body (but not the
|
||||
;;; head of the whole rule), or nil if none.
|
||||
;;;
|
||||
;;; phases is a list of phase numbers for which the rule is enabled.
|
||||
;;;
|
||||
;;; A match program is a list of match instructions.
|
||||
;;;
|
||||
;;; In the following, "part" is a register number that contains the
|
||||
;;; subexpression to be operated on.
|
||||
;;;
|
||||
;;; Register 0 is the whole expression being matched. The others are
|
||||
;;; meta-variables in the pattern, temporaries used for matching and
|
||||
;;; backtracking, and constant expressions.
|
||||
;;;
|
||||
;;; (same part reg)
|
||||
;;; The selected part must be math-equal to the contents of "reg".
|
||||
;;;
|
||||
;;; (same-neg part reg)
|
||||
;;; The selected part must be math-equal to the negative of "reg".
|
||||
;;;
|
||||
;;; (copy part reg)
|
||||
;;; The selected part is copied into "reg". (Rarely used.)
|
||||
;;;
|
||||
;;; (copy-neg part reg)
|
||||
;;; The negative of the selected part is copied into "reg".
|
||||
;;;
|
||||
;;; (integer part)
|
||||
;;; The selected part must be an integer.
|
||||
;;;
|
||||
;;; (real part)
|
||||
;;; The selected part must be a real.
|
||||
;;;
|
||||
;;; (constant part)
|
||||
;;; The selected part must be a constant.
|
||||
;;;
|
||||
;;; (negative part)
|
||||
;;; The selected part must "look" negative.
|
||||
;;;
|
||||
;;; (rel part op reg)
|
||||
;;; The selected part must satisfy "part op reg", where "op"
|
||||
;;; is one of the 6 relational ops, and "reg" is a register.
|
||||
;;;
|
||||
;;; (mod part modulo value)
|
||||
;;; The selected part must satisfy "part % modulo = value", where
|
||||
;;; "modulo" and "value" are constants.
|
||||
;;;
|
||||
;;; (func part head reg1 reg2 ... regn)
|
||||
;;; The selected part must be an n-ary call to function "head".
|
||||
;;; The arguments are stored in "reg1" through "regn".
|
||||
;;;
|
||||
;;; (func-def part head defs reg1 reg2 ... regn)
|
||||
;;; The selected part must be an n-ary call to function "head".
|
||||
;;; "Defs" is a list of value/register number pairs for default args.
|
||||
;;; If a match, assign default values to registers and then skip
|
||||
;;; immediately over any following "func-def" instructions and
|
||||
;;; the following "func" instruction. If wrong number of arguments,
|
||||
;;; proceed to the following "func-def" or "func" instruction.
|
||||
;;;
|
||||
;;; (func-opt part head defs reg1)
|
||||
;;; Like func-def with "n=1", except that if the selected part is
|
||||
;;; not a call to "head", then the part itself successfully matches
|
||||
;;; "reg1" (and the defaults are assigned).
|
||||
;;;
|
||||
;;; (try part heads mark reg1 [def])
|
||||
;;; The selected part must be a function of the correct type which is
|
||||
;;; associative and/or commutative. "Heads" is a list of acceptable
|
||||
;;; types. An initial assignment of arguments to "reg1" is tried.
|
||||
;;; If the program later fails, it backtracks to this instruction
|
||||
;;; and tries other assignments of arguments to "reg1".
|
||||
;;; If "def" exists and normal matching fails, backtrack and assign
|
||||
;;; "part" to "reg1", and "def" to "reg2" in the following "try2".
|
||||
;;; The "mark" is a vector of size 5; only "mark[3-4]" are initialized.
|
||||
;;; "mark[0]" points to the argument list; "mark[1]" points to the
|
||||
;;; current argument; "mark[2]" is 0 if there are two arguments,
|
||||
;;; 1 if reg1 is matching single arguments, 2 if reg2 is matching
|
||||
;;; single arguments (a+b+c+d is never split as (a+b)+(c+d)), or
|
||||
;;; 3 if reg2 is matching "def"; "mark[3]" is 0 if the function must
|
||||
;;; have two arguments, 1 if phase-2 can be skipped, 2 if full
|
||||
;;; backtracking is necessary; "mark[4]" is t if the arguments have
|
||||
;;; been switched from the order given in the original pattern.
|
||||
;;;
|
||||
;;; (try2 try reg2)
|
||||
;;; Every "try" will be followed by a "try2" whose "try" field is
|
||||
;;; a pointer to the corresponding "try". The arguments which were
|
||||
;;; not stored in "reg1" by that "try" are now stored in "reg2".
|
||||
;;;
|
||||
;;; (alt instr nil mark)
|
||||
;;; Basic backtracking. Execute the instruction sequence "instr".
|
||||
;;; If this fails, back up and execute following the "alt" instruction.
|
||||
;;; The "mark" must be the vector "[nil nil 4]". The "instr" sequence
|
||||
;;; should execute "end-alt" at the end.
|
||||
;;;
|
||||
;;; (end-alt ptr)
|
||||
;;; Register success of the first alternative of a previous "alt".
|
||||
;;; "Ptr" is a pointer to the next instruction following that "alt".
|
||||
;;;
|
||||
;;; (apply part reg1 reg2)
|
||||
;;; The selected part must be a function call. The functor
|
||||
;;; (as a variable name) is stored in "reg1"; the arguments
|
||||
;;; (as a vector) are stored in "reg2".
|
||||
;;;
|
||||
;;; (cons part reg1 reg2)
|
||||
;;; The selected part must be a nonempty vector. The first element
|
||||
;;; of the vector is stored in "reg1"; the rest of the vector
|
||||
;;; (as another vector) is stored in "reg2".
|
||||
;;;
|
||||
;;; (rcons part reg1 reg2)
|
||||
;;; The selected part must be a nonempty vector. The last element
|
||||
;;; of the vector is stored in "reg2"; the rest of the vector
|
||||
;;; (as another vector) is stored in "reg1".
|
||||
;;;
|
||||
;;; (select part reg)
|
||||
;;; If the selected part is a unary call to function "select", its
|
||||
;;; argument is stored in "reg"; otherwise (provided this is an `a r'
|
||||
;;; and not a `g r' command) the selected part is stored in "reg".
|
||||
;;;
|
||||
;;; (cond expr)
|
||||
;;; The "expr", with registers substituted, must simplify to
|
||||
;;; a non-zero value.
|
||||
;;;
|
||||
;;; (let reg expr)
|
||||
;;; Evaluate "expr" and store the result in "reg". Always succeeds.
|
||||
;;;
|
||||
;;; (done rhs remember)
|
||||
;;; Rewrite the expression to "rhs", with register substituted.
|
||||
;;; Normalize; if the result is different from the original
|
||||
;;; expression, the match has succeeded. This is the last
|
||||
;;; instruction of every program. If "remember" is non-nil,
|
||||
;;; record the result of the match as a new literal rule.
|
||||
;; A compiled rule set is an a-list of entries whose cars are functors,
|
||||
;; and whose cdrs are lists of rules. If there are rules with no
|
||||
;; well-defined head functor, they are included on all lists and also
|
||||
;; on an extra list whose car is nil.
|
||||
;;
|
||||
;; The first entry in the a-list is of the form (schedule A B C ...).
|
||||
;;
|
||||
;; Rule list entries take the form (regs prog head phases), where:
|
||||
;;
|
||||
;; regs is a vector of match registers.
|
||||
;;
|
||||
;; prog is a match program (see below).
|
||||
;;
|
||||
;; head is a rare function name appearing in the rule body (but not the
|
||||
;; head of the whole rule), or nil if none.
|
||||
;;
|
||||
;; phases is a list of phase numbers for which the rule is enabled.
|
||||
;;
|
||||
;; A match program is a list of match instructions.
|
||||
;;
|
||||
;; In the following, "part" is a register number that contains the
|
||||
;; subexpression to be operated on.
|
||||
;;
|
||||
;; Register 0 is the whole expression being matched. The others are
|
||||
;; meta-variables in the pattern, temporaries used for matching and
|
||||
;; backtracking, and constant expressions.
|
||||
;;
|
||||
;; (same part reg)
|
||||
;; The selected part must be math-equal to the contents of "reg".
|
||||
;;
|
||||
;; (same-neg part reg)
|
||||
;; The selected part must be math-equal to the negative of "reg".
|
||||
;;
|
||||
;; (copy part reg)
|
||||
;; The selected part is copied into "reg". (Rarely used.)
|
||||
;;
|
||||
;; (copy-neg part reg)
|
||||
;; The negative of the selected part is copied into "reg".
|
||||
;;
|
||||
;; (integer part)
|
||||
;; The selected part must be an integer.
|
||||
;;
|
||||
;; (real part)
|
||||
;; The selected part must be a real.
|
||||
;;
|
||||
;; (constant part)
|
||||
;; The selected part must be a constant.
|
||||
;;
|
||||
;; (negative part)
|
||||
;; The selected part must "look" negative.
|
||||
;;
|
||||
;; (rel part op reg)
|
||||
;; The selected part must satisfy "part op reg", where "op"
|
||||
;; is one of the 6 relational ops, and "reg" is a register.
|
||||
;;
|
||||
;; (mod part modulo value)
|
||||
;; The selected part must satisfy "part % modulo = value", where
|
||||
;; "modulo" and "value" are constants.
|
||||
;;
|
||||
;; (func part head reg1 reg2 ... regn)
|
||||
;; The selected part must be an n-ary call to function "head".
|
||||
;; The arguments are stored in "reg1" through "regn".
|
||||
;;
|
||||
;; (func-def part head defs reg1 reg2 ... regn)
|
||||
;; The selected part must be an n-ary call to function "head".
|
||||
;; "Defs" is a list of value/register number pairs for default args.
|
||||
;; If a match, assign default values to registers and then skip
|
||||
;; immediately over any following "func-def" instructions and
|
||||
;; the following "func" instruction. If wrong number of arguments,
|
||||
;; proceed to the following "func-def" or "func" instruction.
|
||||
;;
|
||||
;; (func-opt part head defs reg1)
|
||||
;; Like func-def with "n=1", except that if the selected part is
|
||||
;; not a call to "head", then the part itself successfully matches
|
||||
;; "reg1" (and the defaults are assigned).
|
||||
;;
|
||||
;; (try part heads mark reg1 [def])
|
||||
;; The selected part must be a function of the correct type which is
|
||||
;; associative and/or commutative. "Heads" is a list of acceptable
|
||||
;; types. An initial assignment of arguments to "reg1" is tried.
|
||||
;; If the program later fails, it backtracks to this instruction
|
||||
;; and tries other assignments of arguments to "reg1".
|
||||
;; If "def" exists and normal matching fails, backtrack and assign
|
||||
;; "part" to "reg1", and "def" to "reg2" in the following "try2".
|
||||
;; The "mark" is a vector of size 5; only "mark[3-4]" are initialized.
|
||||
;; "mark[0]" points to the argument list; "mark[1]" points to the
|
||||
;; current argument; "mark[2]" is 0 if there are two arguments,
|
||||
;; 1 if reg1 is matching single arguments, 2 if reg2 is matching
|
||||
;; single arguments (a+b+c+d is never split as (a+b)+(c+d)), or
|
||||
;; 3 if reg2 is matching "def"; "mark[3]" is 0 if the function must
|
||||
;; have two arguments, 1 if phase-2 can be skipped, 2 if full
|
||||
;; backtracking is necessary; "mark[4]" is t if the arguments have
|
||||
;; been switched from the order given in the original pattern.
|
||||
;;
|
||||
;; (try2 try reg2)
|
||||
;; Every "try" will be followed by a "try2" whose "try" field is
|
||||
;; a pointer to the corresponding "try". The arguments which were
|
||||
;; not stored in "reg1" by that "try" are now stored in "reg2".
|
||||
;;
|
||||
;; (alt instr nil mark)
|
||||
;; Basic backtracking. Execute the instruction sequence "instr".
|
||||
;; If this fails, back up and execute following the "alt" instruction.
|
||||
;; The "mark" must be the vector "[nil nil 4]". The "instr" sequence
|
||||
;; should execute "end-alt" at the end.
|
||||
;;
|
||||
;; (end-alt ptr)
|
||||
;; Register success of the first alternative of a previous "alt".
|
||||
;; "Ptr" is a pointer to the next instruction following that "alt".
|
||||
;;
|
||||
;; (apply part reg1 reg2)
|
||||
;; The selected part must be a function call. The functor
|
||||
;; (as a variable name) is stored in "reg1"; the arguments
|
||||
;; (as a vector) are stored in "reg2".
|
||||
;;
|
||||
;; (cons part reg1 reg2)
|
||||
;; The selected part must be a nonempty vector. The first element
|
||||
;; of the vector is stored in "reg1"; the rest of the vector
|
||||
;; (as another vector) is stored in "reg2".
|
||||
;;
|
||||
;; (rcons part reg1 reg2)
|
||||
;; The selected part must be a nonempty vector. The last element
|
||||
;; of the vector is stored in "reg2"; the rest of the vector
|
||||
;; (as another vector) is stored in "reg1".
|
||||
;;
|
||||
;; (select part reg)
|
||||
;; If the selected part is a unary call to function "select", its
|
||||
;; argument is stored in "reg"; otherwise (provided this is an `a r'
|
||||
;; and not a `g r' command) the selected part is stored in "reg".
|
||||
;;
|
||||
;; (cond expr)
|
||||
;; The "expr", with registers substituted, must simplify to
|
||||
;; a non-zero value.
|
||||
;;
|
||||
;; (let reg expr)
|
||||
;; Evaluate "expr" and store the result in "reg". Always succeeds.
|
||||
;;
|
||||
;; (done rhs remember)
|
||||
;; Rewrite the expression to "rhs", with register substituted.
|
||||
;; Normalize; if the result is different from the original
|
||||
;; expression, the match has succeeded. This is the last
|
||||
;; instruction of every program. If "remember" is non-nil,
|
||||
;; record the result of the match as a new literal rule.
|
||||
|
||||
|
||||
;;; Pseudo-functions related to rewrites:
|
||||
;;;
|
||||
;;; In patterns: quote, plain, condition, opt, apply, cons, select
|
||||
;;;
|
||||
;;; In righthand sides: quote, plain, eval, evalsimp, evalextsimp,
|
||||
;;; apply, cons, select
|
||||
;;;
|
||||
;;; In conditions: let + same as for righthand sides
|
||||
;; Pseudo-functions related to rewrites:
|
||||
;;
|
||||
;; In patterns: quote, plain, condition, opt, apply, cons, select
|
||||
;;
|
||||
;; In righthand sides: quote, plain, eval, evalsimp, evalextsimp,
|
||||
;; apply, cons, select
|
||||
;;
|
||||
;; In conditions: let + same as for righthand sides
|
||||
|
||||
;;; Some optimizations that would be nice to have:
|
||||
;;;
|
||||
;;; * Merge registers with disjoint lifetimes.
|
||||
;;; * Merge constant registers with equivalent values.
|
||||
;;;
|
||||
;;; * If an argument of a commutative op math-depends neither on the
|
||||
;;; rest of the pattern nor on any of the conditions, then no backtracking
|
||||
;;; should be done for that argument. (This won't apply to very many
|
||||
;;; cases.)
|
||||
;;;
|
||||
;;; * If top functor is "select", and its argument is a unique function,
|
||||
;;; add the rule to the lists for both "select" and that function.
|
||||
;;; (Currently rules like this go on the "nil" list.)
|
||||
;;; Same for "func-opt" functions. (Though not urgent for these.)
|
||||
;;;
|
||||
;;; * Shouldn't evaluate a "let" condition until the end, or until it
|
||||
;;; would enable another condition to be evaluated.
|
||||
;;;
|
||||
;; Some optimizations that would be nice to have:
|
||||
;;
|
||||
;; * Merge registers with disjoint lifetimes.
|
||||
;; * Merge constant registers with equivalent values.
|
||||
;;
|
||||
;; * If an argument of a commutative op math-depends neither on the
|
||||
;; rest of the pattern nor on any of the conditions, then no backtracking
|
||||
;; should be done for that argument. (This won't apply to very many
|
||||
;; cases.)
|
||||
;;
|
||||
;; * If top functor is "select", and its argument is a unique function,
|
||||
;; add the rule to the lists for both "select" and that function.
|
||||
;; (Currently rules like this go on the "nil" list.)
|
||||
;; Same for "func-opt" functions. (Though not urgent for these.)
|
||||
;;
|
||||
;; * Shouldn't evaluate a "let" condition until the end, or until it
|
||||
;; would enable another condition to be evaluated.
|
||||
;;
|
||||
|
||||
;;; Some additional features to add / things to think about:
|
||||
;; Some additional features to add / things to think about:
|
||||
;;;
|
||||
;;; * Figure out what happens to "a +/- b" and "a +/- opt(b)".
|
||||
;;;
|
||||
|
|
@ -1331,14 +1326,14 @@
|
|||
(< (math-rwcomp-priority (car a))
|
||||
(math-rwcomp-priority (car b))))
|
||||
|
||||
;;; Order of priority: 0 Constants and other exact matches (first)
|
||||
;;; 10 Functions (except below)
|
||||
;;; 20 Meta-variables which occur more than once
|
||||
;;; 30 Algebraic functions
|
||||
;;; 40 Commutative/associative functions
|
||||
;;; 50 Meta-variables which occur only once
|
||||
;;; +100 for every "!!!" (pnot) in the pattern
|
||||
;;; 10000 Optional arguments (last)
|
||||
;; Order of priority: 0 Constants and other exact matches (first)
|
||||
;; 10 Functions (except below)
|
||||
;; 20 Meta-variables which occur more than once
|
||||
;; 30 Algebraic functions
|
||||
;; 40 Commutative/associative functions
|
||||
;; 50 Meta-variables which occur only once
|
||||
;; +100 for every "!!!" (pnot) in the pattern
|
||||
;; 10000 Optional arguments (last)
|
||||
|
||||
(defun math-rwcomp-priority (expr)
|
||||
(+ (math-rwcomp-count-pnots expr)
|
||||
|
|
@ -1390,8 +1385,8 @@
|
|||
(setq count (+ count (math-rwcomp-count-pnots (car expr)))))
|
||||
count))))
|
||||
|
||||
;;; In the current implementation, all associative functions must
|
||||
;;; also be commutative.
|
||||
;; In the current implementation, all associative functions must
|
||||
;; also be commutative.
|
||||
|
||||
(put '+ 'math-rewrite-props '(algebraic assoc commut))
|
||||
(put '- 'math-rewrite-props '(algebraic assoc commut)) ; see below
|
||||
|
|
@ -1429,8 +1424,8 @@
|
|||
(put 'calcFunc-vint 'math-rewrite-props '(assoc commut))
|
||||
(put 'calcFunc-vxor 'math-rewrite-props '(assoc commut))
|
||||
|
||||
;;; Note: "*" is not commutative for matrix args, but we pretend it is.
|
||||
;;; Also, "-" is not commutative but the code tweaks things so that it is.
|
||||
;; Note: "*" is not commutative for matrix args, but we pretend it is.
|
||||
;; Also, "-" is not commutative but the code tweaks things so that it is.
|
||||
|
||||
(put '+ 'math-rewrite-default 0)
|
||||
(put '- 'math-rewrite-default 0)
|
||||
|
|
@ -1452,8 +1447,8 @@
|
|||
'btrack)
|
||||
''((backtrack)))))
|
||||
|
||||
;;; This monstrosity is necessary because the use of static vectors of
|
||||
;;; registers makes rewrite rules non-reentrant. Yucko!
|
||||
;; This monstrosity is necessary because the use of static vectors of
|
||||
;; registers makes rewrite rules non-reentrant. Yucko!
|
||||
(defmacro math-rweval (form)
|
||||
(list 'let '((orig (car rules)))
|
||||
'(setcar rules (quote (nil nil nil no-phase)))
|
||||
|
|
|
|||
|
|
@ -637,8 +637,7 @@
|
|||
|
||||
(defun calc-insert-variables (buf)
|
||||
(interactive "bBuffer in which to save variable values: ")
|
||||
(save-excursion
|
||||
(set-buffer buf)
|
||||
(with-current-buffer buf
|
||||
(mapatoms (function
|
||||
(lambda (x)
|
||||
(and (string-match "\\`var-" (symbol-name x))
|
||||
|
|
|
|||
|
|
@ -142,8 +142,7 @@
|
|||
(search-forward " ")
|
||||
(let* ((next (save-excursion (forward-line 1) (point)))
|
||||
(str (buffer-substring (point) (1- next)))
|
||||
(val (save-excursion
|
||||
(set-buffer save-buf)
|
||||
(val (with-current-buffer save-buf
|
||||
(math-read-plain-expr str))))
|
||||
(if (eq (car-safe val) 'error)
|
||||
(error "Can't yank that line: %s" (nth 2 val))
|
||||
|
|
|
|||
|
|
@ -695,8 +695,7 @@ If EXPR is nil, return nil."
|
|||
(setq math-units-table nil)
|
||||
(let ((buf (get-buffer "*Units Table*")))
|
||||
(and buf
|
||||
(save-excursion
|
||||
(set-buffer buf)
|
||||
(with-current-buffer buf
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (looking-at "Calculator Units Table")
|
||||
|
|
|
|||
|
|
@ -444,14 +444,12 @@ With prefix arg, also delete the region."
|
|||
(setq top (point))
|
||||
(calc-cursor-stack-index 0)
|
||||
(setq bot (point))))
|
||||
(save-excursion
|
||||
(set-buffer newbuf)
|
||||
(with-current-buffer newbuf
|
||||
(if (consp nn)
|
||||
(kill-region (region-beginning) (region-end)))
|
||||
(push-mark (point) t)
|
||||
(if (and overwrite-mode (not (consp nn)))
|
||||
(calc-overwrite-string (save-excursion
|
||||
(set-buffer oldbuf)
|
||||
(calc-overwrite-string (with-current-buffer oldbuf
|
||||
(buffer-substring top bot))
|
||||
eat-lnums)
|
||||
(or (bolp) (setq eat-lnums nil))
|
||||
|
|
|
|||
|
|
@ -1427,8 +1427,7 @@ commands given here will actually operate on the *Calculator* stack."
|
|||
(set-window-buffer w (current-buffer))
|
||||
(select-window w))
|
||||
(pop-to-buffer (current-buffer)))))))
|
||||
(save-excursion
|
||||
(set-buffer (calc-trail-buffer))
|
||||
(with-current-buffer (calc-trail-buffer)
|
||||
(and calc-display-trail
|
||||
(= (window-width) (frame-width))
|
||||
(calc-trail-display 1 t)))
|
||||
|
|
@ -1979,8 +1978,7 @@ See calc-keypad for details."
|
|||
(goto-char save-point))
|
||||
(if save-mark (set-mark save-mark))))
|
||||
(and calc-embedded-info (not (eq major-mode 'calc-mode))
|
||||
(save-excursion
|
||||
(set-buffer (aref calc-embedded-info 1))
|
||||
(with-current-buffer (aref calc-embedded-info 1)
|
||||
(calc-refresh align)))
|
||||
(setq calc-refresh-count (1+ calc-refresh-count)))
|
||||
|
||||
|
|
@ -2005,8 +2003,7 @@ See calc-keypad for details."
|
|||
(calc-trail-mode buf)))))
|
||||
(or (and calc-trail-pointer
|
||||
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
|
||||
(save-excursion
|
||||
(set-buffer calc-trail-buffer)
|
||||
(with-current-buffer calc-trail-buffer
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(setq calc-trail-pointer (point-marker))))
|
||||
|
|
@ -2025,8 +2022,7 @@ See calc-keypad for details."
|
|||
(math-showing-full-precision
|
||||
(math-format-flat-expr val 0)))
|
||||
"")))
|
||||
(save-excursion
|
||||
(set-buffer buf)
|
||||
(with-current-buffer buf
|
||||
(let ((aligned (calc-check-trail-aligned))
|
||||
(buffer-read-only nil))
|
||||
(goto-char (point-max))
|
||||
|
|
@ -2262,8 +2258,7 @@ See calc-keypad for details."
|
|||
(or (boundp 'calc-buffer)
|
||||
(use-local-map minibuffer-local-map))
|
||||
(let ((str (minibuffer-contents)))
|
||||
(setq calc-digit-value (save-excursion
|
||||
(set-buffer calc-buffer)
|
||||
(setq calc-digit-value (with-current-buffer calc-buffer
|
||||
(math-read-number str))))
|
||||
(if (and (null calc-digit-value) (> (calc-minibuffer-size) 0))
|
||||
(progn
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue