[Emacs-diffs] /srv/bzr/emacs/trunk r109189: * ses.el (ses-cell-formula-aset): New macro.

[Vincent Belaïche]

------------------------------------------------------------
revno: 109189
committer: Vincent Belaïche  <address@hidden>
branch nick: trunk
timestamp: Sun 2012-07-22 23:14:12 +0200
message:
  * ses.el (ses-cell-formula-aset): New macro.
  (ses-cell-references-aset): New macro.
  (ses-cell-p): New function.
  (ses-rename-cell): Do no longer rely on complex operations like
  ses-cell-set-formula or ses-set-cell to change the cell and handle
  the undo at the same time, but rather use lower level new macros
  `ses-cell-formula-aset' and `ses-cell-references-aset' and handle
  the undo directly. Refresh the mode line.
modified:
  lisp/ChangeLog
  lisp/ses.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-21 06:13:23 +0000
+++ b/lisp/ChangeLog    2012-07-22 21:14:12 +0000
@@ -1,3 +1,14 @@
+2012-07-22  Vincent Belaïche  <address@hidden>
+
+       * ses.el (ses-cell-formula-aset): New macro.
+       (ses-cell-references-aset): New macro.
+       (ses-cell-p): New function.
+       (ses-rename-cell): Do no longer rely on complex operations like
+       ses-cell-set-formula or ses-set-cell to change the cell and handle
+       the undo at the same time, but rather use lower level new macros
+       `ses-cell-formula-aset' and `ses-cell-references-aset' and handle
+       the undo directly. Refresh the mode line.
+
 2012-07-21  Leo Liu  <address@hidden>
 
        * progmodes/cc-cmds.el (c-defun-name): Use

=== modified file 'lisp/ses.el'
--- a/lisp/ses.el       2012-07-22 04:11:49 +0000
+++ b/lisp/ses.el       2012-07-22 21:14:12 +0000
@@ -362,6 +362,10 @@
   "From a CELL or a pair (ROW,COL), get the function that computes its value."
   `(aref ,(if col `(ses-get-cell ,row ,col) row) 1))
 
+(defmacro ses-cell-formula-aset (cell formula)
+  "From a CELL set the function that computes its value."
+  `(aset ,cell 1 ,formula))
+
 (defmacro ses-cell-printer (row &optional col)
   "From a CELL or a pair (ROW,COL), get the function that prints its value."
   `(aref ,(if col `(ses-get-cell ,row ,col) row) 2))
@@ -371,6 +375,19 @@
 functions refer to its value."
   `(aref ,(if col `(ses-get-cell ,row ,col) row) 3))
 
+(defmacro ses-cell-references-aset (cell references)
+  "From a CELL set the list REFERENCES of symbols for cells the
+function of which refer to its value."
+  `(aset ,cell 3 ,references))
+
+(defun ses-cell-p (cell)
+  "Return non `nil' is CELL is a cell of current buffer."
+  (and (vectorp cell)
+       (= (length cell) 5)
+       (eq cell (let ((rowcol (ses-sym-rowcol (ses-cell-symbol cell))))
+                 (and (consp rowcol)
+                      (ses-get-cell (car rowcol) (cdr rowcol)))))))
+
 (defun ses-cell-property-get-fun (property-name cell)
   ;; To speed up property fetching, each time a property is found it is placed
   ;; in the first position.  This way, after the first get, the full property
@@ -3193,50 +3210,52 @@
        (setq formula (cdr formula))))
     new-formula))
 
-(defun ses-rename-cell (new-name)
+(defun ses-rename-cell (new-name &optional cell)
   "Rename current cell."
   (interactive "*SEnter new name: ")
-  (ses-check-curcell)
-  (or
-   (and  (local-variable-p new-name)
-        (ses-sym-rowcol new-name)
-        ;; this test is needed because ses-cell property of deleted cells
-        ;; is not deleted in case of subsequent undo
-        (memq new-name ses--renamed-cell-symb-list)
-        (error "Already a cell name"))
-   (and (boundp new-name)
-       (null (yes-or-no-p (format "`%S' is already bound outside this buffer, 
continue? "
-                                  new-name)))
-       (error "Already a bound cell name")))
-  (let* ((rowcol (ses-sym-rowcol ses--curcell))
+  (and  (local-variable-p new-name)
+       (ses-sym-rowcol new-name)
+       ;; this test is needed because ses-cell property of deleted cells
+       ;; is not deleted in case of subsequent undo
+       (memq new-name ses--renamed-cell-symb-list)
+       (error "Already a cell name"))
+  (and (boundp new-name)
+       (null (yes-or-no-p (format "`%S' is already bound outside this buffer, 
continue? "
+                                 new-name)))
+       (error "Already a bound cell name"))
+  (let* ((sym (if (ses-cell-p cell)
+                 (ses-cell-symbol cell)
+               (setq cell nil)
+               (ses-check-curcell)
+               ses--curcell))
+        (rowcol (ses-sym-rowcol sym))
         (row (car rowcol))
-        (col (cdr rowcol))
-        (cell (ses-get-cell  row  col)))
+        (col (cdr rowcol)))
+    (setq cell (or cell (ses-get-cell row col)))
+    (push `(ses-rename-cell ,(ses-cell-symbol cell) ,cell) buffer-undo-list)
     (put new-name 'ses-cell rowcol)
-    ;; Replace name by new name in formula of cells referring to renamed cell.
+    ;; replace name by new name in formula of cells refering to renamed cell
     (dolist (ref (ses-cell-references cell))
       (let* ((x (ses-sym-rowcol ref))
             (xcell  (ses-get-cell (car x) (cdr x))))
-       (ses-cell-set-formula (car rowcol)
-                             (cdr rowcol)
-                             (ses-replace-name-in-formula
-                              (ses-cell-formula xcell)
-                              ses--curcell
-                              new-name))))
+       (ses-cell-formula-aset xcell
+                              (ses-replace-name-in-formula
+                               (ses-cell-formula xcell)
+                               sym
+                               new-name))))
     ;; replace name by new name in reference list of cells to which renamed 
cell refers to
     (dolist (ref (ses-formula-references (ses-cell-formula cell)))
       (let* ((x (ses-sym-rowcol ref))
-            (xrow (car x))
-            (xcol (cdr x)))
-       (ses-set-cell xrow xcol 'references
-             (cons new-name (delq ses--curcell
-                                 (ses-cell-references xrow xcol))))))
+            (xcell (ses-get-cell (car x) (cdr x))))
+       (ses-cell-references-aset xcell
+                                 (cons new-name (delq sym 
+                                                      (ses-cell-references 
xcell))))))
     (push new-name ses--renamed-cell-symb-list)
-    (set new-name (symbol-value ses--curcell))
+    (set new-name (symbol-value sym))
     (aset cell 0 new-name)
-    (put ses--curcell 'ses-cell nil)
-    (makunbound ses--curcell)
-    (setq ses--curcell new-name)
+    (put sym 'ses-cell nil)
+    (makunbound sym)
+    (setq sym new-name)
     (let* ((pos (point))
           (inhibit-read-only t)
           (col (current-column))
@@ -3245,7 +3264,11 @@
                  (if (eolp)
                      (+ pos (ses-col-width col) 1)
                    (point)))))
-      (put-text-property pos end 'intangible new-name))) )
+      (put-text-property pos end 'intangible new-name))
+    ;; update mode line
+    (setq mode-line-process (list " cell "
+                                 (symbol-name sym)))
+    (force-mode-line-update)))
 
 ;;----------------------------------------------------------------------------
 ;; Checking formulas for safety