emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] emacs/lisp ChangeLog calc/calc-aent.el calc/cal...


From: Stefan Monnier
Subject: [Emacs-diffs] emacs/lisp ChangeLog calc/calc-aent.el calc/cal...
Date: Wed, 28 Oct 2009 18:35:38 +0000

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        09/10/28 18:35:38

Modified files:
        lisp           : ChangeLog 
        lisp/calc      : calc-aent.el calc-embed.el calc-ext.el 
                         calc-graph.el calc-help.el calc-keypd.el 
                         calc-prog.el calc-rewr.el calc-store.el 
                         calc-trail.el calc-units.el calc-yank.el 
                         calc.el 

Log message:
        * 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.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16521&r2=1.16522
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-aent.el?cvsroot=emacs&r1=1.50&r2=1.51
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-embed.el?cvsroot=emacs&r1=1.47&r2=1.48
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-ext.el?cvsroot=emacs&r1=1.80&r2=1.81
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-graph.el?cvsroot=emacs&r1=1.34&r2=1.35
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-help.el?cvsroot=emacs&r1=1.41&r2=1.42
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-keypd.el?cvsroot=emacs&r1=1.23&r2=1.24
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-prog.el?cvsroot=emacs&r1=1.48&r2=1.49
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-rewr.el?cvsroot=emacs&r1=1.24&r2=1.25
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-store.el?cvsroot=emacs&r1=1.32&r2=1.33
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-trail.el?cvsroot=emacs&r1=1.18&r2=1.19
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-units.el?cvsroot=emacs&r1=1.46&r2=1.47
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc-yank.el?cvsroot=emacs&r1=1.34&r2=1.35
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/calc/calc.el?cvsroot=emacs&r1=1.135&r2=1.136

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16521
retrieving revision 1.16522
diff -u -b -r1.16521 -r1.16522
--- ChangeLog   28 Oct 2009 14:01:49 -0000      1.16521
+++ ChangeLog   28 Oct 2009 18:35:33 -0000      1.16522
@@ -1,5 +1,26 @@
 2009-10-28  Stefan Monnier  <address@hidden>
 
+       * 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.

Index: calc/calc-aent.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-aent.el,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -b -r1.50 -r1.51
--- calc/calc-aent.el   9 Jan 2009 03:57:14 -0000       1.50
+++ calc/calc-aent.el   28 Oct 2009 18:35:37 -0000      1.51
@@ -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

Index: calc/calc-embed.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-embed.el,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -b -r1.47 -r1.48
--- calc/calc-embed.el  6 Jul 2009 00:08:29 -0000       1.47
+++ calc/calc-embed.el  28 Oct 2009 18:35:37 -0000      1.48
@@ -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))

Index: calc/calc-ext.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-ext.el,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -b -r1.80 -r1.81
--- calc/calc-ext.el    6 Oct 2009 02:42:32 -0000       1.80
+++ calc/calc-ext.el    28 Oct 2009 18:35:37 -0000      1.81
@@ -1677,7 +1677,7 @@
             (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))
+         (if (with-current-buffer (aref calc-embedded-info 1)
                              calc-show-plain)
              (forward-line 1)))
       (calc-wrapper

Index: calc/calc-graph.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-graph.el,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -b -r1.34 -r1.35
--- calc/calc-graph.el  6 Oct 2009 02:42:32 -0000       1.34
+++ calc/calc-graph.el  28 Oct 2009 18:35:37 -0000      1.35
@@ -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

Index: calc/calc-help.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-help.el,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -b -r1.41 -r1.42
--- calc/calc-help.el   21 Aug 2009 07:24:30 -0000      1.41
+++ calc/calc-help.el   28 Oct 2009 18:35:37 -0000      1.42
@@ -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...")

Index: calc/calc-keypd.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-keypd.el,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -b -r1.23 -r1.24
--- calc/calc-keypd.el  9 Jan 2009 03:57:15 -0000       1.23
+++ calc/calc-keypd.el  28 Oct 2009 18:35:37 -0000      1.24
@@ -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)

Index: calc/calc-prog.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-prog.el,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -b -r1.48 -r1.49
--- calc/calc-prog.el   29 Sep 2009 02:26:24 -0000      1.48
+++ calc/calc-prog.el   28 Oct 2009 18:35:37 -0000      1.49
@@ -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))

Index: calc/calc-rewr.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-rewr.el,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -b -r1.24 -r1.25
--- calc/calc-rewr.el   5 Jan 2009 03:20:18 -0000       1.24
+++ calc/calc-rewr.el   28 Oct 2009 18:35:37 -0000      1.25
@@ -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.
-
-
-;;; 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.
-;;;
+;; 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
+
+;; 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)))

Index: calc/calc-store.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-store.el,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -b -r1.32 -r1.33
--- calc/calc-store.el  9 Jan 2009 03:57:15 -0000       1.32
+++ calc/calc-store.el  28 Oct 2009 18:35:37 -0000      1.33
@@ -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))

Index: calc/calc-trail.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-trail.el,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- calc/calc-trail.el  5 Jan 2009 03:20:26 -0000       1.18
+++ calc/calc-trail.el  28 Oct 2009 18:35:37 -0000      1.19
@@ -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))

Index: calc/calc-units.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-units.el,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -b -r1.46 -r1.47
--- calc/calc-units.el  9 Jan 2009 03:57:15 -0000       1.46
+++ calc/calc-units.el  28 Oct 2009 18:35:37 -0000      1.47
@@ -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")

Index: calc/calc-yank.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc-yank.el,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -b -r1.34 -r1.35
--- calc/calc-yank.el   9 Jan 2009 03:57:16 -0000       1.34
+++ calc/calc-yank.el   28 Oct 2009 18:35:37 -0000      1.35
@@ -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))

Index: calc/calc.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calc/calc.el,v
retrieving revision 1.135
retrieving revision 1.136
diff -u -b -r1.135 -r1.136
--- calc/calc.el        23 Oct 2009 01:39:04 -0000      1.135
+++ calc/calc.el        28 Oct 2009 18:35:37 -0000      1.136
@@ -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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]