Re: Request: ses.el Turn accessors into defsubst

[Stefan Monnier <monnier@IRO.UMontreal.CA>]

> At present, ses.el defines its all its internal accessors as
> macros -- could we please have them changed to use defsubst?

Fine by me.

I have some local changes which do that and a few more things, but
I haven't cleaned it up and some of the changes are probably not
appropriate.  It might be a good starting point for someone to
extract the defstruct part.


        Stefan


Using submit branch file:///home/monnier/src/emacs/bzr/trunk/
=== modified file 'lisp/ses.el'
--- lisp/ses.el	2012-07-22 21:14:12 +0000
+++ lisp/ses.el	2012-07-24 23:57:58 +0000
@@ -25,8 +25,18 @@
 
 ;;; To-do list:
 
+;; * M-w should deactivate the mark.
+;; * offer some way to use absolute cell addressing.
+;; * Maybe some way to copy a reference to a cell's formula rather than the
+;;   formula itself.
 ;; * split (catch 'cycle ...) call back into one or more functions
 ;; * Use $ or … for truncated fields
+;; * M-t to transpose 2 columns.
+;; * M-d should kill the cell under point.
+;; * C-t to transpose 2 rows.
+;; * C-k and M-k should be ses-kill-row and ses-kill-column.
+;; * C-o should insert the row below point rather than above.
+;; * rows inserted with C-o should inherit formulas from surrounding rows.
 ;; * Add command to make a range of columns be temporarily invisible.
 ;; * Allow paste of one cell to a range of cells -- copy formula to each.
 ;; * Do something about control characters & octal codes in cell print
@@ -345,22 +355,30 @@
 
 (defmacro ses-get-cell (row col)
   "Return the cell structure that stores information about cell (ROW,COL)."
+  (declare (debug t))
   `(aref (aref ses--cells ,row) ,col))
 
-;; We might want to use defstruct here, but cells are explicitly used as
-;; arrays in ses-set-cell, so we'd need to fix this first.  --Stef
-(defsubst ses-make-cell (&optional symbol formula printer references
-				   property-list)
-  (vector symbol formula printer references property-list))
+(cl-defstruct (ses-cell
+	       (:constructor nil)
+	       (:constructor ses-make-cell
+		(&optional symbol formula printer references))
+	       (:copier nil)
+	       ;; This is treated as an 4-elem array in various places.
+	       ;; Mostly in ses-set-cell.
+	       (:type vector)		;Not named.
+	       (:conc-name ses-cell--))
+  symbol formula printer references)
 
 (defmacro ses-cell-symbol (row &optional col)
   "From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value.  (0,0) => A1."
-  `(aref ,(if col `(ses-get-cell ,row ,col) row) 0))
+  (declare (debug t))
+  `(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row)))
 (put 'ses-cell-symbol 'safe-function t)
 
 (defmacro ses-cell-formula (row &optional col)
   "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))
+  (declare (debug t))
+  `(ses-cell--formula ,(if col `(ses-get-cell ,row ,col) row)))
 
 (defmacro ses-cell-formula-aset (cell formula)
   "From a CELL set the function that computes its value."
@@ -368,12 +386,14 @@
 
 (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))
