# HG changeset patch # User Stefan Monnier # Date 1256754933 0 # Node ID 2c12fbae77c2bed22fefbd57070b7dc3eb7c20d2 # Parent 84d7bc7104ac3dcc12ec46908796d352ffc7b006 * 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. diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/ChangeLog --- a/lisp/ChangeLog Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/ChangeLog Wed Oct 28 18:35:33 2009 +0000 @@ -1,5 +1,26 @@ 2009-10-28 Stefan Monnier + * 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. diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-aent.el --- a/lisp/calc/calc-aent.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-aent.el Wed Oct 28 18:35:33 2009 +0000 @@ -414,8 +414,7 @@ (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 diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-embed.el --- a/lisp/calc/calc-embed.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-embed.el Wed Oct 28 18:35:33 2009 +0000 @@ -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 @@ (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 @@ (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 @@ (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)) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-ext.el --- a/lisp/calc/calc-ext.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-ext.el Wed Oct 28 18:35:33 2009 +0000 @@ -1677,8 +1677,8 @@ (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)) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-graph.el --- a/lisp/calc/calc-graph.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-graph.el Wed Oct 28 18:35:33 2009 +0000 @@ -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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-help.el --- a/lisp/calc/calc-help.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-help.el Wed Oct 28 18:35:33 2009 +0000 @@ -110,8 +110,7 @@ (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 @@ (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...") diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-keypd.el --- a/lisp/calc/calc-keypd.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-keypd.el Wed Oct 28 18:35:33 2009 +0000 @@ -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) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-prog.el --- a/lisp/calc/calc-prog.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-prog.el Wed Oct 28 18:35:33 2009 +0000 @@ -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)) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-rewr.el --- a/lisp/calc/calc-rewr.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-rewr.el Wed Oct 28 18:35:33 2009 +0000 @@ -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))) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-store.el --- a/lisp/calc/calc-store.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-store.el Wed Oct 28 18:35:33 2009 +0000 @@ -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)) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-trail.el --- a/lisp/calc/calc-trail.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-trail.el Wed Oct 28 18:35:33 2009 +0000 @@ -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)) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-units.el --- a/lisp/calc/calc-units.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-units.el Wed Oct 28 18:35:33 2009 +0000 @@ -695,8 +695,7 @@ (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") diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc-yank.el --- a/lisp/calc/calc-yank.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc-yank.el Wed Oct 28 18:35:33 2009 +0000 @@ -444,14 +444,12 @@ (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)) diff -r 84d7bc7104ac -r 2c12fbae77c2 lisp/calc/calc.el --- a/lisp/calc/calc.el Wed Oct 28 15:54:00 2009 +0000 +++ b/lisp/calc/calc.el Wed Oct 28 18:35:33 2009 +0000 @@ -1427,8 +1427,7 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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