unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Request: ses.el Turn accessors into defsubst
@ 2012-07-31 15:42 T.V. Raman
  2012-08-01 20:30 ` Stefan Monnier
  0 siblings, 1 reply; 3+ messages in thread
From: T.V. Raman @ 2012-07-31 15:42 UTC (permalink / raw)
  To: emacs-devel, Jonathan Yavner

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

Would help Emacspeak out  in that the emacspeak ses extension
would compile cleanly and be less error prone.

For now, I've cloned the macros and redefined them as defsubst in
the emacspeak namespace, but I'd like to avoid having to do that long-term.
-- 

--



^ permalink raw reply	[flat|nested] 3+ messages in thread

* Re: Request: ses.el Turn accessors into defsubst
  2012-07-31 15:42 Request: ses.el Turn accessors into defsubst T.V. Raman
@ 2012-08-01 20:30 ` Stefan Monnier
  2012-08-02 15:32   ` T.V. Raman
  0 siblings, 1 reply; 3+ messages in thread
From: Stefan Monnier @ 2012-08-01 20:30 UTC (permalink / raw)
  To: T.V. Raman; +Cc: Jonathan Yavner, emacs-devel

> 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))
 
 




^ permalink raw reply	[flat|nested] 3+ messages in thread

* Request: ses.el Turn accessors into defsubst
  2012-08-01 20:30 ` Stefan Monnier
@ 2012-08-02 15:32   ` T.V. Raman
  0 siblings, 0 replies; 3+ messages in thread
From: T.V. Raman @ 2012-08-02 15:32 UTC (permalink / raw)
  To: Stefan Monnier, emacs-devel, Jonathan Yavner

An additional "nice to have"  would be to make sure that all
functionality available through the mouse is also available
through the keyboard.  When i first looked at ses.el a couple of
years ago, this was definitely not true; looking at the code and
info pages now, it looks like a lot of those previous issues are
gone. But it's hard for me to tell if I am missing functionality
as a non-mouse-waving human.
-- 

-- 


On 8/1/12, Stefan Monnier <monnier@iro.umontreal.ca> wrote:
>> 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))
>
>
>
>



^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2012-08-02 15:32 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-07-31 15:42 Request: ses.el Turn accessors into defsubst T.V. Raman
2012-08-01 20:30 ` Stefan Monnier
2012-08-02 15:32   ` T.V. Raman

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).