-;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*-
+;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net>
"Simple Emacs Spreadsheet."
:tag "SES"
:group 'applications
+ :link '(custom-manual "(ses) Top")
:prefix "ses-"
:version "21.1")
"\n( ;Global parameters (these are read first)\n 2 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n"
"Initial contents for the three-element list at the bottom of the data area.")
+(defconst ses-initial-global-parameters-re
+ "\n( ;Global parameters (these are read first)\n [23] ;SES file-format\n [0-9]+ ;numrows\n [0-9]+ ;numcols\n\\( [0-9]+ ;numlocprn\n\\)?)\n\n"
+ "Match Global parameters for .")
+
(defconst ses-initial-file-trailer
";; Local Variables:\n;; mode: ses\n;; End:\n"
"Initial contents for the file-trailer area at the bottom of the file.")
'(ses--blank-line ses--cells ses--col-printers
ses--col-widths ses--curcell ses--curcell-overlay
ses--default-printer
+ (ses--local-printer-hashmap . :hashmap)
+ (ses--numlocprn . 0); count of local printers
ses--deferred-narrow ses--deferred-recalc
ses--deferred-write ses--file-format
ses--named-cell-hashmap
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)
((symbolp x)
(set (make-local-variable x) nil))
((consp x)
- (set (make-local-variable (car x)) (cdr x)))
- (t (error "Unexpected elements `%S' in list `ses-localvars'" x))))))
-
-(eval-when-compile ; silence compiler
- (ses-set-localvars))
+ (cond
+ ((integerp (cdr x))
+ (set (make-local-variable (car x)) (cdr x)))
+ ((eq (cdr x) :hashmap)
+ (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)))))
;;; This variable is documented as being permitted in file-locals:
(put 'ses--symbolic-formulas 'safe-local-variable 'consp)
(defconst ses-paramlines-plist
'(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3
ses--header-row -2 ses--file-format 1 ses--numrows 2
- ses--numcols 3)
+ ses--numcols 3 ses--numlocprn 4)
"Offsets from 'Global parameters' line to various parameter lines in the
data area of a spreadsheet.")
+(defconst ses-paramfmt-plist
+ '(ses--col-widths "(ses-column-widths %S)"
+ ses--col-printers "(ses-column-printers %S)"
+ ses--default-printer "(ses-default-printer %S)"
+ ses--header-row "(ses-header-row %S)"
+ ses--file-format " %S ;SES file-format"
+ ses--numrows " %S ;numrows"
+ ses--numcols " %S ;numcols"
+ ses--numlocprn " %S ;numlocprn")
+ "Formats of 'Global parameters' various parameters in the data
+area of a spreadsheet.")
;;
;; "Side-effect variables". They are set in one function, altered in
(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 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))
+ (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."
(< (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)))
(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
+definition."
+ (cond
+ ((functionp printer) printer)
+ ((stringp printer)
+ `(lambda (x) (format ,printer x)))
+ (t (error "Invalid printer %S" printer))))
+
+(defun ses--local-printer (name def)
+ "Define a local printer with name NAME and definition DEF.
+Return the printer info."
+ (or
+ (and (symbolp name)
+ (ses-printer-validate def))
+ (error "Invalid local printer definition"))
+ (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)
"Load the vector of column widths from the spreadsheet file. This is a
(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)
"Signal an error if PRINTER is not a valid SES cell printer."
(or (not printer)
(stringp printer)
+ ;; printer is a local printer
+ (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)
(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-offset 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)
Return nil in case of failure."
(unless (local-variable-p sym)
(make-local-variable sym)
- (if (let (case-fold-search) (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name sym)))
+ (if (let (case-fold-search) (string-match-p "\\`[A-Z]+[0-9]+\\'" (symbol-name sym)))
(put sym 'ses-cell (cons row col))
(put sym 'ses-cell :ses-named)
(setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq)))
;; 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
(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)
(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)
(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)
,@(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
(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))
(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.
(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.
(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)
((< 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)
(format (car printer) value)
""))
(t
- (setq value (funcall printer (or value "")))
+ (setq value (funcall
+ (or (and (symbolp printer)
+ (let ((locprn (gethash printer ses--local-printer-hashmap)))
+ (and locprn
+ (ses--locprn-compiled locprn))))
+ printer)
+ (or value "")))
(if (stringp value)
value
(or (stringp (car-safe value))
(goto-char ses--params-marker)
(forward-line def))))
+(defun ses-file-format-extend-paramter-list (new-file-format)
+ "Extend the global parameters list when file format is updated
+from 2 to 3. This happens when local printer function are added
+to a sheet that was created with SES version 2. This is not
+undoable. Return nil when there was no change, and non nil otherwise."
+ (save-excursion
+ (cond
+ ((and (= ses--file-format 2) (= 3 new-file-format))
+ (ses-set-parameter 'ses--file-format 3)
+ (message "Upgrading from SES-2 to SES-3 file format")
+ (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)
+ ?\n)
+ t) )))
+
(defun ses-set-parameter (def value &optional elem)
"Set parameter DEF to VALUE (with undo) and write the value to the data area.
See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped.
;; in case one of them is being changed.
(ses-goto-data def)
(let ((inhibit-read-only t)
- (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)"
- ses--col-printers "(ses-column-printers %S)"
- ses--default-printer "(ses-default-printer %S)"
- ses--header-row "(ses-header-row %S)"
- ses--file-format " %S ;SES file-format"
- ses--numrows " %S ;numrows"
- ses--numcols " %S ;numcols")
+ (fmt (plist-get ses-paramfmt-plist
def))
oldval)
(if elem
(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)))
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)
(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)
(let (rowcol result)
(if (or (atom formula) (eq (car formula) 'quote))
(if (and (setq rowcol (ses-sym-rowcol formula))
- (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name formula)))
+ (string-match-p "\\`[A-Z]+[0-9]+\\'" (symbol-name formula)))
(ses-relocate-symbol formula rowcol
startrow startcol rowincr colincr)
formula) ; Pass through as-is.
;; 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)
(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
(search-backward ";; Local Variables:\n" nil t)
(backward-list 1)
(setq ses--params-marker (point-marker))
- (let ((params (condition-case nil (read (current-buffer)) (error nil))))
- (or (and (= (safe-length params) 3)
+ (let* ((params (ignore-errors (read (current-buffer))))
+ (params-len (safe-length params)))
+ (or (and (>= params-len 3)
+ (<= params-len 4)
(numberp (car params))
(numberp (cadr params))
(>= (cadr params) 0)
(numberp (nth 2 params))
- (> (nth 2 params) 0))
+ (> (nth 2 params) 0)
+ (or (<= params-len 3)
+ (let ((numlocprn (nth 3 params)))
+ (and (integerp numlocprn) (>= numlocprn 0)))))
(error "Invalid SES file"))
(setq ses--file-format (car params)
ses--numrows (cadr params)
- ses--numcols (nth 2 params))
+ ses--numcols (nth 2 params)
+ ses--numlocprn (or (nth 3 params) 0))
(when (= ses--file-format 1)
(let (buffer-undo-list) ; This is not undoable.
(ses-goto-data 'ses--header-row)
(insert "(ses-header-row 0)\n")
- (ses-set-parameter 'ses--file-format 2)
- (message "Upgrading from SES-1 file format")))
- (or (= ses--file-format 2)
+ (ses-set-parameter 'ses--file-format 3)
+ (message "Upgrading from SES-1 to SES-2 file format")))
+ (or (<= ses--file-format 3)
(error "This file needs a newer version of the SES library code"))
;; Initialize cell array.
(setq ses--cells (make-vector ses--numrows nil))
(dotimes (row ses--numrows)
- (aset ses--cells row (make-vector ses--numcols nil))))
+ (aset ses--cells row (make-vector ses--numcols nil)))
+ ;; initialize local printer map.
+ (clrhash ses--local-printer-hashmap))
+
;; Skip over print area, which we assume is correct.
(goto-char (point-min))
(forward-line ses--numrows)
- (or (looking-at ses-print-data-boundary)
+ (or (looking-at-p ses-print-data-boundary)
(error "Missing marker between print and data areas"))
(forward-char 1)
(setq ses--data-marker (point-marker))
(forward-char (1- (length ses-print-data-boundary)))
;; Initialize printer and symbol lists.
(mapc 'ses-printer-record ses-standard-printer-functions)
- (setq ses--symbolic-formulas nil)
+ (setq ses--symbolic-formulas nil)
+
+ ;; Load local printer definitions.
+ ;; This must be loaded *BEFORE* cells and column printers because the latters
+ ;; may call them.
+ (save-excursion
+ (forward-line (* ses--numrows (1+ ses--numcols)))
+ (let ((numlocprn ses--numlocprn))
+ (setq ses--numlocprn 0)
+ (dotimes (_ numlocprn)
+ (let ((x (read (current-buffer))))
+ (or (and (looking-at-p "\n")
+ (eq (car-safe x) 'ses-local-printer)
+ (apply #'ses--local-printer (cdr x)))
+ (error "local printer-def error"))
+ (setq ses--numlocprn (1+ ses--numlocprn))))))
;; Load cell definitions.
(dotimes (row ses--numrows)
(dotimes (col ses--numcols)
(let* ((x (read (current-buffer)))
(sym (car-safe (cdr-safe x))))
- (or (and (looking-at "\n")
+ (or (and (looking-at-p "\n")
(eq (car-safe x) 'ses-cell)
(ses-create-cell-variable sym row col))
(error "Cell-def error"))
- (eval x)))
- (or (looking-at "\n\n")
+ (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.
+ (forward-line (+ 2 ses--numlocprn))
;; Load global parameters.
(let ((widths (read (current-buffer)))
(n1 (char-after (point)))
(1value (eval head-row)))
;; Should be back at global-params.
(forward-char 1)
- (or (looking-at (replace-regexp-in-string "1" "[0-9]+"
- ses-initial-global-parameters))
+ (or (looking-at-p ses-initial-global-parameters-re)
(error "Problem with column-defs or global-params"))
;; Check for overall newline count in definitions area.
(forward-line 3)
;;;###autoload
(defun ses-mode ()
"Major mode for Simple Emacs Spreadsheet.
-See \"ses-example.ses\" (in `data-directory') for more info.
-Key definitions:
+When you invoke SES in a new buffer, it is divided into cells
+that you can enter data into. You can navigate the cells with
+the arrow keys and add more cells with the tab key. The contents
+of these cells can be numbers, text, or Lisp expressions. (To
+enter text, enclose it in double quotes.)
+
+In an expression, you can use cell coordinates to refer to the
+contents of another cell. For example, you can sum a range of
+cells with `(+ A1 A2 A3)'. There are specialized functions like
+`ses+' (addition for ranges with empty cells), `ses-average' (for
+performing calculations on cells), and `ses-range' and `ses-select'
+\(for extracting ranges of cells).
+
+Each cell also has a print function that controls how it is
+displayed.
+
+Each SES buffer is divided into a print area and a data area.
+Normally, you can simply use SES to look at and manipulate the print
+area, and let SES manage the data area outside the visible region.
+
+See \"ses-example.ses\" (in `data-directory') for an example
+spreadsheet, and the Info node `(ses)Top.'
+
+In the following, note the separate keymaps for cell editing mode
+and print mode specifications. Key definitions:
+
\\{ses-mode-map}
-These key definitions are active only in the print area (the visible part):
+These key definitions are active only in the print area (the visible
+part):
\\{ses-mode-print-map}
-These are active only in the minibuffer, when entering or editing a formula:
+These are active only in the minibuffer, when entering or editing a
+formula:
\\{ses-mode-edit-map}"
(interactive)
(unless (and (boundp 'ses--deferred-narrow)
;; 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)
(defun ses-jump-safe (cell)
"Like `ses-jump', but no error if invalid cell."
- (condition-case nil
- (ses-jump cell)
- (error)))
+ (ignore-errors
+ (ses-jump cell)))
(defun ses-reprint-all (&optional nonarrow)
"Recreate the display area. Calls all printer functions. Narrows to
(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*)
(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)))))
;; 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)
(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)))
(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)
(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))
(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)))
;;----------------------------------------------------------------------------
(defun ses-read-printer (prompt default)
- "Common code for `ses-read-cell-printer', `ses-read-column-printer', and `ses-read-default-printer'.
-PROMPT should end with \": \". Result is t if operation was canceled."
+ "Common code for functions `ses-read-cell-printer', `ses-read-column-printer',
+`ses-read-default-printer' and `ses-define-local-printer'.
+PROMPT should end with \": \". Result is t if operation was
+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
(or (not new)
(stringp new)
(stringp (car-safe new))
+ (and (symbolp new) (gethash new ses--local-printer-hashmap))
(ses-warn-unsafe new 'unsafep-function)
(setq new t)))
new))
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)
(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.
;; For some reason, the text-read-only error is not caught by `delete-region',
;; so we have to use subterfuge.
(let ((buffer-read-only t))
- (1value (condition-case x
+ (1value (condition-case nil
(noreturn (funcall (lookup-key (current-global-map)
(this-command-keys))
beg end))
;; 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))
(if rowbool (format "%d rows" needrows) "")
(if (and rowbool colbool) " and " "")
(if colbool (format "%d columns" needcols) "")))
- (error "Cancelled"))
+ (error "Canceled"))
(when rowbool
(let (ses--curcell)
(save-excursion
(ses-col-printer (1- ses--numcols)))))
rowcol))
-(defun ses-export-tsv (beg end)
+(defun ses-export-tsv (_beg _end)
"Export values from the current range, with tabs between columns and
newlines between rows. Result is placed in kill ring."
(interactive "r")
(ses-export-tab nil))
-(defun ses-export-tsf (beg end)
+(defun ses-export-tsf (_beg _end)
"Export formulas from the current range, with tabs between columns and
newlines between rows. Result is placed in kill ring."
(interactive "r")
(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))
(symbol-name new-name)))
(force-mode-line-update)))
+(defun ses-refresh-local-printer (name compiled-value)
+ "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)
+ (dotimes (col ses--numcols)
+ (let ((cell-printer (ses-cell-printer row col)))
+ (when (eq cell-printer name)
+ (unless new-print
+ (setq new-print t)
+ (ses-begin-change))
+ (ses-print-cell row col)))))))
+
+(defun ses-define-local-printer (name)
+ "Define a local printer with name NAME."
+ (interactive "*SEnter printer name: ")
+ (let* ((cur-printer (gethash name ses--local-printer-hashmap))
+ (default (and (vectorp cur-printer) (ses--locprn-def cur-printer)))
+ create-printer
+ (new-def
+ (ses-read-printer (format "Enter definition of printer %S: " name)
+ default)))
+ (cond
+ ;; cancelled operation => do nothing
+ ((eq new-def t))
+ ;; no change => do nothing
+ ((and (vectorp cur-printer) (equal new-def default)))
+ ;; re-defined printer
+ ((vectorp cur-printer)
+ (setq create-printer 0)
+ (setf (ses--locprn-def cur-printer) new-def)
+ (ses-refresh-local-printer
+ name
+ (setf (ses--locprn-compiled cur-printer)
+ (ses-local-printer-compile new-def))))
+ ;; new definition
+ (t
+ (setq create-printer 1)
+ (puthash name
+ (setq cur-printer
+ (ses-make-local-printer-info new-def))
+ ses--local-printer-hashmap)))
+ (when 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))))))))))
+
+
;;----------------------------------------------------------------------------
;; Checking formulas for safety
;;----------------------------------------------------------------------------
(if (or (stringp printer)
(stringp (car-safe printer))
(not printer)
+ (and (symbolp printer) (gethash printer ses--local-printer-hashmap))
(ses-warn-unsafe printer 'unsafep-function))
printer
'ses-unsafe))
current column and continues until the next nonblank column."
(ses-center-span value ?~))
-(defun ses-unsafe (value)
+(defun ses-unsafe (_value)
"Substitute for an unsafe formula or printer."
(error "Unsafe formula or printer"))
HCoop / bpt / emacs.git / blobdiff