[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r117339: * lisp/ses.el: Miscellaneous cleanups; use
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] trunk r117339: * lisp/ses.el: Miscellaneous cleanups; use lexical-binding; avoid add-to-list. |
|
Date: |
Sun, 15 Jun 2014 04:10:48 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 117339
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sun 2014-06-15 00:10:40 -0400
message:
* 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.
modified:
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/ses.el ses.el-20091113204419-o5vbwnq5f7feedwu-2447
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2014-06-15 00:34:22 +0000
+++ b/lisp/ChangeLog 2014-06-15 04:10:40 +0000
@@ -1,3 +1,45 @@
+2014-06-15 Stefan Monnier <address@hidden>
+
+ * 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 <address@hidden>
* Makefile.in (leim, semantic): Use `make -C' rather than `cd && make'.
=== modified file 'lisp/ses.el'
--- a/lisp/ses.el 2014-06-12 06:04:48 +0000
+++ b/lisp/ses.el 2014-06-15 04:10:40 +0000
@@ -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 @@
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 @@
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 @@
((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 @@
(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 @@
(< (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 @@
(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 @@
`(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 @@
(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 @@
(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 @@
(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 @@
;; 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 @@
(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 @@
(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 @@
(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 @@
,@(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 @@
(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 @@
(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))
+ (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)
- (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)))
+ (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 @@
(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 @@
(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 @@
((< 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 @@
(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 @@
(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 @@
(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 @@
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 @@
(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 @@
;; 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 @@
(insert-and-inherit "X")
(delete-region (1- (point)) (point))))
+(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)
+ (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)
- "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-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 (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 @@
(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 @@
(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 @@
;; 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 @@
(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 @@
(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 @@
;; 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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
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 @@
(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 @@
;; 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 @@
(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 @@
(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 @@
(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))))))))))
;;----------------------------------------------------------------------------
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r117339: * lisp/ses.el: Miscellaneous cleanups; use lexical-binding; avoid add-to-list.,
Stefan Monnier <=