+  (declare (debug t))
+  `(ses-cell--printer ,(if col `(ses-get-cell ,row ,col) row)))
 
 (defmacro ses-cell-references (row &optional col)
   "From a CELL or a pair (ROW,COL), get the list of symbols for cells whose
 functions refer to its value."
-  `(aref ,(if col `(ses-get-cell ,row ,col) row) 3))
+  (declare (debug t))
+  `(ses-cell--references ,(if col `(ses-get-cell ,row ,col) row)))
 
 (defmacro ses-cell-references-aset (cell references)
   "From a CELL set the list REFERENCES of symbols for cells the
@@ -500,19 +520,23 @@
 
 (defmacro ses-cell-value (row &optional col)
   "From a CELL or a pair (ROW,COL), get the current value for that cell."
+  (declare (debug t))
   `(symbol-value (ses-cell-symbol ,row ,col)))
 
 (defmacro ses-col-width (col)
   "Return the width for column COL."
+  (declare (debug t))
   `(aref ses--col-widths ,col))
 
 (defmacro ses-col-printer (col)
   "Return the default printer for column COL."
+  (declare (debug t))
   `(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."
+  (declare (debug t))
   `(and (symbolp ,sym) (get ,sym 'ses-cell)))
 
 (defmacro ses-cell (sym value formula printer references)
@@ -536,6 +560,28 @@
   (set sym value)
   sym)
 
+(defmacro ses-c (sym formula &optional references value printer)
+  "Load a cell SYM from the spreadsheet file.  Does not recompute VALUE from
+FORMULA, does not reprint using PRINTER, does not check REFERENCES.  This is a
+macro to prevent propagate-on-load viruses.  Safety-checking for FORMULA and
+PRINTER are deferred until first use."
+  (unless value (setq value formula))
+  (let ((rowcol (ses-sym-rowcol sym)))
+    (ses-formula-record formula)
+    (ses-printer-record printer)
+    (or (atom formula)
+	(eq safe-functions t)
+	(setq formula `(ses-safe-formula ,formula)))
+    (or (not printer)
+	(stringp printer)
+	(eq safe-functions t)
+	(setq printer `(ses-safe-printer ,printer)))
+    (aset (aref ses--cells (car rowcol))
+	  (cdr rowcol)
+	  (ses-make-cell sym formula printer references)))
+  (set sym value)
+  sym)
+
 (defmacro ses-column-widths (widths)
   "Load the vector of column widths from the spreadsheet file.  This is a
 macro to prevent propagate-on-load viruses."
@@ -604,9 +650,11 @@
 (defmacro 1value (form)
   "For code-coverage testing, indicate that FORM is expected to always have
 the same value."
+  (declare (debug t))
   form)
 (defmacro noreturn (form)
   "For code-coverage testing, indicate that FORM will always signal an error."
+  (declare (debug t))
   form)
 
 
@@ -745,21 +793,23 @@
 ;; The cells
 ;;----------------------------------------------------------------------------
 
-(defun ses-set-cell (row col field val)
-  "Install VAL as the contents for field FIELD (named by a quoted symbol) of
-cell (ROW,COL).  This is undoable.  The cell's data will be updated through
-`post-command-hook'."
-  (let ((cell (ses-get-cell row col))
-	(elt  (plist-get '(value t symbol 0 formula 1 printer 2 references 3)
-			 field))
-	change)
+(defmacro ses-set-cell (row col field val)
+  "Install VAL as the contents for field FIELD of cell (ROW,COL).
+FIELD is a quoted symbol.  This is undoable.
+The cell's data will be updated through `post-command-hook'."
+  (declare (debug t))
+  (let ((elt  (plist-get '(value t symbol 0 formula 1 printer 2 references 3)
+			 (eval field))))
     (or elt (signal 'args-out-of-range nil))
-    (setq change (if (eq elt t)
-		     (ses-set-with-undo (ses-cell-symbol cell) val)
-		   (ses-aset-with-undo cell elt val)))
+    `(let* ((row ,row)
+	    (col ,col)
+	    (val ,val)
+	    (cell (ses-get-cell row col))
+	    (change ,(if (eq elt t)
+			`(ses-set-with-undo (ses-cell-symbol cell) val)
+		       `(ses-aset-with-undo cell ,elt val))))
     (if change
-	(add-to-list 'ses--deferred-write (cons row col))))
-  nil) ; Make coverage-tester happy.
+	   (add-to-list 'ses--deferred-write (cons row col))))))
 
 (defun ses-cell-set-formula (row col formula)
   "Store a new formula for (ROW . COL) and enqueue the cell for
@@ -1124,7 +1174,8 @@
 	 ((< len width)
 	  ;; Fill field to length with spaces.
 	  (setq len  (make-string (- width len) ?\s)
-		text (if (eq ses-call-printer-return t)
+		text (if (or (stringp value)
+			     (eq ses-call-printer-return t))
 			 (concat text len)
 		       (concat len text))))
 	 ((> len width)
@@ -1331,8 +1382,9 @@
   "Write cells in `ses--deferred-write' from local variables to data area.
 Newlines in the data are escaped."
   (let* ((inhibit-read-only t)
+	 (standard-output (current-buffer))
 	 (print-escape-newlines t)
-	 rowcol row col cell sym formula printer text)
+	 rowcol row col cell sym formula printer)
     (setq ses-start-time (float-time))
     (with-temp-message " "
       (save-excursion
@@ -1350,27 +1402,26 @@
 	      (setq formula (cadr formula)))
 	  (if (eq (car-safe printer) 'ses-safe-printer)
 	      (setq printer (cadr printer)))
-	  ;; This is noticeably faster than (format "%S %S %S %S %S")
-	  (setq text    (concat "(ses-cell "
-				(symbol-name sym)
-				" "
-				(prin1-to-string (symbol-value sym))
-				" "
-				(prin1-to-string formula)
-				" "
-				(prin1-to-string printer)
-				" "
-				(if (atom (ses-cell-references cell))
-				    "nil"
-				  (concat "("
-					  (mapconcat 'symbol-name
-						     (ses-cell-references cell)
-						     " ")
-					  ")"))
-				")"))
 	  (ses-goto-data row col)
 	  (delete-region (point) (line-end-position))
-	  (insert text)))
+	  ;; This is noticably faster than (format "%S %S %S %S %S")
+	  (insert "(ses-c ")
+	  (prin1 sym)
+	  (insert " ")
+	  (prin1 formula)
+	  (let ((refs (ses-cell-references cell))
+		(val (symbol-value sym)))
+	    (if (eq val formula) (setq val nil))
+	    (when (or refs val printer)
+	      (insert " ")
+	      (prin1 refs)
+	      (when (or val printer)
+		(insert " ")
+		(prin1 val)
+		(when printer
+		  (insert " ")
+		  (prin1 printer)))))
+ 	  (insert ")")))
       (message " "))))
 
 
@@ -1405,6 +1456,8 @@
       ))
     result-so-far)
 
+(defalias 'ses-absolute 'identity)
+
 (defsubst ses-relocate-symbol (sym rowcol startrow startcol rowincr colincr)
   "Relocate one symbol SYM, which corresponds to ROWCOL (a cons of ROW and
 COL).  Cells starting at (STARTROW,STARTCOL) are being shifted
@@ -1457,7 +1510,7 @@
 	  (setq cur (ses-relocate-range cur startrow startcol rowincr colincr))
 	  (if cur
 	      (push cur result)))
