;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2016 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net>
;;; To-do list:
+;; * M-w should deactivate the mark.
+;; * offer some way to use absolute cell addressing.
+;; * Maybe some way to copy a reference to a cell's formula rather than the
+;; formula itself.
;; * split (catch 'cycle ...) call back into one or more functions
;; * Use $ or … for truncated fields
+;; * M-t to transpose 2 columns.
+;; * M-d should kill the cell under point.
+;; * C-t to transpose 2 rows.
+;; * C-k and M-k should be ses-kill-row and ses-kill-column.
+;; * C-o should insert the row below point rather than above?
+;; * rows inserted with C-o should inherit formulas from surrounding rows.
;; * Add command to make a range of columns be temporarily invisible.
;; * Allow paste of one cell to a range of cells -- copy formula to each.
;; * Do something about control characters & octal codes in cell print
"\C-c\C-s" ses-insert-ses-range
[S-mouse-3] ses-insert-range-click
[C-S-mouse-3] ses-insert-ses-range-click
- "\M-\C-i" lisp-complete-symbol))
+ "\M-\C-i" lisp-complete-symbol)) ; FIXME obsolete
(newmap (make-sparse-keymap)))
(set-keymap-parent newmap minibuffer-local-map)
(while keys
ses--numcols ses--numrows ses--symbolic-formulas
ses--data-marker ses--params-marker (ses--Dijkstra-attempt-nb . 0)
ses--Dijkstra-weight-bound
- ;; This list is useful to speed-up clean-up of symbols when
- ;; an area containing renamed cell is deleted.
- ses--renamed-cell-symb-list
+ ;; This list is useful for clean-up of symbols when an area
+ ;; containing renamed cell is deleted.
+ ses--in-killing-named-cell-list
;; Global variables that we override
- mode-line-process next-line-add-newlines transient-mark-mode)
+ next-line-add-newlines transient-mark-mode)
"Buffer-local variables used by SES."))
(defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t))
'(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--numlocprn 4)
- "Offsets from 'Global parameters' line to various parameter lines in the
+ "Offsets from \"Global parameters\" line to various parameter lines in the
data area of a spreadsheet.")
(defconst ses-paramfmt-plist
ses--numrows " %S ;numrows"
ses--numcols " %S ;numcols"
ses--numlocprn " %S ;numlocprn")
- "Formats of 'Global parameters' various parameters in the data
+ "Formats of \"Global parameters\" various parameters in the data
area of a spreadsheet.")
;;
(defvar ses-relocate-return nil
"Set by `ses-relocate-formula' and `ses-relocate-range', read by
-`ses-relocate-all'. Set to 'delete if a cell-reference was deleted from a
-formula--so the formula needs recalculation. Set to 'range if the size of a
+`ses-relocate-all'. Set to `delete' if a cell-reference was deleted from a
+formula--so the formula needs recalculation. Set to `range' if the size of a
`ses-range' was changed--so both the formula's value and list of dependents
need to be recalculated.")
(declare (debug t))
`(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."
+ (declare (debug t))
+ `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
+ (if (eq rc :ses-named)
+ (gethash ,sym ses--named-cell-hashmap)
+ rc)))
+
(defun ses-cell-p (cell)
"Return non-nil if CELL is a cell of current buffer."
(and (vectorp cell)
(and (consp rowcol)
(ses-get-cell (car rowcol) (cdr rowcol)))))))
+(defun ses-plist-delq (plist prop)
+ "Return PLIST after deleting the first pair (if any) with symbol PROP.
+This can alter PLIST."
+ (cond
+ ((null plist) nil)
+ ((eq (car plist) prop) (cddr plist))
+ (t (let* ((plist-1 (cdr plist))
+ (plist-2 (cdr plist-1)))
+ (setcdr plist-1 (ses-plist-delq plist-2 prop))
+ plist))))
+
+(defvar ses--ses-buffer-list nil "A list of buffers containing a SES spreadsheet.")
+
+(defun ses--unbind-cell-name (name)
+ "Make NAME non longer a renamed cell name."
+ (remhash name ses--named-cell-hashmap)
+ (kill-local-variable name)
+ ;; remove symbol property 'ses-cell from symbol NAME, unless this
+ ;; symbol is also a renamed cell name in another SES buffer.
+ (let (used-elsewhere (buffer-list ses--ses-buffer-list) buf)
+ (while buffer-list
+ (setq buf (pop buffer-list))
+ (cond
+ ((eq buf (current-buffer)))
+ ;; This case should not happen, some SES buffer has been
+ ;; killed without the ses-killbuffer-hook being called.
+ ((null (buffer-live-p buf))
+ ;; Silently repair ses--ses-buffer-list
+ (setq ses--ses-buffer-list (delq buf ses--ses-buffer-list)))
+ (t
+ (with-current-buffer buf
+ (when (gethash name ses--named-cell-hashmap)
+ (setq used-elsewhere t
+ buffer-list nil))))))
+ (unless used-elsewhere
+ (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)))
(defmacro ses-cell-value (row &optional col)
"From a CELL or a pair (ROW,COL), get the current value for that cell."
+ (declare (debug t))
`(symbol-value (ses-cell-symbol ,row ,col)))
(defmacro ses-col-width (col)
"Return the width for column COL."
+ (declare (debug t))
`(aref ses--col-widths ,col))
(defmacro ses-col-printer (col)
"Return the default printer for column COL."
+ (declare (debug t))
`(aref ses--col-printers ,col))
-(defmacro ses-sym-rowcol (sym)
- "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result
-is nil if SYM is not a symbol that names a cell."
- `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
- (if (eq rc :ses-named)
- (gethash ,sym ses--named-cell-hashmap)
- rc)))
-
(defun ses-is-cell-sym-p (sym)
"Check whether SYM point at a cell of this spread sheet."
(let ((rowcol (get sym 'ses-cell)))
(add-to-list 'ses-read-printer-history (prin1-to-string printer))))
(defun ses-formula-record (formula)
- "If FORMULA is of the form 'symbol, add it to the list of symbolic formulas
+ "If FORMULA is of the form \\='SYMBOL, add it to the list of symbolic formulas
for this spreadsheet."
(when (and (eq (car-safe formula) 'quote)
(symbolp (cadr formula)))
(concat (ses-column-letter (1- (/ col 26))) units))))
(defun ses-create-cell-symbol (row col)
- "Produce a symbol that names the cell (ROW,COL). (0,0) => 'A1."
+ "Produce a symbol that names the cell (ROW,COL). (0,0) => A1."
(intern (concat (ses-column-letter col) (number-to-string (1+ row)))))
(defun ses-decode-cell-symbol (str)
;; is called during a recursive ses-print-cell).
(defun ses-goto-print (row col)
"Move point to print area for cell (ROW,COL)."
- (let ((inhibit-point-motion-hooks t)
- (n 0))
+ (let ((n 0))
(goto-char (point-min))
(forward-line row)
;; Calculate column position.
;; Move point to the bol of next line (for TAB at the last cell).
(forward-char))))
-(defun ses-set-curcell ()
- "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a
+(defun ses--cell-at-pos (pos &optional object)
+ (or (get-text-property pos 'cursor-intangible object)
+ ;; (when (> pos (if object 0 (point-min)))
+ ;; (get-text-property (1- pos) 'cursor-intangible object))
+ ))
+
+(defun ses--curcell (&optional pos)
+ "Return the current cell symbol, or a cons (BEG,END) for a
region, or nil if cursor is not at a cell."
+ (unless pos (setq pos (point)))
(if (or (not mark-active)
deactivate-mark
- (= (region-beginning) (region-end)))
+ (= pos (mark t)))
;; Single cell.
- (setq ses--curcell (get-text-property (point) 'intangible))
+ (ses--cell-at-pos pos)
;; Range.
- (let ((bcell (get-text-property (region-beginning) 'intangible))
- (ecell (get-text-property (1- (region-end)) 'intangible)))
- (when (= (region-end) ses--data-marker)
+ (let* ((re (max pos (mark t)))
+ (bcell (ses--cell-at-pos (min pos (mark t))))
+ (ecell (ses--cell-at-pos (1- re))))
+ (when (= re ses--data-marker)
;; Correct for overflow.
- (setq ecell (get-text-property (- (region-end) 2) 'intangible)))
- (setq ses--curcell (if (and bcell ecell)
- (cons bcell ecell)
- nil))))
+ (setq ecell (ses--cell-at-pos (- (region-end) 2))))
+ (if (and bcell ecell)
+ (cons bcell ecell)
+ nil))))
+
+(defun ses-set-curcell ()
+ "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a
+region, or nil if cursor is not at a cell."
+ (setq ses--curcell (ses--curcell))
nil)
(defun ses-check-curcell (&rest args)
"Signal an error if `ses--curcell' is inappropriate.
-The end marker is appropriate if some argument is 'end.
-A range is appropriate if some argument is 'range.
-A single cell is appropriate unless some argument is 'needrange."
- (if (eq ses--curcell t)
- ;; curcell recalculation was postponed, but user typed ahead.
- (ses-set-curcell))
+The end marker is appropriate if some argument is `end'.
+A range is appropriate if some argument is `range'.
+A single cell is appropriate unless some argument is `needrange'."
+ (ses-set-curcell); fix bug#21054
(cond
((not ses--curcell)
(or (memq 'end args)
;; Install the printed result. This is not interruptible.
(let ((inhibit-read-only t)
(inhibit-quit t))
- (let ((inhibit-point-motion-hooks t))
- (delete-region (point) (progn
- (move-to-column (+ (current-column)
- (string-width text)))
- (1+ (point)))))
+ (delete-region (point) (progn
+ (move-to-column (+ (current-column)
+ (string-width text)))
+ (1+ (point))))
;; We use concat instead of inserting separate strings in order to
;; reduce the number of cells in the undo list.
(setq x (concat text (if (< maxcol ses--numcols) " " "\n")))
;; inherit from surrounding text?)
(set-text-properties 0 (length x) nil x)
(insert-and-inherit x)
- (put-text-property startpos (point) 'intangible
+ (put-text-property startpos (point) 'cursor-intangible
(ses-cell-symbol cell))
(when (and (zerop row) (zerop col))
;; Reconstruct special beginning-of-buffer attributes.
(put-text-property (point-min) (point) 'keymap 'ses-mode-print-map)
(put-text-property (point-min) (point) 'read-only 'ses)
- (put-text-property (point-min) (1+ (point-min)) 'front-sticky t)))
+ (put-text-property (point-min) (1+ (point-min))
+ ;; `cursor-intangible' shouldn't be sticky at BOB.
+ 'front-sticky '(read-only keymap))))
(if (= row (1- ses--header-row))
;; This line is part of the header --- force recalc.
(ses-reset-header-string))
(ses-goto-print row col)
(when at-end
;; Insert new columns before newline.
- (let ((inhibit-point-motion-hooks t))
- (backward-char 1)))
+ (backward-char 1))
(if blank
(insert blank)
(delete-char (- change))))))
;;Cell was skipped over - reprint previous
(ses-goto-print row col)
(backward-char 1)
- (let ((rowcol (ses-sym-rowcol (get-text-property (point) 'intangible))))
+ (let ((rowcol (ses-sym-rowcol (ses--cell-at-pos (point)))))
(ses-print-cell (car rowcol) (cdr rowcol)))))
is one of the symbols ses--col-widths, ses--col-printers,
ses--default-printer, ses--numrows, or ses--numcols."
(ses-widen)
- (let ((inhibit-point-motion-hooks t)) ; In case intangible attrs are wrong.
- (if col
- ;; It's a cell.
- (progn
- (goto-char ses--data-marker)
- (forward-line (+ 1 (* def (1+ ses--numcols)) col)))
- ;; Convert def-symbol to offset.
- (setq def (plist-get ses-paramlines-plist def))
- (or def (signal 'args-out-of-range nil))
- (goto-char ses--params-marker)
- (forward-line def))))
+ (if col
+ ;; It's a cell.
+ (progn
+ (goto-char ses--data-marker)
+ (forward-line (+ 1 (* def (1+ ses--numcols)) col)))
+ ;; Convert def-symbol to offset.
+ (setq def (plist-get ses-paramlines-plist def))
+ (or def (signal 'args-out-of-range nil))
+ (goto-char ses--params-marker)
+ (forward-line def)))
(defun ses-file-format-extend-parameter-list (new-file-format)
"Extend the global parameters list when file format is updated
col (+ col colincr))
(if (and (>= row startrow) (>= col startcol)
(< row ses--numrows) (< col ses--numcols))
- ;;Relocate this variable
- (ses-create-cell-symbol row col)
+ ;;Relocate this variable, unless it is a named cell
+ (if (eq (get sym 'ses-cell) :ses-named)
+ sym
+ (ses-create-cell-symbol row col))
;;Delete reference to a deleted cell
nil))))
"Produce a copy of FORMULA where all symbols that refer to cells in row
STARTROW or above, and col STARTCOL or above, are altered by adding ROWINCR
and COLINCR. STARTROW and STARTCOL are 0-based. Example:
- (ses-relocate-formula '(+ A1 B2 D3) 1 2 1 -1)
+ (ses-relocate-formula \\='(+ A1 B2 D3) 1 2 1 -1)
=> (+ A1 B2 C4)
If ROWINCR or COLINCR is negative, references to cells being deleted are
removed. Example:
- (ses-relocate-formula '(+ A1 B2 D3) 0 1 0 -1)
+ (ses-relocate-formula \\='(+ A1 B2 D3) 0 1 0 -1)
=> (+ A1 C3)
-Sets `ses-relocate-return' to 'delete if cell-references were removed."
+Sets `ses-relocate-return' to `delete' if cell-references were removed."
(let (rowcol result)
(if (or (atom formula) (eq (car formula) 'quote))
- (if (and (setq rowcol (ses-sym-rowcol formula))
- (string-match-p "\\`[A-Z]+[0-9]+\\'" (symbol-name formula)))
+ (if (setq rowcol (ses-sym-rowcol formula))
(ses-relocate-symbol formula rowcol
startrow startcol rowincr colincr)
formula) ; Pass through as-is.
(nreverse result))))
(defun ses-relocate-range (range startrow startcol rowincr colincr)
- "Relocate one RANGE, of the form '(ses-range min max). Cells starting
+ "Relocate one RANGE, of the form (ses-range MIN MAX). Cells starting
at (STARTROW,STARTCOL) are being shifted by (ROWINCR,COLINCR). Result is the
new range, or nil if the entire range is deleted. If new rows are being added
just beyond the end of a row range, or new columns just beyond a column range,
sym
(>= xrow 0)
(>= xcol 0)
- (null (eq sym
- (ses-create-cell-symbol xrow xcol))))
+ ;; the following could also be tested as
+ ;; (null (eq sym (ses-create-cell-symbol xrow xcol)))
+ (eq (get sym 'ses-cell) :ses-named))
;; This is a renamed cell, do not update the cell
;; name, but just update the coordinate property.
- (put sym 'ses-cell (cons row col))
+ (puthash sym (cons row col) ses--named-cell-hashmap)
(ses-set-cell row col 'symbol
(setq sym (ses-create-cell-symbol row col)))
- (unless (and (boundp sym) (local-variable-p sym))
+ (unless (local-variable-if-set-p sym)
(set (make-local-variable sym) nil)
(put sym 'ses-cell (cons row col)))))) )))
;; Relocate the cell values.
(setq mycol (+ col mincol)
xrow (- myrow rowincr)
xcol (- mycol colincr))
- (let ((sym (ses-cell-symbol myrow mycol))
- (xsym (ses-create-cell-symbol xrow xcol)))
- ;; Make the value relocation only when if the cell is not
- ;; a renamed cell. Otherwise this is not needed.
- (and (eq sym xsym)
- (ses-set-cell myrow mycol 'value
- (if (and (< xrow ses--numrows) (< xcol ses--numcols))
- (ses-cell-value xrow xcol)
- ;;Cell is off the end of the array
- (symbol-value xsym))))))))
+ (let ((sym (ses-cell-symbol myrow mycol)))
+ ;; We don't need to relocate value for renamed cells, as they keep the same
+ ;; symbol.
+ (unless (eq (get sym 'ses-cell) :ses-named)
+ (ses-set-cell myrow mycol 'value
+ (if (and (< xrow ses--numrows) (< xcol ses--numcols))
+ (ses-cell-value xrow xcol)
+ ;; Cell is off the end of the array.
+ (symbol-value (ses-create-cell-symbol xrow xcol))))))))
+ (when ses--in-killing-named-cell-list
+ (message "Unbinding killed named cell symbols...")
+ (setq ses-start-time (float-time))
+ (while ses--in-killing-named-cell-list
+ (ses--time-check "Unbinding killed named cell symbols... (%d left)" (length ses--in-killing-named-cell-list))
+ (ses--unbind-cell-name (pop ses--in-killing-named-cell-list)) )
+ (message nil)) )
((and (wholenump rowincr) (wholenump colincr))
;; Insertion of rows and/or columns. Run the loop backwards.
`intangible' properties. Sets up highlighting for current cell."
(interactive)
(let ((end (point-min))
- (inhibit-point-motion-hooks t)
pos sym)
(with-silent-modifications
(ses-goto-data 0 0) ; Include marker between print-area and data-area.
(put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map)
;; For the beginning of the buffer, we want the read-only and keymap
;; attributes to be inherited from the first character.
- (put-text-property (point-min) (1+ (point-min)) 'front-sticky t)
+ (put-text-property (point-min) (1+ (point-min))
+ ;; `cursor-intangible' shouldn't be sticky at BOB.
+ 'front-sticky '(read-only keymap))
;; Create intangible properties, which also indicate which cell the text
;; came from.
(dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
(+ end (ses-col-width col) 1)
(forward-char)
(point))))
- (put-text-property pos end 'intangible sym))))))
+ (put-text-property pos end 'cursor-intangible sym))))))
;; Create the underlining overlay. It's impossible for (point) to be 2,
;; because column A must be at least 1 column wide.
(setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min))))
(unless was-modified
(restore-buffer-modified-p nil))))
+(defun ses-killbuffer-hook ()
+ "Hook when the current buffer is killed."
+ (setq ses--ses-buffer-list (delq (current-buffer) ses--ses-buffer-list)))
+
+
;;;###autoload
(defun ses-mode ()
"Major mode for Simple Emacs Spreadsheet.
;; 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))
+ (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))
(setq header-line-format '(:eval (progn
(window-hscroll))
(ses-create-header-string))
ses--header-string)))
+ (setq-local mode-line-process '(:eval (ses--mode-line-process)))
+ (add-hook 'pre-redisplay-functions #'ses--cursor-sensor-highlight
+ ;; Highlight the cell after moving cursor out of intangible.
+ 'append t)
+ (cursor-intangible-mode 1)
(let ((was-empty (zerop (buffer-size)))
(was-modified (buffer-modified-p)))
(save-excursion
;; read the local variables at the end of the file. Now it's safe to
;; do the narrowing.
(narrow-to-region (point-min) ses--data-marker)
- (setq ses--deferred-narrow nil))
- ;; Update the mode line.
- (let ((oldcell ses--curcell))
- (ses-set-curcell)
- (unless (eq ses--curcell oldcell)
- (cond
- ((not ses--curcell)
- (setq mode-line-process nil))
- ((atom ses--curcell)
- (setq mode-line-process (list " cell "
- (symbol-name ses--curcell))))
- (t
- (setq mode-line-process (list " range "
- (symbol-name (car ses--curcell))
- "-"
- (symbol-name (cdr ses--curcell))))))
- (force-mode-line-update)))
- ;; Use underline overlay for single-cells only, turn off otherwise.
- (if (listp ses--curcell)
- (move-overlay ses--curcell-overlay 2 2)
- (let ((next (next-single-property-change (point) 'intangible)))
- (move-overlay ses--curcell-overlay (point) (1- next))))
- (when (not (pos-visible-in-window-p))
- ;; Scrolling will happen later.
- (run-with-idle-timer 0.01 nil 'ses-command-hook)
- (setq ses--curcell t)))
+ (setq ses--deferred-narrow nil)))
;; Prevent errors in this post-command-hook from silently erasing the hook!
(error
(unless executing-kbd-macro
(message "%s" (error-message-string err))))
nil) ; Make coverage-tester happy.
+(defun ses--mode-line-process ()
+ (let ((cmlp (window-parameter nil 'ses--mode-line-process))
+ (curcell (ses--curcell (window-point))))
+ (if (equal curcell (car cmlp))
+ (cdr cmlp)
+ (let ((mlp
+ (cond
+ ((not curcell) nil)
+ ((atom curcell) (list " cell " (symbol-name curcell)))
+ (t
+ (list " range "
+ (symbol-name (car curcell))
+ "-"
+ (symbol-name (cdr curcell)))))))
+ (set-window-parameter nil 'ses--mode-line-process (cons curcell mlp))
+ mlp))))
+
+(defun ses--cursor-sensor-highlight (window)
+ (let ((curcell (ses--curcell))
+ (ol (window-parameter window 'ses--curcell-overlay)))
+ (unless ol
+ (setq ol (make-overlay (point) (point)))
+ (overlay-put ol 'window window)
+ (overlay-put ol 'face 'underline)
+ (set-window-parameter window 'ses--curcell-overlay ol))
+ ;; Use underline overlay for single-cells only, turn off otherwise.
+ (if (listp curcell)
+ (delete-overlay ol)
+ (let* ((pos (window-point window))
+ (next (next-single-property-change pos 'cursor-intangible)))
+ (move-overlay ol pos (1- next))))))
+
(defun ses-create-header-string ()
"Set up `ses--header-string' as the buffer's header line.
Based on the current set of columns and `window-hscroll' position."
(widen)
(unless nonarrow
(setq ses--deferred-narrow t))
- (let ((startcell (get-text-property (point) 'intangible))
+ (let ((startcell (ses--cell-at-pos (point)))
(inhibit-read-only t))
(ses-begin-change)
(goto-char (point-min))
(defun ses-recalculate-all ()
"Recalculate and reprint all cells."
(interactive "*")
- (let ((startcell (get-text-property (point) 'intangible))
+ (let ((startcell (ses--cell-at-pos (point)))
(ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows)
(1- ses--numcols)))))
(ses-recalculate-cell)
(when (and (< col (1- ses--numcols)) ;;Last column can't spill over, anyway
(eq (ses-cell-value row (1+ col)) '*skip*))
;; This cell has spill-over. We'll momentarily pretend the following cell
- ;; has a `t' in it.
+ ;; has a t in it.
(cl-progv
(list (ses-cell-symbol row (1+ col)))
'(t)
;;Delete lines from cell data area
(ses-goto-data row 0)
(ses-delete-line (* count (1+ ses--numcols)))
+ ;; Collect named cells in the deleted rows, in order to clean the
+ ;; symbols out of the named cell hash map, once the deletion is
+ ;; complete
+ (unless (null ses--in-killing-named-cell-list)
+ (warn "Internal error, `ses--in-killing-named-cell-list' should be nil, but is equal to %S"
+ ses--in-killing-named-cell-list)
+ (setq ses--in-killing-named-cell-list nil))
+ (dotimes-with-progress-reporter (nrow count)
+ "Collecting named cell in deleted rows..."
+ (dotimes (col ses--numcols)
+ (let* ((row (+ row nrow))
+ (sym (ses-cell-symbol row col)))
+ (and (eq (get sym 'ses-cell) :ses-named)
+ (push sym ses--in-killing-named-cell-list)))))
;;Relocate variables and formulas
(ses-set-with-undo 'ses--cells (ses-vector-delete ses--cells row count))
(ses-relocate-all row 0 (- count) 0)
(ses-begin-change)
(ses-set-parameter 'ses--numcols (- ses--numcols count))
(ses-adjust-print-width col (- width))
+ ;; Prepare collecting named cells in the deleted columns, in order
+ ;; to clean the symbols out of the named cell hash map, once the
+ ;; deletion is complete
+ (unless (null ses--in-killing-named-cell-list)
+ (warn "Internal error, `ses--in-killing-named-cell-list' should be nil, but is equal to %S"
+ ses--in-killing-named-cell-list)
+ (setq ses--in-killing-named-cell-list nil))
(dotimes-with-progress-reporter (row ses--numrows) "Deleting column..."
;;Delete lines from cell data area
(ses-goto-data row col)
(ses-delete-line count)
+ ;; Collect named cells in the deleted columns within this row
+ (dotimes (ncol count)
+ (let ((sym (ses-cell-symbol row (+ col ncol))))
+ (and (eq (get sym 'ses-cell) :ses-named)
+ (push sym ses--in-killing-named-cell-list))))
;;Delete cells. Check if deletion area begins or ends with a skip.
(if (or (eq (ses-cell-value row col) '*skip*)
(and (< col ses--numcols)
(let ((col (cdr (ses-sym-rowcol ses--curcell))))
(when (/= 32
(char-before (next-single-property-change (point)
- 'intangible)))
+ 'cursor-intangible)))
;; We're already in last nonskipped cell on line. Need to create a
;; new column.
(barf-if-buffer-read-only)
(when (= end ses--data-marker)
;;Avoid overflow situation
(setq end (1- ses--data-marker)))
- (let* ((inhibit-point-motion-hooks t)
- (x (mapconcat #'ses-copy-region-helper
+ (let* ((x (mapconcat #'ses-copy-region-helper
(extract-rectangle beg (1- end)) "\n")))
(remove-text-properties 0 (length x)
'(read-only t
- intangible t
+ cursor-intangible t
keymap t
front-sticky t)
x)
(defun ses-copy-region-helper (line)
"Converts one line (of a rectangle being extracted from a spreadsheet) to
-external form by attaching to each print cell a 'ses attribute that records
+external form by attaching to each print cell a `ses' attribute that records
the corresponding data cell."
(or (> (length line) 1)
(error "Empty range"))
(pos 0)
mycell next sym rowcol)
(while pos
- (setq sym (get-text-property pos 'intangible line)
- next (next-single-property-change pos 'intangible line)
+ (setq sym (ses--cell-at-pos pos line)
+ next (next-single-property-change pos 'cursor-intangible line)
rowcol (ses-sym-rowcol sym)
mycell (ses-get-cell (car rowcol) (cdr rowcol)))
(put-text-property pos (or next (length line))
(defun ses--advice-yank (yank-fun &optional arg &rest args)
"In SES mode, the yanked text is inserted as cells.
-If the text contains 'ses attributes (meaning it went to the kill-ring from a
+If the text contains `ses' attributes (meaning it went to the kill-ring from a
SES buffer), the formulas and print functions are restored for the cells. If
the text contains tabs, this is an insertion of tab-separated formulas.
Otherwise the text is inserted as the formula for the current cell.
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
+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
as symbols."
(if (not (and (derived-mode-p 'ses-mode)
(setq this-command 'yank))
(defun ses-yank-cells (text arg)
- "If the TEXT has a proper set of 'ses attributes, insert the text as
+ "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
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
;;Get key columns and sort them
(dotimes (x (- maxrow minrow -1))
(ses-goto-print (+ minrow x) sorter)
- (setq end (next-single-property-change (point) 'intangible))
+ (setq end (next-single-property-change (point) 'cursor-intangible))
(push (cons (buffer-substring-no-properties (point) end)
(+ minrow x))
keys))
(ses-is-cell-sym-p new-name)
(error "Already a cell name"))
(and (boundp new-name)
- (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? "
- new-name)))
+ (null (yes-or-no-p
+ (format-message
+ "`%S' is already bound outside this buffer, continue? "
+ new-name)))
(error "Already a bound cell name")))
(let* (curcell
(sym (if (ses-cell-p cell)
(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))
+ (set (make-local-variable new-name) (symbol-value sym))
(setf (ses-cell--symbol cell) new-name)
(makunbound sym)
(and curcell (setq ses--curcell new-name))
- (let* ((pos (point))
- (inhibit-read-only t)
- (col (current-column))
- (end (save-excursion
- (move-to-column (1+ col))
- (if (eolp)
- (+ pos (ses-col-width col) 1)
- (point)))))
- (put-text-property pos end 'intangible new-name))
- ;; update mode line
- (setq mode-line-process (list " cell "
- (symbol-name new-name)))
+ (save-excursion
+ (or curcell (ses-goto-print row col))
+ (let* ((pos (point))
+ (inhibit-read-only t)
+ (end (next-single-property-change pos 'cursor-intangible)))
+ (put-text-property pos end 'cursor-intangible new-name)))
+ ;; Update the cell name in the mode-line.
(force-mode-line-update)))
(defun ses-refresh-local-printer (name _compiled-value) ;FIXME: unused arg?
;;----------------------------------------------------------------------------
(defun ses--clean-! (&rest x)
- "Clean by `delq' list X from any occurrence of `nil' or `*skip*'."
+ "Clean by `delq' list X from any occurrence of nil or `*skip*'."
(delq nil (delq '*skip* x)))
(defun ses--clean-_ (x y)
- "Clean list X by replacing by Y any occurrence of `nil' or `*skip*'.
+ "Clean list X by replacing by Y any occurrence of nil or `*skip*'.
This will change X by making `setcar' on its cons cells."
(let ((ret x) ret-elt)
In the sequel we assume that cells A1, B1, A2 B2 have respective values
1 2 3 and 4.
-Readout direction is specified by a `>v', '`>^', `<v', `<^',
+Readout direction is specified by a `>v', `>^', `<v', `<^',
`v>', `v<', `^>', `^<' flag. For historical reasons, in absence
of such a flag, a default direction of `^<' is assumed. This
way `(ses-range A1 B2 ^>)' will evaluate to `(1 3 2 4)',
"Return ARGS reversed, with the blank elements (nil and *skip*) removed."
(let (result)
(dolist (cur args)
- (unless (memq cur '(nil *skip*))
+ (unless (memq cur '(nil *skip* *error*))
(push cur result)))
result))