X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e8757f091a502b858912a4c267210e009227d6e6..f1e06f7bffc1407f7e597f714b2969fc6d1d8eed:/lisp/ses.el?ds=sidebyside diff --git a/lisp/ses.el b/lisp/ses.el index 7cdac74e31..1626147dab 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1,6 +1,6 @@ ;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*- -;; Copyright (C) 2002-2012 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; Author: Jonathan Yavner ;; Maintainer: Vincent Belaïche @@ -67,6 +67,7 @@ "Simple Emacs Spreadsheet." :tag "SES" :group 'applications + :link '(custom-manual "(ses) Top") :prefix "ses-" :version "21.1") @@ -278,6 +279,7 @@ default printer and then modify its output.") ses--default-printer ses--deferred-narrow ses--deferred-recalc ses--deferred-write ses--file-format + ses--named-cell-hashmap (ses--header-hscroll . -1) ; Flag for "initial recalc needed" ses--header-row ses--header-string ses--linewidth ses--numcols ses--numrows ses--symbolic-formulas @@ -511,9 +513,22 @@ PROPERTY-NAME." `(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." - `(and (symbolp ,sym) (get ,sym 'ses-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." + `(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))) + (and rowcol + (if (eq rowcol :ses-named) + (and ses--named-cell-hashmap (gethash sym ses--named-cell-hashmap)) + (and (< (car rowcol) ses--numrows) + (< (cdr rowcol) ses--numcols) + (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym)))))) (defmacro ses-cell (sym value formula printer references) "Load a cell SYM from the spreadsheet file. Does not recompute VALUE from @@ -682,6 +697,27 @@ for this spreadsheet." "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) + "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a + canonical cell name. Does not save match data." + (let (case-fold-search) + (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str) + (let* ((col-str (match-string-no-properties 1 str)) + (col 0) + (col-base 1) + (col-idx (1- (length col-str))) + (row (1- (string-to-number (match-string-no-properties 2 str))))) + (and (>= row 0) + (progn + (while + (progn + (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) + (setq col (+ col col-base))))) + (cons row col))))))) + (defun ses-create-cell-variable-range (minrow maxrow mincol maxcol) "Create buffer-local variables for cells. This is undoable." (push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol) @@ -704,7 +740,11 @@ row and column of the cell, with numbering starting from 0. Return nil in case of failure." (unless (local-variable-p sym) (make-local-variable sym) - (put sym 'ses-cell (cons row col)))) + (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))) + (puthash sym (cons row col) ses--named-cell-hashmap)))) ;; We do not delete the ses-cell properties for the cell-variables, in ;; case a formula that refers to this cell is in the kill-ring and is @@ -1434,7 +1474,7 @@ 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 "\\`[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. @@ -1695,7 +1735,7 @@ Does not execute cell formulas or print functions." (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)))) + (let ((params (ignore-errors (read (current-buffer))))) (or (and (= (safe-length params) 3) (numberp (car params)) (numberp (cadr params)) @@ -1721,7 +1761,7 @@ Does not execute cell formulas or print functions." ;; 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)) @@ -1734,12 +1774,12 @@ Does not execute cell formulas or print functions." (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") + (or (looking-at-p "\n\n") (error "Missing blank line between rows"))) ;; Load global parameters. (let ((widths (read (current-buffer))) @@ -1765,8 +1805,8 @@ Does not execute cell formulas or print functions." (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 (replace-regexp-in-string "1" "[0-9]+" + ses-initial-global-parameters)) (error "Problem with column-defs or global-params")) ;; Check for overall newline count in definitions area. (forward-line 3) @@ -1847,13 +1887,39 @@ Delete overlays, remove special text properties." ;;;###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) @@ -2037,9 +2103,8 @@ Based on the current set of columns and `window-hscroll' position." (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 @@ -2678,8 +2743,9 @@ inserts a new row if at bottom of print area. Repeat COUNT times." ;; Cut and paste, import and export ;;---------------------------------------------------------------------------- -(defadvice copy-region-as-kill (around ses-copy-region-as-kill - activate preactivate) +(defun ses--advice-copy-region-as-kill (crak-fun beg end &rest args) + ;; FIXME: Why doesn't it make sense to copy read-only or + ;; intangible attributes? They're removed upon yank! "It doesn't make sense to copy read-only or intangible attributes into the kill ring. It probably doesn't make sense to copy keymap properties. We'll assume copying front-sticky properties doesn't make sense, either. @@ -2690,14 +2756,15 @@ hard to override how mouse-1 works." (let ((temp beg)) (setq beg end end temp))) - (if (not (and (eq major-mode 'ses-mode) + (if (not (and (derived-mode-p 'ses-mode) (eq (get-text-property beg 'read-only) 'ses) (eq (get-text-property (1- end) 'read-only) 'ses))) - ad-do-it ; Normal copy-region-as-kill. + (apply crak-fun beg end args) ; Normal copy-region-as-kill. (kill-new (ses-copy-region beg end)) (if transient-mark-mode (setq deactivate-mark t)) nil)) +(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 @@ -2747,7 +2814,7 @@ We clear the killed cells instead of deleting them." ;; 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)) @@ -2761,7 +2828,7 @@ We clear the killed cells instead of deleting them." (ses-clear-cell row col)) (ses-jump (car ses--curcell))) -(defadvice yank (around ses-yank activate preactivate) +(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 @@ -2779,9 +2846,9 @@ 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 as symbols." - (if (not (and (eq major-mode 'ses-mode) + (if (not (and (derived-mode-p 'ses-mode) (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) - ad-do-it ; Normal non-SES yank. + (apply yank-fun arg args) ; Normal non-SES yank. (ses-check-curcell 'end) (push-mark (point)) (let ((text (current-kill (cond @@ -2799,6 +2866,7 @@ as symbols." arg))) (if (consp arg) (exchange-point-and-mark)))) +(advice-add 'yank :around #'ses--advice-yank) (defun ses-yank-pop (arg) "Replace just-yanked stretch of killed text with a different stretch. @@ -2958,7 +3026,7 @@ spot, or error signal if user requests cancel." (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 @@ -2971,13 +3039,13 @@ spot, or error signal if user requests cancel." (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") @@ -3211,27 +3279,36 @@ highlighted range in the spreadsheet." (defun ses-rename-cell (new-name &optional cell) "Rename current cell." (interactive "*SEnter new name: ") - (and (local-variable-p new-name) - (ses-sym-rowcol new-name) - ;; this test is needed because ses-cell property of deleted cells - ;; is not deleted in case of subsequent undo - (memq new-name ses--renamed-cell-symb-list) - (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))) - (error "Already a bound cell name")) - (let* ((sym (if (ses-cell-p cell) + (or + (and (local-variable-p new-name) + (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))) + (error "Already a bound cell name"))) + (let* (curcell + (sym (if (ses-cell-p cell) (ses-cell-symbol cell) - (setq cell nil) + (setq cell nil + curcell t) (ses-check-curcell) ses--curcell)) (rowcol (ses-sym-rowcol sym)) (row (car rowcol)) - (col (cdr rowcol))) - (setq cell (or cell (ses-get-cell row col))) - (push `(ses-rename-cell ,(ses-cell-symbol cell) ,cell) buffer-undo-list) - (put new-name 'ses-cell rowcol) + (col (cdr rowcol)) + new-rowcol old-name) + (setq cell (or cell (ses-get-cell row col)) + old-name (ses-cell-symbol cell) + new-rowcol (ses-decode-cell-symbol (symbol-name new-name))) + (if new-rowcol + (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))) + (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 (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) @@ -3246,14 +3323,13 @@ highlighted range in the spreadsheet." (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) (ses-cell-references-aset xcell - (cons new-name (delq sym + (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) - (put sym 'ses-cell nil) (makunbound sym) - (setq sym new-name) + (and curcell (setq ses--curcell new-name)) (let* ((pos (point)) (inhibit-read-only t) (col (current-column)) @@ -3265,7 +3341,7 @@ highlighted range in the spreadsheet." (put-text-property pos end 'intangible new-name)) ;; update mode line (setq mode-line-process (list " cell " - (symbol-name sym))) + (symbol-name new-name))) (force-mode-line-update))) ;;---------------------------------------------------------------------------- @@ -3528,7 +3604,7 @@ current column and continues until the next nonblank column." 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")) @@ -3538,10 +3614,9 @@ current column and continues until the next nonblank column." (defun ses-unload-function () "Unload the Simple Emacs Spreadsheet." - (dolist (fun '(copy-region-as-kill yank)) - (ad-remove-advice fun 'around (intern (concat "ses-" (symbol-name fun)))) - (ad-update fun)) - ;; continue standard unloading + (advice-remove 'yank #'ses--advice-yank) + (advice-remove 'copy-region-as-kill #'ses--advice-copy-region-as-kill) + ;; Continue standard unloading. nil) (provide 'ses)