Request: ses.el Turn accessors into defsubst

[T.V. Raman]

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 <address@hidden> 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))
>
>
>
>