-	 ((or (atom cur) (eq (car cur) 'quote))
+	 ((or (atom cur) (eq (car cur) 'quote) (eq (car cur) 'ses-absolute))
 	  ;; Constants pass through unchanged.
 	  (push cur result))
 	 (t
@@ -1677,6 +1730,7 @@
 (defun ses-aset-with-undo (array idx newval)
   "Like `aset', but undoable.
 Result is t if element has changed."
+  ;; BEWARE: This is also used on ses-cell elements, assuming they're arrays.
   (unless (equal (aref array idx) newval)
     (push `(apply ses-aset-with-undo ,array ,idx
 		  ,(aref array idx)) buffer-undo-list)
@@ -1737,7 +1791,7 @@
       (let* ((x      (read (current-buffer)))
 	     (sym  (car-safe (cdr-safe x))))
 	(or (and (looking-at "\n")
-		 (eq (car-safe x) 'ses-cell)
+		 (memq (car-safe x) '(ses-cell ses-c))
 		 (ses-create-cell-variable sym row col))
 	    (error "Cell-def error"))
 	(eval x)))
@@ -1874,7 +1928,8 @@
 	  ;; calculation).
 	  indent-tabs-mode	 nil)
     (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t))
-    (1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
+    ;; This makes revert impossible if the buffer is read-only.
+    ;; (1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
     (setq header-line-format   '(:eval (progn
 					 (when (/= (window-hscroll)
 						   ses--header-hscroll)
@@ -2258,16 +2313,23 @@
      (barf-if-buffer-read-only)
      (list (car rowcol)
 	   (cdr rowcol)
+           (if (equal initial "\"")
+               (progn
+                 (if (not (stringp curval)) (setq curval nil))
+                 (read-string (if curval
+                                  (format "String Cell %s (default %s): "
+                                          ses--curcell curval)
+                                (format "String Cell %s: " ses--curcell))
+                              nil 'ses-read-string-history curval))
            (read-from-minibuffer
             (format "Cell %s: " ses--curcell)
-            (cons (if (equal initial "\"") "\"\""
-                    (if (equal initial "(") "()" initial)) 2)
+              (cons (if (equal initial "(") "()" initial) 2)
             ses-mode-edit-map
             t                         ; Convert to Lisp object.
             'ses-read-cell-history
             (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula)
 				 (cadr curval)
-			       curval))))))
+                                 curval)))))))
   (when (ses-edit-cell row col newval)
     (ses-command-hook) ; Update cell widths before movement.
     (dolist (x ses-after-entry-functions)
@@ -2891,9 +2953,9 @@
       ;; Invalid sexp --- leave it as a string.
       (setq val (substring text from to)))
      ((and (car val) (symbolp (car val)))
-      (if (consp arg)
-	  (setq val (list 'quote (car val)))  ; Keep symbol.
-	(setq val (substring text from to)))) ; Treat symbol as text.
+      (setq val (if (consp arg)
+		    (list 'quote (car val))   ; Keep symbol.
+		  (substring text from to)))) ; Treat symbol as text.
      (t
       (setq val (car val))))
     (let ((row (car rowcol))
@@ -3437,7 +3499,7 @@
   "Return ARGS reversed, with the blank elements (nil and *skip*) removed."
   (let (result)
     (dolist (cur args)
-      (unless (memq cur '(nil *skip*))
+      (unless (memq cur '(nil *skip* *error*))
 	(push cur result)))
     result))
 
@@ -3470,7 +3532,7 @@
 
 ;;All standard formulas are safe
 (dolist (x '(ses-cell-value ses-range ses-delete-blanks ses+ ses-average
-	     ses-select))
+	     ses-select ses-absolute))
   (put x 'side-effect-free t))