;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*-
-;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005 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")
;;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)
(setq ses--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
(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)
+ (push `(apply 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 sym (ses-create-cell-symbol (+ row minrow) (+ col mincol)))
(if (boundp sym)
- (push `(ses-set-with-undo ,sym ,(symbol-value sym))
+ (push `(apply 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)
+ (push `(apply 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)
+ (push '(apply ses-reset-header-string) buffer-undo-list)
(setq ses--header-hscroll -1))
;;Split this code off into a function to avoid coverage-testing difficulties
(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
to each symbol."
(let (reform)
(let (mycell newval)
- (ses-dotimes-msg (row ses--numrows) "Relocating formulas..."
+ (dotimes-with-progress-reporter
+ (row ses--numrows) "Relocating formulas..."
(dotimes (col ses--numcols)
(setq ses-relocate-return nil
mycell (ses-get-cell row col)
(cond
((and (<= rowincr 0) (<= colincr 0))
;;Deletion of rows and/or columns
- (ses-dotimes-msg (row (- ses--numrows minrow)) "Relocating variables..."
+ (dotimes-with-progress-reporter
+ (row (- ses--numrows minrow)) "Relocating variables..."
(setq myrow (+ row minrow))
(dotimes (col (- ses--numcols mincol))
(setq mycol (+ col mincol)
(let ((disty (1- ses--numrows))
(distx (1- ses--numcols))
myrow mycol)
- (ses-dotimes-msg (row (- ses--numrows minrow)) "Relocating variables..."
+ (dotimes-with-progress-reporter
+ (row (- ses--numrows minrow)) "Relocating variables..."
(setq myrow (- disty row))
(dotimes (col (- ses--numcols mincol))
(setq mycol (- distx col)
;; Undo control
;;----------------------------------------------------------------------------
+;; This should be unnecessary, because the feature is now built in.
+
(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))
+ "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
- ;;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)))))))
+ (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."
+ "For undo, remember point before we start changing hidden stuff."
(let ((inhibit-read-only t))
(insert-and-inherit "X")
(delete-region (1- (point)) (point))))
(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))
+ `(apply ses-set-with-undo ,sym ,(symbol-value sym))
+ `(apply 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)
+ (push `(apply 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)
+ (push `(apply ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list)
(aset array idx newval)
t))
(ses-set-parameter 'ses--file-format 2)
(message "Upgrading from SES-1 file format")))
(or (= ses--file-format 2)
- (error "This file needs a newer version of the SES library code."))
+ (error "This file needs a newer version of the SES library code"))
(ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols))
;;Initialize cell array
(setq ses--cells (make-vector ses--numrows nil))
(put-text-property (point-min) (1+ (point-min)) 'front-sticky t)
;;Create intangible properties, which also indicate which cell the text
;;came from.
- (ses-dotimes-msg (row ses--numrows) "Finding cells..."
+ (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
(dotimes (col ses--numcols)
(setq pos end
sym (ses-cell-symbol row col))
(setq ses--deferred-narrow 'ses-mode)
(1value (add-hook 'post-command-hook 'ses-command-hook nil t))
(run-with-idle-timer 0.01 nil 'ses-command-hook)
- (run-hooks 'ses-mode-hook)))
+ (run-mode-hooks 'ses-mode-hook)))
(put 'ses-mode 'mode-class 'special)
(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 ()
;;find the data area when inserting or deleting *skip* values for cells
(dotimes (row ses--numrows)
(insert-and-inherit ses--blank-line))
- (ses-dotimes-msg (row ses--numrows) "Reprinting..."
+ (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..."
(if (eq (ses-cell-value row 0) '*skip*)
;;Column deletion left a dangling skip
(ses-set-cell row 0 'value nil))
(error (setq sig hold))))
(cond
(sig
- (message (error-message-string sig)))
+ (message "%s" (error-message-string sig)))
((consp ses--curcell)
(message " "))
(t
;;Reconstruct reference lists.
(let (x yrow ycol)
;;Delete old reference lists
- (ses-dotimes-msg (row ses--numrows) "Deleting references..."
+ (dotimes-with-progress-reporter
+ (row ses--numrows) "Deleting references..."
(dotimes (col ses--numcols)
(ses-set-cell row col 'references nil)))
;;Create new reference lists
- (ses-dotimes-msg (row ses--numrows) "Computing references..."
+ (dotimes-with-progress-reporter
+ (row ses--numrows) "Computing references..."
(dotimes (col ses--numcols)
(dolist (ref (ses-formula-references (ses-cell-formula row col)))
(setq x (ses-sym-rowcol ref)
(ses-set-parameter 'ses--numrows (+ ses--numrows count))
;;Insert each row
(ses-goto-print row 0)
- (ses-dotimes-msg (x count) "Inserting row..."
+ (dotimes-with-progress-reporter (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 ses--numcols nil))
(dotimes (col ses--numcols)
(aset newrow col (ses-make-cell)))
(setq ses--cells (ses-vector-insert ses--cells row newrow))
- (push `(ses-vector-delete ses--cells ,row 1) buffer-undo-list)
+ (push `(apply ses-vector-delete ses--cells ,row 1) buffer-undo-list)
(insert ses--blank-line))
;;Insert empty lines in cell data area (will be replaced by
;;ses-relocate-all)
(ses-create-cell-variable-range 0 (1- ses--numrows)
ses--numcols (+ ses--numcols count -1))
;;Insert each column.
- (ses-dotimes-msg (x count) "Inserting column..."
+ (dotimes-with-progress-reporter (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-begin-change)
(ses-set-parameter 'ses--numcols (- ses--numcols count))
(ses-adjust-print-width col (- width))
- (ses-dotimes-msg (row ses--numrows) "Deleting column..."
+ (dotimes-with-progress-reporter (row ses--numrows) "Deleting column..."
;;Delete lines from cell data area
(ses-goto-data row col)
(ses-delete-line count)
(colincr (- (cdr rowcol) (cdr first)))
(pos 0)
myrow mycol x)
- (ses-dotimes-msg (row needrows) "Yanking..."
+ (dotimes-with-progress-reporter (row needrows) "Yanking..."
(setq myrow (+ row (car rowcol)))
(dotimes (col needcols)
(setq mycol (+ col (cdr rowcol))
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) "")))
(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)