diff options
Diffstat (limited to 'lisp/ses.el')
| -rw-r--r-- | lisp/ses.el | 401 |
1 files changed, 209 insertions, 192 deletions
diff --git a/lisp/ses.el b/lisp/ses.el index 9221476e7a1..a5fd1774dd7 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1,9 +1,9 @@ -;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*- +;;; ses.el --- Simple Emacs Spreadsheet -*- lexical-binding:t -*- -;; Copyright (C) 2002-2017 Free Software Foundation, Inc. +;; Copyright (C) 2002-2022 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@member.fsf.org> -;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net> +;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net> ;; Keywords: spreadsheet Dijkstra ;; This file is part of GNU Emacs. @@ -84,17 +84,14 @@ (defcustom ses-initial-size '(1 . 1) "Initial size of a new spreadsheet, as a cons (NUMROWS . NUMCOLS)." - :group 'ses :type '(cons (integer :tag "numrows") (integer :tag "numcols"))) (defcustom ses-initial-column-width 7 "Initial width of columns in a new spreadsheet." - :group 'ses :type '(integer :match (lambda (widget value) (> value 0)))) (defcustom ses-initial-default-printer "%.7g" "Initial default printer for a new spreadsheet." - :group 'ses :type '(choice string (list :tag "Parenthesized string" string) function)) @@ -103,15 +100,30 @@ "Things to do after entering a value into a cell. An abnormal hook that usually runs a cursor-movement function. Each function is called with ARG=1." - :group 'ses :type 'hook :options '(forward-char backward-char next-line previous-line)) (defcustom ses-mode-hook nil "Hook functions to be run upon entering SES mode." - :group 'ses :type 'hook) +(defcustom ses-jump-cell-name-function #'upcase + "Function to process the string passed to function `ses-jump'. +Set it to `identity' to make no change. +Set it to `upcase' to make cell name change case isensitive. + + May return + +* a string, in this case this must be a cell name. +* a (row . col) cons cell, in this case that must be valid cell coordinates." + :type 'function) + +(defcustom ses-jump-prefix-function #'ses-jump-prefix + "Function that takes the prefix argument passed to function `ses-jump'. +It may return the same sort of thing as `ses-jump-cell-name-function'." + :type 'function) + + ;;---------------------------------------------------------------------------- ;; Global variables and constants @@ -172,14 +184,14 @@ Each function is called with ARG=1." (defvar ses--completion-table nil "Set globally to what completion table to use depending on type - of completion (local printers, cells, etc.). We need to go - through a local variable to pass the SES buffer local variable - to completing function while the current buffer is the - minibuffer.") +of completion (local printers, cells, etc.). We need to go +through a local variable to pass the SES buffer local variable +to completing function while the current buffer is the +minibuffer.") (defvar ses--list-orig-buffer nil - "Calling buffer for SES listing help. Used for listing local - printers or renamed cells.") + "Calling buffer for SES listing help. +Used for listing local printers or renamed cells.") (defconst ses-mode-edit-map @@ -227,26 +239,18 @@ Each function is called with ARG=1." "w" ses-set-column-width "x" ses-export-keymap "\M-p" ses-read-column-printer)) - (repl '(;;We'll replace these wherever they appear in the keymap - clipboard-kill-region ses-kill-override - end-of-line ses-end-of-line - kill-line ses-delete-row - kill-region ses-kill-override - open-line ses-insert-row)) (numeric "0123456789.-") (newmap (make-keymap))) ;;Get rid of printables (suppress-keymap newmap t) ;;These keys insert themselves as the beginning of a numeric value (dotimes (x (length numeric)) - (define-key newmap (substring numeric x (1+ x)) 'ses-read-cell)) - ;;Override these global functions wherever they're bound - (while repl - (substitute-key-definition (car repl) (cadr repl) newmap - (current-global-map)) - (setq repl (cddr repl))) - ;;Apparently substitute-key-definition doesn't catch this? - (define-key newmap [(menu-bar) edit cut] 'ses-kill-override) + (define-key newmap (substring numeric x (1+ x)) #'ses-read-cell)) + (define-key newmap [remap clipboard-kill-region] #'ses-kill-override) + (define-key newmap [remap end-of-line] #'ses-end-of-line) + (define-key newmap [remap kill-line] #'ses-delete-row) + (define-key newmap [remap kill-region] #'ses-kill-override) + (define-key newmap [remap open-line] #'ses-insert-row) ;;Define our other local keys (while keys (define-key newmap (car keys) (cadr keys)) @@ -299,11 +303,11 @@ Each function is called with ARG=1." ses-center-span ses-dashfill ses-dashfill-span ses-tildefill-span ses-prin1) - "List of print functions to be included in initial history of -printer functions. None of these standard-printer functions, -except function `ses-prin1', is suitable for use as a column -printer or a global-default printer because they invoke the -column or default printer and then modify its output.") + "List of print functions to be included in initial history of printer functions. +None of these standard-printer functions, except function +`ses-prin1', is suitable for use as a column printer or a +global-default printer because they invoke the column or default +printer and then modify its output.") ;;---------------------------------------------------------------------------- @@ -332,9 +336,9 @@ column or default printer and then modify its output.") next-line-add-newlines transient-mark-mode) "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))) +(defmacro ses--\,@ (exp) (declare (debug t)) (macroexp-progn (eval exp t))) +(ses--\,@ + (mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars)) (defun ses-set-localvars () "Set buffer-local and initialize some SES variables." @@ -353,7 +357,7 @@ column or default printer and then modify its output.") (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) +(put 'ses--symbolic-formulas 'safe-local-variable #'consp) (defconst ses-paramlines-plist '(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3 @@ -378,7 +382,7 @@ area of a spreadsheet.") ;; "Side-effect variables". They are set in one function, altered in ;; another as a side effect, then read back by the first, as a way of ;; passing back more than one value. These declarations are just to make -;; the compiler happy, and to conform to standard Emacs-Lisp practice (I +;; the compiler happy, and to conform to standard Emacs Lisp practice (I ;; think the make-local-variable trick above is cleaner). ;; @@ -395,8 +399,9 @@ left-justification of the result. Set to error-signal if `ses-call-printer' encountered an error during printing. Otherwise nil.") (defvar ses-start-time nil - "Time when current operation started. Used by `ses-time-check' to decide -when to emit a progress message.") + "Time when current operation started. +Used by `ses--time-check' to decide when to emit a progress +message.") ;;---------------------------------------------------------------------------- @@ -430,7 +435,8 @@ when to emit a progress message.") 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." + "Return symbol of the local-variable holding value of CELL or pair (ROW,COL). +For example, (0,0) => A1." (declare (debug t)) `(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row))) (put 'ses-cell-symbol 'safe-function t) @@ -452,8 +458,8 @@ functions refer to its value." `(ses-cell--references ,(if col `(ses-get-cell ,row ,col) row))) (defmacro ses-sym-rowcol (sym) - "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result -is nil if SYM is not a symbol that names a cell." + "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). +Result is nil if SYM is not a symbol that names a cell." (declare (debug t)) `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) (if (eq rc :ses-named) @@ -506,7 +512,7 @@ This can alter PLIST." (setplist name (ses-plist-delq (symbol-plist name) 'ses-cell))) )) (defmacro ses--letref (vars place &rest body) - (declare (indent 2) (debug (sexp form &rest body))) + (declare (indent 2) (debug (sexp form body))) (gv-letplace (getter setter) place `(cl-macrolet ((,(nth 0 vars) () ',getter) (,(nth 1 vars) (v) (funcall ',setter v))) @@ -559,9 +565,10 @@ the corresponding cell with name PROPERTY-NAME." (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym)))))) (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. -Safety-checking for FORMULA and PRINTER are deferred until first use." + "Load a cell SYM from the spreadsheet file. +Does not recompute VALUE from 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) @@ -579,8 +586,7 @@ Safety-checking for FORMULA and PRINTER are deferred until first use." (set sym value)) (defun ses-local-printer-compile (printer) - "Convert local printer function into faster printer -definition." + "Convert local printer function into faster printer definition." (cond ((functionp printer) printer) ((stringp printer) @@ -609,8 +615,8 @@ Return the printer info." ses--local-printer-hashmap)) (defmacro ses-column-widths (widths) - "Load the vector of column widths from the spreadsheet file. This is a -macro to prevent propagate-on-load viruses." + "Load the vector of column widths from the spreadsheet file. +This is a macro to prevent propagate-on-load viruses." (or (and (vectorp widths) (= (length widths) ses--numcols)) (error "Bad column-width vector")) ;;To save time later, we also calculate the total width of each line in the @@ -621,7 +627,7 @@ macro to prevent propagate-on-load viruses." t) (defmacro ses-column-printers (printers) - "Load the vector of column printers from the spreadsheet file and checks + "Load the vector of column printers from the spreadsheet file and check them for safety. This is a macro to prevent propagate-on-load viruses." (or (and (vectorp printers) (= (length printers) ses--numcols)) (error "Bad column-printers vector")) @@ -632,14 +638,14 @@ them for safety. This is a macro to prevent propagate-on-load viruses." t) (defmacro ses-default-printer (def) - "Load the global default printer from the spreadsheet file and checks it + "Load the global default printer from the spreadsheet file and check it for safety. This is a macro to prevent propagate-on-load viruses." (setq ses--default-printer (ses-safe-printer def)) (ses-printer-record def) t) (defmacro ses-header-row (row) - "Load the header row from the spreadsheet file and checks it + "Load the header row from the spreadsheet file and check it for safety. This is a macro to prevent propagate-on-load viruses." (or (and (wholenump row) (or (zerop ses--numrows) (< row ses--numrows))) (error "Bad header-row")) @@ -671,17 +677,6 @@ variables `minrow', `maxrow', `mincol', and `maxcol'." (let ((col (+ ,c mincol))) ,@body)))))))) -;;Support for coverage testing. -(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) - ;;---------------------------------------------------------------------------- ;; Utility functions @@ -758,8 +753,8 @@ 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). Return nil if STR is not a -canonical cell name." + "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)) @@ -828,8 +823,8 @@ Return nil in case of failure." buffer-undo-list)) (defun ses-reset-header-string () - "Flag the header string for update. Upon undo, the header string will be -updated again." + "Flag the header string for update. +Upon undo, the header string will be updated again." (push '(apply ses-reset-header-string) buffer-undo-list) (setq ses--header-hscroll -1)) @@ -837,7 +832,7 @@ updated again." (defmacro ses--time-check (format &rest args) "If `ses-start-time' is more than a second ago, call `message' with FORMAT and ARGS and reset `ses-start-time' to the current time." - `(when (> (- (float-time) ses-start-time) 1.0) + `(when (time-less-p 1 (time-since ses-start-time)) (message ,format ,@args) (setq ses-start-time (float-time)))) @@ -850,31 +845,31 @@ and ARGS and reset `ses-start-time' to the current time." "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 ((row ,row) - (col ,col) - (val ,val)) - (let* ((cell (ses-get-cell row col)) + (macroexp-let2 nil row row + (macroexp-let2 nil col col + (macroexp-let2 nil val val + `(let* ((cell (ses-get-cell ,row ,col)) (change ,(let ((field (progn (cl-assert (eq (car field) 'quote)) (cadr field)))) (if (eq field 'value) - `(ses-set-with-undo (ses-cell-symbol cell) val) + `(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)) + ;; `(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)))))) + ,val cell)))))) (if change - (add-to-list 'ses--deferred-write (cons row col)))) - nil)) ; Make coverage-tester happy. + (add-to-list 'ses--deferred-write (cons ,row ,col))) + 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 @@ -1071,15 +1066,14 @@ the old and FORCE is nil." (ses-cell-set-formula row col nil)) (defcustom ses-self-reference-early-detection nil - "True if cycle detection is early for cells that refer to themselves." + "Non-nil if cycle detection is early for cells that refer to themselves." :version "24.1" - :type 'boolean - :group 'ses) + :type 'boolean) (defun ses-update-cells (list &optional force) - "Recalculate cells in LIST, checking for dependency loops. Prints -progress messages every second. Dependent cells are not recalculated -if the cell's value is unchanged and FORCE is nil." + "Recalculate cells in LIST, checking for dependency loops. +Print progress messages every second. Dependent cells are not +recalculated if the cell's value is unchanged and FORCE is nil." (let ((ses--deferred-recalc list) (nextlist list) (pos (point)) @@ -1254,8 +1248,7 @@ preceding cell has spilled over." ((< len width) ;; Fill field to length with spaces. (setq len (make-string (- width len) ?\s) - text (if (or (stringp value) - (eq ses-call-printer-return t)) + text (if (eq ses-call-printer-return t) (concat text len) (concat len text)))) ((> len width) @@ -1436,7 +1429,7 @@ ses--default-printer, ses--numrows, or ses--numcols." "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." +undoable. Return nil when there was no change, and non-nil otherwise." (save-excursion (cond ((and (= ses--file-format 2) (= 3 new-file-format)) @@ -1510,8 +1503,9 @@ Newlines in the data are escaped." ,printer ,(ses-cell-references cell)))) (ses-goto-data row col) - (delete-region (point) (line-end-position)) - (insert text))) + (let ((inhibit-quit t)) + (delete-region (point) (line-end-position)) + (insert text)))) (message " ")))) @@ -1686,7 +1680,7 @@ if the range was altered." (funcall field (ses-sym-rowcol min)))) ;; This range has changed size. (setq ses-relocate-return 'range)) - `(ses-range ,min ,max ,@(cl-cdddr range))))) + `(ses-range ,min ,max ,@(cdddr range))))) (defun ses-relocate-all (minrow mincol rowincr colincr) "Alter all cell values, symbols, formulas, and reference-lists to relocate @@ -1907,7 +1901,7 @@ Does not execute cell formulas or print functions." (or (and (= (following-char) ?\n) (eq (car-safe x) 'ses-local-printer) (apply #'ses--local-printer (cdr x))) - (error "local printer-def error")) + (error "Local printer-def error")) (setq ses--numlocprn (1+ ses--numlocprn)))))) ;; Load cell definitions. (dotimes (row ses--numrows) @@ -2035,7 +2029,7 @@ Delete overlays, remove special text properties." 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 +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 @@ -2081,8 +2075,8 @@ formula: ;; Not to use tab characters for safe (tabs may do bad for column ;; calculation). indent-tabs-mode nil) - (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t)) - (1value (add-hook 'kill-buffer-hook 'ses-killbuffer-hook nil t)) + (1value (add-hook 'change-major-mode-hook #'ses-cleanup nil t)) + (1value (add-hook 'kill-buffer-hook #'ses-killbuffer-hook nil t)) (cl-pushnew (current-buffer) ses--ses-buffer-list :test 'eq) ;; This makes revert impossible if the buffer is read-only. ;; (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) @@ -2133,17 +2127,17 @@ formula: ;; find-alternate-file, post-command-hook doesn't get run for some reason, ;; so use an idle timer to make sure. (setq ses--deferred-narrow 'ses-mode) - (1value (add-hook 'post-command-hook 'ses-command-hook nil t)) - (run-with-idle-timer 0.01 nil 'ses-command-hook) + (1value (add-hook 'post-command-hook #'ses-command-hook nil t)) + (run-with-idle-timer 0.01 nil #'ses-command-hook) (run-mode-hooks 'ses-mode-hook))) (put 'ses-mode 'mode-class 'special) (defun ses-command-hook () "Invoked from `post-command-hook'. If point has moved to a different cell, -moves the underlining overlay. Performs any recalculations or cell-data +move the underlining overlay. Perform any recalculations or cell-data writes that have been deferred. If buffer-narrowing has been deferred, -narrows the buffer now." +narrow the buffer now." (condition-case err (when (eq major-mode 'ses-mode) ; Otherwise, not our buffer anymore. (when ses--deferred-recalc @@ -2250,25 +2244,43 @@ Based on the current set of columns and `window-hscroll' position." ;;---------------------------------------------------------------------------- ;; Redisplay and recalculation ;;---------------------------------------------------------------------------- +(defun ses-jump-prefix (prefix-int) + "Convert an integer (unversal prefix) into a (ROW . COL). +Does it by numbering cells starting from 0 from top left to bottom right, +going row by row." + (and (>= prefix-int 0) + (< prefix-int (* ses--numcols ses--numrows)) + (cons (/ prefix-int ses--numcols) (% prefix-int ses--numcols)))) + -(defun ses-jump (sym) +(defun ses-jump (&optional sym) "Move point to cell SYM." - (interactive (let* (names - (s (completing-read - "Jump to cell: " - (and ses--named-cell-hashmap - (progn (maphash (lambda (key _val) - (push (symbol-name key) names)) - ses--named-cell-hashmap) - names))))) - (if - (string= s "") - (error "Invalid cell name") - (list (intern s))))) - (let ((rowcol (ses-sym-rowcol sym))) + (interactive "P") + (setq sym + (if current-prefix-arg + (funcall ses-jump-prefix-function (prefix-numeric-value sym)) + (or sym + (completing-read + "Jump to cell: " + (and ses--named-cell-hashmap + (let (names) + (maphash (lambda (key _val) + (push (symbol-name key) names)) + ses--named-cell-hashmap) + names)))))) + (and (stringp sym) + (not (and ses--named-cell-hashmap (gethash (intern sym) ses--named-cell-hashmap))) + (setq sym (funcall ses-jump-cell-name-function sym))) + (if (stringp sym) + (if (string= sym "") + (user-error "Empty cell name") + (setq sym (intern sym)))) + (let ((rowcol (if (consp sym) + (prog1 sym (setq sym (ses-cell-symbol (car sym) (cdr sym)))) + (ses-sym-rowcol sym)))) (or rowcol (error "Invalid cell name")) (if (eq (symbol-value sym) '*skip*) - (error "Cell is covered by preceding cell")) + (error "Cell is covered by preceding cell")) (ses-goto-print (car rowcol) (cdr rowcol)))) (defun ses-jump-safe (cell) @@ -2277,8 +2289,8 @@ Based on the current set of columns and `window-hscroll' position." (ses-jump cell))) (defun ses-reprint-all (&optional nonarrow) - "Recreate the display area. Calls all printer functions. Narrows to -print area if NONARROW is nil." + "Recreate the display area. Call all printer functions. +Narrow to print area if optional argument NONARROW is nil." (interactive "*P") (widen) (unless nonarrow @@ -2319,7 +2331,7 @@ print area if NONARROW is nil." "Recalculate and reprint the current cell or range. If CURCELL is non nil use it as current cell or range -without any check, otherwise function (ses-check-curcell 'range) +without any check, otherwise function (ses-check-curcell \\='range) is called. For an individual cell, shows the error if the formula or printer @@ -2496,7 +2508,7 @@ to are recalculated first." prefix-length) (when (and prefix (null (string= prefix ""))) (setq prefix-length (length prefix)) - (maphash (lambda (key val) + (maphash (lambda (key _val) (let ((key-name (symbol-name key))) (when (and (>= (length key-name) prefix-length) (string= prefix (substring key-name 0 prefix-length))) @@ -2505,8 +2517,8 @@ to are recalculated first." (and collection (list start end collection)))))) (defun ses-edit-cell (row col newval) - "Display current cell contents in minibuffer, for editing. Returns nil if -cell formula was unsafe and user declined confirmation." + "Display current cell contents in minibuffer, for editing. +Return nil if cell formula was unsafe and user declined confirmation." (interactive (progn (barf-if-buffer-read-only) @@ -2525,7 +2537,7 @@ cell formula was unsafe and user declined confirmation." ;; Position cursor inside close-quote. (setq initial (cons initial (length initial)))) (dolist (key ses-completion-keys) - (define-key ses-mode-edit-map key 'ses-edit-cell-complete-symbol)) + (define-key ses-mode-edit-map key #'ses-edit-cell-complete-symbol)) ;; make it globally visible, so that it can be visible from the minibuffer. (setq ses--completion-table ses--named-cell-hashmap) (list row col @@ -2551,10 +2563,8 @@ cell formula was unsafe and user declined confirmation." (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)) + (read-string (format-prompt "String Cell %s" + curval ses--curcell) nil 'ses-read-string-history curval)) (read-from-minibuffer (format "Cell %s: " ses--curcell) @@ -2571,8 +2581,9 @@ cell formula was unsafe and user declined confirmation." (funcall x 1)))) (defun ses-read-symbol (row col symb) - "Self-insert for a symbol as a cell formula. The set of all symbols that -have been used as formulas in this spreadsheet is available for completions." + "Self-insert for a symbol as a cell formula. +The set of all symbols that have been used as formulas in this +spreadsheet is available for completions." (interactive (let ((rowcol (progn (ses-check-curcell) (ses-sym-rowcol ses--curcell))) newval) @@ -2605,8 +2616,7 @@ With prefix, deletes several cells." (forward-char 1)))) (defun ses-clear-cell-backward (count) - "Move to previous cell and then delete it. With prefix, deletes several -cells." + "Move to previous cell and then delete it. With prefix, delete several cells." (interactive "*p") (if (< count 0) (1value (ses-clear-cell-forward (- count))) @@ -2624,8 +2634,9 @@ cells." ;;---------------------------------------------------------------------------- (defun ses-read-printer-complete-symbol () (interactive) - (let ((completion-at-point-functions (cons 'ses--read-printer-completion-at-point-function - completion-at-point-functions))) + (let ((completion-at-point-functions + (cons #'ses--read-printer-completion-at-point-function + completion-at-point-functions))) (completion-at-point))) (defun ses--read-printer-completion-at-point-function () @@ -2649,7 +2660,7 @@ cells." prefix-length) (when prefix (setq prefix-length (length prefix)) - (maphash (lambda (key val) + (maphash (lambda (key _val) (let ((key-name (symbol-name key))) (when (and (>= (length key-name) prefix-length) (string= prefix (substring key-name 0 prefix-length))) @@ -2665,11 +2676,9 @@ canceled." (barf-if-buffer-read-only) (if (eq default t) (setq default "") - (setq prompt (format "%s (default %S): " - (substring prompt 0 -2) - default))) + (setq prompt (format-prompt prompt default))) (dolist (key ses-completion-keys) - (define-key ses-mode-edit-map key 'ses-read-printer-complete-symbol)) + (define-key ses-mode-edit-map key #'ses-read-printer-complete-symbol)) ;; make it globally visible, so that it can be visible from the minibuffer. (setq ses--completion-table ses--local-printer-hashmap) (let ((new (read-from-minibuffer prompt @@ -2714,7 +2723,7 @@ right-justified) or a list of one string (will be left-justified)." ;;Range contains differing printer functions (setq default t) (throw 'ses-read-cell-printer t)))))) - (list (ses-read-printer (format "Cell %S printer: " ses--curcell) + (list (ses-read-printer (format "Cell %S printer" ses--curcell) default)))) (unless (eq newval t) (ses-begin-change) @@ -2728,7 +2737,7 @@ See `ses-read-cell-printer' for input forms." (interactive (let ((col (cdr (ses-sym-rowcol ses--curcell)))) (ses-check-curcell) - (list col (ses-read-printer (format "Column %s printer: " + (list col (ses-read-printer (format "Column %s printer" (ses-column-letter col)) (ses-col-printer col))))) @@ -2743,7 +2752,7 @@ See `ses-read-cell-printer' for input forms." "Set the default printer function for cells that have no other. See `ses-read-cell-printer' for input forms." (interactive - (list (ses-read-printer "Default printer: " ses--default-printer))) + (list (ses-read-printer "Default printer" ses--default-printer))) (unless (eq newval t) (ses-begin-change) (ses-set-parameter 'ses--default-printer newval) @@ -3018,9 +3027,9 @@ 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 (default %d): " - (ses-column-letter col) - (ses-col-width col)) + (read-from-minibuffer (format-prompt "Column %s width" + (ses-col-width col) + (ses-column-letter col)) nil ; No initial contents. nil ; No override keymap. t ; Convert to Lisp object. @@ -3052,7 +3061,7 @@ We'll assume copying front-sticky properties doesn't make sense, either. This advice also includes some SES-specific code because otherwise it's too hard to override how mouse-1 works." - (when (> beg end) + (when (and beg end (> beg end)) (let ((temp beg)) (setq beg end end temp))) @@ -3067,8 +3076,9 @@ hard to override how mouse-1 works." (advice-add 'copy-region-as-kill :around #'ses--advice-copy-region-as-kill) (defun ses-copy-region (beg end) - "Treat the region as rectangular. Convert the intangible attributes to -SES attributes recording the contents of the cell as of the time of copying." + "Treat the region as rectangular. +Convert the intangible attributes to SES attributes recording the +contents of the cell as of the time of copying." (when (= end ses--data-marker) ;;Avoid overflow situation (setq end (1- ses--data-marker))) @@ -3083,7 +3093,7 @@ SES attributes recording the contents of the cell as of the time of copying." x)) (defun ses-copy-region-helper (line) - "Converts one line (of a rectangle being extracted from a spreadsheet) to + "Convert one line (of a rectangle being extracted from a spreadsheet) to external form by attaching to each print cell a `ses' attribute that records the corresponding data cell." (or (> (length line) 1) @@ -3137,13 +3147,13 @@ Otherwise the text is inserted as the formula for the current cell. When inserting cells, the formulas are usually relocated to keep the same relative references to neighboring cells. This is best if the formulas -generally refer to other cells within the yanked text. You can use the C-u +generally refer to other cells within the yanked text. You can use the \\[universal-argument] prefix to specify insertion without relocation, which is best when the formulas refer to cells outside the yanked text. When inserting formulas, the text is treated as a string constant if it doesn't make sense as a sexp or would otherwise be considered a symbol. Use `sym' to -explicitly insert a symbol, or use the C-u prefix to treat all unmarked words +explicitly insert a symbol, or use the \\[universal-argument] prefix to treat all unmarked words as symbols." (if (not (and (derived-mode-p 'ses-mode) (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) @@ -3185,8 +3195,8 @@ previous insertion." (setq this-command 'yank)) (defun ses-yank-cells (text arg) - "If the TEXT has a proper set of `ses' attributes, insert the text as -cells, else return nil. The cells are reprinted--the supplied text is + "If TEXT has a proper set of `ses' attributes, insert it as cells. +Otherwise, return nil. The cells are reprinted--the supplied text is ignored because the column widths, default printer, etc. at yank time might be different from those at kill-time. ARG is a list to indicate that formulas are to be inserted without relocation." @@ -3370,7 +3380,7 @@ is non-nil. Newlines and tabs in the export text are escaped." (push "'" result) (setq item (cadr item))) (setq item (ses-prin1 item)) - (setq item (replace-regexp-in-string "\t" "\\\\t" item)) + (setq item (string-replace "\t" "\\t" item)) (push item result) (cond ((< col maxcol) @@ -3385,15 +3395,15 @@ is non-nil. Newlines and tabs in the export text are escaped." ;;---------------------------------------------------------------------------- (defun ses-list-local-printers (&optional local-printer-hashmap) - "List local printers in a help buffer. Can be called either -during editing a printer or a formula, or while in the SES -buffer." + "List local printers in a help buffer. +Can be called either during editing a printer or a formula, or +while in the SES buffer." (interactive (list (cond ((derived-mode-p 'ses-mode) ses--local-printer-hashmap) ((minibufferp) ses--completion-table) ((derived-mode-p 'help-mode) nil) - (t (error "Not in a SES buffer"))))) + (t (user-error "Not in a SES buffer"))))) (when local-printer-hashmap (let ((ses--list-orig-buffer (or ses--list-orig-buffer (current-buffer)))) (help-setup-xref @@ -3419,15 +3429,15 @@ buffer." (buffer-string))))))) (defun ses-list-named-cells (&optional named-cell-hashmap) - "List named cells in a help buffer. Can be called either -during editing a printer or a formula, or while in the SES -buffer." + "List named cells in a help buffer. +Can be called either during editing a printer or a formula, or +while in the SES buffer." (interactive (list (cond ((derived-mode-p 'ses-mode) ses--named-cell-hashmap) ((minibufferp) ses--completion-table) ((derived-mode-p 'help-mode) nil) - (t (error "Not in a SES buffer"))))) + (t (user-error "Not in a SES buffer"))))) (when named-cell-hashmap (let ((ses--list-orig-buffer (or ses--list-orig-buffer (current-buffer)))) (help-setup-xref @@ -3470,7 +3480,9 @@ With a \\[universal-argument] prefix arg, prompt the user. The top row is row 1. Selecting row 0 displays the default header row." (interactive (list (if (numberp current-prefix-arg) current-prefix-arg - (let ((currow (1+ (car (ses-sym-rowcol ses--curcell))))) + (let* ((curcell (or (ses--cell-at-pos (point)) + (user-error "Invalid header-row"))) + (currow (1+ (car (ses-sym-rowcol curcell))))) (if current-prefix-arg (read-number "Header row: " currow) currow))))) @@ -3565,7 +3577,7 @@ With prefix, sorts in REVERSE order." (push (cons (buffer-substring-no-properties (point) end) (+ minrow x)) keys)) - (setq keys (sort keys #'(lambda (x y) (string< (car x) (car y))))) + (setq keys (sort keys (lambda (x y) (string< (car x) (car y))))) ;;Extract the lines in reverse sorted order (or reverse (setq keys (nreverse keys))) @@ -3685,7 +3697,7 @@ highlighted range in the spreadsheet." ;; 'rowcol' corresponding to 'ses-cell' property of symbol ;; 'sym'. Both must be the same. (unless (eq sym old-name) - (error "Spreadsheet is broken, both symbols %S and %S refering to cell (%d,%d)" sym old-name row col)) + (error "Spreadsheet is broken, both symbols %S and %S referring to cell (%d,%d)" sym old-name row col)) (if new-rowcol ;; the new name is of A1 type, so we test that the coordinate ;; inferred from new name @@ -3698,7 +3710,7 @@ highlighted range in the spreadsheet." (puthash new-name rowcol ses--named-cell-hashmap)) (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list) (cl-pushnew rowcol ses--deferred-write :test #'equal) - ;; Replace name by new name in formula of cells refering to renamed cell. + ;; Replace name by new name in formula of cells referring to renamed cell. (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) @@ -3754,7 +3766,7 @@ Uses the value COMPILED-VALUE for this printer." (defun ses-define-local-printer (name definition) "Define a local printer with name NAME and definition DEFINITION. -NAME shall be a symbol. Use TAB to complete over existing local +NAME shall be a symbol. Use TAB to complete over existing local printer names. DEFINITION shall be either a string formatter, e.g.: @@ -3762,15 +3774,15 @@ DEFINITION shall be either a string formatter, e.g.: \"%.2f\" or (\"%.2f\") for left alignment. or a lambda expression, e.g. for formatting in ISO format dates -created with a '(calcFunc-date YEAR MONTH DAY)' formula: +created with a `(calcFunc-date YEAR MONTH DAY)' formula: (lambda (x) (cond ((null val) \"\") - ((eq (car-safe x) 'date) - (let ((calc-format-date '(X YYYY \"-\" MM \"-\" DD))) + ((eq (car-safe x) \\='date) + (let ((calc-format-date \\='(X YYYY \"-\" MM \"-\" DD))) (math-format-date x))) - (t (ses-center-span val ?# 'ses-prin1)))) + (t (ses-center-span val ?# \\='ses-prin1)))) If NAME is already used to name a local printer function, then the current definition is proposed as default value, and the @@ -3785,7 +3797,9 @@ function is redefined." (setq name (intern name)) (let* ((cur-printer (gethash name ses--local-printer-hashmap)) (default (and cur-printer (ses--locprn-def cur-printer)))) - (setq def (ses-read-printer (format "Enter definition of printer %S: " name) + (setq def (ses-read-printer (format-prompt + "Enter definition of printer %S" + default name) default))) (list name def))) @@ -3793,7 +3807,7 @@ function is redefined." (default (and cur-printer (ses--locprn-def cur-printer))) create-printer) (cond - ;; cancelled operation => do nothing + ;; canceled operation => do nothing ((eq definition t)) ;; no change => do nothing ((and cur-printer (equal definition default))) @@ -3957,17 +3971,17 @@ Use `math-format-value' as a printer for Calc objects." (while rest (let ((x (pop rest))) (pcase x - (`>v (setq transpose nil reorient-x nil reorient-y nil)) - (`>^ (setq transpose nil reorient-x nil reorient-y t)) - (`<^ (setq transpose nil reorient-x t reorient-y t)) - (`<v (setq transpose nil reorient-x t reorient-y nil)) - (`v> (setq transpose t reorient-x nil reorient-y t)) - (`^> (setq transpose t reorient-x nil reorient-y nil)) - (`^< (setq transpose t reorient-x t reorient-y nil)) - (`v< (setq transpose t reorient-x t reorient-y t)) - ((or `* `*2 `*1) (setq vectorize x)) - (`! (setq clean 'ses--clean-!)) - (`_ (setq clean `(lambda (&rest x) + ('>v (setq transpose nil reorient-x nil reorient-y nil)) + ('>^ (setq transpose nil reorient-x nil reorient-y t)) + ('<^ (setq transpose nil reorient-x t reorient-y t)) + ('<v (setq transpose nil reorient-x t reorient-y nil)) + ('v> (setq transpose t reorient-x nil reorient-y t)) + ('^> (setq transpose t reorient-x nil reorient-y nil)) + ('^< (setq transpose t reorient-x t reorient-y nil)) + ('v< (setq transpose t reorient-x t reorient-y t)) + ((or '* '*2 '*1) (setq vectorize x)) + ('! (setq clean 'ses--clean-!)) + ('_ (setq clean `(lambda (&rest x) (ses--clean-_ x ,(if rest (pop rest) 0))))) (_ (cond @@ -4002,10 +4016,10 @@ Use `math-format-value' as a printer for Calc objects." (cons clean (cons (quote 'vec) x))) result))))) (pcase vectorize - (`nil (cons clean (apply #'append result))) - (`*1 (vectorize-*1 clean result)) - (`*2 (vectorize-*2 clean result)) - (`* (funcall (if (cdr result) + ('nil (cons clean (apply #'append result))) + ('*1 (vectorize-*1 clean result)) + ('*2 (vectorize-*2 clean result)) + ('* (funcall (if (cdr result) #'vectorize-*2 #'vectorize-*1) clean result)))))) @@ -4023,8 +4037,9 @@ Use `math-format-value' as a printer for Calc objects." (apply #'+ (apply #'ses-delete-blanks args))) (defun ses-average (list) - "Computes the sum of the numbers in LIST, divided by their length. Blanks -are ignored. Result is always floating-point, even if all args are integers." + "Calculate the sum of the numbers in LIST, divided by their length. +Blanks are ignored. Result is always floating-point, even if all +args are integers." (setq list (apply #'ses-delete-blanks list)) (/ (float (apply #'+ list)) (length list))) @@ -4095,17 +4110,19 @@ SPAN indicates how many rightward columns to include in width (default = 0)." (ses-center value span ?- printer)) (defun ses-dashfill-span (value &optional printer) - "Print VALUE, centered using dashes within the span that starts in the -current column and continues until the next nonblank column." + "Print VALUE, centered using dashes. +Centers within the span that starts in the current column and continues +until the next nonblank column." (ses-center-span value ?- printer)) (defun ses-tildefill-span (value &optional printer) - "Print VALUE, centered using tildes within the span that starts in the -current column and continues until the next nonblank column." + "Print VALUE, centered using tildes. +Centers within the span that starts in the current column and continues +until the next nonblank column." (ses-center-span value ?~ printer)) (defun ses-prin1 (value) - "Shorthand for '(prin1-to-string VALUE t)'. + "Shorthand for `(prin1-to-string VALUE t)'. Useful to handle the default behavior in custom lambda based printer functions." (prin1-to-string value t)) |