[Emacs-diffs] /srv/bzr/emacs/trunk r110852: * ses.el: Use hash map for getting named cells coordinates.

[Vincent Belaïche]

------------------------------------------------------------
revno: 110852
committer: Vincent Belaïche  <address@hidden>
branch nick: trunk
timestamp: Fri 2012-11-09 06:48:05 +0100
message:
  * ses.el: Use hash map for getting named cells coordinates.
   symbol to coordinate mapping is made by symbol property
   `ses-cell'. This means that the same mapping is done for all SES
   sheets. That is good enough for cells with standard A1 names, but
   not for named cell. So a hash map is added for those
   latter.
   (defconst ses-localvars): added local variable ses--named-cell-hashmap
   (ses-sym-rowcol): Use hashmap for named cell.
   (ses-is-cell-sym-p): New defun.
   (ses-decode-cell-symbol): New defun.
   (ses-create-cell-variable): Add cell to hashmap when name is not A1-like.
   (ses-rename-cell): Check that cell new name is not already in
   spreadsheet with the use of ses-is-cell-sym-p
   (ses-rename-cell): Use hash map for named cells, but accept also
   renaming back to A1-like.
modified:
  lisp/ChangeLog
  lisp/ses.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-11-09 04:10:16 +0000
+++ b/lisp/ChangeLog    2012-11-09 05:48:05 +0000
@@ -1,3 +1,20 @@
+2012-11-09  Vincent Belaïche  <address@hidden>
+
+       * ses.el: symbol to coordinate mapping is made by symbol property
+       `ses-cell'. This means that the same mapping is done for all SES
+       sheets. That is good enough for cells with standard A1 names, but
+       not for named cell. So a hash map is added for those
+       latter.
+       (defconst ses-localvars): added local variable ses--named-cell-hashmap
+       (ses-sym-rowcol): Use hashmap for named cell.
+       (ses-is-cell-sym-p): New defun.
+       (ses-decode-cell-symbol): New defun.
+       (ses-create-cell-variable): Add cell to hashmap when name is not 
A1-like.
+       (ses-rename-cell): Check that cell new name is not already in
+       spreadsheet with the use of ses-is-cell-sym-p
+       (ses-rename-cell): Use hash map for named cells, but accept also
+       renaming back to A1-like.
+
 2012-11-09  Stefan Monnier  <address@hidden>
 
        * emacs-lisp/advice.el: Use new dynamic docstrings.

=== modified file 'lisp/ses.el'
--- a/lisp/ses.el       2012-09-07 08:58:31 +0000
+++ b/lisp/ses.el       2012-11-09 05:48:05 +0000
@@ -278,6 +278,7 @@
       ses--default-printer
       ses--deferred-narrow ses--deferred-recalc
       ses--deferred-write ses--file-format
+      ses--named-cell-hashmap
       (ses--header-hscroll . -1) ; Flag for "initial recalc needed"
       ses--header-row ses--header-string ses--linewidth
       ses--numcols ses--numrows ses--symbolic-formulas
