;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*-
-;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;----------------------------------------------------------------------------
(defgroup ses nil
- "Simple Emacs Spreadsheet"
+ "Simple Emacs Spreadsheet."
:group 'applications
:prefix "ses-"
:version "21.1")
(newmap (make-sparse-keymap)))
(set-keymap-parent newmap minibuffer-local-map)
(while keys
- (define-key newmap (car keys) (cadr keys))
- (setq keys (cddr keys)))
+ (define-key newmap (pop keys) (pop keys)))
newmap)
"Local keymap for SES minibuffer cell-editing.")
;;print area (excluding the terminating newline)
(setq ses--col-widths widths
ses--linewidth (apply '+ -1 (mapcar '1+ widths))
- ses--blank-line (concat (make-string ses--linewidth ? ) "\n"))
+ ses--blank-line (concat (make-string ses--linewidth ?\s) "\n"))
t)
(defmacro ses-column-printers (printers)
(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 ses--numrows))
+ (or (and (wholenump row) (or (zerop ses--numrows) (< row ses--numrows)))
(error "Bad header-row"))
(setq ses--header-row row)
t)
(cond
((< len width)
;;Fill field to length with spaces
- (setq len (make-string (- width len) ? )
+ (setq len (make-string (- width len) ?\s)
text (if (eq ses-call-printer-return t)
(concat text len)
(concat len text))))
maxcol (1+ maxcol)))
(if (<= len maxwidth)
;;Fill to complete width of all the fields spanned
- (setq text (concat text (make-string (- maxwidth len) ? )))
+ (setq text (concat text (make-string (- maxwidth len) ?\s)))
;;Not enough room to end of line or next non-nil field. Truncate
;;if string or decimal; otherwise fill with error indicator
(setq sig `(error "Too wide" ,text))
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."
+printer signaled one (and \"%s\" is used as the default printer), else nil."
(setq ses-call-printer-return nil)
(unless value
(setq value ""))
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 ? )))
+ (blank (if (> change 0) (make-string change ?\s)))
(at-end (= col ses--numcols)))
(ses-set-with-undo 'ses--linewidth (+ ses--linewidth change))
;;ses-set-with-undo always returns t for strings.
(1value (ses-set-with-undo 'ses--blank-line
- (concat (make-string ses--linewidth ? ) "\n")))
+ (concat (make-string ses--linewidth ?\s) "\n")))
(dotimes (row ses--numrows)
(ses-goto-print row col)
(when at-end
(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size)))
+(defun ses-widen ()
+ "Turn off narrowing, to be reenabled at end of command loop."
+ (if (ses-narrowed-p)
+ (setq ses--deferred-narrow t))
+ (widen))
+
(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 ses--col-widths, ses--col-printers,
ses--default-printer, ses--numrows, or ses--numcols."
- (if (ses-narrowed-p)
- (setq ses--deferred-narrow t))
- (widen)
+ (ses-widen)
(let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong
(goto-char (point-min))
(if col
;;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 '(ses--col-widths "(ses-column-widths %S)"
ses--col-printers "(ses-column-printers %S)"
ses--file-format " %S ;SES file-format"
ses--numrows " %S ;numrows"
ses--numcols " %S ;numcols")
- def)))
- (delete-region (point) (line-end-position))
- (insert (format fmt (symbol-value def))))))
+ def))
+ oldval)
+ (if elem
+ (progn
+ (setq oldval (aref (symbol-value def) elem))
+ (aset (symbol-value def) elem value))
+ (setq oldval (symbol-value def))
+ (set def value))
+ ;;Special undo since it's outside the narrowed buffer
+ (let (buffer-undo-list)
+ (delete-region (point) (line-end-position))
+ (insert (format fmt (symbol-value def))))
+ (push `(apply ses-set-parameter ,def ,oldval ,elem) buffer-undo-list))))
+
(defun ses-write-cells ()
"Write cells in `ses--deferred-write' from local variables to data area.
;; Undo control
;;----------------------------------------------------------------------------
-;; This should be unnecessary, because the feature is now built in.
-
-(defadvice undo-more (around ses-undo-more activate preactivate)
- "For SES mode, allow undo outside of narrowed buffer range."
- (if (not (eq major-mode 'ses-mode))
- ad-do-it
- ;;Here is some extra code for SES mode.
- (setq ses--deferred-narrow
- (or ses--deferred-narrow (ses-narrowed-p)))
- (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 point before we start changing hidden stuff."
(let ((inhibit-read-only t))
(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
+ ;;We try to avoid adding redundant entries to the undo list, but this is
;;unavoidable for strings because equal ignores text properties and there's
;;no easy way to get the whole property list to see if it's different!
(unless (and (boundp sym)
(or (and (= (safe-length params) 3)
(numberp (car params))
(numberp (cadr params))
- (> (cadr params) 0)
+ (>= (cadr params) 0)
(numberp (nth 2 params))
(> (nth 2 params) 0))
(error "Invalid SES file"))
(let ((old ses--deferred-recalc))
(setq ses--deferred-recalc nil)
(ses-update-cells old)))
- (if ses--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 ses--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)
+ (push '(apply ses-widen) buffer-undo-list))
(when ses--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
(error
(unless executing-kbd-macro
(ding))
- (message (error-message-string err))))
+ (message "%s" (error-message-string err))))
nil) ;Make coverage-tester happy
(defun ses-create-header-string ()
(error (setq sig hold))))
(cond
(sig
- (message (error-message-string sig)))
+ (message "%s" (error-message-string sig)))
((consp ses--curcell)
(message " "))
(t
(cons (ses-cell-symbol row col)
(ses-cell-references yrow ycol)))))))
;;Delete everything and reconstruct basic data area
- (if (ses-narrowed-p)
- (setq ses--deferred-narrow t))
- (widen)
+ (ses-widen)
(let ((inhibit-read-only t))
(goto-char (point-max))
(if (search-backward ";; Local Variables:\n" nil 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 ses--curcell))))
+ (let* ((initial (this-command-keys))
+ (rowcol (progn (ses-check-curcell) (ses-sym-rowcol ses--curcell)))
+ (curval (ses-cell-formula (car rowcol) (cdr rowcol))))
(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: " ses--curcell)
- (cons initial 2)
- ses-mode-edit-map
- t ;Convert to Lisp object
- 'ses-read-cell-history))))
+ (read-from-minibuffer
+ (format "Cell %s: " ses--curcell)
+ (cons (if (equal initial "\"") "\"\""
+ (if (equal initial "(") "()" initial)) 2)
+ ses-mode-edit-map
+ t ;Convert to Lisp object
+ 'ses-read-cell-history
+ (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula)
+ (cadr curval)
+ curval))))))
(when (ses-edit-cell row col newval)
(ses-command-hook) ;Update cell widths before movement
(dolist (x ses-after-entry-functions)
(ses-reset-header-string)))
;;Reconstruct text attributes
(ses-setup)
+ ;;Prepare for undo
+ (push '(apply ses-widen) buffer-undo-list)
;;Return to current cell
(if ses--curcell
(ses-jump-safe ses--curcell)
(ses-reset-header-string)))
;;Reconstruct attributes
(ses-setup)
+ ;;Prepare for undo
+ (push '(apply ses-widen) buffer-undo-list)
(ses-jump-safe ses--curcell))
(defun ses-insert-column (count &optional col width printer)
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 "
+ (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) "")))
(if (or (< row 0) (> row ses--numrows))
(error "Invalid header-row"))
(ses-begin-change)
- (ses-set-parameter 'ses--header-row row)
+ (let ((oldval ses--header-row))
+ (let (buffer-undo-list)
+ (ses-set-parameter 'ses--header-row row))
+ (push `(apply ses-set-header-row ,oldval) buffer-undo-list))
(ses-reset-header-string))
(defun ses-mark-row ()
(let ((printer (or (ses-col-printer col) ses--default-printer))
(width (ses-col-width col))
half)
- (or fill (setq fill ? ))
+ (or fill (setq fill ?\s))
(or span (setq span 0))
(setq value (ses-call-printer printer value))
(dotimes (x span)