--- /dev/null
+;;;; ses.el -- Simple Emacs Spreadsheet
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Jonathan Yavner <jyavner@engineer.com>
+;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
+;; Keywords: spreadsheet
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; To-do list:
+;; * Do something about control characters & octal codes in cell print
+;; areas. Currently they distort the columnar appearance, but fixing them
+;; seems like too much work? Use text-char-description?
+;; * Input validation functions. How specified?
+;; * Menubar and popup menus.
+;; * Faces (colors & styles) in print cells.
+;; * Move a column by dragging its letter in the header line.
+;; * Left-margin column for row number.
+;; * Move a row by dragging its number in the left-margin.
+
+(require 'unsafep)
+
+
+;;;----------------------------------------------------------------------------
+;;;; User-customizable variables
+;;;----------------------------------------------------------------------------
+
+(defgroup ses nil
+ "Simple Emacs Spreadsheet"
+ :group 'applications
+ :prefix "ses-"
+ :version "21.1")
+
+(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))
+
+(defcustom ses-after-entry-functions '(forward-char)
+ "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)
+
+
+;;;----------------------------------------------------------------------------
+;;;; Global variables and constants
+;;;----------------------------------------------------------------------------
+
+(defvar ses-read-cell-history nil
+ "List of formulas that have been typed in.")
+
+(defvar ses-read-printer-history nil
+ "List of printer functions that have been typed in.")
+
+(defvar ses-mode-map nil
+ "Local keymap for Simple Emacs Spreadsheet.")
+
+(defvar ses-mode-print-map nil
+ "Local keymap for SES print area.")
+
+(defvar ses-mode-edit-map nil
+ "Local keymap for SES minibuffer cell-editing.")
+
+;Key map used for 'x' key.
+(defalias 'ses-export-keymap
+ (let ((map (make-sparse-keymap "SES export")))
+ (define-key map "T" (cons " tab-formulas" 'ses-export-tsf))
+ (define-key map "t" (cons " tab-values" 'ses-export-tsv))
+ map))
+
+(defconst ses-print-data-boundary "\n\014\n"
+ "Marker string denoting the boundary between print area and data area")
+
+(defconst ses-initial-global-parameters
+ "\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-file-trailer
+ ";;; Local Variables:\n;;; mode: ses\n;;; End:\n"
+ "Initial contents for the file-trailer area at the bottom of the file.")
+
+(defconst ses-initial-file-contents
+ (concat " \n" ;One blank cell in print area
+ ses-print-data-boundary
+ "(ses-cell A1 nil nil nil nil)\n" ;One blank cell in data area
+ "\n" ;End-of-row terminator for the one row in data area
+ "(ses-column-widths [7])\n"
+ "(ses-column-printers [nil])\n"
+ "(ses-default-printer \"%.7g\")\n"
+ "(ses-header-row 0)\n"
+ ses-initial-global-parameters
+ ses-initial-file-trailer)
+ "The initial contents of an empty spreadsheet.")
+
+(defconst ses-cell-size 4
+ "A cell consists of a SYMBOL, a FORMULA, a PRINTER-function, and a list of
+REFERENCES.")
+
+(defconst ses-paramlines-plist
+ '(column-widths 2 col-printers 3 default-printer 4 header-row 5
+ file-format 8 numrows 9 numcols 10)
+ "Offsets from last cell line to various parameter lines in the data area
+of a spreadsheet.")
+
+(defconst ses-box-prop '(:box (:line-width 2 :style released-button))
+ "Display properties to create a raised box for cells in the header line.")
+
+(defconst ses-standard-printer-functions
+ '(ses-center ses-center-span ses-dashfill ses-dashfill-span
+ ses-tildefill-span)
+ "List of print functions to be included in initial history of printer
+functions. None of these standard-printer functions 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.")
+
+(eval-and-compile
+ (defconst ses-localvars
+ '(blank-line cells col-printers column-widths curcell curcell-overlay
+ default-printer deferred-narrow deferred-recalc deferred-write
+ file-format header-hscroll header-row header-string linewidth
+ mode-line-process next-line-add-newlines numcols numrows
+ symbolic-formulas transient-mark-mode)
+ "Buffer-local variables used by SES."))
+
+;;When compiling, create all the buffer locals and give them values
+(eval-when-compile
+ (dolist (x ses-localvars)
+ (make-local-variable x)
+ (set x nil)))
+
+
+;;;
+;;; "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
+;;; think the make-local-variable trick above is cleaner).
+;;;
+
+(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-range' was changed--so both the formula's value and list of dependents
+need to be recalculated.")
+
+(defvar ses-call-printer-return nil
+ "Set to t if last cell printer invoked by `ses-call-printer' requested
+left-justification of the result. Set to error-signal if ses-call-printer
+encountered an error during printing. Nil otherwise.")
+
+(defvar ses-start-time nil
+ "Time when current operation started. Used by `ses-time-check' to decide
+when to emit a progress message.")
+
+
+;;;----------------------------------------------------------------------------
+;;;; Macros
+;;;----------------------------------------------------------------------------
+
+(defmacro ses-get-cell (row col)
+ "Return the cell structure that stores information about cell (ROW,COL)."
+ `(aref (aref cells ,row) ,col))
+
+(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))
+
+(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-printer (row &optional col)
+ "From a CELL or a pair (ROW,COL), get the function that prints its value."
+ `(aref ,(if col `(ses-get-cell ,row ,col) row) 2))
+
+(defmacro ses-cell-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-value (row &optional col)
+ "From a CELL or a pair (ROW,COL), get the current value for that cell."
+ `(symbol-value (ses-cell-symbol ,row ,col)))
+
+(defmacro ses-col-width (col)
+ "Return the width for column COL."
+ `(aref column-widths ,col))
+
+(defmacro ses-col-printer (col)
+ "Return the default printer for column COL."
+ `(aref 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)))
+
+(defmacro 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."
+ (let ((rowcol (ses-sym-rowcol sym)))
+ (ses-formula-record formula)
+ (ses-printer-record printer)
+ (or (atom formula)
+ (eq safe-functions t)
+ (setq formula `(ses-safe-formula ,formula)))
+ (or (not printer)
+ (stringp printer)
+ (eq safe-functions t)
+ (setq printer `(ses-safe-printer ,printer)))
+ (aset (aref cells (car rowcol))
+ (cdr rowcol)
+ (vector sym formula printer references)))
+ (set sym value)
+ sym)
+
+(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."
+ (or (and (vectorp widths) (= (length widths) numcols))
+ (error "Bad column-width vector"))
+ ;;To save time later, we also calculate the total width of each line in the
+ ;;print area (excluding the terminating newline)
+ (setq column-widths widths
+ linewidth (apply '+ -1 (mapcar '1+ widths))
+ blank-line (concat (make-string linewidth ? ) "\n"))
+ t)
+
+(defmacro ses-column-printers (printers)
+ "Load the vector of column printers from the spreadsheet file and checks
+them for safety. This is a macro to prevent propagate-on-load viruses."
+ (or (and (vectorp printers) (= (length printers) numcols))
+ (error "Bad column-printers vector"))
+ (dotimes (x numcols)
+ (aset printers x (ses-safe-printer (aref printers x))))
+ (setq col-printers printers)
+ (mapc 'ses-printer-record printers)
+ t)
+
+(defmacro ses-default-printer (def)
+ "Load the global default printer from the spreadsheet file and checks it
+for safety. This is a macro to prevent propagate-on-load viruses."
+ (setq 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
+for safety. This is a macro to prevent propagate-on-load viruses."
+ (or (and (wholenump row) (< row numrows))
+ (error "Bad header-row"))
+ (setq header-row row)
+ t)
+
+(defmacro ses-dotimes-msg (spec msg &rest body)
+ "(ses-dotimes-msg (VAR LIMIT) MSG BODY...): Like `dotimes', but
+a message is emitted using MSG every second or so during the loop."
+ (let ((msgvar (make-symbol "msg"))
+ (limitvar (make-symbol "limit"))
+ (var (car spec))
+ (limit (cadr spec)))
+ `(let ((,limitvar ,limit)
+ (,msgvar ,msg))
+ (setq ses-start-time (float-time))
+ (message ,msgvar)
+ (setq ,msgvar (concat ,msgvar " (%d%%)"))
+ (dotimes (,var ,limitvar)
+ (ses-time-check ,msgvar '(/ (* ,var 100) ,limitvar))
+ ,@body)
+ (message nil))))
+
+(put 'ses-dotimes-msg 'lisp-indent-function 2)
+(def-edebug-spec ses-dotimes-msg ((symbolp form) form body))
+
+(defmacro ses-dorange (curcell &rest body)
+ "Execute BODY repeatedly, with the variables `row' and `col' set to each
+cell in the range specified by CURCELL. The range is available in the
+variables `minrow', `maxrow', `mincol', and `maxcol'."
+ (let ((cur (make-symbol "cur"))
+ (min (make-symbol "min"))
+ (max (make-symbol "max"))
+ (r (make-symbol "r"))
+ (c (make-symbol "c")))
+ `(let* ((,cur ,curcell)
+ (,min (ses-sym-rowcol (if (consp ,cur) (car ,cur) ,cur)))
+ (,max (ses-sym-rowcol (if (consp ,cur) (cdr ,cur) ,cur))))
+ (let ((minrow (car ,min))
+ (maxrow (car ,max))
+ (mincol (cdr ,min))
+ (maxcol (cdr ,max))
+ row col)
+ (if (or (> minrow maxrow) (> mincol maxcol))
+ (error "Empty range"))
+ (dotimes (,r (- maxrow minrow -1))
+ (setq row (+ ,r minrow))
+ (dotimes (,c (- maxcol mincol -1))
+ (setq col (+ ,c mincol))
+ ,@body))))))
+
+(put 'ses-dorange 'lisp-indent-function 'defun)
+(def-edebug-spec ses-dorange (form body))
+
+;;Support for coverage testing.
+(defmacro 1value (form)
+ "For code-coverage testing, indicate that FORM is expected to always have
+the same value."
+ form)
+(defmacro noreturn (form)
+ "For code-coverage testing, indicate that FORM will always signal an error."
+ form)
+
+
+;;;----------------------------------------------------------------------------
+;;;; Utility functions
+;;;----------------------------------------------------------------------------
+
+(defun ses-vector-insert (array idx new)
+ "Create a new vector which is one larger than ARRAY and has NEW inserted
+before element IDX."
+ (let* ((len (length array))
+ (result (make-vector (1+ len) new)))
+ (dotimes (x len)
+ (aset result
+ (if (< x idx) x (1+ x))
+ (aref array x)))
+ result))
+
+;;Allow ARRAY to be a symbol for use in buffer-undo-list
+(defun ses-vector-delete (array idx count)
+ "Create a new vector which is a copy of ARRAY with COUNT objects removed
+starting at element IDX. ARRAY is either a vector or a symbol whose value
+is a vector--if a symbol, the new vector is assigned as the symbol's value."
+ (let* ((a (if (arrayp array) array (symbol-value array)))
+ (len (- (length a) count))
+ (result (make-vector len nil)))
+ (dotimes (x len)
+ (aset result x (aref a (if (< x idx) x (+ x count)))))
+ (if (symbolp array)
+ (set array result))
+ result))
+
+(defun ses-delete-line (count)
+ "Like `kill-line', but no kill ring."
+ (let ((pos (point)))
+ (forward-line count)
+ (delete-region pos (point))))
+
+(defun ses-printer-validate (printer)
+ "Signals an error if PRINTER is not a valid SES cell printer."
+ (or (not printer)
+ (stringp printer)
+ (functionp printer)
+ (and (stringp (car-safe printer)) (not (cdr printer)))
+ (error "Invalid printer function"))
+ printer)
+
+(defun ses-printer-record (printer)
+ "Add PRINTER to `ses-read-printer-history' if not already there, after first
+checking that it is a valid printer function."
+ (ses-printer-validate printer)
+ ;;To speed things up, we avoid calling prin1 for the very common "nil" case.
+ (if printer
+ (add-to-list 'ses-read-printer-history (prin1-to-string printer))))
+
+(defun ses-formula-record (formula)
+ "If FORMULA is of the form 'symbol, adds it to the list of symbolic formulas
+for this spreadsheet."
+ (when (and (eq (car-safe formula) 'quote)
+ (symbolp (cadr formula)))
+ (add-to-list 'symbolic-formulas
+ (list (symbol-name (cadr formula))))))
+
+(defun ses-column-letter (col)
+ "Converts a column number to A..Z or AA..ZZ"
+ (if (< col 26)
+ (char-to-string (+ ?A col))
+ (string (+ ?@ (/ col 26)) (+ ?A (% col 26)))))
+
+(defun ses-create-cell-symbol (row col)
+ "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-create-cell-variable-range (minrow maxrow mincol maxcol)
+ "Create buffer-local variables for cells. This is undoable."
+ (push `(ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
+ buffer-undo-list)
+ (let (sym xrow xcol)
+ (dotimes (row (1+ (- maxrow minrow)))
+ (dotimes (col (1+ (- maxcol mincol)))
+ (setq xrow (+ row minrow)
+ xcol (+ col mincol)
+ sym (ses-create-cell-symbol xrow xcol))
+ (put sym 'ses-cell (cons xrow xcol))
+ (make-local-variable sym)))))
+
+;;;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 later pasted
+;;;back in.
+(defun ses-destroy-cell-variable-range (minrow maxrow mincol maxcol)
+ "Destroy buffer-local variables for cells. This is undoable."
+ (let (sym)
+ (dotimes (row (1+ (- maxrow minrow)))
+ (dotimes (col (1+ (- maxcol mincol)))
+ (setq sym (ses-create-cell-symbol (+ row minrow) (+ col mincol)))
+ (if (boundp sym)
+ (push `(ses-set-with-undo ,sym ,(symbol-value sym))
+ buffer-undo-list))
+ (kill-local-variable sym))))
+ (push `(ses-create-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
+ buffer-undo-list))
+
+(defun ses-reset-header-string ()
+ "Flags the header string for update. Upon undo, the header string will be
+updated again."
+ (push '(ses-reset-header-string) buffer-undo-list)
+ (setq header-hscroll -1))
+
+;;Split this code off into a function to avoid coverage-testing difficulties
+(defun ses-time-check (format arg)
+ "If `ses-start-time' is more than a second ago, call `message' with FORMAT
+and (eval ARG) and reset `ses-start-time' to the current time."
+ (when (> (- (float-time) ses-start-time) 1.0)
+ (message format (eval arg))
+ (setq ses-start-time (float-time)))
+ nil)
+
+
+;;;----------------------------------------------------------------------------
+;;;; The cells
+;;;----------------------------------------------------------------------------
+
+(defun 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 '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 enqueues the cell for
+recalculation via `post-command-hook'. Updates the reference lists for the
+cells that this cell refers to. Does not update cell value or reprint the
+cell. To avoid inconsistencies, this function is not interruptible, which
+means Emacs will crash if FORMULA contains a circular list."
+ (let* ((cell (ses-get-cell row col))
+ (old (ses-cell-formula cell)))
+ (let ((sym (ses-cell-symbol cell))
+ (oldref (ses-formula-references old))
+ (newref (ses-formula-references formula))
+ (inhibit-quit t)
+ x xrow xcol)
+ (add-to-list 'deferred-recalc sym)
+ ;;Delete old references from this cell. Skip the ones that are also
+ ;;in the new list.
+ (dolist (ref oldref)
+ (unless (memq ref newref)
+ (setq x (ses-sym-rowcol ref)
+ xrow (car x)
+ xcol (cdr x))
+ (ses-set-cell xrow xcol 'references
+ (delq sym (ses-cell-references xrow xcol)))))
+ ;;Add new ones. Skip ones left over from old list
+ (dolist (ref newref)
+ (setq x (ses-sym-rowcol ref)
+ xrow (car x)
+ xcol (cdr x)
+ x (ses-cell-references xrow xcol))
+ (or (memq sym x)
+ (ses-set-cell xrow xcol 'references (cons sym x))))
+ (ses-formula-record formula)
+ (ses-set-cell row col 'formula formula))))
+
+(defun ses-calculate-cell (row col force)
+ "Calculate and print the value for cell (ROW,COL) using the cell's formula
+function and print functions, if any. Result is nil for normal operation, or
+the error signal if the formula or print function failed. The old value is
+left unchanged if it was *skip* and the new value is nil.
+ Any cells that depend on this cell are queued for update after the end of
+processing for the current keystroke, unless the new value is the same as
+the old and FORCE is nil."
+ (let ((cell (ses-get-cell row col))
+ formula-error printer-error)
+ (let ((symbol (ses-cell-symbol cell))
+ (oldval (ses-cell-value cell))
+ (formula (ses-cell-formula cell))
+ newval)
+ (if (eq (car-safe formula) 'ses-safe-formula)
+ (ses-set-cell row col 'formula (ses-safe-formula (cadr formula))))
+ (condition-case sig
+ (setq newval (eval formula))
+ (error
+ (setq formula-error sig
+ newval '*error*)))
+ (if (and (not newval) (eq oldval '*skip*))
+ ;;Don't lose the *skip* - previous field spans this one
+ (setq newval '*skip*))
+ (when (or force (not (eq newval oldval)))
+ (add-to-list 'deferred-write (cons row col)) ;In case force=t
+ (ses-set-cell row col 'value newval)
+ (dolist (ref (ses-cell-references cell))
+ (add-to-list 'deferred-recalc ref))))
+ (setq printer-error (ses-print-cell row col))
+ (or formula-error printer-error)))
+
+(defun ses-clear-cell (row col)
+ "Delete formula and printer for cell (ROW,COL)."
+ (ses-set-cell row col 'printer nil)
+ (ses-cell-set-formula row col nil))
+
+(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 if FORCE is nil."
+ (let ((deferred-recalc list)
+ (nextlist list)
+ (pos (point))
+ curlist prevlist rowcol formula)
+ (with-temp-message " "
+ (while (and deferred-recalc (not (equal nextlist prevlist)))
+ ;;In each loop, recalculate cells that refer only to other cells that
+ ;;have already been recalculated or aren't in the recalculation
+ ;;region. Repeat until all cells have been processed or until the
+ ;;set of cells being worked on stops changing.
+ (if prevlist
+ (message "Recalculating... (%d cells left)"
+ (length deferred-recalc)))
+ (setq curlist deferred-recalc
+ deferred-recalc nil
+ prevlist nextlist)
+ (while curlist
+ (setq rowcol (ses-sym-rowcol (car curlist))
+ formula (ses-cell-formula (car rowcol) (cdr rowcol)))
+ (or (catch 'ref
+ (dolist (ref (ses-formula-references formula))
+ (when (or (memq ref curlist)
+ (memq ref deferred-recalc))
+ ;;This cell refers to another that isn't done yet
+ (add-to-list 'deferred-recalc (car curlist))
+ (throw 'ref t))))
+ ;;ses-update-cells is called from post-command-hook, so
+ ;;inhibit-quit is implicitly bound to t.
+ (when quit-flag
+ ;;Abort the recalculation. User will probably undo now.
+ (error "Quit"))
+ (ses-calculate-cell (car rowcol) (cdr rowcol) force))
+ (setq curlist (cdr curlist)))
+ (dolist (ref deferred-recalc)
+ (add-to-list 'nextlist ref))
+ (setq nextlist (sort (copy-sequence nextlist) 'string<))
+ (if (equal nextlist prevlist)
+ ;;We'll go around the loop one more time.
+ (add-to-list 'nextlist t)))
+ (when deferred-recalc
+ ;;Just couldn't finish these
+ (dolist (x deferred-recalc)
+ (let ((rowcol (ses-sym-rowcol x)))
+ (ses-set-cell (car rowcol) (cdr rowcol) 'value '*error*)
+ (1value (ses-print-cell (car rowcol) (cdr rowcol)))))
+ (error "Circular references: %s" deferred-recalc))
+ (message " "))
+ ;;Can't use save-excursion here: if the cell under point is
+ ;;updated, save-excusion's marker will move past the cell.
+ (goto-char pos)))
+
+
+;;;----------------------------------------------------------------------------
+;;;; The print area
+;;;----------------------------------------------------------------------------
+
+;;;We turn off point-motion-hooks and explicitly position the cursor, in case
+;;;the intangible properties have gotten screwed up (e.g., when
+;;;ses-goto-print 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))
+ (goto-char 1)
+ (forward-line row)
+ (dotimes (c col)
+ (forward-char (1+ (ses-col-width c))))))
+
+(defun ses-set-curcell ()
+ "Sets `curcell' to the current cell symbol, or a cons (BEG,END) for a
+region, or nil if cursor is not at a cell."
+ (if (or (not mark-active)
+ deactivate-mark
+ (= (region-beginning) (region-end)))
+ ;;Single cell
+ (setq curcell (get-text-property (point) 'intangible))
+ ;;Range
+ (let ((bcell (get-text-property (region-beginning) 'intangible))
+ (ecell (get-text-property (1- (region-end)) 'intangible)))
+ (setq curcell (if (and bcell ecell)
+ (cons bcell ecell)
+ nil))))
+ nil)
+
+(defun ses-check-curcell (&rest args)
+ "Signal an error if 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 curcell t)
+ ;;curcell recalculation was postponed, but user typed ahead
+ (ses-set-curcell))
+ (cond
+ ((not curcell)
+ (or (memq 'end args)
+ (error "Not at cell")))
+ ((consp curcell)
+ (or (memq 'range args)
+ (memq 'needrange args)
+ (error "Can't use a range")))
+ ((memq 'needrange args)
+ (error "Need a range"))))
+
+(defun ses-print-cell (row col)
+ "Format and print the value of cell (ROW,COL) to the print area, using the
+cell's printer function. If the cell's new print form is too wide, it will
+spill over into the following cell, but will not run off the end of the row
+or overwrite the next non-nil field. Result is nil for normal operation, or
+the error signal if the printer function failed and the cell was formatted
+with \"%s\". If the cell's value is *skip*, nothing is printed because the
+preceding cell has spilled over."
+ (catch 'ses-print-cell
+ (let* ((cell (ses-get-cell row col))
+ (value (ses-cell-value cell))
+ (printer (ses-cell-printer cell))
+ (maxcol (1+ col))
+ text sig startpos x)
+ ;;Create the string to print
+ (cond
+ ((eq value '*skip*)
+ ;;Don't print anything
+ (throw 'ses-print-cell nil))
+ ((eq value '*error*)
+ (setq text (make-string (ses-col-width col) ?#)))
+ (t
+ ;;Deferred safety-check on printer
+ (if (eq (car-safe printer) 'ses-safe-printer)
+ (ses-set-cell row col 'printer
+ (setq printer (ses-safe-printer (cadr printer)))))
+ ;;Print the value
+ (setq text (ses-call-printer (or printer
+ (ses-col-printer col)
+ default-printer)
+ value))
+ (if (consp ses-call-printer-return)
+ ;;Printer returned an error
+ (setq sig ses-call-printer-return))))
+ ;;Adjust print width to match column width
+ (let ((width (ses-col-width col))
+ (len (length text)))
+ (cond
+ ((< len width)
+ ;;Fill field to length with spaces
+ (setq len (make-string (- width len) ? )
+ text (if (eq ses-call-printer-return t)
+ (concat text len)
+ (concat len text))))
+ ((> len width)
+ ;;Spill over into following cells, if possible
+ (let ((maxwidth width))
+ (while (and (> len maxwidth)
+ (< maxcol numcols)
+ (or (not (setq x (ses-cell-value row maxcol)))
+ (eq x '*skip*)))
+ (unless x
+ ;;Set this cell to '*skip* so it won't overwrite our spillover
+ (ses-set-cell row maxcol 'value '*skip*))
+ (setq maxwidth (+ maxwidth (ses-col-width maxcol) 1)
+ maxcol (1+ maxcol)))
+ (if (<= len maxwidth)
+ ;;Fill to complete width of all the fields spanned
+ (setq text (concat text (make-string (- maxwidth len) ? )))
+ ;;Not enough room to end of line or next non-nil field. Truncate
+ ;;if string; otherwise fill with error indicator
+ (setq sig `(error "Too wide" ,text))
+ (if (stringp value)
+ (setq text (substring text 0 maxwidth))
+ (setq text (make-string maxwidth ?#))))))))
+ ;;Substitute question marks for tabs and newlines. Newlines are
+ ;;used as row-separators; tabs could confuse the reimport logic.
+ (setq text (replace-regexp-in-string "[\t\n]" "?" text))
+ (ses-goto-print row col)
+ (setq startpos (point))
+ ;;Install the printed result. This is not interruptible.
+ (let ((inhibit-read-only t)
+ (inhibit-quit t))
+ (delete-char (1+ (length text)))
+ ;;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 numcols) " " "\n")))
+ ;;We use set-text-properties to prevent a wacky print function
+ ;;from inserting rogue properties, and to ensure that the keymap
+ ;;property is inherited (is it a bug that only unpropertied strings
+ ;;actually inherit from surrounding text?)
+ (set-text-properties 0 (length x) nil x)
+ (insert-and-inherit x)
+ (put-text-property startpos (point) 'intangible
+ (ses-cell-symbol cell))
+ (when (and (zerop row) (zerop col))
+ ;;Reconstruct special beginning-of-buffer attributes
+ (put-text-property 1 (point) 'keymap 'ses-mode-print-map)
+ (put-text-property 1 (point) 'read-only 'ses)
+ (put-text-property 1 2 'front-sticky t)))
+ (if (= row (1- header-row))
+ ;;This line is part of the header - force recalc
+ (ses-reset-header-string))
+ ;;If this cell (or a preceding one on the line) previously spilled over
+ ;;and has gotten shorter, redraw following cells on line recursively.
+ (when (and (< maxcol numcols) (eq (ses-cell-value row maxcol) '*skip*))
+ (ses-set-cell row maxcol 'value nil)
+ (ses-print-cell row maxcol))
+ ;;Return to start of cell
+ (goto-char startpos)
+ sig)))
+
+(defun ses-call-printer (printer &optional value)
+ "Invokes PRINTER (a string or parenthesized string or function-symbol or
+lambda of one argument) on VALUE. Result is the the printed cell as a
+string. The variable `ses-call-printer-return' is set to t if the printer
+used parenthesis to request left-justification, or the error-signal if the
+printer signalled one (and \"%s\" is used as the default printer), else nil."
+ (setq ses-call-printer-return nil)
+ (unless value
+ (setq value ""))
+ (condition-case signal
+ (cond
+ ((stringp printer)
+ (format printer value))
+ ((stringp (car-safe printer))
+ (setq ses-call-printer-return t)
+ (format (car printer) value))
+ (t
+ (setq value (funcall printer value))
+ (if (stringp value)
+ value
+ (or (stringp (car-safe value))
+ (error "Printer should return \"string\" or (\"string\")"))
+ (setq ses-call-printer-return t)
+ (car value))))
+ (error
+ (setq ses-call-printer-return signal)
+ (prin1-to-string value t))))
+
+(defun ses-adjust-print-width (col change)
+ "Insert CHANGE spaces in front of column COL, or at end of line if
+COL=NUMCOLS. Deletes characters if CHANGE < 0. Caller should bind
+inhibit-quit to t."
+ (let ((inhibit-read-only t)
+ (blank (if (> change 0) (make-string change ? )))
+ (at-end (= col numcols)))
+ (ses-set-with-undo 'linewidth (+ linewidth change))
+ ;;ses-set-with-undo always returns t for strings.
+ (1value (ses-set-with-undo 'blank-line
+ (concat (make-string linewidth ? ) "\n")))
+ (dotimes (row numrows)
+ (ses-goto-print row col)
+ (when at-end
+ ;;Insert new columns before newline
+ (let ((inhibit-point-motion-hooks t))
+ (backward-char 1)))
+ (if blank
+ (insert blank)
+ (delete-char (- change))))))
+
+(defun ses-print-cell-new-width (row col)
+ "Same as ses-print-cell, except if the cell's value is *skip*, the preceding
+nonskipped cell is reprinted. This function is used when the width of
+cell (ROW,COL) has changed."
+ (if (not (eq (ses-cell-value row col) '*skip*))
+ (ses-print-cell row col)
+ ;;Cell was skipped over - reprint previous
+ (ses-goto-print row col)
+ (backward-char 1)
+ (let ((rowcol (ses-sym-rowcol (get-text-property (point) 'intangible))))
+ (ses-print-cell (car rowcol) (cdr rowcol)))))
+
+
+;;;----------------------------------------------------------------------------
+;;;; The data area
+;;;----------------------------------------------------------------------------
+
+(defun ses-goto-data (def &optional col)
+ "Move point to data area for (DEF,COL). If DEF is a row number, COL is the
+column number for a data cell -- otherwise DEF is one of the symbols
+column-widths, col-printers, default-printer, numrows, or numcols."
+ (if (< (point-max) (buffer-size))
+ (setq deferred-narrow t))
+ (widen)
+ (let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong
+ (goto-char 1)
+ (if col
+ ;;It's a cell
+ (forward-line (+ numrows 2 (* def (1+ numcols)) col))
+ ;;Convert def-symbol to offset
+ (setq def (plist-get ses-paramlines-plist def))
+ (or def (signal 'args-out-of-range nil))
+ (forward-line (+ (* numrows (+ numcols 2)) def)))))
+
+(defun ses-set-parameter (def value &optional elem)
+ "Sets parameter DEF to VALUE (with undo) and writes the value to the data
+area. See `ses-goto-data' for meaning of DEF. Newlines in the data
+are escaped. If ELEM is specified, it is the array subscript within DEF to
+be set to VALUE."
+ (save-excursion
+ ;;We call ses-goto-data early, using the old values of numrows and
+ ;;numcols in case one of them is being changed.
+ (ses-goto-data def)
+ (if elem
+ (ses-aset-with-undo (symbol-value def) elem value)
+ (ses-set-with-undo def value))
+ (let ((inhibit-read-only t)
+ (fmt (plist-get '(column-widths "(ses-column-widths %S)"
+ col-printers "(ses-column-printers %S)"
+ default-printer "(ses-default-printer %S)"
+ header-row "(ses-header-row %S)"
+ file-format " %S ;SES file-format"
+ numrows " %S ;numrows"
+ numcols " %S ;numcols")
+ def)))
+ (delete-region (point) (line-end-position))
+ (insert (format fmt (symbol-value def))))))
+
+(defun ses-write-cells ()
+ "`deferred-write' is a list of (ROW,COL) for cells to be written from
+buffer-local variables to data area. Newlines in the data are escaped."
+ (let* ((inhibit-read-only t)
+ (print-escape-newlines t)
+ rowcol row col cell sym formula printer text)
+ (setq ses-start-time (float-time))
+ (with-temp-message " "
+ (save-excursion
+ (while deferred-write
+ (ses-time-check "Writing... (%d cells left)"
+ '(length deferred-write))
+ (setq rowcol (pop deferred-write)
+ row (car rowcol)
+ col (cdr rowcol)
+ cell (ses-get-cell row col)
+ sym (ses-cell-symbol cell)
+ formula (ses-cell-formula cell)
+ printer (ses-cell-printer cell))
+ (if (eq (car-safe formula) 'ses-safe-formula)
+ (setq formula (cadr formula)))
+ (if (eq (car-safe printer) 'ses-safe-printer)
+ (setq printer (cadr printer)))
+ ;;This is noticably 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)
+ " ")
+ ")"))
+ ")"))
+ (ses-goto-data row col)
+ (delete-region (point) (line-end-position))
+ (insert text)))
+ (message " "))))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Formula relocation
+;;;----------------------------------------------------------------------------
+
+(defun ses-formula-references (formula &optional result-so-far)
+ "Produce a list of symbols for cells that this formula's value
+refers to. For recursive calls, RESULT-SO-FAR is the list being constructed,
+or t to get a wrong-type-argument error when the first reference is found."
+ (if (atom formula)
+ (if (ses-sym-rowcol formula)
+ ;;Entire formula is one symbol
+ (add-to-list 'result-so-far formula)
+ ) ;;Ignore other atoms
+ (dolist (cur formula)
+ (cond
+ ((ses-sym-rowcol cur)
+ ;;Save this reference
+ (add-to-list 'result-so-far cur))
+ ((eq (car-safe cur) 'ses-range)
+ ;;All symbols in range are referenced
+ (dolist (x (cdr (macroexpand cur)))
+ (add-to-list 'result-so-far x)))
+ ((and (consp cur) (not (eq (car cur) 'quote)))
+ ;;Recursive call for subformulas
+ (setq result-so-far (ses-formula-references cur result-so-far)))
+ (t
+ ;;Ignore other stuff
+ ))))
+ result-so-far)
+
+(defun ses-relocate-formula (formula startrow startcol rowincr colincr)
+ "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)
+ => (+ 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)
+ => (+ A1 C3)
+Sets `ses-relocate-return' to 'delete if cell-references were removed."
+ (let (rowcol result)
+ (if (or (atom formula) (eq (car formula) 'quote))
+ (if (setq rowcol (ses-sym-rowcol formula))
+ (ses-relocate-symbol formula rowcol
+ startrow startcol rowincr colincr)
+ formula) ;Pass through as-is
+ (dolist (cur formula)
+ (setq rowcol (ses-sym-rowcol cur))
+ (cond
+ (rowcol
+ (setq cur (ses-relocate-symbol cur rowcol
+ startrow startcol rowincr colincr))
+ (if cur
+ (push cur result)
+ ;;Reference to a deleted cell. Set a flag in ses-relocate-return.
+ ;;don't change the flag if it's already 'range, since range
+ ;;implies 'delete.
+ (unless ses-relocate-return
+ (setq ses-relocate-return 'delete))))
+ ((eq (car-safe cur) 'ses-range)
+ (setq cur (ses-relocate-range cur startrow startcol rowincr colincr))
+ (if cur
+ (push cur result)))
+ ((or (atom cur) (eq (car cur) 'quote))
+ ;;Constants pass through unchanged
+ (push cur result))
+ (t
+ ;;Recursively copy and alter subformulas
+ (push (ses-relocate-formula cur startrow startcol
+ rowincr colincr)
+ result))))
+ (nreverse result))))
+
+(defun ses-relocate-symbol (sym rowcol startrow startcol rowincr colincr)
+ "Relocate one symbol SYM, whichs corresponds to ROWCOL (a cons of ROW and
+COL). Cells starting at (STARTROW,STARTCOL) are being shifted
+by (ROWINCR,COLINCR)."
+ (let ((row (car rowcol))
+ (col (cdr rowcol)))
+ (if (or (< row startrow) (< col startcol))
+ sym
+ (setq row (+ row rowincr)
+ col (+ col colincr))
+ (if (and (>= row startrow) (>= col startcol)
+ (< row numrows) (< col numcols))
+ ;;Relocate this variable
+ (ses-create-cell-symbol row col)
+ ;;Delete reference to a deleted cell
+ nil))))
+
+(defun ses-relocate-range (range startrow startcol rowincr colincr)
+ "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,
+the new rows/columns will be added to the range. Sets `ses-relocate-return'
+if the range was altered."
+ (let* ((minorig (cadr range))
+ (minrowcol (ses-sym-rowcol minorig))
+ (min (ses-relocate-symbol minorig minrowcol
+ startrow startcol
+ rowincr colincr))
+ (maxorig (nth 2 range))
+ (maxrowcol (ses-sym-rowcol maxorig))
+ (max (ses-relocate-symbol maxorig maxrowcol
+ startrow startcol
+ rowincr colincr))
+ field)
+ (cond
+ ((and (not min) (not max))
+ (setq range nil)) ;;The entire range is deleted
+ ((zerop colincr)
+ ;;Inserting or deleting rows
+ (setq field 'car)
+ (if (not min)
+ ;;Chopped off beginning of range
+ (setq min (ses-create-cell-symbol startrow (cdr minrowcol))
+ ses-relocate-return 'range))
+ (if (not max)
+ (if (> rowincr 0)
+ ;;Trying to insert a nonexistent row
+ (setq max (ses-create-cell-symbol (1- numrows) (cdr minrowcol)))
+ ;;End of range is being deleted
+ (setq max (ses-create-cell-symbol (1- startrow) (cdr minrowcol))
+ ses-relocate-return 'range))
+ (and (> rowincr 0)
+ (= (car maxrowcol) (1- startrow))
+ (= (cdr minrowcol) (cdr maxrowcol))
+ ;;Insert after ending row of vertical range - include it
+ (setq max (ses-create-cell-symbol (+ startrow rowincr -1)
+ (cdr maxrowcol))))))
+ (t
+ ;;Inserting or deleting columns
+ (setq field 'cdr)
+ (if (not min)
+ ;;Chopped off beginning of range
+ (setq min (ses-create-cell-symbol (car minrowcol) startcol)
+ ses-relocate-return 'range))
+ (if (not max)
+ (if (> colincr 0)
+ ;;Trying to insert a nonexistent column
+ (setq max (ses-create-cell-symbol (car maxrowcol) (1- numcols)))
+ ;;End of range is being deleted
+ (setq max (ses-create-cell-symbol (car maxrowcol) (1- startcol))
+ ses-relocate-return 'range))
+ (and (> colincr 0)
+ (= (cdr maxrowcol) (1- startcol))
+ (= (car minrowcol) (car maxrowcol))
+ ;;Insert after ending column of horizontal range - include it
+ (setq max (ses-create-cell-symbol (car maxrowcol)
+ (+ startcol colincr -1)))))))
+ (when range
+ (if (/= (- (funcall field maxrowcol)
+ (funcall field minrowcol))
+ (- (funcall field (ses-sym-rowcol max))
+ (funcall field (ses-sym-rowcol min))))
+ ;;This range has changed size
+ (setq ses-relocate-return 'range))
+ (list 'ses-range min max))))
+
+(defun ses-relocate-all (minrow mincol rowincr colincr)
+ "Alter all cell values, symbols, formulas, and reference-lists to relocate
+the rectangle (MINROW,MINCOL)..(NUMROWS,NUMCOLS) by adding ROWINCR and COLINCR
+to each symbol."
+ (let (reform)
+ (let (mycell newval)
+ (ses-dotimes-msg (row numrows) "Relocating formulas..."
+ (dotimes (col numcols)
+ (setq ses-relocate-return nil
+ mycell (ses-get-cell row col)
+ newval (ses-relocate-formula (ses-cell-formula mycell)
+ minrow mincol rowincr colincr))
+ (ses-set-cell row col 'formula newval)
+ (if (eq ses-relocate-return 'range)
+ ;;This cell contains a (ses-range X Y) where a cell has been
+ ;;inserted or deleted in the middle of the range.
+ (push (cons row col) reform))
+ (if ses-relocate-return
+ ;;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 'deferred-recalc
+ (ses-create-cell-symbol row col)))
+ (setq newval (ses-relocate-formula (ses-cell-references mycell)
+ minrow mincol rowincr colincr))
+ (ses-set-cell row col 'references newval)
+ (and (>= row minrow) (>= col mincol)
+ (ses-set-cell row col 'symbol
+ (ses-create-cell-symbol row col))))))
+ ;;Relocate the cell values
+ (let (oldval myrow mycol xrow xcol)
+ (cond
+ ((and (<= rowincr 0) (<= colincr 0))
+ ;;Deletion of rows and/or columns
+ (ses-dotimes-msg (row (- numrows minrow)) "Relocating variables..."
+ (setq myrow (+ row minrow))
+ (dotimes (col (- numcols mincol))
+ (setq mycol (+ col mincol)
+ xrow (- myrow rowincr)
+ xcol (- mycol colincr))
+ (if (and (< xrow numrows) (< xcol numcols))
+ (setq oldval (ses-cell-value xrow xcol))
+ ;;Cell is off the end of the array
+ (setq oldval (symbol-value (ses-create-cell-symbol xrow xcol))))
+ (ses-set-cell myrow mycol 'value oldval))))
+ ((and (wholenump rowincr) (wholenump colincr))
+ ;;Insertion of rows and/or columns. Run the loop backwards.
+ (let ((disty (1- numrows))
+ (distx (1- numcols))
+ myrow mycol)
+ (ses-dotimes-msg (row (- numrows minrow)) "Relocating variables..."
+ (setq myrow (- disty row))
+ (dotimes (col (- numcols mincol))
+ (setq mycol (- distx col)
+ xrow (- myrow rowincr)
+ xcol (- mycol colincr))
+ (if (or (< xrow minrow) (< xcol mincol))
+ ;;Newly-inserted value
+ (setq oldval nil)
+ ;;Transfer old value
+ (setq oldval (ses-cell-value xrow xcol)))
+ (ses-set-cell myrow mycol 'value oldval)))
+ t)) ;Make testcover happy by returning non-nil here
+ (t
+ (error "ROWINCR and COLINCR must have the same sign"))))
+ ;;Reconstruct reference lists for cells that contain ses-ranges that
+ ;;have changed size.
+ (when reform
+ (message "Fixing ses-ranges...")
+ (let (row col)
+ (setq ses-start-time (float-time))
+ (while reform
+ (ses-time-check "Fixing ses-ranges... (%d left)" '(length reform))
+ (setq row (caar reform)
+ col (cdar reform)
+ reform (cdr reform))
+ (ses-cell-set-formula row col (ses-cell-formula row col))))
+ (message nil))))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Undo control
+;;;----------------------------------------------------------------------------
+
+(defadvice undo-more (around ses-undo-more activate preactivate)
+ "Define a meaning for conses in buffer-undo-list whose car is a symbol
+other than t or nil. To undo these, apply the car--a function--to the
+cdr--its arglist."
+ (let ((ses-count (ad-get-arg 0)))
+ (catch 'undo
+ (dolist (ses-x pending-undo-list)
+ (unless ses-x
+ ;;End of undo boundary
+ (setq ses-count (1- ses-count))
+ (if (<= ses-count 0)
+ ;;We've seen enough boundaries - stop undoing
+ (throw 'undo nil)))
+ (and (consp ses-x) (symbolp (car ses-x)) (fboundp (car ses-x))
+ ;;Undo using apply
+ (apply (car ses-x) (cdr ses-x)))))
+ (if (not (eq major-mode 'ses-mode))
+ ad-do-it
+ ;;Here is some extra code for SES mode.
+ (setq deferred-narrow (or deferred-narrow (< (point-max) (buffer-size))))
+ (widen)
+ (condition-case x
+ ad-do-it
+ (error
+ ;;Restore narrow if appropriate
+ (ses-command-hook)
+ (signal (car x) (cdr x)))))))
+
+(defun ses-begin-change ()
+ "For undo, remember current buffer-position before we start changing hidden
+stuff."
+ (let ((inhibit-read-only t))
+ (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 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)
+ `(ses-set-with-undo ,sym ,(symbol-value sym))
+ `(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 `(ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list)
+ (makunbound sym)))
+
+(defun ses-aset-with-undo (array idx newval)
+ "Like aset, but undoable. Result is t if element has changed"
+ (unless (equal (aref array idx) newval)
+ (push `(ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list)
+ (aset array idx newval)
+ t))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Startup for major mode
+;;;----------------------------------------------------------------------------
+
+(defun ses-build-mode-map ()
+ "Set up `ses-mode-map', `ses-mode-print-map', and `ses-mode-edit-map' with
+standard keymap bindings for SES."
+ (message "Building mode map...")
+ ;;;Define ses-mode-map
+ (let ((keys '("\C-c\M-\C-l" ses-reconstruct-all
+ "\C-c\C-l" ses-recalculate-all
+ "\C-c\C-n" ses-renarrow-buffer
+ "\C-c\C-c" ses-recalculate-cell
+ "\C-c\M-\C-s" ses-sort-column
+ "\C-c\M-\C-h" ses-read-header-row
+ "\C-c\C-t" ses-truncate-cell
+ "\C-c\C-j" ses-jump
+ "\C-c\C-p" ses-read-default-printer
+ "\M-\C-l" ses-reprint-all
+ [?\S-\C-l] ses-reprint-all
+ [header-line mouse-2] ses-sort-column-click))
+ (newmap (make-sparse-keymap)))
+ (while keys
+ (define-key (1value newmap) (car keys) (cadr keys))
+ (setq keys (cddr keys)))
+ (setq ses-mode-map (1value newmap)))
+ ;;;Define ses-mode-print-map
+ (let ((keys '(;;At least three ways to define shift-tab--and some PC systems
+ ;;won't generate it at all!
+ [S-tab] backward-char
+ [backtab] backward-char
+ [S-iso-backtab] backward-char
+ [S-iso-lefttab] backward-char
+ [tab] ses-forward-or-insert
+ "\C-i" ses-forward-or-insert ;Needed for ses-coverage.el?
+ "\M-o" ses-insert-column
+ "\C-o" ses-insert-row
+ "\C-m" ses-edit-cell
+ "\M-k" ses-delete-column
+ "\M-y" ses-yank-pop
+ "\C-k" ses-delete-row
+ "\C-j" ses-append-row-jump-first-column
+ "\M-h" ses-mark-row
+ "\M-H" ses-mark-column
+ "\C-d" ses-clear-cell-forward
+ "\C-?" ses-clear-cell-backward
+ "(" ses-read-cell
+ "\"" ses-read-cell
+ "'" ses-read-symbol
+ "=" ses-edit-cell
+ "j" ses-jump
+ "p" ses-read-cell-printer
+ "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 (1value newmap) t)
+ ;;These keys insert themselves as the beginning of a numeric value
+ (dotimes (x (length (1value numeric)))
+ (define-key (1value newmap)
+ (substring (1value numeric) x (1+ x))
+ 'ses-read-cell))
+ ;;Override these global functions wherever they're bound
+ (while repl
+ (substitute-key-definition (car repl) (cadr repl)
+ (1value newmap)
+ (current-global-map))
+ (setq repl (cddr repl)))
+ ;;Apparently substitute-key-definition doesn't catch this?
+ (define-key (1value newmap) [(menu-bar) edit cut] 'ses-kill-override)
+ ;;Define our other local keys
+ (while keys
+ (define-key (1value newmap) (car keys) (cadr keys))
+ (setq keys (cddr keys)))
+ ;;Keymap property wants the map as a function, not a variable
+ (fset 'ses-mode-print-map (1value newmap))
+ (setq ses-mode-print-map (1value newmap)))
+ ;;;Define ses-mode-edit-map
+ (let ((keys '("\C-c\C-r" ses-insert-range
+ "\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))
+ (newmap (make-sparse-keymap)))
+ (1value (set-keymap-parent (1value newmap) (1value minibuffer-local-map)))
+ (while keys
+ (define-key (1value newmap) (car keys) (cadr keys))
+ (setq keys (cddr keys)))
+ (setq ses-mode-edit-map (1value newmap)))
+ (message nil))
+
+(defun ses-load ()
+ "Parse the current buffer and sets up buffer-local variables. Does not
+execute cell formulas or print functions."
+ (widen)
+ ;;Read our global parameters, which should be a 3-element list
+ (goto-char (point-max))
+ (search-backward ";;; Local Variables:\n" nil t)
+ (backward-list 1)
+ (let ((params (condition-case nil (read (current-buffer)) (error nil)))
+ sym)
+ (or (and (= (safe-length params) 3)
+ (numberp (car params))
+ (numberp (cadr params))
+ (> (cadr params) 0)
+ (numberp (nth 2 params))
+ (> (nth 2 params) 0))
+ (error "Invalid SES file"))
+ (setq file-format (car params)
+ numrows (cadr params)
+ numcols (nth 2 params))
+ (when (= file-format 1)
+ (let (buffer-undo-list) ;This is not undoable
+ (ses-goto-data 'header-row)
+ (insert "(ses-header-row 0)\n")
+ (ses-set-parameter 'file-format 2)
+ (message "Upgrading from SES-1 file format")))
+ (or (= file-format 2)
+ (error "This file needs a newer version of the SES library code."))
+ (ses-create-cell-variable-range 0 (1- numrows) 0 (1- numcols))
+ ;;Initialize cell array
+ (setq cells (make-vector numrows nil))
+ (dotimes (row numrows)
+ (aset cells row (make-vector numcols nil))))
+ ;;Skip over print area, which we assume is correct
+ (goto-char 1)
+ (forward-line numrows)
+ (or (looking-at ses-print-data-boundary)
+ (error "Missing marker between print and data areas"))
+ (forward-char (length ses-print-data-boundary))
+ ;;Initialize printer and symbol lists
+ (mapc 'ses-printer-record ses-standard-printer-functions)
+ (setq symbolic-formulas nil)
+ ;;Load cell definitions
+ (dotimes (row numrows)
+ (dotimes (col numcols)
+ (let* ((x (read (current-buffer)))
+ (rowcol (ses-sym-rowcol (car-safe (cdr-safe x)))))
+ (or (and (looking-at "\n")
+ (eq (car-safe x) 'ses-cell)
+ (eq row (car rowcol))
+ (eq col (cdr rowcol)))
+ (error "Cell-def error"))
+ (eval x)))
+ (or (looking-at "\n\n")
+ (error "Missing blank line between rows")))
+ ;;Load global parameters
+ (let ((widths (read (current-buffer)))
+ (n1 (char-after (point)))
+ (printers (read (current-buffer)))
+ (n2 (char-after (point)))
+ (def-printer (read (current-buffer)))
+ (n3 (char-after (point)))
+ (head-row (read (current-buffer)))
+ (n4 (char-after (point))))
+ (or (and (eq (car-safe widths) 'ses-column-widths)
+ (= n1 ?\n)
+ (eq (car-safe printers) 'ses-column-printers)
+ (= n2 ?\n)
+ (eq (car-safe def-printer) 'ses-default-printer)
+ (= n3 ?\n)
+ (eq (car-safe head-row) 'ses-header-row)
+ (= n4 ?\n))
+ (error "Invalid SES global parameters"))
+ (1value (eval widths))
+ (1value (eval def-printer))
+ (1value (eval printers))
+ (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))
+ (error "Problem with column-defs or global-params"))
+ ;;Check for overall newline count in definitions area
+ (forward-line 3)
+ (let ((start (point)))
+ (ses-goto-data 'numrows)
+ (or (= (point) start)
+ (error "Extraneous newlines someplace?"))))
+
+(defun ses-setup ()
+ "Set up for display of only the printed cell values.
+
+Narrows the buffer to show only the print area. Gives it `read-only' and
+`intangible' properties. Sets up highlighting for current cell."
+ (interactive)
+ (let ((end 1)
+ (inhibit-read-only t)
+ (was-modified (buffer-modified-p))
+ pos sym)
+ (ses-goto-data 0 0) ;;Include marker between print-area and data-area
+ (set-text-properties (point) (buffer-size) nil) ;Delete garbage props
+ (mapc 'delete-overlay (overlays-in 1 (buffer-size)))
+ ;;The print area is read-only (except for our special commands) and uses a
+ ;;special keymap.
+ (put-text-property 1 (1- (point)) 'read-only 'ses)
+ (put-text-property 1 (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 1 2 'front-sticky t)
+ ;;Create intangible properties, which also indicate which cell the text
+ ;;came from.
+ (ses-dotimes-msg (row numrows) "Finding cells..."
+ (dotimes (col numcols)
+ (setq pos end
+ sym (ses-cell-symbol row col))
+ ;;Include skipped cells following this one
+ (while (and (< col (1- numcols))
+ (eq (ses-cell-value row (1+ col)) '*skip*))
+ (setq end (+ end (ses-col-width col) 1)
+ col (1+ col)))
+ (setq end (+ end (ses-col-width col) 1))
+ (put-text-property pos end 'intangible sym)))
+ ;;Adding these properties did not actually alter the text
+ (unless was-modified
+ (set-buffer-modified-p nil)
+ (buffer-disable-undo)
+ (buffer-enable-undo)))
+ ;;Create the underlining overlay. It's impossible for (point) to be 2,
+ ;;because column A must be at least 1 column wide.
+ (setq curcell-overlay (make-overlay 2 2))
+ (overlay-put curcell-overlay 'face 'underline))
+
+(defun ses-cleanup ()
+ "Cleanup when changing a buffer from SES mode to something else. Delete
+overlay, remove special text properties."
+ (widen)
+ (let ((inhibit-read-only t)
+ (was-modified (buffer-modified-p))
+ end)
+ ;;Delete read-only, keymap, and intangible properties
+ (set-text-properties 1 (point-max) nil)
+ ;;Delete overlay
+ (mapc 'delete-overlay (overlays-in 1 (point-max)))
+ (unless was-modified
+ (set-buffer-modified-p nil))))
+
+;;;###autoload
+(defun ses-mode ()
+ "Major mode for Simple Emacs Spreadsheet. See \"ses-readme.txt\" for more info.
+
+Key definitions:
+\\{ses-mode-map}
+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:
+\\{ses-mode-edit-map}"
+ (interactive)
+ (unless (and (boundp 'deferred-narrow)
+ (eq deferred-narrow 'ses-mode))
+ (kill-all-local-variables)
+ (mapc 'make-local-variable ses-localvars)
+ (setq major-mode 'ses-mode
+ mode-name "SES"
+ next-line-add-newlines nil
+ truncate-lines t
+ ;;SES deliberately puts lots of trailing whitespace in its buffer
+ show-trailing-whitespace nil
+ ;;Cell ranges do not work reasonably without this
+ transient-mark-mode t)
+ (unless (and ses-mode-map ses-mode-print-map ses-mode-edit-map)
+ (ses-build-mode-map))
+ (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t))
+ (1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
+ (setq curcell nil
+ deferred-recalc nil
+ deferred-write nil
+ header-hscroll -1 ;Flag for "initial recalc needed"
+ header-line-format '(:eval (progn
+ (when (/= (window-hscroll)
+ header-hscroll)
+ ;;Reset header-hscroll first, to
+ ;;avoid recursion problems when
+ ;;debugging ses-create-header-string
+ (setq header-hscroll (window-hscroll))
+ (ses-create-header-string))
+ header-string)))
+ (let ((was-empty (zerop (buffer-size)))
+ (was-modified (buffer-modified-p)))
+ (save-excursion
+ (if was-empty
+ ;;Initialize buffer to contain one cell, for now
+ (insert ses-initial-file-contents))
+ (ses-load)
+ (ses-setup))
+ (when was-empty
+ (unless (equal ses-initial-default-printer (1value default-printer))
+ (1value (ses-read-default-printer ses-initial-default-printer)))
+ (unless (= ses-initial-column-width (1value (ses-col-width 0)))
+ (1value (ses-set-column-width 0 ses-initial-column-width)))
+ (ses-set-curcell)
+ (if (> (car ses-initial-size) (1value numrows))
+ (1value (ses-insert-row (1- (car ses-initial-size)))))
+ (if (> (cdr ses-initial-size) (1value numcols))
+ (1value (ses-insert-column (1- (cdr ses-initial-size)))))
+ (ses-write-cells)
+ (set-buffer-modified-p was-modified)
+ (buffer-disable-undo)
+ (buffer-enable-undo)
+ (goto-char 1)))
+ (use-local-map ses-mode-map)
+ ;;Set the deferred narrowing flag (we can't narrow until after
+ ;;after-find-file completes). If .ses is on the auto-load alist and the
+ ;;file has "mode: ses", our ses-mode function will be called twice! Use
+ ;;a special flag to detect this (will be reset by ses-command-hook).
+ ;;For find-alternate-file, post-command-hook doesn't get run for some
+ ;;reason, so use an idle timer to make sure.
+ (setq 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)
+ (run-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
+writes that have been deferred. If buffer-narrowing has been deferred,
+narrows the buffer now."
+ (condition-case err
+ (when (eq major-mode 'ses-mode) ;Otherwise, not our buffer anymore
+ (when deferred-recalc
+ ;;We reset the deferred list before starting on the recalc -- in case
+ ;;of error, we don't want to retry the recalc after every keystroke!
+ (let ((old deferred-recalc))
+ (setq deferred-recalc nil)
+ (ses-update-cells old)))
+ (if deferred-write
+ ;;We don't reset the deferred list before starting -- the most
+ ;;likely error is keyboard-quit, and we do want to keep trying
+ ;;these writes after a quit.
+ (ses-write-cells))
+ (when deferred-narrow
+ ;;We're not allowed to narrow the buffer until after-find-file has
+ ;;read the local variables at the end of the file. Now it's safe to
+ ;;do the narrowing.
+ (save-excursion
+ (goto-char 1)
+ (forward-line numrows)
+ (narrow-to-region 1 (point)))
+ (setq deferred-narrow nil))
+ ;;Update the modeline
+ (let ((oldcell curcell))
+ (ses-set-curcell)
+ (unless (eq curcell oldcell)
+ (cond
+ ((not curcell)
+ (setq mode-line-process nil))
+ ((atom curcell)
+ (setq mode-line-process (list " cell " (symbol-name curcell))))
+ (t
+ (setq mode-line-process (list " range "
+ (symbol-name (car curcell))
+ "-"
+ (symbol-name (cdr curcell))))))
+ (force-mode-line-update)))
+ ;;Use underline overlay for single-cells only, turn off otherwise
+ (if (listp curcell)
+ (move-overlay curcell-overlay 2 2)
+ (let ((next (next-single-property-change (point) 'intangible)))
+ (move-overlay 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 curcell t)))
+ ;;Prevent errors in this post-command-hook from silently erasing the hook!
+ (error
+ (unless executing-kbd-macro
+ (ding))
+ (message (error-message-string err))))
+ nil) ;Make coverage-tester happy
+
+(defun ses-create-header-string ()
+ "Sets up `header-string' as the buffer's header line, based on the
+current set of columns and window-scroll position."
+ (let ((totwidth (- 1 (window-hscroll)))
+ result width result x)
+ (if window-system
+ ;;Leave room for the left-side fringe
+ (push " " result))
+ (dotimes (col numcols)
+ (setq width (ses-col-width col)
+ totwidth (+ totwidth width 1))
+ (if (= totwidth 2) ;Scrolled so intercolumn space is leftmost
+ (push " " result))
+ (when (> totwidth 2)
+ (if (> header-row 0)
+ (save-excursion
+ (ses-goto-print (1- header-row) col)
+ (setq x (buffer-substring-no-properties (point)
+ (+ (point) width)))
+ (if (>= width (1- totwidth))
+ (setq x (substring x (- width totwidth -2))))
+ (push (propertize x 'face ses-box-prop) result))
+ (setq x (ses-column-letter col))
+ (push (propertize x 'face ses-box-prop) result)
+ (push (propertize (make-string (- width (length x)) ?.)
+ 'display `((space :align-to ,(1- totwidth)))
+ 'face ses-box-prop)
+ result))
+ ;;Allow the following space to be squished to make room for the 3-D box
+ ;;Coverage test ignores properties, thinks this is always a space!
+ (push (1value (propertize " " 'display `((space :align-to ,totwidth))))
+ result)))
+ (if (> header-row 0)
+ (push (propertize (format " [row %d]" header-row)
+ 'display '((height (- 1))))
+ result))
+ (setq header-string (apply 'concat (nreverse result)))))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Redisplay and recalculation
+;;;----------------------------------------------------------------------------
+
+(defun ses-jump (sym)
+ "Move point to cell SYM."
+ (interactive "SJump to cell: ")
+ (let ((rowcol (ses-sym-rowcol sym)))
+ (or rowcol (error "Invalid cell name"))
+ (if (eq (symbol-value sym) '*skip*)
+ (error "Cell is covered by preceding cell"))
+ (ses-goto-print (car rowcol) (cdr rowcol))))
+
+(defun ses-jump-safe (cell)
+ "Like `ses-jump', but no error if invalid cell."
+ (condition-case nil
+ (ses-jump cell)
+ (error)))
+
+(defun ses-reprint-all (&optional nonarrow)
+ "Recreate the display area. Calls all printer functions. Narrows to
+print area if NONARROW is nil."
+ (interactive "*P")
+ (widen)
+ (unless nonarrow
+ (setq deferred-narrow t))
+ (let ((startcell (get-text-property (point) 'intangible))
+ (inhibit-read-only t))
+ (ses-begin-change)
+ (goto-char 1)
+ (search-forward ses-print-data-boundary)
+ (backward-char (length ses-print-data-boundary))
+ (delete-region 1 (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 numrows)
+ (insert-and-inherit blank-line))
+ (ses-dotimes-msg (row numrows) "Reprinting..."
+ (if (eq (ses-cell-value row 0) '*skip*)
+ ;;Column deletion left a dangling skip
+ (ses-set-cell row 0 'value nil))
+ (dotimes (col numcols)
+ (ses-print-cell row col))
+ (beginning-of-line 2))
+ (ses-jump-safe startcell)))
+
+(defun ses-recalculate-cell ()
+ "Recalculate and reprint the current cell or range.
+
+For an individual cell, shows the error if the formula or printer
+signals one, or otherwise shows the cell's complete value. For a range, the
+cells are recalculated in \"natural\" order, so cells that other cells refer
+to are recalculated first."
+ (interactive "*")
+ (ses-check-curcell 'range)
+ (ses-begin-change)
+ (let (sig)
+ (setq ses-start-time (float-time))
+ (if (atom curcell)
+ (setq sig (ses-sym-rowcol curcell)
+ sig (ses-calculate-cell (car sig) (cdr sig) t))
+ ;;First, recalculate all cells that don't refer to other cells and
+ ;;produce a list of cells with references.
+ (ses-dorange curcell
+ (ses-time-check "Recalculating... %s" '(ses-cell-symbol row col))
+ (condition-case nil
+ (progn
+ ;;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))
+ (setq sig (ses-calculate-cell row col t)))
+ (wrong-type-argument
+ ;;The formula contains a reference
+ (add-to-list 'deferred-recalc (ses-cell-symbol row col))))))
+ ;;Do the update now, so we can force recalculation
+ (let ((x deferred-recalc))
+ (setq deferred-recalc nil)
+ (condition-case hold
+ (ses-update-cells x t)
+ (error (setq sig hold))))
+ (cond
+ (sig
+ (message (error-message-string sig)))
+ ((consp curcell)
+ (message " "))
+ (t
+ (princ (symbol-value curcell))))))
+
+(defun ses-recalculate-all ()
+ "Recalculate and reprint all cells."
+ (interactive "*")
+ (let ((startcell (get-text-property (point) 'intangible))
+ (curcell (cons 'A1 (ses-cell-symbol (1- numrows) (1- numcols)))))
+ (ses-recalculate-cell)
+ (ses-jump-safe startcell)))
+
+(defun ses-truncate-cell ()
+ "Reprint current cell, but without spillover into any following blank
+cells."
+ (interactive "*")
+ (ses-check-curcell)
+ (let* ((rowcol (ses-sym-rowcol curcell))
+ (row (car rowcol))
+ (col (cdr rowcol)))
+ (when (and (< col (1- 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.
+ (eval `(let ((,(ses-cell-symbol row (1+ col)) t))
+ (ses-print-cell row col)))
+ ;;Now remove the *skip*. ses-print-cell is always nil here
+ (ses-set-cell row (1+ col) 'value nil)
+ (1value (ses-print-cell row (1+ col))))))
+
+(defun ses-reconstruct-all ()
+ "Reconstruct buffer based on cell data stored in Emacs variables."
+ (interactive "*")
+ (ses-begin-change)
+ ;;Reconstruct reference lists.
+ (let (refs x yrow ycol)
+ ;;Delete old reference lists
+ (ses-dotimes-msg (row numrows) "Deleting references..."
+ (dotimes (col numcols)
+ (ses-set-cell row col 'references nil)))
+ ;;Create new reference lists
+ (ses-dotimes-msg (row numrows) "Computing references..."
+ (dotimes (col numcols)
+ (dolist (ref (ses-formula-references (ses-cell-formula row col)))
+ (setq x (ses-sym-rowcol ref)
+ yrow (car x)
+ ycol (cdr x))
+ (ses-set-cell yrow ycol 'references
+ (cons (ses-cell-symbol row col)
+ (ses-cell-references yrow ycol)))))))
+ ;;Delete everything and reconstruct basic data area
+ (if (< (point-max) (buffer-size))
+ (setq deferred-narrow t))
+ (widen)
+ (let ((inhibit-read-only t))
+ (goto-char (point-max))
+ (if (search-backward ";;; Local Variables:\n" nil t)
+ (delete-region 1 (point))
+ ;;Buffer is quite screwed up - can't even save the user-specified locals
+ (delete-region 1 (point-max))
+ (insert ses-initial-file-trailer)
+ (goto-char 1))
+ ;;Create a blank display area
+ (dotimes (row numrows)
+ (insert blank-line))
+ (insert ses-print-data-boundary)
+ ;;Placeholders for cell data
+ (insert (make-string (* numrows (1+ numcols)) ?\n))
+ ;;Placeholders for col-widths, col-printers, default-printer, header-row
+ (insert "\n\n\n\n")
+ (insert ses-initial-global-parameters))
+ (ses-set-parameter 'column-widths column-widths)
+ (ses-set-parameter 'col-printers col-printers)
+ (ses-set-parameter 'default-printer default-printer)
+ (ses-set-parameter 'header-row header-row)
+ (ses-set-parameter 'numrows numrows)
+ (ses-set-parameter 'numcols numcols)
+ ;;Keep our old narrowing
+ (ses-setup)
+ (ses-recalculate-all)
+ (goto-char 1))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Input of cell formulas
+;;;----------------------------------------------------------------------------
+
+(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."
+ (interactive
+ (progn
+ (barf-if-buffer-read-only)
+ (ses-check-curcell)
+ (let* ((rowcol (ses-sym-rowcol curcell))
+ (row (car rowcol))
+ (col (cdr rowcol))
+ (formula (ses-cell-formula row col))
+ initial)
+ (if (eq (car-safe formula) 'ses-safe-formula)
+ (setq formula (cadr formula)))
+ (if (eq (car-safe formula) 'quote)
+ (setq initial (format "'%S" (cadr formula)))
+ (setq initial (prin1-to-string formula)))
+ (if (stringp formula)
+ ;;Position cursor inside close-quote
+ (setq initial (cons initial (length initial))))
+ (list row col
+ (read-from-minibuffer (format "Cell %s: " curcell)
+ initial
+ ses-mode-edit-map
+ t ;Convert to Lisp object
+ 'ses-read-cell-history)))))
+ (when (ses-warn-unsafe newval 'unsafep)
+ (ses-begin-change)
+ (ses-cell-set-formula row col newval)
+ t))
+
+(defun ses-read-cell (row col newval)
+ "Self-insert for initial character of cell function."
+ (interactive
+ (let ((initial (this-command-keys))
+ (rowcol (progn (ses-check-curcell) (ses-sym-rowcol curcell))))
+ (barf-if-buffer-read-only)
+ (if (string= initial "\"")
+ (setq initial "\"\"") ;Enter a string
+ (if (string= initial "(")
+ (setq initial "()"))) ;Enter a formula list
+ (list (car rowcol)
+ (cdr rowcol)
+ (read-from-minibuffer (format "Cell %s: " curcell)
+ (cons initial 2)
+ ses-mode-edit-map
+ t ;Convert to Lisp object
+ 'ses-read-cell-history))))
+ (when (ses-edit-cell row col newval)
+ (ses-command-hook) ;Update cell widths before movement
+ (dolist (x ses-after-entry-functions)
+ (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."
+ (interactive
+ (let ((rowcol (progn (ses-check-curcell) (ses-sym-rowcol curcell)))
+ newval)
+ (barf-if-buffer-read-only)
+ (setq newval (completing-read (format "Cell %s ': " curcell)
+ symbolic-formulas))
+ (list (car rowcol)
+ (cdr rowcol)
+ (if (string= newval "")
+ nil ;Don't create zero-length symbols!
+ (list 'quote (intern newval))))))
+ (when (ses-edit-cell row col symb)
+ (ses-command-hook) ;Update cell widths before movement
+ (dolist (x ses-after-entry-functions)
+ (funcall x 1))))
+
+(defun ses-clear-cell-forward (count)
+ "Delete formula and printer for current cell and then move to next cell.
+With prefix, deletes several cells."
+ (interactive "*p")
+ (if (< count 0)
+ (1value (ses-clear-cell-backward (- count)))
+ (ses-check-curcell)
+ (ses-begin-change)
+ (dotimes (x count)
+ (ses-set-curcell)
+ (let ((rowcol (ses-sym-rowcol curcell)))
+ (or rowcol (signal 'end-of-buffer nil))
+ (ses-clear-cell (car rowcol) (cdr rowcol)))
+ (forward-char 1))))
+
+(defun ses-clear-cell-backward (count)
+ "Move to previous cell and then delete it. With prefix, deletes several
+cells."
+ (interactive "*p")
+ (if (< count 0)
+ (1value (ses-clear-cell-forward (- count)))
+ (ses-check-curcell 'end)
+ (ses-begin-change)
+ (dotimes (x count)
+ (backward-char 1) ;Will signal 'beginning-of-buffer if appropriate
+ (ses-set-curcell)
+ (let ((rowcol (ses-sym-rowcol curcell)))
+ (ses-clear-cell (car rowcol) (cdr rowcol))))))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Input of cell-printer functions
+;;;----------------------------------------------------------------------------
+
+(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 cancelled."
+ (barf-if-buffer-read-only)
+ (if (eq default t)
+ (setq default "")
+ (setq prompt (format "%s [currently %S]: "
+ (substring prompt 0 -2)
+ default)))
+ (let ((new (read-from-minibuffer prompt
+ nil ;Initial contents
+ ses-mode-edit-map
+ t ;Evaluate the result
+ 'ses-read-printer-history
+ (prin1-to-string default))))
+ (if (equal new default)
+ ;;User changed mind, decided not to change printer
+ (setq new t)
+ (ses-printer-validate new)
+ (or (not new)
+ (stringp new)
+ (stringp (car-safe new))
+ (ses-warn-unsafe new 'unsafep-function)
+ (setq new t)))
+ new))
+
+(defun ses-read-cell-printer (newval)
+ "Set the printer function for the current cell or range.
+
+A printer function is either a string (a format control-string with one
+%-sequence -- result from format will be right-justified), or a list of one
+string (result from format will be left-justified), or a lambda-expression of
+one argument, or a symbol that names a function of one argument. In the
+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)
+ prompt)
+ (ses-check-curcell 'range)
+ ;;Default is none if not all cells in range have same printer
+ (catch 'ses-read-cell-printer
+ (ses-dorange 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)))))
+ (list (ses-read-printer (format "Cell %S printer: " curcell) default))))
+ (unless (eq newval t)
+ (ses-begin-change)
+ (ses-dorange curcell
+ (ses-set-cell row col 'printer newval)
+ (ses-print-cell row col))))
+
+(defun ses-read-column-printer (col newval)
+ "Set the printer function for the current column. See
+`ses-read-cell-printer' for input forms."
+ (interactive
+ (let ((col (cdr (ses-sym-rowcol curcell))))
+ (ses-check-curcell)
+ (list col (ses-read-printer (format "Column %s printer: "
+ (ses-column-letter col))
+ (ses-col-printer col)))))
+
+ (unless (eq newval t)
+ (ses-begin-change)
+ (ses-set-parameter 'col-printers newval col)
+ (save-excursion
+ (dotimes (row numrows)
+ (ses-print-cell row col)))))
+
+(defun ses-read-default-printer (newval)
+ "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: " default-printer)))
+ (unless (eq newval t)
+ (ses-begin-change)
+ (ses-set-parameter 'default-printer newval)
+ (ses-reprint-all t)))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Spreadsheet size adjustments
+;;;----------------------------------------------------------------------------
+
+(defun ses-insert-row (count)
+ "Insert a new row before the current one. With prefix, insert COUNT rows
+before current one."
+ (interactive "*p")
+ (ses-check-curcell 'end)
+ (or (> count 0) (signal 'args-out-of-range nil))
+ (ses-begin-change)
+ (let ((inhibit-quit t)
+ (inhibit-read-only t)
+ (row (or (car (ses-sym-rowcol curcell)) numrows))
+ newrow)
+ ;;Create a new set of cell-variables
+ (ses-create-cell-variable-range numrows (+ numrows count -1)
+ 0 (1- numcols))
+ (ses-set-parameter 'numrows (+ numrows count))
+ ;;Insert each row
+ (ses-goto-print row 0)
+ (ses-dotimes-msg (x count) "Inserting row..."
+ ;;Create a row of empty cells. The `symbol' fields will be set by
+ ;;the call to ses-relocate-all.
+ (setq newrow (make-vector numcols nil))
+ (dotimes (col numcols)
+ (aset newrow col (make-vector ses-cell-size nil)))
+ (setq cells (ses-vector-insert cells row newrow))
+ (push `(ses-vector-delete cells ,row 1) buffer-undo-list)
+ (insert blank-line))
+ ;;Insert empty lines in cell data area (will be replaced by
+ ;;ses-relocate-all)
+ (ses-goto-data row 0)
+ (insert (make-string (* (1+ numcols) count) ?\n))
+ (ses-relocate-all row 0 count 0)
+ ;;If any cell printers insert constant text, insert that text
+ ;;into the line.
+ (let ((cols (mapconcat #'ses-call-printer col-printers nil))
+ (global (ses-call-printer default-printer)))
+ (if (or (> (length cols) 0) (> (length global) 0))
+ (dotimes (x count)
+ (dotimes (col numcols)
+ ;;These cells are always nil, only constant formatting printed
+ (1value (ses-print-cell (+ x row) col))))))
+ (when (> header-row row)
+ ;;Inserting before header
+ (ses-set-parameter 'header-row (+ header-row count))
+ (ses-reset-header-string)))
+ ;;Reconstruct text attributes
+ (ses-setup)
+ ;;Return to current cell
+ (if curcell
+ (ses-jump-safe curcell)
+ (ses-goto-print (1- numrows) 0)))
+
+(defun ses-delete-row (count)
+ "Delete the current row. With prefix, Deletes COUNT rows starting from the
+current one."
+ (interactive "*p")
+ (ses-check-curcell)
+ (or (> count 0) (signal 'args-out-of-range nil))
+ (let ((inhibit-quit t)
+ (inhibit-read-only t)
+ (row (car (ses-sym-rowcol curcell)))
+ pos)
+ (setq count (min count (- numrows row)))
+ (ses-begin-change)
+ (ses-set-parameter 'numrows (- numrows count))
+ ;;Delete lines from print area
+ (ses-goto-print row 0)
+ (ses-delete-line count)
+ ;;Delete lines from cell data area
+ (ses-goto-data row 0)
+ (ses-delete-line (* count (1+ numcols)))
+ ;;Relocate variables and formulas
+ (ses-set-with-undo 'cells (ses-vector-delete cells row count))
+ (ses-relocate-all row 0 (- count) 0)
+ (ses-destroy-cell-variable-range numrows (+ numrows count -1)
+ 0 (1- numcols))
+ (when (> header-row row)
+ (if (<= header-row (+ row count))
+ ;;Deleting the header row
+ (ses-set-parameter 'header-row 0)
+ (ses-set-parameter 'header-row (- header-row count)))
+ (ses-reset-header-string)))
+ ;;Reconstruct attributes
+ (ses-setup)
+ (ses-jump-safe curcell))
+
+(defun ses-insert-column (count &optional col width printer)
+ "Insert a new column before COL (default is the current one). With prefix,
+insert COUNT columns before current one. If COL is specified, the new
+column(s) get the specified WIDTH and PRINTER (otherwise they're taken from
+the current column)."
+ (interactive "*p")
+ (ses-check-curcell)
+ (or (> count 0) (signal 'args-out-of-range nil))
+ (or col
+ (setq col (cdr (ses-sym-rowcol curcell))
+ width (ses-col-width col)
+ printer (ses-col-printer col)))
+ (ses-begin-change)
+ (let ((inhibit-quit t)
+ (inhibit-read-only t)
+ (widths column-widths)
+ (printers col-printers)
+ has-skip)
+ ;;Create a new set of cell-variables
+ (ses-create-cell-variable-range 0 (1- numrows)
+ numcols (+ numcols count -1))
+ ;;Insert each column.
+ (ses-dotimes-msg (x count) "Inserting column..."
+ ;;Create a column of empty cells. The `symbol' fields will be set by
+ ;;the call to ses-relocate-all.
+ (ses-adjust-print-width col (1+ width))
+ (ses-set-parameter 'numcols (1+ numcols))
+ (dotimes (row numrows)
+ (and (< (1+ col) numcols) (eq (ses-cell-value row col) '*skip*)
+ ;;Inserting in the middle of a spill-over
+ (setq has-skip t))
+ (ses-aset-with-undo cells row
+ (ses-vector-insert (aref cells row)
+ col
+ (make-vector ses-cell-size nil)))
+ ;;Insert empty lines in cell data area (will be replaced by
+ ;;ses-relocate-all)
+ (ses-goto-data row col)
+ (insert ?\n))
+ ;;Insert column width and printer
+ (setq widths (ses-vector-insert widths col width)
+ printers (ses-vector-insert printers col printer)))
+ (ses-set-parameter 'column-widths widths)
+ (ses-set-parameter 'col-printers printers)
+ (ses-reset-header-string)
+ (ses-relocate-all 0 col 0 count)
+ (if has-skip
+ (ses-reprint-all t)
+ (when (or (> (length (ses-call-printer printer)) 0)
+ (> (length (ses-call-printer default-printer)) 0))
+ ;;Either column printer or global printer inserts some constant text
+ ;;Reprint the new columns to insert that text.
+ (dotimes (x numrows)
+ (dotimes (y count)
+ ;Always nil here - this is a blank column
+ (1value (ses-print-cell-new-width x (+ y col))))))
+ (ses-setup)))
+ (ses-jump-safe curcell))
+
+(defun ses-delete-column (count)
+ "Delete the current column. With prefix, Deletes COUNT columns starting
+from the current one."
+ (interactive "*p")
+ (ses-check-curcell)
+ (or (> count 0) (signal 'args-out-of-range nil))
+ (let ((inhibit-quit t)
+ (inhibit-read-only t)
+ (rowcol (ses-sym-rowcol curcell))
+ (width 0)
+ new col origrow has-skip)
+ (setq origrow (car rowcol)
+ col (cdr rowcol)
+ count (min count (- numcols col)))
+ (if (= count numcols)
+ (error "Can't delete all columns!"))
+ ;;Determine width of column(s) being deleted
+ (dotimes (x count)
+ (setq width (+ width (ses-col-width (+ col x)) 1)))
+ (ses-begin-change)
+ (ses-set-parameter 'numcols (- numcols count))
+ (ses-adjust-print-width col (- width))
+ (ses-dotimes-msg (row numrows) "Deleting column..."
+ ;;Delete lines from cell data area
+ (ses-goto-data row col)
+ (ses-delete-line count)
+ ;;Delete cells. Check if deletion area begins or ends with a skip.
+ (if (or (eq (ses-cell-value row col) '*skip*)
+ (and (< col numcols)
+ (eq (ses-cell-value row (+ col count)) '*skip*)))
+ (setq has-skip t))
+ (ses-aset-with-undo cells row
+ (ses-vector-delete (aref cells row) col count)))
+ ;;Update globals
+ (ses-set-parameter 'column-widths
+ (ses-vector-delete column-widths col count))
+ (ses-set-parameter 'col-printers
+ (ses-vector-delete col-printers col count))
+ (ses-reset-header-string)
+ ;;Relocate variables and formulas
+ (ses-relocate-all 0 col 0 (- count))
+ (ses-destroy-cell-variable-range 0 (1- numrows)
+ numcols (+ numcols count -1))
+ (if has-skip
+ (ses-reprint-all t)
+ (ses-setup))
+ (if (>= col numcols)
+ (setq col (1- col)))
+ (ses-goto-print origrow col)))
+
+(defun ses-forward-or-insert (&optional count)
+ "Move to next cell in row, or inserts a new cell if already in last one, or
+inserts a new row if at bottom of print area. Repeat COUNT times."
+ (interactive "p")
+ (ses-check-curcell 'end)
+ (setq deactivate-mark t) ;Doesn't combine well with ranges
+ (dotimes (x count)
+ (ses-set-curcell)
+ (if (not curcell)
+ (progn ;At bottom of print area
+ (barf-if-buffer-read-only)
+ (ses-insert-row 1))
+ (let ((col (cdr (ses-sym-rowcol curcell))))
+ (when (/= 32
+ (char-before (next-single-property-change (point)
+ 'intangible)))
+ ;;We're already in last nonskipped cell on line. Need to create a
+ ;;new column.
+ (barf-if-buffer-read-only)
+ (ses-insert-column (- count x)
+ numcols
+ (ses-col-width col)
+ (ses-col-printer col)))))
+ (forward-char)))
+
+(defun ses-append-row-jump-first-column ()
+ "Insert a new row after current one and jumps to its first column."
+ (interactive "*")
+ (ses-check-curcell)
+ (ses-begin-change)
+ (beginning-of-line 2)
+ (ses-set-curcell)
+ (ses-insert-row 1))
+
+(defun ses-set-column-width (col newwidth)
+ "Set the width of the current column."
+ (interactive
+ (let ((col (cdr (progn (ses-check-curcell) (ses-sym-rowcol curcell)))))
+ (barf-if-buffer-read-only)
+ (list col
+ (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ (read-from-minibuffer (format "Column %s width [currently %d]: "
+ (ses-column-letter col)
+ (ses-col-width col))
+ nil ;No initial contents
+ nil ;No override keymap
+ t ;Convert to Lisp object
+ nil ;No history
+ (number-to-string
+ (ses-col-width col))))))) ;Default value
+ (if (< newwidth 1)
+ (error "Invalid column width"))
+ (ses-begin-change)
+ (ses-reset-header-string)
+ (save-excursion
+ (let ((inhibit-quit t))
+ (ses-adjust-print-width col (- newwidth (ses-col-width col)))
+ (ses-set-parameter 'column-widths newwidth col))
+ (dotimes (row numrows)
+ (ses-print-cell-new-width row col))))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Cut and paste, import and export
+;;;----------------------------------------------------------------------------
+
+(defadvice copy-region-as-kill (around ses-copy-region-as-kill
+ activate preactivate)
+ "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.
+
+This advice also includes some SES-specific code because otherwise it's too
+hard to override how mouse-1 works."
+ (when (> beg end)
+ (let ((temp beg))
+ (setq beg end
+ end temp)))
+ (if (not (and (eq major-mode '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
+ (kill-new (ses-copy-region beg end))))
+
+(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."
+ (let* ((inhibit-point-motion-hooks t)
+ (x (mapconcat 'ses-copy-region-helper
+ (extract-rectangle beg (1- end)) "\n")))
+ (remove-text-properties 0 (length x)
+ '(read-only t
+ intangible t
+ keymap t
+ front-sticky t)
+ x)
+ 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
+the corresponding data cell."
+ (or (> (length line) 1)
+ (error "Empty range"))
+ (let ((inhibit-read-only t)
+ (pos 0)
+ mycell next sym rowcol)
+ (while pos
+ (setq sym (get-text-property pos 'intangible line)
+ next (next-single-property-change pos 'intangible line)
+ rowcol (ses-sym-rowcol sym)
+ mycell (ses-get-cell (car rowcol) (cdr rowcol)))
+ (put-text-property pos (or next (length line))
+ 'ses
+ (list (ses-cell-symbol mycell)
+ (ses-cell-formula mycell)
+ (ses-cell-printer mycell))
+ line)
+ (setq pos next)))
+ line)
+
+(defun ses-kill-override (beg end)
+ "Generic override for any commands that kill text. We clear the killed
+cells instead of deleting them."
+ (interactive "r")
+ (ses-check-curcell 'needrange)
+ ;;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
+ (noreturn (funcall (lookup-key (current-global-map)
+ (this-command-keys))
+ beg end))
+ (buffer-read-only nil)))) ;The expected error
+ ;;Because the buffer was marked read-only, the kill command turned itself
+ ;;into a copy. Now we clear the cells or signal the error. First we
+ ;;check whether the buffer really is read-only.
+ (barf-if-buffer-read-only)
+ (ses-begin-change)
+ (ses-dorange curcell
+ (ses-clear-cell row col))
+ (ses-jump (car curcell)))
+
+(defadvice yank (around ses-yank activate preactivate)
+ "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
+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.
+
+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
+prefix to specify insertion without relocation, which is best when the
+formulas refer to cells outsite 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
+as symbols."
+ (if (not (and (eq major-mode 'ses-mode)
+ (eq (get-text-property (point) 'keymap) 'ses-mode-print-map)))
+ ad-do-it ;Normal non-SES yank
+ (ses-check-curcell 'end)
+ (push-mark (point))
+ (let ((text (current-kill (cond
+ ((listp arg) 0)
+ ((eq arg '-) -1)
+ (t (1- arg))))))
+ (or (ses-yank-cells text arg)
+ (ses-yank-tsf text arg)
+ (ses-yank-one (ses-yank-resize 1 1)
+ text
+ 0
+ (if (memq (aref text (1- (length text))) '(?\t ?\n))
+ ;;Just one cell - delete final tab or newline
+ (1- (length text)))
+ arg)))
+ (if (consp arg)
+ (exchange-point-and-mark))))
+
+(defun ses-yank-pop (arg)
+ "Replace just-yanked stretch of killed text with a different stretch.
+This command is allowed only immediately after a `yank' or a `yank-pop', when
+the region contains a stretch of reinserted previously-killed text. We
+replace it with a different stretch of killed text.
+ Unlike standard `yank-pop', this function uses `undo' to delete the
+previous insertion."
+ (interactive "*p")
+ (or (eq last-command 'yank)
+ ;;Use noreturn here just to avoid a "poor-coverage" warning in its
+ ;;macro definition.
+ (noreturn (error "Previous command was not a yank")))
+ (undo)
+ (ses-set-curcell)
+ (yank (1+ (or arg 1)))
+ (setq this-command 'yank))
+
+(defun ses-yank-cells (text arg)
+ "If the TEXT has a proper set of 'ses attributes, inserts 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
+formulas are to be inserted without relocation."
+ (let ((first (get-text-property 0 'ses text))
+ (last (get-text-property (1- (length text)) 'ses text)))
+ (when (and first last) ;;Otherwise not proper set of attributes
+ (setq first (ses-sym-rowcol (car first))
+ last (ses-sym-rowcol (car last)))
+ (let* ((needrows (- (car last) (car first) -1))
+ (needcols (- (cdr last) (cdr first) -1))
+ (rowcol (ses-yank-resize needrows needcols))
+ (rowincr (- (car rowcol) (car first)))
+ (colincr (- (cdr rowcol) (cdr first)))
+ (pos 0)
+ myrow mycol x)
+ (ses-dotimes-msg (row needrows) "Yanking..."
+ (setq myrow (+ row (car rowcol)))
+ (dotimes (col needcols)
+ (setq mycol (+ col (cdr rowcol))
+ last (get-text-property pos 'ses text)
+ pos (next-single-property-change pos 'ses text)
+ x (ses-sym-rowcol (car last)))
+ (if (not last)
+ ;;Newline - all remaining cells on row are skipped
+ (setq x (cons (- myrow rowincr) (+ needcols colincr -1))
+ last (list nil nil nil)
+ pos (1- pos)))
+ (if (/= (car x) (- myrow rowincr))
+ (error "Cell row error"))
+ (if (< (- mycol colincr) (cdr x))
+ ;;Some columns were skipped
+ (let ((oldcol mycol))
+ (while (< (- mycol colincr) (cdr x))
+ (ses-clear-cell myrow mycol)
+ (setq col (1+ col)
+ mycol (1+ mycol)))
+ (ses-print-cell myrow (1- oldcol)))) ;;This inserts *skip*
+ (when (car last) ;Skip this for *skip* cells
+ (setq x (nth 2 last))
+ (unless (equal x (ses-cell-printer myrow mycol))
+ (or (not x)
+ (stringp x)
+ (eq (car-safe x) 'ses-safe-printer)
+ (setq x `(ses-safe-printer ,x)))
+ (ses-set-cell myrow mycol 'printer x))
+ (setq x (cadr last))
+ (if (atom arg)
+ (setq x (ses-relocate-formula x 0 0 rowincr colincr)))
+ (or (atom x)
+ (eq (car-safe x) 'ses-safe-formula)
+ (setq x `(ses-safe-formula ,x)))
+ (ses-cell-set-formula myrow mycol x)))
+ (when pos
+ (if (get-text-property pos 'ses text)
+ (error "Missing newline between rows"))
+ (setq pos (next-single-property-change pos 'ses text))))
+ t))))
+
+(defun ses-yank-one (rowcol text from to arg)
+ "Insert the substring [FROM,TO] of TEXT as the formula for cell ROWCOL (a
+cons of ROW and COL). Treat plain symbols as strings unless ARG is a list."
+ (let ((val (condition-case nil
+ (read-from-string text from to)
+ (error (cons nil from)))))
+ (cond
+ ((< (cdr val) (or to (length text)))
+ ;;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
+ (t
+ (setq val (car val))))
+ (let ((row (car rowcol))
+ (col (cdr rowcol)))
+ (or (atom val)
+ (setq val `(ses-safe-formula ,val)))
+ (ses-cell-set-formula row col val))))
+
+(defun ses-yank-tsf (text arg)
+ "If TEXT contains tabs and/or newlines, treats the tabs as
+column-separators and the newlines as row-separators and inserts the text as
+cell formulas--else return nil. Treat plain symbols as strings unless ARG
+is a list. Ignore a final newline."
+ (if (or (not (string-match "[\t\n]" text))
+ (= (match-end 0) (length text)))
+ ;;Not TSF format
+ nil
+ (if (/= (aref text (1- (length text))) ?\n)
+ (setq text (concat text "\n")))
+ (let ((pos -1)
+ (spots (list -1))
+ (cols 0)
+ (needrows 0)
+ needcols rowcol)
+ ;;Find all the tabs and newlines
+ (while (setq pos (string-match "[\t\n]" text (1+ pos)))
+ (push pos spots)
+ (setq cols (1+ cols))
+ (when (eq (aref text pos) ?\n)
+ (if (not needcols)
+ (setq needcols cols)
+ (or (= needcols cols)
+ (error "Inconsistent row lengths")))
+ (setq cols 0
+ needrows (1+ needrows))))
+ ;;Insert the formulas
+ (setq rowcol (ses-yank-resize needrows needcols))
+ (dotimes (row needrows)
+ (dotimes (col needcols)
+ (ses-yank-one (cons (+ (car rowcol) needrows (- row) -1)
+ (+ (cdr rowcol) needcols (- col) -1))
+ text (1+ (cadr spots)) (car spots) arg)
+ (setq spots (cdr spots))))
+ (ses-goto-print (+ (car rowcol) needrows -1)
+ (+ (cdr rowcol) needcols -1))
+ t)))
+
+(defun ses-yank-resize (needrows needcols)
+ "If this yank will require inserting rows and/or columns, asks for
+confirmation and then inserts them. Result is (row,col) for top left of yank
+spot, or error signal if user requests cancel."
+ (ses-begin-change)
+ (let ((rowcol (if curcell (ses-sym-rowcol curcell) (cons numrows 0)))
+ rowbool colbool)
+ (setq needrows (- (+ (car rowcol) needrows) numrows)
+ needcols (- (+ (cdr rowcol) needcols) numcols)
+ rowbool (> needrows 0)
+ colbool (> needcols 0))
+ (when (or rowbool colbool)
+ ;;Need to insert. Get confirm
+ (or (y-or-n-p (format "Yank will insert %s%s%s. Continue "
+ (if rowbool (format "%d rows" needrows) "")
+ (if (and rowbool colbool) " and " "")
+ (if colbool (format "%d columns" needcols) "")))
+ (error "Cancelled"))
+ (when rowbool
+ (let (curcell)
+ (save-excursion
+ (ses-goto-print numrows 0)
+ (ses-insert-row needrows))))
+ (when colbool
+ (ses-insert-column needcols
+ numcols
+ (ses-col-width (1- numcols))
+ (ses-col-printer (1- numcols)))))
+ rowcol))
+
+(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)
+ "Export formulas from the current range, with tabs between columns and
+newlines between rows. Result is placed in kill ring."
+ (interactive "r")
+ (ses-export-tab t))
+
+(defun ses-export-tab (want-formulas)
+ "Export the current range with tabs between columns and newlines between
+rows. Result is placed in kill ring. The export is values unless
+WANT-FORMULAS is non-nil. Newlines and tabs in the export text are escaped."
+ (ses-check-curcell 'needrange)
+ (let ((print-escape-newlines t)
+ result item)
+ (ses-dorange curcell
+ (setq item (if want-formulas
+ (ses-cell-formula row col)
+ (ses-cell-value row col)))
+ (if (eq (car-safe item) 'ses-safe-formula)
+ ;;Hide our deferred safety-check marker
+ (setq item (cadr item)))
+ (if (or (not item) (eq item '*skip*))
+ (setq item ""))
+ (when (eq (car-safe item) 'quote)
+ (push "'" result)
+ (setq item (cadr item)))
+ (setq item (prin1-to-string item t))
+ (setq item (replace-regexp-in-string "\t" "\\\\t" item))
+ (push item result)
+ (cond
+ ((< col maxcol)
+ (push "\t" result))
+ ((< row maxrow)
+ (push "\n" result))))
+ (setq result (apply 'concat (nreverse result)))
+ (kill-new result)))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Other user commands
+;;;----------------------------------------------------------------------------
+
+(defun ses-read-header-row (row)
+ (interactive "NHeader row: ")
+ (if (or (< row 0) (> row numrows))
+ (error "Invalid header-row"))
+ (ses-begin-change)
+ (ses-set-parameter 'header-row row)
+ (ses-reset-header-string))
+
+(defun ses-mark-row ()
+ "Marks the entirety of current row as a range."
+ (interactive)
+ (ses-check-curcell 'range)
+ (let ((row (car (ses-sym-rowcol (or (car-safe curcell) curcell)))))
+ (push-mark (point))
+ (ses-goto-print (1+ row) 0)
+ (push-mark (point) nil t)
+ (ses-goto-print row 0)))
+
+(defun ses-mark-column ()
+ "Marks the entirety of current column as a range."
+ (interactive)
+ (ses-check-curcell 'range)
+ (let ((col (cdr (ses-sym-rowcol (or (car-safe curcell) curcell))))
+ (row 0))
+ (push-mark (point))
+ (ses-goto-print (1- numrows) col)
+ (forward-char 1)
+ (push-mark (point) nil t)
+ (while (eq '*skip* (ses-cell-value row col))
+ ;;Skip over initial cells in column that can't be selected
+ (setq row (1+ row)))
+ (ses-goto-print row col)))
+
+(defun ses-end-of-line ()
+ "Move point to last cell on line."
+ (interactive)
+ (ses-check-curcell 'end 'range)
+ (when curcell ;Otherwise we're at the bottom row, which is empty anyway
+ (let ((col (1- numcols))
+ row rowcol)
+ (if (symbolp curcell)
+ ;;Single cell
+ (setq row (car (ses-sym-rowcol curcell)))
+ ;;Range - use whichever end of the range the point is at
+ (setq rowcol (ses-sym-rowcol (if (< (point) (mark))
+ (car curcell)
+ (cdr curcell))))
+ ;;If range already includes the last cell in a row, point is actually
+ ;;in the following row
+ (if (<= (cdr rowcol) (1- col))
+ (setq row (car rowcol))
+ (setq row (1+ (car rowcol)))
+ (if (= row numrows)
+ ;;Already at end - can't go anywhere
+ (setq col 0))))
+ (when (< row numrows) ;Otherwise it's a range that includes last cell
+ (while (eq (ses-cell-value row col) '*skip*)
+ ;;Back to beginning of multi-column cell
+ (setq col (1- col)))
+ (ses-goto-print row col)))))
+
+(defun ses-renarrow-buffer ()
+ "Narrow the buffer so only the print area is visible. Use after \\[widen]."
+ (interactive)
+ (setq deferred-narrow t))
+
+(defun ses-sort-column (sorter &optional reverse)
+ "Sorts the range by a specified column. With prefix, sorts in
+REVERSE order."
+ (interactive "*sSort column: \nP")
+ (ses-check-curcell 'needrange)
+ (let ((min (ses-sym-rowcol (car curcell)))
+ (max (ses-sym-rowcol (cdr curcell))))
+ (let ((minrow (car min))
+ (mincol (cdr min))
+ (maxrow (car max))
+ (maxcol (cdr max))
+ keys extracts end)
+ (setq sorter (cdr (ses-sym-rowcol (intern (concat sorter "1")))))
+ (or (and sorter (>= sorter mincol) (<= sorter maxcol))
+ (error "Invalid sort column"))
+ ;;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))
+ (push (cons (buffer-substring-no-properties (point) end)
+ (+ minrow x))
+ keys))
+ (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)))
+ (dolist (x keys)
+ (ses-goto-print (cdr x) (1+ maxcol))
+ (setq end (point))
+ (ses-goto-print (cdr x) mincol)
+ (push (ses-copy-region (point) end) extracts))
+ (deactivate-mark)
+ ;;Paste the lines sequentially
+ (dotimes (x (- maxrow minrow -1))
+ (ses-goto-print (+ minrow x) mincol)
+ (ses-set-curcell)
+ (ses-yank-cells (pop extracts) nil)))))
+
+(defun ses-sort-column-click (event reverse)
+ (interactive "*e\nP")
+ (setq event (event-end event))
+ (select-window (posn-window event))
+ (setq event (car (posn-col-row event))) ;Click column
+ (let ((col 0))
+ (while (and (< col numcols) (> event (ses-col-width col)))
+ (setq event (- event (ses-col-width col) 1)
+ col (1+ col)))
+ (if (>= col numcols)
+ (ding)
+ (ses-sort-column (ses-column-letter col) reverse))))
+
+(defun ses-insert-range ()
+ "Inserts into minibuffer the list of cells currently highlighted in the
+spreadsheet."
+ (interactive "*")
+ (let (x)
+ (with-current-buffer (window-buffer minibuffer-scroll-window)
+ (ses-command-hook) ;For ses-coverage
+ (ses-check-curcell 'needrange)
+ (setq x (cdr (macroexpand `(ses-range ,(car curcell) ,(cdr curcell))))))
+ (insert (substring (prin1-to-string (nreverse x)) 1 -1))))
+
+(defun ses-insert-ses-range ()
+ "Inserts \"(ses-range x y)\" in the minibuffer to represent the currently
+highlighted range in the spreadsheet."
+ (interactive "*")
+ (let (x)
+ (with-current-buffer (window-buffer minibuffer-scroll-window)
+ (ses-command-hook) ;For ses-coverage
+ (ses-check-curcell 'needrange)
+ (setq x (format "(ses-range %S %S)" (car curcell) (cdr curcell))))
+ (insert x)))
+
+(defun ses-insert-range-click (event)
+ "Mouse version of `ses-insert-range'."
+ (interactive "*e")
+ (mouse-set-point event)
+ (ses-insert-range))
+
+(defun ses-insert-ses-range-click (event)
+ "Mouse version of `ses-insert-ses-range'."
+ (interactive "*e")
+ (mouse-set-point event)
+ (ses-insert-ses-range))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Checking formulas for safety
+;;;----------------------------------------------------------------------------
+
+(defun ses-safe-printer (printer)
+ "Returns PRINTER if safe, or the substitute printer `ses-unsafe' otherwise."
+ (if (or (stringp printer)
+ (stringp (car-safe printer))
+ (not printer)
+ (ses-warn-unsafe printer 'unsafep-function))
+ printer
+ 'ses-unsafe))
+
+(defun ses-safe-formula (formula)
+ "Returns FORMULA if safe, or the substitute formula *unsafe* otherwise."
+ (if (ses-warn-unsafe formula 'unsafep)
+ formula
+ `(ses-unsafe ',formula)))
+
+(defun ses-warn-unsafe (formula checker)
+ "Applies CHECKER to FORMULA. If result is non-nil, asks user for
+confirmation about FORMULA, which might be unsafe. Returns t if formula
+is safe or user allows execution anyway. Always returns t if
+`safe-functions' is t."
+ (if (eq safe-functions t)
+ t
+ (setq checker (funcall checker formula))
+ (if (not checker)
+ t
+ (y-or-n-p (format "Formula %S\nmight be unsafe %S. Process it? "
+ formula checker)))))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Standard formulas
+;;;----------------------------------------------------------------------------
+
+(defmacro ses-range (from to)
+ "Expands to a list of cell-symbols for the range. The range automatically
+expands to include any new row or column inserted into its middle. The SES
+library code specifically looks for the symbol `ses-range', so don't create an
+alias for this macro!"
+ (let (result)
+ (ses-dorange (cons from to)
+ (push (ses-cell-symbol row col) result))
+ (cons 'list result)))
+
+(defun ses-delete-blanks (&rest args)
+ "Return ARGS reversed, with the blank elements (nil and *skip*) removed."
+ (let (result)
+ (dolist (cur args)
+ (and cur (not (eq cur '*skip*))
+ (push cur result)))
+ result))
+
+(defun ses+ (&rest args)
+ "Compute the sum of the arguments, ignoring blanks."
+ (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."
+ (setq list (apply 'ses-delete-blanks list))
+ (/ (float (apply '+ list)) (length list)))
+
+(defmacro ses-select (fromrange test torange)
+ "Select cells in FROMRANGE that are `equal' to TEST. For each match, return
+the corresponding cell from TORANGE. The ranges are macroexpanded but not
+evaluated so they should be either (ses-range BEG END) or (list ...). The
+TEST is evaluated."
+ (setq fromrange (cdr (macroexpand fromrange))
+ torange (cdr (macroexpand torange))
+ test (eval test))
+ (or (= (length fromrange) (length torange))
+ (error "ses-select: Ranges not same length"))
+ (let (result)
+ (dolist (x fromrange)
+ (if (equal test (symbol-value x))
+ (push (car torange) result))
+ (setq torange (cdr torange)))
+ (cons 'list result)))
+
+;;All standard formulas are safe
+(dolist (x '(ses-range ses-delete-blanks ses+ ses-average ses-select))
+ (put x 'side-effect-free t))
+
+
+;;;----------------------------------------------------------------------------
+;;;; Standard print functions
+;;;----------------------------------------------------------------------------
+
+;;These functions use the variables 'row' and 'col' that are
+;;dynamically bound by ses-print-cell. We define these varables at
+;;compile-time to make the compiler happy.
+(eval-when-compile
+ (make-local-variable 'row)
+ (make-local-variable 'col)
+ ;;Don't use setq -- that gives a "free variable" compiler warning
+ (set 'row nil)
+ (set 'col nil))
+
+(defun ses-center (value &optional span fill)
+ "Print VALUE, centered within column. FILL is the fill character for
+centering (default = space). SPAN indicates how many additional rightward
+columns to include in width (default = 0)."
+ (let ((printer (or (ses-col-printer col) default-printer))
+ (width (ses-col-width col))
+ half)
+ (or fill (setq fill ? ))
+ (or span (setq span 0))
+ (setq value (ses-call-printer printer value))
+ (dotimes (x span)
+ (setq width (+ width 1 (ses-col-width (+ col span (- x))))))
+ (setq width (- width (length value)))
+ (if (<= width 0)
+ value ;Too large for field, anyway
+ (setq half (make-string (/ width 2) fill))
+ (concat half value half
+ (if (> (% width 2) 0) (char-to-string fill))))))
+
+(defun ses-center-span (value &optional fill)
+ "Print VALUE, centered within the span that starts in the current column
+and continues until the next nonblank column. FILL specifies the fill
+character (default = space)."
+ (let ((end (1+ col)))
+ (while (and (< end numcols)
+ (memq (ses-cell-value row end) '(nil *skip*)))
+ (setq end (1+ end)))
+ (ses-center value (- end col 1) fill)))
+
+(defun ses-dashfill (value &optional span)
+ "Print VALUE centered using dashes. SPAN indicates how many rightward
+columns to include in width (default = 0)."
+ (ses-center value span ?-))
+
+(defun ses-dashfill-span (value)
+ "Print VALUE, centered using dashes within the span that starts in the
+current column and continues until the next nonblank column."
+ (ses-center-span value ?-))
+
+(defun ses-tildefill-span (value)
+ "Print VALUE, centered using tildes within the span that starts in the
+current column and continues until the next nonblank column."
+ (ses-center-span value ?~))
+
+(defun ses-unsafe (value)
+ "Substitute for an unsafe formula or printer"
+ (error "Unsafe formula or printer"))
+
+;;All standard printers are safe, including ses-unsafe!
+(dolist (x (cons 'ses-unsafe ses-standard-printer-functions))
+ (put x 'side-effect-free t))
+
+(provide 'ses)
+
+;; ses.el ends here.
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename ../info/ses
+@settitle SES: Simple Emacs Spreadsheet
+@setchapternewpage off
+@c %**end of header
+
+@dircategory Emacs
+@direntry
+* SES: (ses). Simple Emacs Spreadsheet
+@end direntry
+
+@ifinfo
+This file documents SES: the Simple Emacs Spreadsheet.
+
+Copyright @copyright{} 2002 Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover texts being ``A GNU
+Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the
+license is included in the section entitled ``GNU Free Documentation
+License'' in the Emacs manual.
+
+(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
+this GNU Manual, like GNU software. Copies published by the Free
+Software Foundation raise funds for GNU development.''
+
+This document is part of a collection distributed under the GNU Free
+Documentation License. If you want to distribute this document
+separately from the collection, you can do so by adding a copy of the
+license to the document, as described in section 6 of the license.
+@end ifinfo
+
+@finalout
+
+@titlepage
+@title SES
+@subtitle Simple Emacs Spreadsheet
+@author Jonathan A. Yavner
+@author @email{jyavner@@engineer.com}
+
+@comment The following two commands start the copyright page.
+@page
+@vskip 0pt plus 1filll
+@noindent
+Copyright @copyright{} 2002 Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover texts being ``A GNU
+Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
+license is included in the section entitled ``GNU Free Documentation
+License'' in the Emacs manual.
+
+(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
+this GNU Manual, like GNU software. Copies published by the Free
+Software Foundation raise funds for GNU development.''
+
+This document is part of a collection distributed under the GNU Free
+Documentation License. If you want to distribute this document
+separately from the collection, you can do so by adding a copy of the
+license to the document, as described in section 6 of the license.
+@end titlepage
+
+@contents
+
+@c ===================================================================
+
+@ifnottex
+@node Top, Introduction, (dir), (dir)
+@comment node-name, next, previous, up
+@top SES: Simple Emacs Spreadsheet
+
+@display
+SES is a major mode for GNU Emacs to edit spreadsheet files, which
+contain a rectangular grid of cells. The cells' values are specified
+by formulas that can refer to the values of other cells.
+@end display
+@end ifnottex
+
+This (such as @pxref{Top,calc,,calc}) is good.
+
+To report bugs, send email to @email{jyavner@@engineer.com}.
+
+@menu
+* Sales pitch:: Why use SES?
+* The Basics:: Basic spreadsheet commands
+* Advanced Features:: Want to know more?
+* For Gurus:: Want to know @emph{even more}?
+* Acknowledgements:: Acknowledgements
+@end menu
+
+@c ===================================================================
+
+@node Sales Pitch, The Basics, Top, Top
+@comment node-name, next, previous, up
+@chapter Sales Pitch
+
+@itemize @bullet
+@item Create and edit simple spreadsheets with a minimum of fuss.
+@item Full undo/redo/autosave.
+@item Immune to viruses in spreadsheet files.
+@item Cell formulas are straight Emacs Lisp.
+@item Printer functions for control of cell appearance.
+@item Intuitive keystroke commands: C-o = insert row, M-o = insert column, etc.
+@item ``Spillover'' of lengthy cell values into following blank cells.
+@item Header line shows column letters or a selected row.
+@item Completing-read for entering symbols as cell values.
+@item Cut, copy, and paste can transfer formulas and printer functions.
+@item Import and export of tab-separated values or tab-separated formulas.
+@item Plaintext, easily-hacked file format.
+@end itemize
+
+@c ===================================================================
+
+@node The Basics, Advanced Features, Sales Pitch, Top
+@comment node-name, next, previous, up
+@chapter The Basics
+
+A @dfn{cell identifier} is a symbol with a column letter and a row
+number. Cell B7 is the 2nd column of the 7th row. For very wide
+spreadsheets, there are two column letters: cell AB7 is the 28th
+column of the 7th row.
+
+@table @kbd
+@item j
+Moves point to cell, specified by identifier (@code{ses-jump}).
+@end table
+
+Point is always at the left edge of a cell, or at the empty endline.
+When mark is inactive, the current cell is underlined. When mark is
+active, the range is the highlighted rectangle of cells (SES always
+uses transient mark mode). Drag the mouse from A1 to A3 to create the
+range A1-A2. Many SES commands operate only on single cells, not
+ranges.
+
+@table @kbd
+@item C-SPC
+@itemx C-@@
+Set mark at point (@code{set-mark-command}).
+
+@item C-g
+Turn off the mark (@code{keyboard-quit}).
+
+@item M-h
+Highlight current row (@code{ses-mark-row}).
+
+@item S-M-h
+Highlight current column (@code{ses-mark-column}).
+
+@item C-x h
+Highlight all cells (@code{mark-whole-buffer}).
+@end table
+
+@menu
+* Formulas::
+* Resizing::
+* Printer functions::
+* Clearing cells::
+* Copy/cut/paste::
+* Customizing SES::
+@end menu
+
+@node Formulas, Resizing, The Basics, The Basics
+@section Cell formulas
+
+To enter a number into the current cell, just start typing:
+
+@table @kbd
+@item 0..9
+Self-insert a digit (@code{ses-read-cell}).
+
+@item -
+Self-insert a negative number (@code{ses-read-cell}).
+
+@item .
+Self-insert a fractional number (@code{ses-read-cell}).
+
+@item "
+Self-insert a quoted string. The ending double-quote
+is inserted for you (@code{ses-read-cell}).
+
+@item (
+Self-insert an expression. The right-parenthesis is inserted for you
+(@code{ses-read-cell}). To access another cell's value, just use its
+identifier in your expression. Whenever the other cell is changed,
+this cell's formula will be reevaluated. While typing in the
+expression, you can use @kbd{M-TAB} to complete symbol names.
+
+@item ' @r{(apostrophe)}
+Enter a symbol (ses-read-symbol). SES remembers all symbols that have
+been used as formulas, so you can type just the beginning of a symbol
+and use @kbd{SPC}, @kbd{TAB}, and @kbd{?} to complete it.
+@end table
+
+To enter something else (e.g., a vector), begin with a digit, then
+erase the digit and type whatever you want.
+
+@table @kbd
+@item RET
+Edit the existing formula in the current cell (@code{ses-edit-cell}).
+
+@item C-c C-c
+Force recalculation of the current cell or range (@code{ses-recalculate-cell}).
+
+@item C-c C-l
+Recalculate the entire spreadsheet (@code{ses-recalculate-all}).
+@end table
+
+@node Resizing, Printer functions, Formulas, The Basics
+@section Resizing the spreadsheet
+
+Basic commands:
+
+@table @kbd
+@item C-o
+(@code{ses-insert-row})
+
+@item M-o
+(@code{ses-insert-column})
+
+@item C-k
+(@code{ses-delete-row})
+
+@item M-k
+(@code{ses-delete-column})
+
+@item w
+(@code{ses-set-column-width})
+
+@item TAB
+Moves point to the next rightward cell, or inserts a new column if
+already at last cell on line, or inserts a new row if at endline
+(@code{ses-forward-or-insert}).
+
+@item C-j
+Linefeed inserts below the current row and moves to column A
+(@code{ses-append-row-jump-first-column}).
+@end table
+
+Resizing the spreadsheet (unless you're just changing a column width)
+relocates all the cell-references in formulas so they still refer to
+the same cells. If a formula mentioned B1 and you insert a new first
+row, the formula will now mention B2.
+
+If you delete a cell that a formula refers to, the cell-symbol is
+deleted from the formula, so @code{(+ A1 B1 C1)} after deleting the third
+column becomes @code{(+ A1 B1)}. In case this is not what you wanted:
+
+@table @kbd
+@item C-_
+@itemx C-x u
+Undo previous action (@code{(undo)}).
+@end table
+
+
+@node Printer functions, Clearing cells, Resizing, The Basics
+@section Printer functions
+
+Printer functions convert binary cell values into the print forms that
+Emacs will display on the screen.
+
+A printer can be a format string, like @samp{"$%.2f"}. The result
+string is right-aligned within the print cell. To get left-alignment,
+use parentheses: @samp{("$%.2f")}. A printer can also be a
+one-argument function (a symbol or a lambda), whose result is a string
+(right-aligned) or list of one string (left-aligned). While typing in
+a lambda, you can use @kbd{M-TAB} to complete the names of symbols.
+
+Each cell has a printer. If nil, the column-printer for the cell's
+column is used. If that is also nil, the default-printer for the
+spreadsheet is used.
+
+@table @kbd
+@item p
+Enter a printer for current cell or range (@code{ses-read-cell-printer}).
+
+@item M-p
+Enter a printer for the current column (@code{ses-read-column-printer}).
+
+@item C-c C-p
+Enter the default printer for the spreadsheet
+(@code{ses-read-default-printer}).
+@end table
+
+The @code{ses-read-@r{XXX}-printer} commands have their own minibuffer
+history, which is preloaded with the set of all printers used in this
+spreadsheet, plus the standard printers.
+
+The standard printers are suitable only for cells, not columns or
+default, because they format the value using the column-printer (or
+default-printer if nil) and then center the result:
+
+@table @code
+@item ses-center
+Just centering.
+
+@item ses-center-span
+Centering with spill-over to following blank cells.
+
+@item ses-dashfill
+Centering using dashes (-) instead of spaces.
+
+@item ses-dashfill-span
+Centering with dashes and spill-over.
+
+@item ses-tildefill-span
+Centering with tildes (~) and spill-over.
+@end table
+
+
+@node Clearing cells, Copy/cut/paste, Printer functions, The Basics
+@section Clearing cells
+
+These commands set both formula and printer to nil:
+
+@table @kbd
+@item DEL
+Clear cell and move left (@code{ses-clear-cell-backward}).
+
+@item C-d
+Clear cell and move right (@code{ses-clear-cell-forward}).
+@end table
+
+
+@node Copy/cut/paste, Customizing SES, Clearing cells, The Basics
+@section Copy, cut, and paste
+
+The copy functions work on rectangular regions of cells. You can paste the
+copies into non-SES buffers to export the print text.
+
+@table @kbd
+@item M-w
+@itemx [copy]
+@itemx [C-insert]
+Copy the highlighted cells to kill ring and primary clipboard
+(@code{kill-ring-save}).
+
+@item [drag-mouse-1]
+Mark a region and copy it to kill ring and primary clipboard
+(@code{mouse-set-region}).
+
+@item [M-drag-mouse-1]
+Mark a region and copy it to kill ring and secondary clipboard
+(@code{mouse-set-secondary}).
+
+@item C-w
+@itemx [cut]
+@itemx [S-delete]
+The cut functions do not actually delete rows or columns - they copy
+and then clear (@code{ses-kill-override}).
+
+@item C-y
+@itemx [S-insert]
+Paste from kill ring (@code{yank}). The paste functions behave
+differently depending on the format of the text being inserted:
+@itemize @bullet
+@item
+When pasting cells that were cut from a SES buffer, the print text is
+ignored and only the attached formula and printer are inserted; cell
+references in the formula are relocated unless you use @kbd{C-u}.
+@item
+The pasted text overwrites a rectangle of cells whose top left corner
+is the current cell. If part of the rectangle is beyond the edges of
+the spreadsheet, you must confirm the increase in spreadsheet size.
+@item
+Non-SES text is usually inserted as a replacement formula for the
+current cell. If the formula would be a symbol, it's treated as a
+string unless you use @kbd{C-u}. Pasted formulas with syntax errors
+are always treated as strings.
+@end itemize
+
+@item [paste]
+Paste from primary clipboard or kill ring (@code{clipboard-yank}).
+
+@item [mouse-2]
+Set point and paste from primary clipboard (@code{mouse-yank-at-click}).
+
+@item [M-mouse-2]
+Set point and paste from secondary clipboard (@code{mouse-yank-secondary}).
+
+@item M-y
+Immediately after a paste, you can replace the text with a preceding
+element from the kill ring (@code{ses-yank-pop}). Unlike the standard
+Emacs yank-pop, the SES version uses @code{undo} to delete the old
+yank. This doesn't make any difference?
+@end table
+
+@node Customizing SES, , Copy/cut/paste, The Basics
+@section Customizing SES
+
+By default, a newly-created spreadsheet has 1 row and 1 column. The
+column width is 7 and the default printer is @samp{"%.7g"}. Each of these
+can be customized. Look in group ``ses''.
+
+After entering a cell value, point normally moves right to the next
+cell. You can customize @code{ses-after-entry-functions} to move left or
+up or down. For diagonal movement, select two functions from the
+list.
+
+@code{ses-mode-hook} is a normal mode hook (list of functions to
+execute when starting SES mode for a buffer).
+
+The variable @code{safe-functions} is a a list of possibly-unsafe
+functions to be treated as safe when analysing formulas and printers.
+@xref{Virus protection}. Before customizing @code{safe-functions},
+think about how much you trust the person who's suggesting this
+change. The value t turns off all anti-virus protection. A
+list-of-functions value might enable a ``gee whiz'' spreadsheet, but it
+also creates trapdoors in your anti-virus armor. In order for virus
+protection to work, you must always press @kbd{n} when presented with
+a virus warning, unless you understand what the questionable code is
+trying to do. Do not listen to those who tell you to customize
+@code{enable-local-eval}---this variable is for people who don't wear
+safety belts!
+
+
+@c ===================================================================
+
+@node Advanced Features, For Gurus, The Basics, Top
+@chapter Advanced Features
+
+@table @kbd
+@item C-c M-C-h
+(@code{ses-read-header-row}). The header line at the top of the SES
+window normally shows the column letter for each column. You can set
+it to show a copy of some row, such as a row of column titles, so that
+row will always be visible. Set the header line to row 0 to show
+column letters again.
+@end table
+
+@menu
+* The print area::
+* Ranges in formulas::
+* Sorting by column::
+* Standard formula functions::
+* More on cell printing::
+* Import and export::
+* Virus protection::
+* Spreadsheets with details and summary::
+@end menu
+
+@node The print area, Ranges in formulas, Advanced Features, Advanced Features
+@section The print area
+
+A SES file consists of a print area and a data area. Normally the
+buffer is narrowed to show only the print area. The print area is
+read-only except for special SES commands; it contains cell values
+formatted by printer functions. The data area records the formula and
+printer functions, etc.
+
+@table @kbd
+@item C-x n w
+Show print and data areas (@code{widen}).
+
+@item C-c C-n
+Show only print area (@code{ses-renarrow-buffer}).
+
+@item S-C-l
+@itemx M-C-l
+Recreate print area by reevaluating printer functions for all cells
+(@code{ses-reprint-all}).
+@end table
+
+@node Ranges in formulas, Sorting by column, The print area, Advanced Features
+@section Ranges in formulas
+
+A formula like
+@lisp
+(+ A1 A2 A3)
+@end lisp
+is the sum of three specific cells. If you insert a new second row,
+the formula becomes
+@lisp
+(+ A1 A3 A4)
+@end lisp
+and the new row is not included in the sum.
+
+The macro @code{(ses-range @var{from} @var{to})} evalutes to a list of
+the values in a rectangle of cells. If your formula is
+@lisp
+(apply '+ (ses-range A1 A3))
+@end lisp
+and you insert a new second row, it becomes
+@lisp
+(apply '+ (ses-range A1 A4))
+@end lisp
+and the new row is included in the sum.
+
+While entering or editing a formula in the minibuffer, you can select
+a range in the spreadsheet (using mouse or keyboard), then paste a
+representation of that range into your formula. Suppose you select
+A1-C1:
+
+@table @kbd
+@item [S-mouse-3]
+Inserts "A1 B1 C1" @code{(ses-insert-range-click})
+
+@item C-c C-r
+Keyboard version (@code{ses-insert-range}).
+
+@item [C-S-mouse-3]
+Inserts "(ses-range A1 C1)" (@code{ses-insert-ses-range-click}).
+
+@item C-c C-s
+Keyboard version (@code{ses-insert-ses-range}).
+@end table
+
+If you delete the @var{from} or @var{to} cell for a range, the nearest
+still-existing cell is used instead. If you delete the entire range,
+the formula relocator will delete the ses-range from the formula.
+
+If you insert a new row just beyond the end of a one-column range, or
+a new column just beyond a one-row range, the new cell is included in
+the range. New cells inserted just before a range are not included.
+
+
+@node Sorting by column, Standard formula functions, Ranges in formulas, Advanced Features
+@section Sorting by column
+
+@table @kbd
+@item C-c M-C-s
+Sort the cells of a range using one of the columns
+(@code{ses-sort-column}). The rows (or partial rows if the range
+doesn't include all columns) are rearranged so the chosen column will
+be in order.
+
+@item [header-line mouse-2]
+The easiest way to sort is to click mouse-2 on the chosen column's header row
+(@code{ses-sort-column-click}).
+@end table
+
+The sort comparison uses @code{string<}, which works well for
+right-justified numbers and left-justified strings.
+
+With prefix arg, sort is in descending order.
+
+Rows are moved one at a time, with relocation of formulas. This works
+well if formulas refer to other cells in their row, not so well for
+formulas that refer to other rows in the range or to cells outside the
+range.
+
+
+@node Standard formula functions, More on cell printing, Sorting by column, Advanced Features
+@section Standard formula functions
+
+Oftentimes you want a calculation to exclude the blank cells. Here
+are some useful functions to call from your formulas:
+
+@table @code
+@item (ses-delete-blanks &rest @var{args})
+Returns a list from which all blank cells (value is either nil or
+'*skip*) have been deleted.
+
+@item (ses+ &rest @var{args})
+Sum of non-blank arguments.
+
+@item (ses-average @var{list})
+Average of non-blank elements in @var{list}. Here the list is passed
+as a single argument, since you'll probably use it with @code{ses-range}.
+@end table
+
+@node More on cell printing, Import and export, Standard formula functions, Advanced Features
+@section More on cell printing
+
+Special cell values:
+@itemize
+@item nil prints the same as "", but allows previous cell to spill over.
+@item '*skip* replaces nil when the previous cell actually does spill over;
+nothing is printed for it.
+@item '*error* indicates that the formula signalled an error instead of
+producing a value: the print cell is filled with hash marks (#).
+@end itemize
+
+If the result from the printer function is too wide for the cell and
+the following cell is nil, the result will spill over into the
+following cell. Very wide results can spill over several cells. If
+the result is too wide for the available space (up to the end of the
+row or the next non-nil cell), the result is truncated if the cell's
+value is a string, or replaced with hash marks otherwise.
+
+SES could get confused by printer results that contain newlines or
+tabs, so these are replaced with question marks.
+
+@table @kbd
+@item C-c C-t
+Confine a cell to its own column (@code{ses-truncate-cell}). This
+alows you to move point to a rightward cell that would otherwise be
+covered by a spill-over. If you don't change the rightward cell, the
+confined cell will spill over again the next time it is reprinted.
+
+@item C-c C-c
+When applied to a single cell, this command displays in the echo area any
+formula error or printer error that occurred during
+recalculation/reprinting (@code{ses-recalculate-cell}).
+@end table
+
+When a printer function signals an error, the default printer
+@samp{"%s"} is substituted. This is useful when your column printer
+is numeric-only and you use a string as a cell value.
+
+
+@node Import and export, Virus protection, More on cell printing, Advanced Features
+@section Import and export
+
+@table @kbd
+@item x t
+Export a range of cells as tab-separated values (@code{ses-export-tsv}).
+@item x T
+Export a range of cells as tab-separated formulas (@code{ses-export-tsf}).
+@end table
+
+The exported text goes to the kill ring --- you can paste it into
+another buffer. Columns are separated by tabs, rows by newlines.
+
+To import text, use any of the yank commands where the text to paste
+contains tabs and/or newlines. Imported formulas are not relocated.
+
+@node Virus protection, Spreadsheets with details and summary, Import and export, Advanced Features
+@section Virus protection
+
+Whenever a formula or printer is read from a file or is pasted into
+the spreadsheet, it receives a ``needs safety check'' marking. Later,
+when the formula or printer is evaluated for the first time, it is
+checked for safety using the @code{unsafep} predicate; if found to be
+``possibly unsafe'', the questionable formula or printer is displayed
+and you must press Y to approve it or N to use a substitute. The
+substitute always signals an error.
+
+Formulas or printers that you type in are checked immediately for
+safety. If found to be possibly unsafe and you press N to disapprove,
+the action is cancelled and the old formula or printer will remain.
+
+Besides viruses (which try to copy themselves to other files),
+@code{unsafep} can also detect all other kinds of Trojan horses, such as
+spreadsheets that delete files, send email, flood Web sites, alter
+your Emacs settings, etc.
+
+Generally, spreadsheet formulas and printers are simple things that
+don't need to do any fancy computing, so all potentially-dangerous
+parts of the Emacs Lisp environment can be excluded without cramping
+your style as a formula-writer. See the documentation in @file{unsafep.el}
+for more info on how Lisp forms are classified as safe or unsafe.
+
+@node Spreadsheets with details and summary, , Virus protection, Advanced Features
+@section Spreadsheets with details and summary
+
+A common organization for spreadsheets is to have a bunch of ``detail''
+rows, each perhaps describing a transaction, and then a set of
+``summary'' rows that each show reduced data for some subset of the
+details. SES supports this organization via the @code{ses-select}
+function.
+
+@table @code
+@item (ses-select @var{fromrange} @var{test} @var{torange})
+Returns a subset of @var{torange}. For each member in @var{fromrange}
+that is equal to @var{test}, the corresponding member of @var{torange}
+is included in the result.
+@end table
+
+Example of use:
+@lisp
+(ses-average (ses-select (ses-range A1 A5) 'Smith (ses-range B1 B5)))
+@end lisp
+This computes the average of the B column values for those rows whose
+A column value is the symbol 'Smith.
+
+Arguably one could specify only @var{fromrange} plus
+@var{to-row-offset} and @var{to-column-offset}. The @var{torange} is
+stated explicitly to ensure that the formula will be recalculated if
+any cell in either range is changed.
+
+File @file{etc/ses-example.el} in the Emacs distribution is an example of a
+details-and-summary spreadsheet.
+
+
+@c ===================================================================
+
+@node For Gurus, Acknowledgements, Advanced Features, Top
+@chapter For Gurus
+
+@menu
+* Deferred updates::
+* Nonrelocatable references::
+* The data area::
+* Buffer-local variables in spreadsheets::
+* Uses of defadvice in SES::
+@end menu
+
+@node Deferred updates, Nonrelocatable references, For Gurus, For Gurus
+@section Deferred updates
+
+To save time by avoiding redundant computations, cells that need
+recalculation due to changes in other cells are added to a set. At
+the end of the command, each cell in the set is recalculated once.
+This can create a new set of cells that need recalculation. The
+process is repeated until either the set is empty or it stops changing
+(due to circular references among the cells). In extreme cases, you
+might see progress messages of the form ``Recalculating... (@var{nnn}
+cells left)''. If you interrupt the calculation using @kbd{C-g}, the
+spreadsheet will be left in an inconsistent state, so use @kbd{C-_} or
+@kbd{C-c C-l} to fix it.
+
+To save even more time by avoiding redundant writes, cells that have
+changes are added to a set instead of being written immediately to the
+data area. Each cell in the set is written once, at the end of the
+command. If you change vast quantities of cells, you might see a
+progress message of the form ``Writing... (@var{nnn} cells left)''.
+These deferred cell-writes cannot be interrupted by @kbd{C-g}, so
+you'll just have to wait.
+
+SES uses @code{run-with-idle-timer} to move the cell underline when
+Emacs will be scrolling the buffer after the end of a command, and
+also to narrow and underline after @kbd{C-x C-v}. This is visible as
+a momentary glitch after C-x C-v and certain scrolling commands. You
+can type ahead without worrying about the glitch.
+
+
+@node Nonrelocatable references, The data area, Deferred updates, For Gurus
+@section Nonrelocatable references
+
+@kbd{C-y} relocates all cell-references in a pasted formula, while
+@kbd{C-u C-y} relocates none of the cell-references. What about mixed
+cases?
+
+You can use
+@lisp
+(symbol-value 'B3)
+@end lisp
+to make an @dfn{absolute reference}. The formula relocator skips over
+quoted things, so this will not be relocated when pasted or when
+rows/columns are inserted/deleted. However, B3 will not be recorded
+as a dependency of this cell, so this cell will not be updated
+automatically when B3 is changed.
+
+The variables @code{row} and @code{col} are dynamically bound while a
+cell formula is being evaluated. You can use
+@lisp
+(ses-cell-value row 0)
+@end lisp
+to get the value from the leftmost column in the current row. This
+kind of dependency is also not recorded.
+
+
+@node The data area, Buffer-local variables in spreadsheets, Nonrelocatable references, For Gurus
+@section The data area
+
+Begins with an 014 character, followed by sets of cell-definition
+macros for each row, followed by column-widths, column-printers,
+default-printer, and header-row. Then there's the global parameters
+(file-format ID, numrows, numcols) and the local variables (specifying
+SES mode for the buffer, etc.)
+
+When a SES file is loaded, first the numrows and numcols values are
+loaded, then the entire data area is @code{eval}ed, and finally the local
+variables are processed.
+
+You can edit the data area, but don't insert or delete any newlines
+except in the local-variables part, since SES locates things by
+counting newlines. Use @kbd{C-x C-e} at the end of a line to install
+your edits into the spreadsheet data structures (this does not update
+the print area, use e.g. @kbd{C-c C-l} for that).
+
+The data area is maintained as an image of spreadsheet data
+structures that area stored in buffer-local variables. If the data
+area gets messed up, you can try reconstructing the data area from the
+data structures:
+
+@table @kbd
+@item C-c M-C-l
+(@code{ses-reconstruct-all}).
+@end table
+
+
+@node Buffer-local variables in spreadsheets, Uses of defadvice in SES, The data area, For Gurus
+@section Buffer-local variables in spreadsheets
+
+You can add additional local variables to the list at the bottom of
+the data area, such as hidden constants you want to refer to in your
+formulas.
+
+You can override the variable @code{symbolic-formulas} to be a list of
+symbols (as parenthesized strings) to show as completions for the '
+command. This initial completions list is used instead of the actual
+set of symbols-as-formulas in the spreadsheet.
+
+For examples of these, see file @file{etc/ses-example.ses}.
+
+If (for some reason) you want your formulas or printers to save data
+into variables, you must declare these variables as buffer-locals in
+order to avoid a virus warning.
+
+You can define functions by making them values for the fake local
+variable @code{eval}. Such functions can then be used in your
+formulas and printers, but usually each @code{eval} is presented to
+the user during file loading as a potential virus --- this can get
+annoying.
+
+You can define functions in your @file{.emacs} file. Other people can
+still read the print area of your spreadsheet, but they won't be able
+to recalculate or reprint anything that depends on your functions. To
+avoid virus warnings, each function used in a formula needs
+@lisp
+(put 'your-function-name 'safe-function t)
+@end lisp
+
+@node Uses of defadvice in SES, , Buffer-local variables in spreadsheets, For Gurus
+@section Uses of defadvice in SES
+
+@table @code
+@item undo-more
+Defines a new undo element format (@var{fun} . @var{args}), which
+means ``undo by applying @var{fun} to @var{args}''. For spreadsheet
+buffers, it allows undos in the data area even though that's outside
+the narrowing.
+
+@item copy-region-as-kill
+When copying from the print area of a spreadsheet, treat the region as
+a rectangle and attach each cell's formula and printer as 'ses
+properties.
+
+@item yank
+When yanking into the print area of a spreadsheet, first try to yank
+as cells (if the yank text has 'ses properties), then as tab-separated
+formulas, then (if all else fails) as a single formula for the current
+cell.
+@end table
+
+
+@c ===================================================================
+
+@node Acknowledgements, , For Gurus, Top
+@chapter Acknowledgements
+
+@quotation
+Christoph Conrad @email{christoph.conrad@@gmx.de}@*
+CyberBob @email{cyberbob@@redneck.gacracker.org}@*
+Syver Enstad @email{syver-en@@online.no}@*
+Ami Fischman @email{fischman@@zion.bpnetworks.com}@*
+Thomas Gehrlein @email{Thomas.Gehrlein@@t-online.de}@*
+Chris F.A. Johnson @email{c.f.a.johnson@@rogers.com}@*
+Yusong Li @email{lyusong@@hotmail.com}@*
+Yuri Linkov @email{link0ff@@yahoo.com}@*
+Harald Maier @email{maierh@@myself.com}@*
+Alan Nash @email{anash@@san.rr.com}@*
+François Pinard @email{pinard@@iro.umontreal.ca}@*
+Pedro Pinto @email{ppinto@@cs.cmu.edu}@*
+Stefan Reichör @email{xsteve@@riic.at}@*
+Oliver Scholz @email{epameinondas@@gmx.de}@*
+Richard M. Stallman @email{rms@@gnu.org}@*
+J. Otto Tennant @email{jotto@@pobox.com}@*
+Jean-Philippe Theberge @email{jphil@@acs.pagesjaunes.fr}
+@end quotation
+
+@c ===================================================================
+
+@bye