diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-06-15 00:10:40 -0400 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-06-15 00:10:40 -0400 |
| commit | df5703a00d610a89fa6bc1da906228907b36b5d8 (patch) | |
| tree | 037d32ed58ad5c713baa21d64632c94c5d4a7839 | |
| parent | e52868b16f33eb31cbe912f1ebc98136c5743238 (diff) | |
| download | emacs-df5703a00d610a89fa6bc1da906228907b36b5d8.tar.gz emacs-df5703a00d610a89fa6bc1da906228907b36b5d8.tar.bz2 emacs-df5703a00d610a89fa6bc1da906228907b36b5d8.zip | |
* lisp/ses.el: Miscellaneous cleanups; use lexical-binding; avoid add-to-list.
(ses-localvars): Remove ses--local-printer-list, unused.
(ses--metaprogramming): New macro. Use it to defvar variables.
(ses-set-localvars): Simplify.
(ses--locprn, ses-cell): Use defstruct. Change ses-cell's
property-list into an alist.
(ses-locprn-get-compiled, ses-locprn-compiled-aset)
(ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number):
Remove; use defstruct accessors/setters instead.
(ses-cell-formula-aset, ses-cell-printer-aset)
(ses-cell-references-aset): Remove, use setf instead.
(ses--alist-get): New function.
(ses-cell-property): Rename from ses-cell-property-get and rewrite.
Use an alist instead of a plist and don't do move-to-front since the
list is always short.
(ses-cell-property-get-fun, ses-cell-property-delq-fun)
(ses-cell-property-set-fun, ses-cell-property-set)
(ses-cell-property-pop-fun, ses-cell-property-get-handle)
(ses-cell-property-handle-car, ses-cell-property-handle-setcar): Remove.
(ses--letref): New macro.
(ses-cell-property-pop): Rewrite.
(ses--cell): Rename from ses-cell and make it into a function.
Make `formula' fallback on `value' if nil.
(ses--local-printer): Rename from ses-local-printer and make it into
a function.
(ses-set-cell): Turn it into a macro so finding the accessor from the
field name is done at compile time.
(ses-repair-cell-reference-all): Test presence of `sym' rather than
`ref' before adding `sym' to :ses-repair-reference.
(ses-calculate-cell): Use ses--letref rather than
ses-cell-property-get-handle.
(ses-write-cells): Use a single prin1-to-string.
(ses-setter-with-undo): New function.
(ses-aset-with-undo, ses-set-with-undo): Rewrite using it.
(ses-unset-with-undo): Remove.
(ses-load): Prefer apply' over `eval'.
(ses-read-printer, ses-set-column-width): Use standard "(default
foo)" format.
| -rw-r--r-- | lisp/ChangeLog | 42 | ||||
| -rw-r--r-- | lisp/ses.el | 742 |
2 files changed, 375 insertions, 409 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8cb58bde25c..c243c6ea3ef 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,45 @@ +2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * ses.el: Miscellaneous cleanups; use lexical-binding; avoid + add-to-list. + (ses-localvars): Remove ses--local-printer-list, unused. + (ses--metaprogramming): New macro. Use it to defvar variables. + (ses-set-localvars): Simplify. + (ses--locprn, ses-cell): Use defstruct. Change ses-cell's + property-list into an alist. + (ses-locprn-get-compiled, ses-locprn-compiled-aset) + (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number): + Remove; use defstruct accessors/setters instead. + (ses-cell-formula-aset, ses-cell-printer-aset) + (ses-cell-references-aset): Remove, use setf instead. + (ses--alist-get): New function. + (ses-cell-property): Rename from ses-cell-property-get and rewrite. + Use an alist instead of a plist and don't do move-to-front since the + list is always short. + (ses-cell-property-get-fun, ses-cell-property-delq-fun) + (ses-cell-property-set-fun, ses-cell-property-set) + (ses-cell-property-pop-fun, ses-cell-property-get-handle) + (ses-cell-property-handle-car, ses-cell-property-handle-setcar): Remove. + (ses--letref): New macro. + (ses-cell-property-pop): Rewrite. + (ses--cell): Rename from ses-cell and make it into a function. + Make `formula' fallback on `value' if nil. + (ses--local-printer): Rename from ses-local-printer and make it into + a function. + (ses-set-cell): Turn it into a macro so finding the accessor from the + field name is done at compile time. + (ses-repair-cell-reference-all): Test presence of `sym' rather than + `ref' before adding `sym' to :ses-repair-reference. + (ses-calculate-cell): Use ses--letref rather than + ses-cell-property-get-handle. + (ses-write-cells): Use a single prin1-to-string. + (ses-setter-with-undo): New function. + (ses-aset-with-undo, ses-set-with-undo): Rewrite using it. + (ses-unset-with-undo): Remove. + (ses-load): Prefer apply' over `eval'. + (ses-read-printer, ses-set-column-width): Use standard "(default + foo)" format. + 2014-06-15 Glenn Morris <rgm@gnu.org> * Makefile.in (leim, semantic): Use `make -C' rather than `cd && make'. diff --git a/lisp/ses.el b/lisp/ses.el index c7c39e0a5eb..a4f5609575d 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1,4 +1,4 @@ -;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*- +;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*- ;; Copyright (C) 2002-2014 Free Software Foundation, Inc. @@ -282,10 +282,6 @@ default printer and then modify its output.") ses--col-widths ses--curcell ses--curcell-overlay ses--default-printer (ses--local-printer-hashmap . :hashmap) - ;; the list is there to remember the order of local printers like there - ;; are written to the SES filen which service the hashmap does not - ;; provide. - ses--local-printer-list (ses--numlocprn . 0); count of local printers ses--deferred-narrow ses--deferred-recalc ses--deferred-write ses--file-format @@ -300,8 +296,12 @@ default printer and then modify its output.") ses--renamed-cell-symb-list ;; Global variables that we override mode-line-process next-line-add-newlines transient-mark-mode) - "Buffer-local variables used by SES.") + "Buffer-local variables used by SES.")) +(defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t)) +(ses--metaprogramming + `(progn ,@(mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars))) + (defun ses-set-localvars () "Set buffer-local and initialize some SES variables." (dolist (x ses-localvars) @@ -313,20 +313,10 @@ default printer and then modify its output.") ((integerp (cdr x)) (set (make-local-variable (car x)) (cdr x))) ((eq (cdr x) :hashmap) - (set (make-local-variable (car x)) - (if (boundp (car x)) - (let ((xv (symbol-value (car x)))) - (if (hash-table-p xv) - (clrhash xv) - (warn "Unexpected value of symbol %S, should be a hash table" x) - (make-hash-table :test 'eq))) - (make-hash-table :test 'eq)))) + (set (make-local-variable (car x)) (make-hash-table :test 'eq))) (t (error "Unexpected initializer `%S' in list `ses-localvars' for entry %S" (cdr x) (car x)) ) )) - (t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))) - -(eval-when-compile ; silence compiler - (ses-set-localvars)) + (t (error "Unexpected elements `%S' in list `ses-localvars'" x))))) ;;; This variable is documented as being permitted in file-locals: (put 'ses--symbolic-formulas 'safe-local-variable 'consp) @@ -381,186 +371,115 @@ when to emit a progress message.") (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)) - -(defsubst ses-make-local-printer-info (def &optional compiled-def number) - (let ((v (vector def - (or compiled-def (ses-local-printer-compile def)) - (or number ses--numlocprn) - nil))) - (push v ses--local-printer-list) - (aset v 3 ses--local-printer-list) - v)) - -(defmacro ses-locprn-get-compiled (locprn) - `(aref ,locprn 1)) - -(defmacro ses-locprn-compiled-aset (locprn compiled) - `(aset ,locprn 1 ,compiled)) - -(defmacro ses-locprn-get-def (locprn) - `(aref ,locprn 0)) - -(defmacro ses-locprn-def-aset (locprn def) - `(aset ,locprn 0 ,def)) - -(defmacro ses-locprn-get-number (locprn) - `(aref ,locprn 2)) +(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 properties) + +(cl-defstruct (ses--locprn + (:constructor) + (:constructor ses-make-local-printer-info + (def &optional (compiled (ses-local-printer-compile def)) + (number ses--numlocprn)))) + def + compiled + number + local-printer-list) (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)) - -(defmacro ses-cell-formula-aset (cell formula) - "From a CELL set the function that computes its value." - `(aset ,cell 1 ,formula)) + (declare (debug t)) + `(ses-cell--formula ,(if col `(ses-get-cell ,row ,col) row))) (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)) - -(defmacro ses-cell-printer-aset (cell printer) - "From a CELL set the printer that prints its value." - `(aset ,cell 2 ,printer)) + (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)) - -(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)) + (declare (debug t)) + `(ses-cell--references ,(if col `(ses-get-cell ,row ,col) row))) (defun ses-cell-p (cell) - "Return non `nil' is CELL is a cell of current buffer." + "Return non-nil if 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 - ;; list needs to be scanned only when the property does not exist for that - ;; cell. - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - ;; Property was found. - (let ((val (cadr ret))) - (if (eq ret plist) - ;; Property found is already in the first position, so just return - ;; its value. - val - ;; Property is not in the first position, the following will move it - ;; there before returning its value. - (let ((next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (setcdr (last plist 1) nil))) - (aset cell 4 - `(,property-name ,val ,@plist)) - val))))) - -(defmacro ses-cell-property-get (property-name row &optional col) - "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL). + +(defun ses--alist-get (key alist &optional remove) + "Get the value associated to KEY in ALIST." + (declare + (gv-expander + (lambda (do) + (macroexp-let2 macroexp-copyable-p k key + (gv-letplace (getter setter) alist + (macroexp-let2 nil p `(assq ,k ,getter) + (funcall do `(cdr ,p) + (lambda (v) + (let ((set-exp + `(if ,p (setcdr ,p ,v) + ,(funcall setter + `(cons (setq ,p (cons ,k ,v)) + ,getter))))) + (cond + ((null remove) set-exp) + ((null v) + `(if ,p ,(funcall setter `(delq ,p ,getter)))) + (t + `(cond + (,v ,set-exp) + (,p ,(funcall setter + `(delq ,p ,getter))))))))))))))) + (ignore remove) ;;Silence byte-compiler. + (cdr (assoc key alist))) + +(defmacro ses--letref (vars place &rest body) + (declare (indent 2) (debug (sexp form &rest body))) + (gv-letplace (getter setter) place + `(cl-macrolet ((,(nth 0 vars) () ',getter) + (,(nth 1 vars) (v) (funcall ,setter v))) + ,@body))) + +(defmacro ses-cell-property (property-name row &optional col) + "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL). When COL is omitted, CELL=ROW is a cell object. When COL is present ROW and COL are the integer coordinates of the cell of interest." - (declare (debug t)) - `(ses-cell-property-get-fun - ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - -(defun ses-cell-property-delq-fun (property-name cell) - (let ((ret (plist-get (aref cell 4) property-name))) - (if ret - (setcdr ret (cddr ret))))) - -(defun ses-cell-property-set-fun (property-name property-val cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (setcar (cdr ret) property-val) - (aset cell 4 `(,property-name ,property-val ,@plist))))) - -(defmacro ses-cell-property-set (property-name property-value row &optional col) - "From a CELL or a pair (ROW,COL), set the property value of -the corresponding cell with name PROPERTY-NAME to PROPERTY-VALUE." - (if property-value - `(ses-cell-property-set-fun ,property-name ,property-value - ,(if col `(ses-get-cell ,row ,col) row)) - `(ses-cell-property-delq-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row)))) - -(defun ses-cell-property-pop-fun (property-name cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (prog1 (cadr ret) - (let ((next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (if (eq plist ret) - (aset cell 4 nil) - (setcdr (last plist 2) nil)))))))) - + (declare (debug t)) + `(ses--alist-get ,property-name + (ses-cell--properties + ,(if col `(ses-get-cell ,row ,col) row)))) (defmacro ses-cell-property-pop (property-name row &optional col) - "From a CELL or a pair (ROW,COL), get and remove the property value of + "From a CELL or a pair (ROW,COL), get and remove the property value of the corresponding cell with name PROPERTY-NAME." - `(ses-cell-property-pop-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - -(defun ses-cell-property-get-handle-fun (property-name cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (if (eq ret plist) - (cdr ret) - (let ((val (cadr ret)) - (next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (setcdr (last plist 2) nil)) - (setq ret (cons val plist)) - (aset cell 4 (cons property-name ret)) - ret)) - (setq ret (cons nil plist)) - (aset cell 4 (cons property-name ret)) - ret))) - -(defmacro ses-cell-property-get-handle (property-name row &optional col) - "From a CELL or a pair (ROW,COL), get a cons cell whose car is -the property value of the corresponding cell property with name -PROPERTY-NAME." - `(ses-cell-property-get-handle-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - - -(defalias 'ses-cell-property-handle-car 'car) -(defalias 'ses-cell-property-handle-setcar 'setcar) + `(ses--letref (pget pset) + (ses--alist-get ,property-name + (ses-cell--properties + ,(if col `(ses-get-cell ,row ,col) row)) + t) + (prog1 (pget) (pset nil)))) (defmacro ses-cell-value (row &optional col) "From a CELL or a pair (ROW,COL), get the current value for that cell." @@ -592,14 +511,14 @@ is nil if SYM is not a symbol that names a cell." (< (cdr rowcol) ses--numcols) (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym)))))) -(defmacro ses-cell (sym value formula printer references) +(defun ses--cell (sym value formula printer references) "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." +FORMULA, does not reprint using PRINTER, does not check REFERENCES. +Safety-checking for FORMULA and PRINTER are deferred until first use." (let ((rowcol (ses-sym-rowcol sym))) (ses-formula-record formula) (ses-printer-record printer) + (unless formula (setq formula value)) (or (atom formula) (eq safe-functions t) (setq formula `(ses-safe-formula ,formula))) @@ -607,11 +526,9 @@ PRINTER are deferred until first use." (stringp printer) (eq safe-functions t) (setq printer `(ses-safe-printer ,printer))) - (aset (aref ses--cells (car rowcol)) - (cdr rowcol) + (setf (ses-get-cell (car rowcol) (cdr rowcol)) (ses-make-cell sym formula printer references))) - (set sym value) - sym) + (set sym value)) (defun ses-local-printer-compile (printer) "Convert local printer function into faster printer @@ -622,18 +539,18 @@ definition." `(lambda (x) (format ,printer x))) (t (error "Invalid printer %S" printer)))) -(defmacro ses-local-printer (printer-name printer-def) - "Define a local printer with name PRINTER-NAME and definition -PRINTER-DEF. Return the printer info." +(defun ses--local-printer (name def) + "Define a local printer with name NAME and definition DEF. +Return the printer info." (or - (and (symbolp printer-name) - (ses-printer-validate printer-def)) + (and (symbolp name) + (ses-printer-validate def)) (error "Invalid local printer definition")) - (and (gethash printer-name ses--local-printer-hashmap) - (error "Duplicate printer definition %S" printer-name)) - (add-to-list 'ses-read-printer-history (symbol-name printer-name)) - (puthash printer-name - (ses-make-local-printer-info (ses-safe-printer printer-def)) + (and (gethash name ses--local-printer-hashmap) + (error "Duplicate printer definition %S" name)) + (add-to-list 'ses-read-printer-history (symbol-name name)) + (puthash name + (ses-make-local-printer-info (ses-safe-printer def)) ses--local-printer-hashmap)) (defmacro ses-column-widths (widths) @@ -704,9 +621,11 @@ variables `minrow', `maxrow', `mincol', and `maxcol'." (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) @@ -753,7 +672,7 @@ is a vector--if a symbol, the new vector is assigned as the symbol's value." (and (symbolp printer) (gethash printer ses--local-printer-hashmap)) (functionp printer) (and (stringp (car-safe printer)) (not (cdr printer))) - (error "Invalid printer function")) + (error "Invalid printer function %S" printer)) printer) (defun ses-printer-record (printer) @@ -785,20 +704,22 @@ for this spreadsheet." (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." + "Decode a symbol \"A1\" => (0,0). Return nil if STR is not a +canonical cell name." (let (case-fold-search) (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str) (let* ((col-str (match-string-no-properties 1 str)) - (col 0) - (col-base 1) - (col-idx (1- (length col-str))) - (row (1- (string-to-number (match-string-no-properties 2 str))))) + (col 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)) + (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) @@ -872,21 +793,34 @@ and (eval ARG) and reset `ses-start-time' to the current time." ;; The cells ;;---------------------------------------------------------------------------- -(defun ses-set-cell (row col field val) +(defmacro 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) - (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))) - (if change - (add-to-list 'ses--deferred-write (cons row col)))) - nil) ; Make coverage-tester happy. + `(let ((row ,row) + (col ,col) + (val ,val)) + (let* ((cell (ses-get-cell row col)) + (change + ,(let ((field (eval field t))) + (if (eq field 'value) + `(ses-set-with-undo (ses-cell-symbol cell) val) + ;; (let* ((slots (get 'ses-cell 'cl-struct-slots)) + ;; (slot (or (assq field slots) + ;; (error "Unknown field %S" field))) + ;; (idx (- (length slots) + ;; (length (memq slot slots))))) + ;; `(ses-aset-with-undo cell ,idx val)) + (let ((getter (intern-soft (format "ses-cell--%s" field)))) + `(ses-setter-with-undo + (eval-when-compile + (cons #',getter + (lambda (newval cell) + (setf (,getter cell) newval)))) + val cell)))))) + (if change + (add-to-list 'ses--deferred-write (cons row col)))) + nil)) ; Make coverage-tester happy. (defun ses-cell-set-formula (row col formula) "Store a new formula for (ROW . COL) and enqueue the cell for @@ -901,7 +835,7 @@ means Emacs will crash if FORMULA contains a circular list." (newref (ses-formula-references formula)) (inhibit-quit t) x xrow xcol) - (add-to-list 'ses--deferred-recalc sym) + (cl-pushnew sym ses--deferred-recalc) ;;Delete old references from this cell. Skip the ones that are also ;;in the new list. (dolist (ref oldref) @@ -932,11 +866,11 @@ means Emacs will crash if FORMULA contains a circular list." (dotimes (col ses--numcols) (let ((references (ses-cell-property-pop :ses-repair-reference row col))) - (when references - (push (list - (ses-cell-symbol row col) - :corrupt-property - references) errors))))) + (when references + (push (list (ses-cell-symbol row col) + :corrupt-property + references) + errors))))) ;; Step 2, build new. (dotimes (row ses--numrows) @@ -946,21 +880,17 @@ means Emacs will crash if FORMULA contains a circular list." (formula (ses-cell-formula cell)) (new-ref (ses-formula-references formula))) (dolist (ref new-ref) - (let* ((rowcol (ses-sym-rowcol ref)) - (h (ses-cell-property-get-handle :ses-repair-reference - (car rowcol) (cdr rowcol)))) - (unless (memq ref (ses-cell-property-handle-car h)) - (ses-cell-property-handle-setcar - h - (cons sym - (ses-cell-property-handle-car h))))))))) + (let ((rowcol (ses-sym-rowcol ref))) + (cl-pushnew sym (ses-cell-property :ses-repair-reference + (car rowcol) + (cdr rowcol)))))))) ;; Step 3, overwrite with check. (dotimes (row ses--numrows) (dotimes (col ses--numcols) (let* ((cell (ses-get-cell row col)) (irrelevant (ses-cell-references cell)) - (new-ref (ses-cell-property-pop :ses-repair-reference cell)) + (new-ref (ses-cell-property-pop :ses-repair-reference cell)) missing) (dolist (ref new-ref) (if (memq ref irrelevant) @@ -973,7 +903,7 @@ means Emacs will crash if FORMULA contains a circular list." ,@(and irrelevant (list :irrelevant irrelevant))) errors))))) (if errors - (warn "---------------------------------------------------------------- + (warn "---------------------------------------------------------------- Some references were corrupted. The following is a list where each element ELT is such @@ -1004,12 +934,7 @@ the old and FORCE is nil." (let ((oldval (ses-cell-value cell)) (formula (ses-cell-formula cell)) newval - this-cell-Dijkstra-attempt-h - this-cell-Dijkstra-attempt - this-cell-Dijkstra-attempt+1 - ref-cell-Dijkstra-attempt-h - ref-cell-Dijkstra-attempt - ref-rowcol) + this-cell-Dijkstra-attempt+1) (when (eq (car-safe formula) 'ses-safe-formula) (setq formula (ses-safe-formula (cadr formula))) (ses-set-cell row col 'formula formula)) @@ -1025,46 +950,42 @@ the old and FORCE is nil." (setq newval '*skip*)) (catch 'cycle (when (or force (not (eq newval oldval))) - (add-to-list 'ses--deferred-write (cons row col)) ; In case force=t. - (setq this-cell-Dijkstra-attempt-h - (ses-cell-property-get-handle :ses-Dijkstra-attempt cell); - this-cell-Dijkstra-attempt - (ses-cell-property-handle-car this-cell-Dijkstra-attempt-h)) - (if (null this-cell-Dijkstra-attempt) - (ses-cell-property-handle-setcar - this-cell-Dijkstra-attempt-h - (setq this-cell-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0))) - (unless (= ses--Dijkstra-attempt-nb - (car this-cell-Dijkstra-attempt)) - (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) - (setcdr this-cell-Dijkstra-attempt 0))) - (setq this-cell-Dijkstra-attempt+1 - (1+ (cdr this-cell-Dijkstra-attempt))) + (cl-pushnew (cons row col) ses--deferred-write :test #'equal) ; In case force=t. + (ses--letref (pget pset) + (ses-cell-property :ses-Dijkstra-attempt cell) + (let ((this-cell-Dijkstra-attempt (pget))) + (if (null this-cell-Dijkstra-attempt) + (pset + (setq this-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb 0))) + (unless (= ses--Dijkstra-attempt-nb + (car this-cell-Dijkstra-attempt)) + (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr this-cell-Dijkstra-attempt 0))) + (setq this-cell-Dijkstra-attempt+1 + (1+ (cdr this-cell-Dijkstra-attempt))))) (ses-set-cell row col 'value newval) (dolist (ref (ses-cell-references cell)) - (add-to-list 'ses--deferred-recalc ref) - (setq ref-rowcol (ses-sym-rowcol ref) - ref-cell-Dijkstra-attempt-h - (ses-cell-property-get-handle - :ses-Dijkstra-attempt - (car ref-rowcol) (cdr ref-rowcol)) - ref-cell-Dijkstra-attempt - (ses-cell-property-handle-car ref-cell-Dijkstra-attempt-h)) - - (if (null ref-cell-Dijkstra-attempt) - (ses-cell-property-handle-setcar - ref-cell-Dijkstra-attempt-h - (setq ref-cell-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb - this-cell-Dijkstra-attempt+1))) - (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb) - (setcdr ref-cell-Dijkstra-attempt - (max (cdr ref-cell-Dijkstra-attempt) - this-cell-Dijkstra-attempt+1)) - (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) - (setcdr ref-cell-Dijkstra-attempt - this-cell-Dijkstra-attempt+1))) + (cl-pushnew ref ses--deferred-recalc) + (ses--letref (pget pset) + (let ((ref-rowcol (ses-sym-rowcol ref))) + (ses-cell-property + :ses-Dijkstra-attempt + (car ref-rowcol) (cdr ref-rowcol))) + (let ((ref-cell-Dijkstra-attempt (pget))) + + (if (null ref-cell-Dijkstra-attempt) + (pset + (setq ref-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb + this-cell-Dijkstra-attempt+1))) + (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + (max (cdr ref-cell-Dijkstra-attempt) + this-cell-Dijkstra-attempt+1)) + (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + this-cell-Dijkstra-attempt+1))))) (when (> this-cell-Dijkstra-attempt+1 ses--Dijkstra-weight-bound) ;; Update print of this cell. @@ -1123,7 +1044,7 @@ if the cell's value is unchanged and FORCE is nil." (when (or (memq ref curlist) (memq ref ses--deferred-recalc)) ;; This cell refers to another that isn't done yet - (add-to-list 'ses--deferred-recalc this-sym) + (cl-pushnew this-sym ses--deferred-recalc :test #'equal) (throw 'ref t))))) ;; ses-update-cells is called from post-command-hook, so ;; inhibit-quit is implicitly bound to t. @@ -1132,7 +1053,7 @@ if the cell's value is unchanged and FORCE is nil." (error "Quit")) (ses-calculate-cell (car this-rowcol) (cdr this-rowcol) force))) (dolist (ref ses--deferred-recalc) - (add-to-list 'nextlist ref))) + (cl-pushnew ref nextlist :test #'equal))) (when ses--deferred-recalc ;; Just couldn't finish these. (dolist (x ses--deferred-recalc) @@ -1251,7 +1172,8 @@ preceding cell has spilled over." ((< 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) @@ -1352,7 +1274,7 @@ printer signaled one (and \"%s\" is used as the default printer), else nil." (or (and (symbolp printer) (let ((locprn (gethash printer ses--local-printer-hashmap))) (and locprn - (ses-locprn-get-compiled locprn)))) + (ses--locprn-compiled locprn)))) printer) (or value ""))) (if (stringp value) @@ -1440,7 +1362,8 @@ undoable. Return nil when there was no change, and non nil otherwise." (ses-widen) (goto-char ses--params-marker) (forward-line (plist-get ses-paramlines-plist 'ses--numlocprn )) - (insert (format (plist-get ses-paramfmt-plist 'ses--numlocprn) ses--numlocprn) + (insert (format (plist-get ses-paramfmt-plist 'ses--numlocprn) + ses--numlocprn) ?\n) t) ))) @@ -1492,24 +1415,17 @@ Newlines in the data are escaped." (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) - " ") - ")")) - ")")) + (setq text (prin1-to-string + ;; We could shorten it to (ses-cell SYM VAL) when + ;; the other parameters are nil, but in practice most + ;; cells have non-nil `references', so it's + ;; rather pointless. + `(ses-cell ,sym + ,(symbol-value sym) + ,(unless (equal formula (symbol-value sym)) + formula) + ,printer + ,(ses-cell-references cell)))) (ses-goto-data row col) (delete-region (point) (line-end-position)) (insert text))) @@ -1526,8 +1442,8 @@ refers to. For recursive calls, RESULT-SO-FAR is the list being constructed, or t to get a wrong-type-argument error when the first reference is found." (if (ses-sym-rowcol formula) - ;;Entire formula is one symbol - (add-to-list 'result-so-far formula) + ;; Entire formula is one symbol. + (cl-pushnew formula result-so-far :test #'equal) (if (consp formula) (cond ((eq (car formula) 'ses-range) @@ -1535,7 +1451,7 @@ first reference is found." (cdr (funcall 'macroexpand (list 'ses-range (nth 1 formula) (nth 2 formula))))) - (add-to-list 'result-so-far cur))) + (cl-pushnew cur result-so-far :test #'equal))) ((null (eq (car formula) 'quote)) ;;Recursive call for subformulas (dolist (cur formula) @@ -1704,8 +1620,8 @@ to each symbol." ;; This cell referred to a cell that's been deleted or is no ;; longer part of the range. We can't fix that now because ;; reference lists cells have been partially updated. - (add-to-list 'ses--deferred-recalc - (ses-create-cell-symbol row col))) + (cl-pushnew (ses-create-cell-symbol row col) + ses--deferred-recalc :test #'equal)) (setq newval (ses-relocate-formula (ses-cell-references mycell) minrow mincol rowincr colincr)) (ses-set-cell row col 'references newval) @@ -1795,36 +1711,30 @@ to each symbol." (insert-and-inherit "X") (delete-region (1- (point)) (point)))) -(defun ses-set-with-undo (sym newval) - "Like set, but undoable. Result is t if value has changed." - ;; We try to avoid adding redundant entries to the undo list, but this is - ;; unavoidable for strings because equal ignores text properties and there's - ;; no easy way to get the whole property list to see if it's different! - (unless (and (boundp sym) - (equal (symbol-value sym) newval) - (not (stringp newval))) - (push (if (boundp sym) - `(apply ses-set-with-undo ,sym ,(symbol-value sym)) - `(apply ses-unset-with-undo ,sym)) - buffer-undo-list) - (set sym newval) - t)) - -(defun ses-unset-with-undo (sym) - "Set SYM to be unbound. This is undoable." - (when (1value (boundp sym)) ; Always bound, except after a programming error. - (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list) - (makunbound sym))) +(defun ses-setter-with-undo (accessors newval &rest args) + "Set a field/variable and record it so it can be undone. +Result is non-nil if field/variable has changed." + (let ((oldval (apply (car accessors) args))) + (unless (equal-including-properties oldval newval) + (push `(apply ses-setter-with-undo ,accessors ,oldval ,@args) + buffer-undo-list) + (apply (cdr accessors) newval args) + t))) (defun ses-aset-with-undo (array idx newval) - "Like `aset', but undoable. -Result is t if element has changed." - (unless (equal (aref array idx) newval) - (push `(apply ses-aset-with-undo ,array ,idx - ,(aref array idx)) buffer-undo-list) - (aset array idx newval) - t)) + (ses-setter-with-undo (eval-when-compile + (cons #'aref + (lambda (newval array idx) (aset array idx newval)))) + newval array idx)) +(defun ses-set-with-undo (sym newval) + (ses-setter-with-undo + (eval-when-compile + (cons (lambda (sym) (if (boundp sym) (symbol-value sym) :ses--unbound)) + (lambda (newval sym) (if (eq newval :ses--unbound) + (makunbound sym) + (set sym newval))))) + newval sym)) ;;---------------------------------------------------------------------------- ;; Startup for major mode @@ -1890,11 +1800,11 @@ Does not execute cell formulas or print functions." (forward-line (* ses--numrows (1+ ses--numcols))) (let ((numlocprn ses--numlocprn)) (setq ses--numlocprn 0) - (dotimes (lp numlocprn) + (dotimes (_ numlocprn) (let ((x (read (current-buffer)))) (or (and (looking-at-p "\n") (eq (car-safe x) 'ses-local-printer) - (eval x)) + (apply #'ses--local-printer (cdr x))) (error "local printer-def error")) (setq ses--numlocprn (1+ ses--numlocprn)))))) ;; Load cell definitions. @@ -1906,7 +1816,7 @@ Does not execute cell formulas or print functions." (eq (car-safe x) 'ses-cell) (ses-create-cell-variable sym row col)) (error "Cell-def error")) - (eval x))) + (apply #'ses--cell (cdr x)))) (or (looking-at-p "\n\n") (error "Missing blank line between rows"))) ;; Skip local printer function declaration --- that were already loaded. @@ -2067,7 +1977,8 @@ formula: ;; 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) @@ -2251,7 +2162,7 @@ print area if NONARROW is nil." (delete-region (point-min) (point)) ;; Insert all blank lines before printing anything, so ses-print-cell can ;; find the data area when inserting or deleting *skip* values for cells. - (dotimes (row ses--numrows) + (dotimes (_ ses--numrows) (insert-and-inherit ses--blank-line)) (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..." (if (eq (ses-cell-value row 0) '*skip*) @@ -2283,9 +2194,10 @@ to are recalculated first." (when (setq cur-rowcol (ses-sym-rowcol ses--curcell) sig (progn - (ses-cell-property-set :ses-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0) - (car cur-rowcol) (cdr cur-rowcol) ) + (setf (ses-cell-property :ses-Dijkstra-attempt + (car cur-rowcol) + (cdr cur-rowcol)) + (cons ses--Dijkstra-attempt-nb 0)) (ses-calculate-cell (car cur-rowcol) (cdr cur-rowcol) t))) (nconc sig (list (ses-cell-symbol (car cur-rowcol) (cdr cur-rowcol))))) @@ -2298,14 +2210,14 @@ to are recalculated first." ;; The t causes an error if the cell has references. If no ;; references, the t will be the result value. (1value (ses-formula-references (ses-cell-formula row col) t)) - (ses-cell-property-set :ses-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0) - row col) + (setf (ses-cell-property :ses-Dijkstra-attempt row col) + (cons ses--Dijkstra-attempt-nb 0)) (when (setq sig (ses-calculate-cell row col t)) (nconc sig (list (ses-cell-symbol row col))))) (wrong-type-argument ;; The formula contains a reference. - (add-to-list 'ses--deferred-recalc (ses-cell-symbol row col)))))) + (cl-pushnew (ses-cell-symbol row col) ses--deferred-recalc + :test #'equal))))) ;; Do the update now, so we can force recalculation. (let ((x ses--deferred-recalc)) (setq ses--deferred-recalc nil) @@ -2380,7 +2292,7 @@ to are recalculated first." (insert ses-initial-file-trailer) (goto-char (point-min))) ;; Create a blank display area. - (dotimes (row ses--numrows) + (dotimes (_ ses--numrows) (insert ses--blank-line)) (insert ses-print-data-boundary) (backward-char (1- (length ses-print-data-boundary))) @@ -2450,16 +2362,23 @@ cell formula was unsafe and user declined confirmation." (barf-if-buffer-read-only) (list (car rowcol) (cdr rowcol) - (read-from-minibuffer - (format "Cell %s: " ses--curcell) - (cons (if (equal initial "\"") "\"\"" - (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)))))) + (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 "(") "()" 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))))))) (when (ses-edit-cell row col newval) (ses-command-hook) ; Update cell widths before movement. (dolist (x ses-after-entry-functions) @@ -2492,7 +2411,7 @@ With prefix, deletes several cells." (1value (ses-clear-cell-backward (- count))) (ses-check-curcell) (ses-begin-change) - (dotimes (x count) + (dotimes (_ count) (ses-set-curcell) (let ((rowcol (ses-sym-rowcol ses--curcell))) (or rowcol (signal 'end-of-buffer nil)) @@ -2507,7 +2426,7 @@ cells." (1value (ses-clear-cell-forward (- count))) (ses-check-curcell 'end) (ses-begin-change) - (dotimes (x count) + (dotimes (_ count) (backward-char 1) ; Will signal 'beginning-of-buffer if appropriate. (ses-set-curcell) (let ((rowcol (ses-sym-rowcol ses--curcell))) @@ -2526,7 +2445,7 @@ canceled." (barf-if-buffer-read-only) (if (eq default t) (setq default "") - (setq prompt (format "%s [currently %S]: " + (setq prompt (format "%s (default %S): " (substring prompt 0 -2) default))) (let ((new (read-from-minibuffer prompt @@ -2557,21 +2476,20 @@ one argument, or a symbol that names a function of one argument. In the latter two cases, the function's result should be either a string (will be right-justified) or a list of one string (will be left-justified)." (interactive - (let ((default t) - x) + (let ((default t)) (ses-check-curcell 'range) ;;Default is none if not all cells in range have same printer (catch 'ses-read-cell-printer (ses-dorange ses--curcell - (setq x (ses-cell-printer row col)) - (if (eq (car-safe x) 'ses-safe-printer) - (setq x (cadr x))) - (if (eq default t) - (setq default x) - (unless (equal default x) - ;;Range contains differing printer functions - (setq default t) - (throw 'ses-read-cell-printer t))))) + (let ((x (ses-cell-printer row col))) + (if (eq (car-safe x) 'ses-safe-printer) + (setq x (cadr x))) + (if (eq default t) + (setq default x) + (unless (equal default x) + ;;Range contains differing printer functions + (setq default t) + (throw 'ses-read-cell-printer t)))))) (list (ses-read-printer (format "Cell %S printer: " ses--curcell) default)))) (unless (eq newval t) @@ -2850,7 +2768,7 @@ inserts a new row if at bottom of print area. Repeat COUNT times." (list col (if current-prefix-arg (prefix-numeric-value current-prefix-arg) - (read-from-minibuffer (format "Column %s width [currently %d]: " + (read-from-minibuffer (format "Column %s width (default %d): " (ses-column-letter col) (ses-col-width col)) nil ; No initial contents. @@ -3089,9 +3007,9 @@ cons of ROW and COL). Treat plain symbols as strings unless ARG is a list." ;; 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,29 +3355,31 @@ highlighted range in the spreadsheet." (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))) + (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 + ;; 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-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 + (setf (ses-cell-formula 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)) (xcell (ses-get-cell (car x) (cdr x)))) - (ses-cell-references-aset xcell - (cons new-name (delq sym - (ses-cell-references xcell)))))) + (setf (ses-cell-references xcell) + (cons new-name (delq sym + (ses-cell-references xcell)))))) (push new-name ses--renamed-cell-symb-list) (set new-name (symbol-value sym)) - (aset cell 0 new-name) + (setf (ses-cell--symbol cell) new-name) (makunbound sym) (and curcell (setq ses--curcell new-name)) (let* ((pos (point)) @@ -3477,8 +3397,9 @@ highlighted range in the spreadsheet." (force-mode-line-update))) (defun ses-refresh-local-printer (name compiled-value) - "Refresh printout of spreadsheet for all cells with printer - defined to local printer named NAME using the value COMPILED-VALUE for this printer" + "Refresh printout for all cells which use printer NAME. +NAME should be the name of a locally defined printer. +Uses the value COMPILED-VALUE for this printer." (message "Refreshing cells using printer %S" name) (let (new-print) (dotimes (row ses--numrows) @@ -3490,55 +3411,58 @@ highlighted range in the spreadsheet." (ses-begin-change)) (ses-print-cell row col))))))) -(defun ses-define-local-printer (printer-name) - "Define a local printer with name PRINTER-NAME." +(defun ses-define-local-printer (name) + "Define a local printer with name NAME." (interactive "*SEnter printer name: ") - (let* ((cur-printer (gethash printer-name ses--local-printer-hashmap)) - (default (and (vectorp cur-printer) (ses-locprn-get-def cur-printer))) - printer-def-text + (let* ((cur-printer (gethash name ses--local-printer-hashmap)) + (default (and (vectorp cur-printer) (ses--locprn-def cur-printer))) create-printer - (new-printer (ses-read-printer (format "Enter definition of printer %S: " printer-name) default))) + (new-def + (ses-read-printer (format "Enter definition of printer %S: " name) + default))) (cond ;; cancelled operation => do nothing - ((eq new-printer t)) + ((eq new-def t)) ;; no change => do nothing - ((and (vectorp cur-printer) (equal new-printer default))) + ((and (vectorp cur-printer) (equal new-def default))) ;; re-defined printer ((vectorp cur-printer) (setq create-printer 0) - (ses-locprn-def-aset cur-printer new-printer) + (setf (ses--locprn-def cur-printer) new-def) (ses-refresh-local-printer - printer-name - (ses-locprn-compiled-aset cur-printer (ses-local-printer-compile new-printer)))) + name + (setf (ses--locprn-compiled cur-printer) + (ses-local-printer-compile new-def)))) ;; new definition (t (setq create-printer 1) - (puthash printer-name + (puthash name (setq cur-printer - (ses-make-local-printer-info new-printer)) + (ses-make-local-printer-info new-def)) ses--local-printer-hashmap))) (when create-printer - (setq printer-def-text - (concat - "(ses-local-printer " - (symbol-name printer-name) - " " - (prin1-to-string (ses-locprn-get-def cur-printer)) - ")")) - (save-excursion - (ses-goto-data ses--numrows - (ses-locprn-get-number cur-printer)) - (let ((inhibit-read-only t)) - ;; Special undo since it's outside the narrowed buffer. - (let (buffer-undo-list) - (if (= create-printer 0) - (delete-region (point) (line-end-position)) - (insert ?\n) - (backward-char)) - (insert printer-def-text) - (when (= create-printer 1) - (ses-file-format-extend-paramter-list 3) - (ses-set-parameter 'ses--numlocprn (+ ses--numlocprn create-printer))) ))))) ) + (let ((printer-def-text + (concat + "(ses-local-printer " + (symbol-name name) + " " + (prin1-to-string (ses--locprn-def cur-printer)) + ")"))) + (save-excursion + (ses-goto-data ses--numrows + (ses--locprn-number cur-printer)) + (let ((inhibit-read-only t)) + ;; Special undo since it's outside the narrowed buffer. + (let (buffer-undo-list) + (if (= create-printer 0) + (delete-region (point) (line-end-position)) + (insert ?\n) + (backward-char)) + (insert printer-def-text) + (when (= create-printer 1) + (ses-file-format-extend-paramter-list 3) + (ses-set-parameter 'ses--numlocprn + (+ ses--numlocprn create-printer)))))))))) ;;---------------------------------------------------------------------------- |