@@ -511,9 +512,22 @@
   `(aref ses--col-printers ,col))
 
 (defmacro ses-sym-rowcol (sym)
-  "From a cell-symbol SYM, gets the cons (row . col).  A1 => (0 . 0).
-Result is nil if SYM is not a symbol that names a cell."
-  `(and (symbolp ,sym) (get ,sym 'ses-cell)))
+  "From a cell-symbol SYM, gets the cons (row . col).  A1 => (0 . 0).  Result
+is nil if SYM is not a symbol that names a cell."
+  `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
+     (if (eq rc :ses-named)
+        (gethash ,sym ses--named-cell-hashmap)
+       rc)))
+
+(defun ses-is-cell-sym-p (sym)
+  "Check whether SYM point at a cell of this spread sheet."
+  (let ((rowcol (get sym 'ses-cell)))
+    (and rowcol
+        (if (eq rowcol :ses-named)
+            (and ses--named-cell-hashmap (gethash sym ses--named-cell-hashmap))
+          (and (< (car rowcol) ses--numrows)
+               (< (cdr rowcol) ses--numcols)
+               (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym))))))
 
 (defmacro ses-cell (sym value formula printer references)
   "Load a cell SYM from the spreadsheet file.  Does not recompute VALUE from
@@ -682,6 +696,28 @@
   "Produce a symbol that names the cell (ROW,COL).  (0,0) => 'A1."
   (intern (concat (ses-column-letter col) (number-to-string (1+ row)))))
 
+(defun ses-decode-cell-symbol (str)
+  "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a
+  canonical cell name. Does not save match data."
+  (let (case-fold-search)
+    (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str)
+        (let* ((col-str (match-string-no-properties 1 str))
+              (col 0)
+              (col-offset 0)
+              (col-base 1)
+              (col-idx (1- (length col-str)))
+              (row (1- (string-to-number (match-string-no-properties 2 str)))))
+          (and (>= row 0)
+               (progn
+                 (while
+                     (progn
+                       (setq col (+ col (* (- (aref col-str col-idx) ?A) 
col-base))
+                             col-base (* col-base 26)
+                             col-idx (1- col-idx))
+                       (and (>= col-idx 0)
+                            (setq col (+ col col-base)))))
+                 (cons row col)))))))
+
 (defun ses-create-cell-variable-range (minrow maxrow mincol maxcol)
   "Create buffer-local variables for cells.  This is undoable."
   (push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol 
,maxcol)
@@ -704,7 +740,11 @@
 Return nil in case of failure."
   (unless (local-variable-p sym)
     (make-local-variable  sym)
-    (put sym 'ses-cell (cons row col))))
+    (if (let (case-fold-search) (string-match "\\`[A-Z]+[0-9]+\\'" 
(symbol-name sym)))
+       (put sym 'ses-cell (cons row col))
+      (put sym 'ses-cell :ses-named)
+      (setq ses--named-cell-hashmap (or ses--named-cell-hashmap 
(make-hash-table :test 'eq)))
+      (puthash sym (cons row col) ses--named-cell-hashmap))))
 
 ;; We do not delete the ses-cell properties for the cell-variables, in
 ;; case a formula that refers to this cell is in the kill-ring and is
@@ -3211,27 +3251,36 @@
 (defun ses-rename-cell (new-name &optional cell)
   "Rename current cell."
   (interactive "*SEnter new name: ")
-  (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)
+  (or
+   (and  (local-variable-p new-name)
+        (ses-is-cell-sym-p new-name)
+        (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* (curcell
+        (sym (if (ses-cell-p cell)
                  (ses-cell-symbol cell)
-               (setq cell nil)
+               (setq cell nil
+                     curcell t)
                (ses-check-curcell)
                ses--curcell))
         (rowcol (ses-sym-rowcol sym))
         (row (car rowcol))
-        (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)
+        (col (cdr rowcol))
+        new-rowcol old-name)
+    (setq cell (or cell (ses-get-cell row col))
+         old-name (ses-cell-symbol cell)
+         new-rowcol (ses-decode-cell-symbol (symbol-name new-name)))
+    (if new-rowcol
+       (if (equal new-rowcol rowcol)
+         (put new-name 'ses-cell rowcol)
+         (error "Not a valid name for this cell location"))
+      (setq ses--named-cell-hashmap (or ses--named-cell-hashmap 
(make-hash-table :test 'eq)))
+      (put new-name 'ses-cell :ses-named)
+      (puthash new-name rowcol ses--named-cell-hashmap))
+    (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
     ;; 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))
@@ -3251,9 +3300,8 @@
     (push new-name ses--renamed-cell-symb-list)
     (set new-name (symbol-value sym))
     (aset cell 0 new-name)
-    (put sym 'ses-cell nil)
     (makunbound sym)
-    (setq sym new-name)
+    (and curcell (setq ses--curcell new-name))
     (let* ((pos (point))
           (inhibit-read-only t)
           (col (current-column))