aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorVincent Belaïche2011-06-27 07:41:58 +0200
committerVincent Belaïche2011-06-27 07:41:58 +0200
commit2bb63e814f7caaa565eaeeaa11a217956c5f4caa (patch)
treefae13634c6c1a236d0ae81da1acb56189cc4af31 /lisp
parent1f773f32c69ffee65937f571228e952a5e6c40f0 (diff)
downloademacs-2bb63e814f7caaa565eaeeaa11a217956c5f4caa.tar.gz
emacs-2bb63e814f7caaa565eaeeaa11a217956c5f4caa.zip
Fix commenting and indenting convention.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog4
-rw-r--r--lisp/ses.el476
2 files changed, 245 insertions, 235 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 384d558c3ab..7e27c65c828 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
12011-06-27 Vincent Belaïche <vincentb1@users.sourceforge.net>
2
3 * ses.el: Fix commenting and indenting convention.
4
12011-06-27 Stefan Monnier <monnier@iro.umontreal.ca> 52011-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
2 6
3 * bs.el (bs-cycle-next): Complete last change. 7 * bs.el (bs-cycle-next): Complete last change.
diff --git a/lisp/ses.el b/lisp/ses.el
index b52d3e23c73..55d3c882e54 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -3,8 +3,8 @@
3;; Copyright (C) 2002-2011 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
4 4
5;; Author: Jonathan Yavner <jyavner@member.fsf.org> 5;; Author: Jonathan Yavner <jyavner@member.fsf.org>
6;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org> 6;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net>
7;; Keywords: spreadsheet 7;; Keywords: spreadsheet Dijkstra
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10 10
@@ -154,7 +154,7 @@ Each function is called with ARG=1."
154(defalias 'ses-mode-print-map 154(defalias 'ses-mode-print-map
155 (let ((keys '([backtab] backward-char 155 (let ((keys '([backtab] backward-char
156 [tab] ses-forward-or-insert 156 [tab] ses-forward-or-insert
157 "\C-i" ses-forward-or-insert ;Needed for ses-coverage.el? 157 "\C-i" ses-forward-or-insert ; Needed for ses-coverage.el?
158 "\M-o" ses-insert-column 158 "\M-o" ses-insert-column
159 "\C-o" ses-insert-row 159 "\C-o" ses-insert-row
160 "\C-m" ses-edit-cell 160 "\C-m" ses-edit-cell
@@ -225,10 +225,10 @@ Each function is called with ARG=1."
225 "Initial contents for the file-trailer area at the bottom of the file.") 225 "Initial contents for the file-trailer area at the bottom of the file.")
226 226
227(defconst ses-initial-file-contents 227(defconst ses-initial-file-contents
228 (concat " \n" ;One blank cell in print area 228 (concat " \n" ; One blank cell in print area.
229 ses-print-data-boundary 229 ses-print-data-boundary
230 "(ses-cell A1 nil nil nil nil)\n" ;One blank cell in data area 230 "(ses-cell A1 nil nil nil nil)\n" ; One blank cell in data area.
231 "\n" ;End-of-row terminator for the one row in data area 231 "\n" ; End-of-row terminator for the one row in data area.
232 "(ses-column-widths [7])\n" 232 "(ses-column-widths [7])\n"
233 "(ses-column-printers [nil])\n" 233 "(ses-column-printers [nil])\n"
234 "(ses-default-printer \"%.7g\")\n" 234 "(ses-default-printer \"%.7g\")\n"
@@ -271,7 +271,7 @@ default printer and then modify its output.")
271 (make-local-variable x) 271 (make-local-variable x)
272 (set x nil))) 272 (set x nil)))
273 273
274;;;This variable is documented as being permitted in file-locals: 274;;; This variable is documented as being permitted in file-locals:
275(put 'ses--symbolic-formulas 'safe-local-variable 'consp) 275(put 'ses--symbolic-formulas 'safe-local-variable 'consp)
276 276
277(defconst ses-paramlines-plist 277(defconst ses-paramlines-plist
@@ -514,7 +514,7 @@ for this spreadsheet."
5140-25 become A-Z; 26-701 become AA-ZZ, and so on." 5140-25 become A-Z; 26-701 become AA-ZZ, and so on."
515 (let ((units (char-to-string (+ ?A (% col 26))))) 515 (let ((units (char-to-string (+ ?A (% col 26)))))
516 (if (< col 26) 516 (if (< col 26)
517 units 517 units
518 (concat (ses-column-letter (1- (/ col 26))) units)))) 518 (concat (ses-column-letter (1- (/ col 26))) units))))
519 519
520(defun ses-create-cell-symbol (row col) 520(defun ses-create-cell-symbol (row col)
@@ -584,7 +584,7 @@ cell (ROW,COL). This is undoable. The cell's data will be updated through
584 (ses-aset-with-undo cell elt val))) 584 (ses-aset-with-undo cell elt val)))
585 (if change 585 (if change
586 (add-to-list 'ses--deferred-write (cons row col)))) 586 (add-to-list 'ses--deferred-write (cons row col))))
587 nil) ;Make coverage-tester happy 587 nil) ; Make coverage-tester happy.
588 588
589(defun ses-cell-set-formula (row col formula) 589(defun ses-cell-set-formula (row col formula)
590 "Store a new formula for (ROW . COL) and enqueues the cell for 590 "Store a new formula for (ROW . COL) and enqueues the cell for
@@ -642,7 +642,7 @@ the old and FORCE is nil."
642 (setq formula-error sig 642 (setq formula-error sig
643 newval '*error*))) 643 newval '*error*)))
644 (if (and (not newval) (eq oldval '*skip*)) 644 (if (and (not newval) (eq oldval '*skip*))
645 ;;Don't lose the *skip* - previous field spans this one 645 ;; Don't lose the *skip* --- previous field spans this one.
646 (setq newval '*skip*)) 646 (setq newval '*skip*))
647 (when (or force (not (eq newval oldval))) 647 (when (or force (not (eq newval oldval)))
648 (add-to-list 'ses--deferred-write (cons row col)) ;In case force=t 648 (add-to-list 'ses--deferred-write (cons row col)) ;In case force=t
@@ -667,10 +667,11 @@ if the cell's value is unchanged and FORCE is nil."
667 curlist prevlist rowcol formula) 667 curlist prevlist rowcol formula)
668 (with-temp-message " " 668 (with-temp-message " "
669 (while (and ses--deferred-recalc (not (equal nextlist prevlist))) 669 (while (and ses--deferred-recalc (not (equal nextlist prevlist)))
670 ;;In each loop, recalculate cells that refer only to other cells that 670 ;; In each loop, recalculate cells that refer only to other
671 ;;have already been recalculated or aren't in the recalculation 671 ;; cells that have already been recalculated or aren't in the
672 ;;region. Repeat until all cells have been processed or until the 672 ;; recalculation region. Repeat until all cells have been
673 ;;set of cells being worked on stops changing. 673 ;; processed or until the set of cells being worked on stops
674 ;; changing.
674 (if prevlist 675 (if prevlist
675 (message "Recalculating... (%d cells left)" 676 (message "Recalculating... (%d cells left)"
676 (length ses--deferred-recalc))) 677 (length ses--deferred-recalc)))
@@ -690,7 +691,7 @@ if the cell's value is unchanged and FORCE is nil."
690 ;;ses-update-cells is called from post-command-hook, so 691 ;;ses-update-cells is called from post-command-hook, so
691 ;;inhibit-quit is implicitly bound to t. 692 ;;inhibit-quit is implicitly bound to t.
692 (when quit-flag 693 (when quit-flag
693 ;;Abort the recalculation. User will probably undo now. 694 ;; Abort the recalculation. User will probably undo now.
694 (error "Quit")) 695 (error "Quit"))
695 (ses-calculate-cell (car rowcol) (cdr rowcol) force)) 696 (ses-calculate-cell (car rowcol) (cdr rowcol) force))
696 (setq curlist (cdr curlist))) 697 (setq curlist (cdr curlist)))
@@ -701,15 +702,15 @@ if the cell's value is unchanged and FORCE is nil."
701 ;;We'll go around the loop one more time. 702 ;;We'll go around the loop one more time.
702 (add-to-list 'nextlist t))) 703 (add-to-list 'nextlist t)))
703 (when ses--deferred-recalc 704 (when ses--deferred-recalc
704 ;;Just couldn't finish these 705 ;; Just couldn't finish these.
705 (dolist (x ses--deferred-recalc) 706 (dolist (x ses--deferred-recalc)
706 (let ((rowcol (ses-sym-rowcol x))) 707 (let ((rowcol (ses-sym-rowcol x)))
707 (ses-set-cell (car rowcol) (cdr rowcol) 'value '*error*) 708 (ses-set-cell (car rowcol) (cdr rowcol) 'value '*error*)
708 (1value (ses-print-cell (car rowcol) (cdr rowcol))))) 709 (1value (ses-print-cell (car rowcol) (cdr rowcol)))))
709 (error "Circular references: %s" ses--deferred-recalc)) 710 (error "Circular references: %s" ses--deferred-recalc))
710 (message " ")) 711 (message " "))
711 ;;Can't use save-excursion here: if the cell under point is 712 ;; Can't use save-excursion here: if the cell under point is updated,
712 ;;updated, save-excusion's marker will move past the cell. 713 ;; save-excusion's marker will move past the cell.
713 (goto-char pos))) 714 (goto-char pos)))
714 715
715 716
@@ -721,22 +722,22 @@ if the cell's value is unchanged and FORCE is nil."
721 "Returns t if point is in print area of spreadsheet." 722 "Returns t if point is in print area of spreadsheet."
722 (<= (point) ses--data-marker)) 723 (<= (point) ses--data-marker))
723 724
724;;We turn off point-motion-hooks and explicitly position the cursor, in case 725;; We turn off point-motion-hooks and explicitly position the cursor, in case
725;;the intangible properties have gotten screwed up (e.g., when 726;; the intangible properties have gotten screwed up (e.g., when ses-goto-print
726;;ses-goto-print is called during a recursive ses-print-cell). 727;; is called during a recursive ses-print-cell).
727(defun ses-goto-print (row col) 728(defun ses-goto-print (row col)
728 "Move point to print area for cell (ROW,COL)." 729 "Move point to print area for cell (ROW,COL)."
729 (let ((inhibit-point-motion-hooks t) 730 (let ((inhibit-point-motion-hooks t)
730 (n 0)) 731 (n 0))
731 (goto-char (point-min)) 732 (goto-char (point-min))
732 (forward-line row) 733 (forward-line row)
733 ;; calculate column position 734 ;; Calculate column position.
734 (dotimes (c col) 735 (dotimes (c col)
735 (setq n (+ n (ses-col-width c) 1))) 736 (setq n (+ n (ses-col-width c) 1)))
736 ;; move to the position 737 ;; Move to the position.
737 (and (> n (move-to-column n)) 738 (and (> n (move-to-column n))
738 (eolp) 739 (eolp)
739 ;; move point to the bol of next line (for TAB at the last cell) 740 ;; Move point to the bol of next line (for TAB at the last cell).
740 (forward-char)))) 741 (forward-char))))
741 742
742(defun ses-set-curcell () 743(defun ses-set-curcell ()
@@ -745,13 +746,13 @@ region, or nil if cursor is not at a cell."
745 (if (or (not mark-active) 746 (if (or (not mark-active)
746 deactivate-mark 747 deactivate-mark
747 (= (region-beginning) (region-end))) 748 (= (region-beginning) (region-end)))
748 ;;Single cell 749 ;; Single cell.
749 (setq ses--curcell (get-text-property (point) 'intangible)) 750 (setq ses--curcell (get-text-property (point) 'intangible))
750 ;;Range 751 ;; Range.
751 (let ((bcell (get-text-property (region-beginning) 'intangible)) 752 (let ((bcell (get-text-property (region-beginning) 'intangible))
752 (ecell (get-text-property (1- (region-end)) 'intangible))) 753 (ecell (get-text-property (1- (region-end)) 'intangible)))
753 (when (= (region-end) ses--data-marker) 754 (when (= (region-end) ses--data-marker)
754 ;;Correct for overflow 755 ;; Correct for overflow.
755 (setq ecell (get-text-property (- (region-end) 2) 'intangible))) 756 (setq ecell (get-text-property (- (region-end) 2) 'intangible)))
756 (setq ses--curcell (if (and bcell ecell) 757 (setq ses--curcell (if (and bcell ecell)
757 (cons bcell ecell) 758 (cons bcell ecell)
@@ -764,7 +765,7 @@ appropriate if some argument is 'end. A range is appropriate if some
764argument is 'range. A single cell is appropriate unless some argument is 765argument is 'range. A single cell is appropriate unless some argument is
765'needrange." 766'needrange."
766 (if (eq ses--curcell t) 767 (if (eq ses--curcell t)
767 ;;curcell recalculation was postponed, but user typed ahead 768 ;; curcell recalculation was postponed, but user typed ahead.
768 (ses-set-curcell)) 769 (ses-set-curcell))
769 (cond 770 (cond
770 ((not ses--curcell) 771 ((not ses--curcell)
@@ -791,53 +792,53 @@ preceding cell has spilled over."
791 (printer (ses-cell-printer cell)) 792 (printer (ses-cell-printer cell))
792 (maxcol (1+ col)) 793 (maxcol (1+ col))
793 text sig startpos x) 794 text sig startpos x)
794 ;;Create the string to print 795 ;; Create the string to print.
795 (cond 796 (cond
796 ((eq value '*skip*) 797 ((eq value '*skip*)
797 ;;Don't print anything 798 ;; Don't print anything.
798 (throw 'ses-print-cell nil)) 799 (throw 'ses-print-cell nil))
799 ((eq value '*error*) 800 ((eq value '*error*)
800 (setq text (make-string (ses-col-width col) ?#))) 801 (setq text (make-string (ses-col-width col) ?#)))
801 (t 802 (t
802 ;;Deferred safety-check on printer 803 ;; Deferred safety-check on printer.
803 (if (eq (car-safe printer) 'ses-safe-printer) 804 (if (eq (car-safe printer) 'ses-safe-printer)
804 (ses-set-cell row col 'printer 805 (ses-set-cell row col 'printer
805 (setq printer (ses-safe-printer (cadr printer))))) 806 (setq printer (ses-safe-printer (cadr printer)))))
806 ;;Print the value 807 ;; Print the value.
807 (setq text (ses-call-printer (or printer 808 (setq text (ses-call-printer (or printer
808 (ses-col-printer col) 809 (ses-col-printer col)
809 ses--default-printer) 810 ses--default-printer)
810 value)) 811 value))
811 (if (consp ses-call-printer-return) 812 (if (consp ses-call-printer-return)
812 ;;Printer returned an error 813 ;; Printer returned an error.
813 (setq sig ses-call-printer-return)))) 814 (setq sig ses-call-printer-return))))
814 ;;Adjust print width to match column width 815 ;; Adjust print width to match column width.
815 (let ((width (ses-col-width col)) 816 (let ((width (ses-col-width col))
816 (len (string-width text))) 817 (len (string-width text)))
817 (cond 818 (cond
818 ((< len width) 819 ((< len width)
819 ;;Fill field to length with spaces 820 ;; Fill field to length with spaces.
820 (setq len (make-string (- width len) ?\s) 821 (setq len (make-string (- width len) ?\s)
821 text (if (eq ses-call-printer-return t) 822 text (if (eq ses-call-printer-return t)
822 (concat text len) 823 (concat text len)
823 (concat len text)))) 824 (concat len text))))
824 ((> len width) 825 ((> len width)
825 ;;Spill over into following cells, if possible 826 ;; Spill over into following cells, if possible.
826 (let ((maxwidth width)) 827 (let ((maxwidth width))
827 (while (and (> len maxwidth) 828 (while (and (> len maxwidth)
828 (< maxcol ses--numcols) 829 (< maxcol ses--numcols)
829 (or (not (setq x (ses-cell-value row maxcol))) 830 (or (not (setq x (ses-cell-value row maxcol)))
830 (eq x '*skip*))) 831 (eq x '*skip*)))
831 (unless x 832 (unless x
832 ;;Set this cell to '*skip* so it won't overwrite our spillover 833 ;; Set this cell to '*skip* so it won't overwrite our spillover.
833 (ses-set-cell row maxcol 'value '*skip*)) 834 (ses-set-cell row maxcol 'value '*skip*))
834 (setq maxwidth (+ maxwidth (ses-col-width maxcol) 1) 835 (setq maxwidth (+ maxwidth (ses-col-width maxcol) 1)
835 maxcol (1+ maxcol))) 836 maxcol (1+ maxcol)))
836 (if (<= len maxwidth) 837 (if (<= len maxwidth)
837 ;;Fill to complete width of all the fields spanned 838 ;; Fill to complete width of all the fields spanned.
838 (setq text (concat text (make-string (- maxwidth len) ?\s))) 839 (setq text (concat text (make-string (- maxwidth len) ?\s)))
839 ;;Not enough room to end of line or next non-nil field. Truncate 840 ;; Not enough room to end of line or next non-nil field. Truncate
840 ;;if string or decimal; otherwise fill with error indicator 841 ;; if string or decimal; otherwise fill with error indicator.
841 (setq sig `(error "Too wide" ,text)) 842 (setq sig `(error "Too wide" ,text))
842 (cond 843 (cond
843 ((stringp value) 844 ((stringp value)
@@ -854,12 +855,12 @@ preceding cell has spilled over."
854 (substring text (match-end 0))))) 855 (substring text (match-end 0)))))
855 (t 856 (t
856 (setq text (make-string maxwidth ?#))))))))) 857 (setq text (make-string maxwidth ?#)))))))))
857 ;;Substitute question marks for tabs and newlines. Newlines are 858 ;; Substitute question marks for tabs and newlines. Newlines are used as
858 ;;used as row-separators; tabs could confuse the reimport logic. 859 ;; row-separators; tabs could confuse the reimport logic.
859 (setq text (replace-regexp-in-string "[\t\n]" "?" text)) 860 (setq text (replace-regexp-in-string "[\t\n]" "?" text))
860 (ses-goto-print row col) 861 (ses-goto-print row col)
861 (setq startpos (point)) 862 (setq startpos (point))
862 ;;Install the printed result. This is not interruptible. 863 ;; Install the printed result. This is not interruptible.
863 (let ((inhibit-read-only t) 864 (let ((inhibit-read-only t)
864 (inhibit-quit t)) 865 (inhibit-quit t))
865 (let ((inhibit-point-motion-hooks t)) 866 (let ((inhibit-point-motion-hooks t))
@@ -867,32 +868,32 @@ preceding cell has spilled over."
867 (move-to-column (+ (current-column) 868 (move-to-column (+ (current-column)
868 (string-width text))) 869 (string-width text)))
869 (1+ (point))))) 870 (1+ (point)))))
870 ;;We use concat instead of inserting separate strings in order to 871 ;; We use concat instead of inserting separate strings in order to
871 ;;reduce the number of cells in the undo list. 872 ;; reduce the number of cells in the undo list.
872 (setq x (concat text (if (< maxcol ses--numcols) " " "\n"))) 873 (setq x (concat text (if (< maxcol ses--numcols) " " "\n")))
873 ;;We use set-text-properties to prevent a wacky print function 874 ;; We use set-text-properties to prevent a wacky print function from
874 ;;from inserting rogue properties, and to ensure that the keymap 875 ;; inserting rogue properties, and to ensure that the keymap property is
875 ;;property is inherited (is it a bug that only unpropertied strings 876 ;; inherited (is it a bug that only unpropertied strings actually
876 ;;actually inherit from surrounding text?) 877 ;; inherit from surrounding text?)
877 (set-text-properties 0 (length x) nil x) 878 (set-text-properties 0 (length x) nil x)
878 (insert-and-inherit x) 879 (insert-and-inherit x)
879 (put-text-property startpos (point) 'intangible 880 (put-text-property startpos (point) 'intangible
880 (ses-cell-symbol cell)) 881 (ses-cell-symbol cell))
881 (when (and (zerop row) (zerop col)) 882 (when (and (zerop row) (zerop col))
882 ;;Reconstruct special beginning-of-buffer attributes 883 ;; Reconstruct special beginning-of-buffer attributes.
883 (put-text-property (point-min) (point) 'keymap 'ses-mode-print-map) 884 (put-text-property (point-min) (point) 'keymap 'ses-mode-print-map)
884 (put-text-property (point-min) (point) 'read-only 'ses) 885 (put-text-property (point-min) (point) 'read-only 'ses)
885 (put-text-property (point-min) (1+ (point-min)) 'front-sticky t))) 886 (put-text-property (point-min) (1+ (point-min)) 'front-sticky t)))
886 (if (= row (1- ses--header-row)) 887 (if (= row (1- ses--header-row))
887 ;;This line is part of the header - force recalc 888 ;; This line is part of the header --- force recalc.
888 (ses-reset-header-string)) 889 (ses-reset-header-string))
889 ;;If this cell (or a preceding one on the line) previously spilled over 890 ;; If this cell (or a preceding one on the line) previously spilled over
890 ;;and has gotten shorter, redraw following cells on line recursively. 891 ;; and has gotten shorter, redraw following cells on line recursively.
891 (when (and (< maxcol ses--numcols) 892 (when (and (< maxcol ses--numcols)
892 (eq (ses-cell-value row maxcol) '*skip*)) 893 (eq (ses-cell-value row maxcol) '*skip*))
893 (ses-set-cell row maxcol 'value nil) 894 (ses-set-cell row maxcol 'value nil)
894 (ses-print-cell row maxcol)) 895 (ses-print-cell row maxcol))
895 ;;Return to start of cell 896 ;; Return to start of cell.
896 (goto-char startpos) 897 (goto-char startpos)
897 sig))) 898 sig)))
898 899
@@ -932,13 +933,13 @@ inhibit-quit to t."
932 (blank (if (> change 0) (make-string change ?\s))) 933 (blank (if (> change 0) (make-string change ?\s)))
933 (at-end (= col ses--numcols))) 934 (at-end (= col ses--numcols)))
934 (ses-set-with-undo 'ses--linewidth (+ ses--linewidth change)) 935 (ses-set-with-undo 'ses--linewidth (+ ses--linewidth change))
935 ;;ses-set-with-undo always returns t for strings. 936 ;; ses-set-with-undo always returns t for strings.
936 (1value (ses-set-with-undo 'ses--blank-line 937 (1value (ses-set-with-undo 'ses--blank-line
937 (concat (make-string ses--linewidth ?\s) "\n"))) 938 (concat (make-string ses--linewidth ?\s) "\n")))
938 (dotimes (row ses--numrows) 939 (dotimes (row ses--numrows)
939 (ses-goto-print row col) 940 (ses-goto-print row col)
940 (when at-end 941 (when at-end
941 ;;Insert new columns before newline 942 ;; Insert new columns before newline.
942 (let ((inhibit-point-motion-hooks t)) 943 (let ((inhibit-point-motion-hooks t))
943 (backward-char 1))) 944 (backward-char 1)))
944 (if blank 945 (if blank
@@ -976,13 +977,13 @@ number, COL is the column number for a data cell -- otherwise DEF
976is one of the symbols ses--col-widths, ses--col-printers, 977is one of the symbols ses--col-widths, ses--col-printers,
977ses--default-printer, ses--numrows, or ses--numcols." 978ses--default-printer, ses--numrows, or ses--numcols."
978 (ses-widen) 979 (ses-widen)
979 (let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong 980 (let ((inhibit-point-motion-hooks t)) ; In case intangible attrs are wrong.
980 (if col 981 (if col
981 ;;It's a cell 982 ;; It's a cell.
982 (progn 983 (progn
983 (goto-char ses--data-marker) 984 (goto-char ses--data-marker)
984 (forward-line (+ 1 (* def (1+ ses--numcols)) col))) 985 (forward-line (+ 1 (* def (1+ ses--numcols)) col)))
985 ;;Convert def-symbol to offset 986 ;; Convert def-symbol to offset.
986 (setq def (plist-get ses-paramlines-plist def)) 987 (setq def (plist-get ses-paramlines-plist def))
987 (or def (signal 'args-out-of-range nil)) 988 (or def (signal 'args-out-of-range nil))
988 (goto-char ses--params-marker) 989 (goto-char ses--params-marker)
@@ -993,8 +994,8 @@ ses--default-printer, ses--numrows, or ses--numcols."
993See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped. 994See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped.
994If ELEM is specified, it is the array subscript within DEF to be set to VALUE." 995If ELEM is specified, it is the array subscript within DEF to be set to VALUE."
995 (save-excursion 996 (save-excursion
996 ;;We call ses-goto-data early, using the old values of numrows and 997 ;; We call ses-goto-data early, using the old values of numrows and numcols
997 ;;numcols in case one of them is being changed. 998 ;; in case one of them is being changed.
998 (ses-goto-data def) 999 (ses-goto-data def)
999 (let ((inhibit-read-only t) 1000 (let ((inhibit-read-only t)
1000 (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" 1001 (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)"
@@ -1012,7 +1013,7 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE."
1012 (aset (symbol-value def) elem value)) 1013 (aset (symbol-value def) elem value))
1013 (setq oldval (symbol-value def)) 1014 (setq oldval (symbol-value def))
1014 (set def value)) 1015 (set def value))
1015 ;;Special undo since it's outside the narrowed buffer 1016 ;; Special undo since it's outside the narrowed buffer.
1016 (let (buffer-undo-list) 1017 (let (buffer-undo-list)
1017 (delete-region (point) (line-end-position)) 1018 (delete-region (point) (line-end-position))
1018 (insert (format fmt (symbol-value def)))) 1019 (insert (format fmt (symbol-value def))))
@@ -1042,7 +1043,7 @@ Newlines in the data are escaped."
1042 (setq formula (cadr formula))) 1043 (setq formula (cadr formula)))
1043 (if (eq (car-safe printer) 'ses-safe-printer) 1044 (if (eq (car-safe printer) 'ses-safe-printer)
1044 (setq printer (cadr printer))) 1045 (setq printer (cadr printer)))
1045 ;;This is noticably faster than (format "%S %S %S %S %S") 1046 ;; This is noticably faster than (format "%S %S %S %S %S")
1046 (setq text (concat "(ses-cell " 1047 (setq text (concat "(ses-cell "
1047 (symbol-name sym) 1048 (symbol-name sym)
1048 " " 1049 " "
@@ -1129,7 +1130,7 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed."
1129 (if (setq rowcol (ses-sym-rowcol formula)) 1130 (if (setq rowcol (ses-sym-rowcol formula))
1130 (ses-relocate-symbol formula rowcol 1131 (ses-relocate-symbol formula rowcol
1131 startrow startcol rowincr colincr) 1132 startrow startcol rowincr colincr)
1132 formula) ;Pass through as-is 1133 formula) ; Pass through as-is.
1133 (dolist (cur formula) 1134 (dolist (cur formula)
1134 (setq rowcol (ses-sym-rowcol cur)) 1135 (setq rowcol (ses-sym-rowcol cur))
1135 (cond 1136 (cond
@@ -1138,9 +1139,9 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed."
1138 startrow startcol rowincr colincr)) 1139 startrow startcol rowincr colincr))
1139 (if cur 1140 (if cur
1140 (push cur result) 1141 (push cur result)
1141 ;;Reference to a deleted cell. Set a flag in ses-relocate-return. 1142 ;; Reference to a deleted cell. Set a flag in ses-relocate-return.
1142 ;;don't change the flag if it's already 'range, since range 1143 ;; don't change the flag if it's already 'range, since range implies
1143 ;;implies 'delete. 1144 ;; 'delete.
1144 (unless ses-relocate-return 1145 (unless ses-relocate-return
1145 (setq ses-relocate-return 'delete)))) 1146 (setq ses-relocate-return 'delete))))
1146 ((eq (car-safe cur) 'ses-range) 1147 ((eq (car-safe cur) 'ses-range)
@@ -1148,10 +1149,10 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed."
1148 (if cur 1149 (if cur
1149 (push cur result))) 1150 (push cur result)))
1150 ((or (atom cur) (eq (car cur) 'quote)) 1151 ((or (atom cur) (eq (car cur) 'quote))
1151 ;;Constants pass through unchanged 1152 ;; Constants pass through unchanged.
1152 (push cur result)) 1153 (push cur result))
1153 (t 1154 (t
1154 ;;Recursively copy and alter subformulas 1155 ;; Recursively copy and alter subformulas.
1155 (push (ses-relocate-formula cur startrow startcol 1156 (push (ses-relocate-formula cur startrow startcol
1156 rowincr colincr) 1157 rowincr colincr)
1157 result)))) 1158 result))))
@@ -1177,47 +1178,47 @@ if the range was altered."
1177 field) 1178 field)
1178 (cond 1179 (cond
1179 ((and (not min) (not max)) 1180 ((and (not min) (not max))
1180 (setq range nil)) ;;The entire range is deleted 1181 (setq range nil)) ; The entire range is deleted.
1181 ((zerop colincr) 1182 ((zerop colincr)
1182 ;;Inserting or deleting rows 1183 ;; Inserting or deleting rows.
1183 (setq field 'car) 1184 (setq field 'car)
1184 (if (not min) 1185 (if (not min)
1185 ;;Chopped off beginning of range 1186 ;; Chopped off beginning of range.
1186 (setq min (ses-create-cell-symbol startrow (cdr minrowcol)) 1187 (setq min (ses-create-cell-symbol startrow (cdr minrowcol))
1187 ses-relocate-return 'range)) 1188 ses-relocate-return 'range))
1188 (if (not max) 1189 (if (not max)
1189 (if (> rowincr 0) 1190 (if (> rowincr 0)
1190 ;;Trying to insert a nonexistent row 1191 ;; Trying to insert a nonexistent row.
1191 (setq max (ses-create-cell-symbol (1- ses--numrows) 1192 (setq max (ses-create-cell-symbol (1- ses--numrows)
1192 (cdr minrowcol))) 1193 (cdr minrowcol)))
1193 ;;End of range is being deleted 1194 ;; End of range is being deleted.
1194 (setq max (ses-create-cell-symbol (1- startrow) (cdr minrowcol)) 1195 (setq max (ses-create-cell-symbol (1- startrow) (cdr minrowcol))
1195 ses-relocate-return 'range)) 1196 ses-relocate-return 'range))
1196 (and (> rowincr 0) 1197 (and (> rowincr 0)
1197 (= (car maxrowcol) (1- startrow)) 1198 (= (car maxrowcol) (1- startrow))
1198 (= (cdr minrowcol) (cdr maxrowcol)) 1199 (= (cdr minrowcol) (cdr maxrowcol))
1199 ;;Insert after ending row of vertical range - include it 1200 ;; Insert after ending row of vertical range --- include it.
1200 (setq max (ses-create-cell-symbol (+ startrow rowincr -1) 1201 (setq max (ses-create-cell-symbol (+ startrow rowincr -1)
1201 (cdr maxrowcol)))))) 1202 (cdr maxrowcol))))))
1202 (t 1203 (t
1203 ;;Inserting or deleting columns 1204 ;; Inserting or deleting columns.
1204 (setq field 'cdr) 1205 (setq field 'cdr)
1205 (if (not min) 1206 (if (not min)
1206 ;;Chopped off beginning of range 1207 ;; Chopped off beginning of range.
1207 (setq min (ses-create-cell-symbol (car minrowcol) startcol) 1208 (setq min (ses-create-cell-symbol (car minrowcol) startcol)
1208 ses-relocate-return 'range)) 1209 ses-relocate-return 'range))
1209 (if (not max) 1210 (if (not max)
1210 (if (> colincr 0) 1211 (if (> colincr 0)
1211 ;;Trying to insert a nonexistent column 1212 ;; Trying to insert a nonexistent column.
1212 (setq max (ses-create-cell-symbol (car maxrowcol) 1213 (setq max (ses-create-cell-symbol (car maxrowcol)
1213 (1- ses--numcols))) 1214 (1- ses--numcols)))
1214 ;;End of range is being deleted 1215 ;; End of range is being deleted.
1215 (setq max (ses-create-cell-symbol (car maxrowcol) (1- startcol)) 1216 (setq max (ses-create-cell-symbol (car maxrowcol) (1- startcol))
1216 ses-relocate-return 'range)) 1217 ses-relocate-return 'range))
1217 (and (> colincr 0) 1218 (and (> colincr 0)
1218 (= (cdr maxrowcol) (1- startcol)) 1219 (= (cdr maxrowcol) (1- startcol))
1219 (= (car minrowcol) (car maxrowcol)) 1220 (= (car minrowcol) (car maxrowcol))
1220 ;;Insert after ending column of horizontal range - include it 1221 ;; Insert after ending column of horizontal range --- include it.
1221 (setq max (ses-create-cell-symbol (car maxrowcol) 1222 (setq max (ses-create-cell-symbol (car maxrowcol)
1222 (+ startcol colincr -1))))))) 1223 (+ startcol colincr -1)))))))
1223 (when range 1224 (when range
@@ -1225,7 +1226,7 @@ if the range was altered."
1225 (funcall field minrowcol)) 1226 (funcall field minrowcol))
1226 (- (funcall field (ses-sym-rowcol max)) 1227 (- (funcall field (ses-sym-rowcol max))
1227 (funcall field (ses-sym-rowcol min)))) 1228 (funcall field (ses-sym-rowcol min))))
1228 ;;This range has changed size 1229 ;; This range has changed size.
1229 (setq ses-relocate-return 'range)) 1230 (setq ses-relocate-return 'range))
1230 (list 'ses-range min max)))) 1231 (list 'ses-range min max))))
1231 1232
@@ -1244,13 +1245,13 @@ to each symbol."
1244 minrow mincol rowincr colincr)) 1245 minrow mincol rowincr colincr))
1245 (ses-set-cell row col 'formula newval) 1246 (ses-set-cell row col 'formula newval)
1246 (if (eq ses-relocate-return 'range) 1247 (if (eq ses-relocate-return 'range)
1247 ;;This cell contains a (ses-range X Y) where a cell has been 1248 ;; This cell contains a (ses-range X Y) where a cell has been
1248 ;;inserted or deleted in the middle of the range. 1249 ;; inserted or deleted in the middle of the range.
1249 (push (cons row col) reform)) 1250 (push (cons row col) reform))
1250 (if ses-relocate-return 1251 (if ses-relocate-return
1251 ;;This cell referred to a cell that's been deleted or is no 1252 ;; This cell referred to a cell that's been deleted or is no
1252 ;;longer part of the range. We can't fix that now because 1253 ;; longer part of the range. We can't fix that now because
1253 ;;reference lists cells have been partially updated. 1254 ;; reference lists cells have been partially updated.
1254 (add-to-list 'ses--deferred-recalc 1255 (add-to-list 'ses--deferred-recalc
1255 (ses-create-cell-symbol row col))) 1256 (ses-create-cell-symbol row col)))
1256 (setq newval (ses-relocate-formula (ses-cell-references mycell) 1257 (setq newval (ses-relocate-formula (ses-cell-references mycell)
@@ -1259,13 +1260,13 @@ to each symbol."
1259 (and (>= row minrow) (>= col mincol) 1260 (and (>= row minrow) (>= col mincol)
1260 (ses-set-cell row col 'symbol 1261 (ses-set-cell row col 'symbol
1261 (ses-create-cell-symbol row col)))))) 1262 (ses-create-cell-symbol row col))))))
1262 ;;Relocate the cell values 1263 ;; Relocate the cell values.
1263 (let (oldval myrow mycol xrow xcol) 1264 (let (oldval myrow mycol xrow xcol)
1264 (cond 1265 (cond
1265 ((and (<= rowincr 0) (<= colincr 0)) 1266 ((and (<= rowincr 0) (<= colincr 0))
1266 ;;Deletion of rows and/or columns 1267 ;; Deletion of rows and/or columns.
1267 (dotimes-with-progress-reporter 1268 (dotimes-with-progress-reporter
1268 (row (- ses--numrows minrow)) "Relocating variables..." 1269 (row (- ses--numrows minrow)) "Relocating variables..."
1269 (setq myrow (+ row minrow)) 1270 (setq myrow (+ row minrow))
1270 (dotimes (col (- ses--numcols mincol)) 1271 (dotimes (col (- ses--numcols mincol))
1271 (setq mycol (+ col mincol) 1272 (setq mycol (+ col mincol)
@@ -1273,11 +1274,11 @@ to each symbol."
1273 xcol (- mycol colincr)) 1274 xcol (- mycol colincr))
1274 (if (and (< xrow ses--numrows) (< xcol ses--numcols)) 1275 (if (and (< xrow ses--numrows) (< xcol ses--numcols))
1275 (setq oldval (ses-cell-value xrow xcol)) 1276 (setq oldval (ses-cell-value xrow xcol))
1276 ;;Cell is off the end of the array 1277 ;; Cell is off the end of the array.
1277 (setq oldval (symbol-value (ses-create-cell-symbol xrow xcol)))) 1278 (setq oldval (symbol-value (ses-create-cell-symbol xrow xcol))))
1278 (ses-set-cell myrow mycol 'value oldval)))) 1279 (ses-set-cell myrow mycol 'value oldval))))
1279 ((and (wholenump rowincr) (wholenump colincr)) 1280 ((and (wholenump rowincr) (wholenump colincr))
1280 ;;Insertion of rows and/or columns. Run the loop backwards. 1281 ;; Insertion of rows and/or columns. Run the loop backwards.
1281 (let ((disty (1- ses--numrows)) 1282 (let ((disty (1- ses--numrows))
1282 (distx (1- ses--numcols)) 1283 (distx (1- ses--numcols))
1283 myrow mycol) 1284 myrow mycol)
@@ -1289,16 +1290,16 @@ to each symbol."
1289 xrow (- myrow rowincr) 1290 xrow (- myrow rowincr)
1290 xcol (- mycol colincr)) 1291 xcol (- mycol colincr))
1291 (if (or (< xrow minrow) (< xcol mincol)) 1292 (if (or (< xrow minrow) (< xcol mincol))
1292 ;;Newly-inserted value 1293 ;; Newly-inserted value.
1293 (setq oldval nil) 1294 (setq oldval nil)
1294 ;;Transfer old value 1295 ;; Transfer old value.
1295 (setq oldval (ses-cell-value xrow xcol))) 1296 (setq oldval (ses-cell-value xrow xcol)))
1296 (ses-set-cell myrow mycol 'value oldval))) 1297 (ses-set-cell myrow mycol 'value oldval)))
1297 t)) ;Make testcover happy by returning non-nil here 1298 t)) ; Make testcover happy by returning non-nil here.
1298 (t 1299 (t
1299 (error "ROWINCR and COLINCR must have the same sign")))) 1300 (error "ROWINCR and COLINCR must have the same sign"))))
1300 ;;Reconstruct reference lists for cells that contain ses-ranges that 1301 ;; Reconstruct reference lists for cells that contain ses-ranges that have
1301 ;;have changed size. 1302 ;; changed size.
1302 (when reform 1303 (when reform
1303 (message "Fixing ses-ranges...") 1304 (message "Fixing ses-ranges...")
1304 (let (row col) 1305 (let (row col)
@@ -1324,9 +1325,9 @@ to each symbol."
1324 1325
1325(defun ses-set-with-undo (sym newval) 1326(defun ses-set-with-undo (sym newval)
1326 "Like set, but undoable. Result is t if value has changed." 1327 "Like set, but undoable. Result is t if value has changed."
1327 ;;We try to avoid adding redundant entries to the undo list, but this is 1328 ;; We try to avoid adding redundant entries to the undo list, but this is
1328 ;;unavoidable for strings because equal ignores text properties and there's 1329 ;; unavoidable for strings because equal ignores text properties and there's
1329 ;;no easy way to get the whole property list to see if it's different! 1330 ;; no easy way to get the whole property list to see if it's different!
1330 (unless (and (boundp sym) 1331 (unless (and (boundp sym)
1331 (equal (symbol-value sym) newval) 1332 (equal (symbol-value sym) newval)
1332 (not (stringp newval))) 1333 (not (stringp newval)))
@@ -1339,14 +1340,15 @@ to each symbol."
1339 1340
1340(defun ses-unset-with-undo (sym) 1341(defun ses-unset-with-undo (sym)
1341 "Set SYM to be unbound. This is undoable." 1342 "Set SYM to be unbound. This is undoable."
1342 (when (1value (boundp sym)) ;;Always bound, except after a programming error 1343 (when (1value (boundp sym)) ; Always bound, except after a programming error.
1343 (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list) 1344 (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list)
1344 (makunbound sym))) 1345 (makunbound sym)))
1345 1346
1346(defun ses-aset-with-undo (array idx newval) 1347(defun ses-aset-with-undo (array idx newval)
1347 "Like aset, but undoable. Result is t if element has changed" 1348 "Like aset, but undoable. Result is t if element has changed"
1348 (unless (equal (aref array idx) newval) 1349 (unless (equal (aref array idx) newval)
1349 (push `(apply ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list) 1350 (push `(apply ses-aset-with-undo ,array ,idx
1351 ,(aref array idx)) buffer-undo-list)
1350 (aset array idx newval) 1352 (aset array idx newval)
1351 t)) 1353 t))
1352 1354
@@ -1359,7 +1361,7 @@ to each symbol."
1359 "Parse the current buffer and sets up buffer-local variables. Does not 1361 "Parse the current buffer and sets up buffer-local variables. Does not
1360execute cell formulas or print functions." 1362execute cell formulas or print functions."
1361 (widen) 1363 (widen)
1362 ;;Read our global parameters, which should be a 3-element list 1364 ;; Read our global parameters, which should be a 3-element list.
1363 (goto-char (point-max)) 1365 (goto-char (point-max))
1364 (search-backward ";; Local Variables:\n" nil t) 1366 (search-backward ";; Local Variables:\n" nil t)
1365 (backward-list 1) 1367 (backward-list 1)
@@ -1376,7 +1378,7 @@ execute cell formulas or print functions."
1376 ses--numrows (cadr params) 1378 ses--numrows (cadr params)
1377 ses--numcols (nth 2 params)) 1379 ses--numcols (nth 2 params))
1378 (when (= ses--file-format 1) 1380 (when (= ses--file-format 1)
1379 (let (buffer-undo-list) ;This is not undoable 1381 (let (buffer-undo-list) ; This is not undoable.
1380 (ses-goto-data 'ses--header-row) 1382 (ses-goto-data 'ses--header-row)
1381 (insert "(ses-header-row 0)\n") 1383 (insert "(ses-header-row 0)\n")
1382 (ses-set-parameter 'ses--file-format 2) 1384 (ses-set-parameter 'ses--file-format 2)
@@ -1384,11 +1386,11 @@ execute cell formulas or print functions."
1384 (or (= ses--file-format 2) 1386 (or (= ses--file-format 2)
1385 (error "This file needs a newer version of the SES library code")) 1387 (error "This file needs a newer version of the SES library code"))
1386 (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols)) 1388 (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols))
1387 ;;Initialize cell array 1389 ;; Initialize cell array.
1388 (setq ses--cells (make-vector ses--numrows nil)) 1390 (setq ses--cells (make-vector ses--numrows nil))
1389 (dotimes (row ses--numrows) 1391 (dotimes (row ses--numrows)
1390 (aset ses--cells row (make-vector ses--numcols nil)))) 1392 (aset ses--cells row (make-vector ses--numcols nil))))
1391 ;;Skip over print area, which we assume is correct 1393 ;; Skip over print area, which we assume is correct.
1392 (goto-char (point-min)) 1394 (goto-char (point-min))
1393 (forward-line ses--numrows) 1395 (forward-line ses--numrows)
1394 (or (looking-at ses-print-data-boundary) 1396 (or (looking-at ses-print-data-boundary)
@@ -1396,10 +1398,10 @@ execute cell formulas or print functions."
1396 (forward-char 1) 1398 (forward-char 1)
1397 (setq ses--data-marker (point-marker)) 1399 (setq ses--data-marker (point-marker))
1398 (forward-char (1- (length ses-print-data-boundary))) 1400 (forward-char (1- (length ses-print-data-boundary)))
1399 ;;Initialize printer and symbol lists 1401 ;; Initialize printer and symbol lists.
1400 (mapc 'ses-printer-record ses-standard-printer-functions) 1402 (mapc 'ses-printer-record ses-standard-printer-functions)
1401 (setq ses--symbolic-formulas nil) 1403 (setq ses--symbolic-formulas nil)
1402 ;;Load cell definitions 1404 ;; Load cell definitions.
1403 (dotimes (row ses--numrows) 1405 (dotimes (row ses--numrows)
1404 (dotimes (col ses--numcols) 1406 (dotimes (col ses--numcols)
1405 (let* ((x (read (current-buffer))) 1407 (let* ((x (read (current-buffer)))
@@ -1412,7 +1414,7 @@ execute cell formulas or print functions."
1412 (eval x))) 1414 (eval x)))
1413 (or (looking-at "\n\n") 1415 (or (looking-at "\n\n")
1414 (error "Missing blank line between rows"))) 1416 (error "Missing blank line between rows")))
1415 ;;Load global parameters 1417 ;; Load global parameters.
1416 (let ((widths (read (current-buffer))) 1418 (let ((widths (read (current-buffer)))
1417 (n1 (char-after (point))) 1419 (n1 (char-after (point)))
1418 (printers (read (current-buffer))) 1420 (printers (read (current-buffer)))
@@ -1434,12 +1436,12 @@ execute cell formulas or print functions."
1434 (1value (eval def-printer)) 1436 (1value (eval def-printer))
1435 (1value (eval printers)) 1437 (1value (eval printers))
1436 (1value (eval head-row))) 1438 (1value (eval head-row)))
1437 ;;Should be back at global-params 1439 ;; Should be back at global-params.
1438 (forward-char 1) 1440 (forward-char 1)
1439 (or (looking-at (replace-regexp-in-string "1" "[0-9]+" 1441 (or (looking-at (replace-regexp-in-string "1" "[0-9]+"
1440 ses-initial-global-parameters)) 1442 ses-initial-global-parameters))
1441 (error "Problem with column-defs or global-params")) 1443 (error "Problem with column-defs or global-params"))
1442 ;;Check for overall newline count in definitions area 1444 ;; Check for overall newline count in definitions area.
1443 (forward-line 3) 1445 (forward-line 3)
1444 (let ((start (point))) 1446 (let ((start (point)))
1445 (ses-goto-data 'ses--numrows) 1447 (ses-goto-data 'ses--numrows)
@@ -1457,23 +1459,23 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
1457 (inhibit-point-motion-hooks t) 1459 (inhibit-point-motion-hooks t)
1458 (was-modified (buffer-modified-p)) 1460 (was-modified (buffer-modified-p))
1459 pos sym) 1461 pos sym)
1460 (ses-goto-data 0 0) ;;Include marker between print-area and data-area 1462 (ses-goto-data 0 0) ; Include marker between print-area and data-area.
1461 (set-text-properties (point) (point-max) nil) ;Delete garbage props 1463 (set-text-properties (point) (point-max) nil) ; Delete garbage props.
1462 (mapc 'delete-overlay (overlays-in (point-min) (point-max))) 1464 (mapc 'delete-overlay (overlays-in (point-min) (point-max)))
1463 ;;The print area is read-only (except for our special commands) and uses a 1465 ;; The print area is read-only (except for our special commands) and uses a
1464 ;;special keymap. 1466 ;; special keymap.
1465 (put-text-property (point-min) (1- (point)) 'read-only 'ses) 1467 (put-text-property (point-min) (1- (point)) 'read-only 'ses)
1466 (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map) 1468 (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map)
1467 ;;For the beginning of the buffer, we want the read-only and keymap 1469 ;; For the beginning of the buffer, we want the read-only and keymap
1468 ;;attributes to be inherited from the first character 1470 ;; attributes to be inherited from the first character.
1469 (put-text-property (point-min) (1+ (point-min)) 'front-sticky t) 1471 (put-text-property (point-min) (1+ (point-min)) 'front-sticky t)
1470 ;;Create intangible properties, which also indicate which cell the text 1472 ;; Create intangible properties, which also indicate which cell the text
1471 ;;came from. 1473 ;; came from.
1472 (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..." 1474 (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
1473 (dotimes (col ses--numcols) 1475 (dotimes (col ses--numcols)
1474 (setq pos end 1476 (setq pos end
1475 sym (ses-cell-symbol row col)) 1477 sym (ses-cell-symbol row col))
1476 ;;Include skipped cells following this one 1478 ;; Include skipped cells following this one.
1477 (while (and (< col (1- ses--numcols)) 1479 (while (and (< col (1- ses--numcols))
1478 (eq (ses-cell-value row (1+ col)) '*skip*)) 1480 (eq (ses-cell-value row (1+ col)) '*skip*))
1479 (setq end (+ end (ses-col-width col) 1) 1481 (setq end (+ end (ses-col-width col) 1)
@@ -1487,13 +1489,13 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
1487 (forward-char) 1489 (forward-char)
1488 (point)))) 1490 (point))))
1489 (put-text-property pos end 'intangible sym))) 1491 (put-text-property pos end 'intangible sym)))
1490 ;;Adding these properties did not actually alter the text 1492 ;; Adding these properties did not actually alter the text.
1491 (unless was-modified 1493 (unless was-modified
1492 (restore-buffer-modified-p nil) 1494 (restore-buffer-modified-p nil)
1493 (buffer-disable-undo) 1495 (buffer-disable-undo)
1494 (buffer-enable-undo))) 1496 (buffer-enable-undo)))
1495 ;;Create the underlining overlay. It's impossible for (point) to be 2, 1497 ;; Create the underlining overlay. It's impossible for (point) to be 2,
1496 ;;because column A must be at least 1 column wide. 1498 ;; because column A must be at least 1 column wide.
1497 (setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min)))) 1499 (setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min))))
1498 (overlay-put ses--curcell-overlay 'face 'underline)) 1500 (overlay-put ses--curcell-overlay 'face 'underline))
1499 1501
@@ -1502,15 +1504,15 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
1502Delete overlays, remove special text properties." 1504Delete overlays, remove special text properties."
1503 (widen) 1505 (widen)
1504 (let ((inhibit-read-only t) 1506 (let ((inhibit-read-only t)
1505 ;; When reverting, hide the buffer name, otherwise Emacs will ask 1507 ;; When reverting, hide the buffer name, otherwise Emacs will ask the
1506 ;; the user "the file is modified, do you really want to make 1508 ;; user "the file is modified, do you really want to make modifications
1507 ;; modifications to this buffer", where the "modifications" refer to 1509 ;; to this buffer", where the "modifications" refer to the irrelevant
1508 ;; the irrelevant set-text-properties below. 1510 ;; set-text-properties below.
1509 (buffer-file-name nil) 1511 (buffer-file-name nil)
1510 (was-modified (buffer-modified-p))) 1512 (was-modified (buffer-modified-p)))
1511 ;;Delete read-only, keymap, and intangible properties 1513 ;; Delete read-only, keymap, and intangible properties.
1512 (set-text-properties (point-min) (point-max) nil) 1514 (set-text-properties (point-min) (point-max) nil)
1513 ;;Delete overlay 1515 ;; Delete overlay.
1514 (mapc 'delete-overlay (overlays-in (point-min) (point-max))) 1516 (mapc 'delete-overlay (overlays-in (point-min) (point-max)))
1515 (unless was-modified 1517 (unless was-modified
1516 (restore-buffer-modified-p nil)))) 1518 (restore-buffer-modified-p nil))))
@@ -1535,12 +1537,12 @@ These are active only in the minibuffer, when entering or editing a formula:
1535 mode-name "SES" 1537 mode-name "SES"
1536 next-line-add-newlines nil 1538 next-line-add-newlines nil
1537 truncate-lines t 1539 truncate-lines t
1538 ;;SES deliberately puts lots of trailing whitespace in its buffer 1540 ;; SES deliberately puts lots of trailing whitespace in its buffer.
1539 show-trailing-whitespace nil 1541 show-trailing-whitespace nil
1540 ;;Cell ranges do not work reasonably without this 1542 ;; Cell ranges do not work reasonably without this.
1541 transient-mark-mode t 1543 transient-mark-mode t
1542 ;;not to use tab characters for safe 1544 ;; Not to use tab characters for safe (tabs may do bad for column
1543 ;;(tabs may do bad for column calculation) 1545 ;; calculation).
1544 indent-tabs-mode nil) 1546 indent-tabs-mode nil)
1545 (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t)) 1547 (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t))
1546 (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) 1548 (1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
@@ -1551,9 +1553,9 @@ These are active only in the minibuffer, when entering or editing a formula:
1551 header-line-format '(:eval (progn 1553 header-line-format '(:eval (progn
1552 (when (/= (window-hscroll) 1554 (when (/= (window-hscroll)
1553 ses--header-hscroll) 1555 ses--header-hscroll)
1554 ;;Reset ses--header-hscroll first, to 1556 ;; Reset ses--header-hscroll first,
1555 ;;avoid recursion problems when 1557 ;; to avoid recursion problems when
1556 ;;debugging ses-create-header-string 1558 ;; debugging ses-create-header-string
1557 (setq ses--header-hscroll 1559 (setq ses--header-hscroll
1558 (window-hscroll)) 1560 (window-hscroll))
1559 (ses-create-header-string)) 1561 (ses-create-header-string))
@@ -1562,12 +1564,13 @@ These are active only in the minibuffer, when entering or editing a formula:
1562 (was-modified (buffer-modified-p))) 1564 (was-modified (buffer-modified-p)))
1563 (save-excursion 1565 (save-excursion
1564 (if was-empty 1566 (if was-empty
1565 ;;Initialize buffer to contain one cell, for now 1567 ;; Initialize buffer to contain one cell, for now.
1566 (insert ses-initial-file-contents)) 1568 (insert ses-initial-file-contents))
1567 (ses-load) 1569 (ses-load)
1568 (ses-setup)) 1570 (ses-setup))
1569 (when was-empty 1571 (when was-empty
1570 (unless (equal ses-initial-default-printer (1value ses--default-printer)) 1572 (unless (equal ses-initial-default-printer
1573 (1value ses--default-printer))
1571 (1value (ses-read-default-printer ses-initial-default-printer))) 1574 (1value (ses-read-default-printer ses-initial-default-printer)))
1572 (unless (= ses-initial-column-width (1value (ses-col-width 0))) 1575 (unless (= ses-initial-column-width (1value (ses-col-width 0)))
1573 (1value (ses-set-column-width 0 ses-initial-column-width))) 1576 (1value (ses-set-column-width 0 ses-initial-column-width)))
@@ -1582,12 +1585,12 @@ These are active only in the minibuffer, when entering or editing a formula:
1582 (buffer-enable-undo) 1585 (buffer-enable-undo)
1583 (goto-char (point-min)))) 1586 (goto-char (point-min))))
1584 (use-local-map ses-mode-map) 1587 (use-local-map ses-mode-map)
1585 ;;Set the deferred narrowing flag (we can't narrow until after 1588 ;; Set the deferred narrowing flag (we can't narrow until after
1586 ;;after-find-file completes). If .ses is on the auto-load alist and the 1589 ;; after-find-file completes). If .ses is on the auto-load alist and the
1587 ;;file has "mode: ses", our ses-mode function will be called twice! Use 1590 ;; file has "mode: ses", our ses-mode function will be called twice! Use a
1588 ;;a special flag to detect this (will be reset by ses-command-hook). 1591 ;; special flag to detect this (will be reset by ses-command-hook). For
1589 ;;For find-alternate-file, post-command-hook doesn't get run for some 1592 ;; find-alternate-file, post-command-hook doesn't get run for some reason,
1590 ;;reason, so use an idle timer to make sure. 1593 ;; so use an idle timer to make sure.
1591 (setq ses--deferred-narrow 'ses-mode) 1594 (setq ses--deferred-narrow 'ses-mode)
1592 (1value (add-hook 'post-command-hook 'ses-command-hook nil t)) 1595 (1value (add-hook 'post-command-hook 'ses-command-hook nil t))
1593 (run-with-idle-timer 0.01 nil 'ses-command-hook) 1596 (run-with-idle-timer 0.01 nil 'ses-command-hook)
@@ -1601,26 +1604,27 @@ moves the underlining overlay. Performs any recalculations or cell-data
1601writes that have been deferred. If buffer-narrowing has been deferred, 1604writes that have been deferred. If buffer-narrowing has been deferred,
1602narrows the buffer now." 1605narrows the buffer now."
1603 (condition-case err 1606 (condition-case err
1604 (when (eq major-mode 'ses-mode) ;Otherwise, not our buffer anymore 1607 (when (eq major-mode 'ses-mode) ; Otherwise, not our buffer anymore.
1605 (when ses--deferred-recalc 1608 (when ses--deferred-recalc
1606 ;;We reset the deferred list before starting on the recalc -- in case 1609 ;; We reset the deferred list before starting on the recalc --- in
1607 ;;of error, we don't want to retry the recalc after every keystroke! 1610 ;; case of error, we don't want to retry the recalc after every
1611 ;; keystroke!
1608 (let ((old ses--deferred-recalc)) 1612 (let ((old ses--deferred-recalc))
1609 (setq ses--deferred-recalc nil) 1613 (setq ses--deferred-recalc nil)
1610 (ses-update-cells old))) 1614 (ses-update-cells old)))
1611 (when ses--deferred-write 1615 (when ses--deferred-write
1612 ;;We don't reset the deferred list before starting -- the most 1616 ;; We don't reset the deferred list before starting --- the most
1613 ;;likely error is keyboard-quit, and we do want to keep trying 1617 ;; likely error is keyboard-quit, and we do want to keep trying these
1614 ;;these writes after a quit. 1618 ;; writes after a quit.
1615 (ses-write-cells) 1619 (ses-write-cells)
1616 (push '(apply ses-widen) buffer-undo-list)) 1620 (push '(apply ses-widen) buffer-undo-list))
1617 (when ses--deferred-narrow 1621 (when ses--deferred-narrow
1618 ;;We're not allowed to narrow the buffer until after-find-file has 1622 ;; We're not allowed to narrow the buffer until after-find-file has
1619 ;;read the local variables at the end of the file. Now it's safe to 1623 ;; read the local variables at the end of the file. Now it's safe to
1620 ;;do the narrowing. 1624 ;; do the narrowing.
1621 (narrow-to-region (point-min) ses--data-marker) 1625 (narrow-to-region (point-min) ses--data-marker)
1622 (setq ses--deferred-narrow nil)) 1626 (setq ses--deferred-narrow nil))
1623 ;;Update the modeline 1627 ;; Update the modeline.
1624 (let ((oldcell ses--curcell)) 1628 (let ((oldcell ses--curcell))
1625 (ses-set-curcell) 1629 (ses-set-curcell)
1626 (unless (eq ses--curcell oldcell) 1630 (unless (eq ses--curcell oldcell)
@@ -1636,34 +1640,34 @@ narrows the buffer now."
1636 "-" 1640 "-"
1637 (symbol-name (cdr ses--curcell)))))) 1641 (symbol-name (cdr ses--curcell))))))
1638 (force-mode-line-update))) 1642 (force-mode-line-update)))
1639 ;;Use underline overlay for single-cells only, turn off otherwise 1643 ;; Use underline overlay for single-cells only, turn off otherwise.
1640 (if (listp ses--curcell) 1644 (if (listp ses--curcell)
1641 (move-overlay ses--curcell-overlay 2 2) 1645 (move-overlay ses--curcell-overlay 2 2)
1642 (let ((next (next-single-property-change (point) 'intangible))) 1646 (let ((next (next-single-property-change (point) 'intangible)))
1643 (move-overlay ses--curcell-overlay (point) (1- next)))) 1647 (move-overlay ses--curcell-overlay (point) (1- next))))
1644 (when (not (pos-visible-in-window-p)) 1648 (when (not (pos-visible-in-window-p))
1645 ;;Scrolling will happen later 1649 ;; Scrolling will happen later.
1646 (run-with-idle-timer 0.01 nil 'ses-command-hook) 1650 (run-with-idle-timer 0.01 nil 'ses-command-hook)
1647 (setq ses--curcell t))) 1651 (setq ses--curcell t)))
1648 ;;Prevent errors in this post-command-hook from silently erasing the hook! 1652 ;; Prevent errors in this post-command-hook from silently erasing the hook!
1649 (error 1653 (error
1650 (unless executing-kbd-macro 1654 (unless executing-kbd-macro
1651 (ding)) 1655 (ding))
1652 (message "%s" (error-message-string err)))) 1656 (message "%s" (error-message-string err))))
1653 nil) ;Make coverage-tester happy 1657 nil) ; Make coverage-tester happy.
1654 1658
1655(defun ses-create-header-string () 1659(defun ses-create-header-string ()
1656 "Set up `ses--header-string' as the buffer's header line. 1660 "Set up `ses--header-string' as the buffer's header line.
1657Based on the current set of columns and `window-hscroll' position." 1661Based on the current set of columns and `window-hscroll' position."
1658 (let ((totwidth (- (window-hscroll))) 1662 (let ((totwidth (- (window-hscroll)))
1659 result width x) 1663 result width x)
1660 ;;Leave room for the left-side fringe and scrollbar 1664 ;; Leave room for the left-side fringe and scrollbar.
1661 (push (propertize " " 'display '((space :align-to 0))) result) 1665 (push (propertize " " 'display '((space :align-to 0))) result)
1662 (dotimes (col ses--numcols) 1666 (dotimes (col ses--numcols)
1663 (setq width (ses-col-width col) 1667 (setq width (ses-col-width col)
1664 totwidth (+ totwidth width 1)) 1668 totwidth (+ totwidth width 1))
1665 (if (= totwidth 1) 1669 (if (= totwidth 1)
1666 ;;Scrolled so intercolumn space is leftmost 1670 ;; Scrolled so intercolumn space is leftmost.
1667 (push " " result)) 1671 (push " " result))
1668 (when (> totwidth 1) 1672 (when (> totwidth 1)
1669 (if (> ses--header-row 0) 1673 (if (> ses--header-row 0)
@@ -1683,8 +1687,8 @@ Based on the current set of columns and `window-hscroll' position."
1683 'display `((space :align-to ,(1- totwidth))) 1687 'display `((space :align-to ,(1- totwidth)))
1684 'face ses-box-prop) 1688 'face ses-box-prop)
1685 result) 1689 result)
1686 ;;Allow the following space to be squished to make room for the 3-D box 1690 ;; Allow the following space to be squished to make room for the 3-D box
1687 ;;Coverage test ignores properties, thinks this is always a space! 1691 ;; Coverage test ignores properties, thinks this is always a space!
1688 (push (1value (propertize " " 'display `((space :align-to ,totwidth)))) 1692 (push (1value (propertize " " 'display `((space :align-to ,totwidth))))
1689 result))) 1693 result)))
1690 (if (> ses--header-row 0) 1694 (if (> ses--header-row 0)
@@ -1727,13 +1731,13 @@ print area if NONARROW is nil."
1727 (search-forward ses-print-data-boundary) 1731 (search-forward ses-print-data-boundary)
1728 (backward-char (length ses-print-data-boundary)) 1732 (backward-char (length ses-print-data-boundary))
1729 (delete-region (point-min) (point)) 1733 (delete-region (point-min) (point))
1730 ;;Insert all blank lines before printing anything, so ses-print-cell can 1734 ;; Insert all blank lines before printing anything, so ses-print-cell can
1731 ;;find the data area when inserting or deleting *skip* values for cells 1735 ;; find the data area when inserting or deleting *skip* values for cells.
1732 (dotimes (row ses--numrows) 1736 (dotimes (row ses--numrows)
1733 (insert-and-inherit ses--blank-line)) 1737 (insert-and-inherit ses--blank-line))
1734 (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..." 1738 (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..."
1735 (if (eq (ses-cell-value row 0) '*skip*) 1739 (if (eq (ses-cell-value row 0) '*skip*)
1736 ;;Column deletion left a dangling skip 1740 ;; Column deletion left a dangling skip.
1737 (ses-set-cell row 0 'value nil)) 1741 (ses-set-cell row 0 'value nil))
1738 (dotimes (col ses--numcols) 1742 (dotimes (col ses--numcols)
1739 (ses-print-cell row col)) 1743 (ses-print-cell row col))
@@ -1755,20 +1759,20 @@ to are recalculated first."
1755 (if (atom ses--curcell) 1759 (if (atom ses--curcell)
1756 (setq sig (ses-sym-rowcol ses--curcell) 1760 (setq sig (ses-sym-rowcol ses--curcell)
1757 sig (ses-calculate-cell (car sig) (cdr sig) t)) 1761 sig (ses-calculate-cell (car sig) (cdr sig) t))
1758 ;;First, recalculate all cells that don't refer to other cells and 1762 ;; First, recalculate all cells that don't refer to other cells and
1759 ;;produce a list of cells with references. 1763 ;; produce a list of cells with references.
1760 (ses-dorange ses--curcell 1764 (ses-dorange ses--curcell
1761 (ses-time-check "Recalculating... %s" '(ses-cell-symbol row col)) 1765 (ses-time-check "Recalculating... %s" '(ses-cell-symbol row col))
1762 (condition-case nil 1766 (condition-case nil
1763 (progn 1767 (progn
1764 ;;The t causes an error if the cell has references. 1768 ;; The t causes an error if the cell has references. If no
1765 ;;If no references, the t will be the result value. 1769 ;; references, the t will be the result value.
1766 (1value (ses-formula-references (ses-cell-formula row col) t)) 1770 (1value (ses-formula-references (ses-cell-formula row col) t))
1767 (setq sig (ses-calculate-cell row col t))) 1771 (setq sig (ses-calculate-cell row col t)))
1768 (wrong-type-argument 1772 (wrong-type-argument
1769 ;;The formula contains a reference 1773 ;; The formula contains a reference.
1770 (add-to-list 'ses--deferred-recalc (ses-cell-symbol row col)))))) 1774 (add-to-list 'ses--deferred-recalc (ses-cell-symbol row col))))))
1771 ;;Do the update now, so we can force recalculation 1775 ;; Do the update now, so we can force recalculation.
1772 (let ((x ses--deferred-recalc)) 1776 (let ((x ses--deferred-recalc))
1773 (setq ses--deferred-recalc nil) 1777 (setq ses--deferred-recalc nil)
1774 (condition-case hold 1778 (condition-case hold
@@ -1801,11 +1805,11 @@ cells."
1801 (col (cdr rowcol))) 1805 (col (cdr rowcol)))
1802 (when (and (< col (1- ses--numcols)) ;;Last column can't spill over, anyway 1806 (when (and (< col (1- ses--numcols)) ;;Last column can't spill over, anyway
1803 (eq (ses-cell-value row (1+ col)) '*skip*)) 1807 (eq (ses-cell-value row (1+ col)) '*skip*))
1804 ;;This cell has spill-over. We'll momentarily pretend the following 1808 ;; This cell has spill-over. We'll momentarily pretend the following cell
1805 ;;cell has a `t' in it. 1809 ;; has a `t' in it.
1806 (eval `(let ((,(ses-cell-symbol row (1+ col)) t)) 1810 (eval `(let ((,(ses-cell-symbol row (1+ col)) t))
1807 (ses-print-cell row col))) 1811 (ses-print-cell row col)))
1808 ;;Now remove the *skip*. ses-print-cell is always nil here 1812 ;; Now remove the *skip*. ses-print-cell is always nil here.
1809 (ses-set-cell row (1+ col) 'value nil) 1813 (ses-set-cell row (1+ col) 'value nil)
1810 (1value (ses-print-cell row (1+ col)))))) 1814 (1value (ses-print-cell row (1+ col))))))
1811 1815
@@ -1817,12 +1821,12 @@ cells."
1817 (let (x yrow ycol) 1821 (let (x yrow ycol)
1818 ;;Delete old reference lists 1822 ;;Delete old reference lists
1819 (dotimes-with-progress-reporter 1823 (dotimes-with-progress-reporter
1820 (row ses--numrows) "Deleting references..." 1824 (row ses--numrows) "Deleting references..."
1821 (dotimes (col ses--numcols) 1825 (dotimes (col ses--numcols)
1822 (ses-set-cell row col 'references nil))) 1826 (ses-set-cell row col 'references nil)))
1823 ;;Create new reference lists 1827 ;;Create new reference lists
1824 (dotimes-with-progress-reporter 1828 (dotimes-with-progress-reporter
1825 (row ses--numrows) "Computing references..." 1829 (row ses--numrows) "Computing references..."
1826 (dotimes (col ses--numcols) 1830 (dotimes (col ses--numcols)
1827 (dolist (ref (ses-formula-references (ses-cell-formula row col))) 1831 (dolist (ref (ses-formula-references (ses-cell-formula row col)))
1828 (setq x (ses-sym-rowcol ref) 1832 (setq x (ses-sym-rowcol ref)
@@ -1831,26 +1835,27 @@ cells."
1831 (ses-set-cell yrow ycol 'references 1835 (ses-set-cell yrow ycol 'references
1832 (cons (ses-cell-symbol row col) 1836 (cons (ses-cell-symbol row col)
1833 (ses-cell-references yrow ycol))))))) 1837 (ses-cell-references yrow ycol)))))))
1834 ;;Delete everything and reconstruct basic data area 1838 ;; Delete everything and reconstruct basic data area.
1835 (ses-widen) 1839 (ses-widen)
1836 (let ((inhibit-read-only t)) 1840 (let ((inhibit-read-only t))
1837 (goto-char (point-max)) 1841 (goto-char (point-max))
1838 (if (search-backward ";; Local Variables:\n" nil t) 1842 (if (search-backward ";; Local Variables:\n" nil t)
1839 (delete-region (point-min) (point)) 1843 (delete-region (point-min) (point))
1840 ;;Buffer is quite screwed up - can't even save the user-specified locals 1844 ;; Buffer is quite screwed up --- can't even save the user-specified
1845 ;; locals.
1841 (delete-region (point-min) (point-max)) 1846 (delete-region (point-min) (point-max))
1842 (insert ses-initial-file-trailer) 1847 (insert ses-initial-file-trailer)
1843 (goto-char (point-min))) 1848 (goto-char (point-min)))
1844 ;;Create a blank display area 1849 ;; Create a blank display area.
1845 (dotimes (row ses--numrows) 1850 (dotimes (row ses--numrows)
1846 (insert ses--blank-line)) 1851 (insert ses--blank-line))
1847 (insert ses-print-data-boundary) 1852 (insert ses-print-data-boundary)
1848 (backward-char (1- (length ses-print-data-boundary))) 1853 (backward-char (1- (length ses-print-data-boundary)))
1849 (setq ses--data-marker (point-marker)) 1854 (setq ses--data-marker (point-marker))
1850 (forward-char (1- (length ses-print-data-boundary))) 1855 (forward-char (1- (length ses-print-data-boundary)))
1851 ;;Placeholders for cell data 1856 ;; Placeholders for cell data.
1852 (insert (make-string (* ses--numrows (1+ ses--numcols)) ?\n)) 1857 (insert (make-string (* ses--numrows (1+ ses--numcols)) ?\n))
1853 ;;Placeholders for col-widths, col-printers, default-printer, header-row 1858 ;; Placeholders for col-widths, col-printers, default-printer, header-row.
1854 (insert "\n\n\n\n") 1859 (insert "\n\n\n\n")
1855 (insert ses-initial-global-parameters) 1860 (insert ses-initial-global-parameters)
1856 (backward-char (1- (length ses-initial-global-parameters))) 1861 (backward-char (1- (length ses-initial-global-parameters)))
@@ -1890,13 +1895,13 @@ cell formula was unsafe and user declined confirmation."
1890 (setq initial (format "'%S" (cadr formula))) 1895 (setq initial (format "'%S" (cadr formula)))
1891 (setq initial (prin1-to-string formula))) 1896 (setq initial (prin1-to-string formula)))
1892 (if (stringp formula) 1897 (if (stringp formula)
1893 ;;Position cursor inside close-quote 1898 ;; Position cursor inside close-quote.
1894 (setq initial (cons initial (length initial)))) 1899 (setq initial (cons initial (length initial))))
1895 (list row col 1900 (list row col
1896 (read-from-minibuffer (format "Cell %s: " ses--curcell) 1901 (read-from-minibuffer (format "Cell %s: " ses--curcell)
1897 initial 1902 initial
1898 ses-mode-edit-map 1903 ses-mode-edit-map
1899 t ;Convert to Lisp object 1904 t ; Convert to Lisp object.
1900 'ses-read-cell-history))))) 1905 'ses-read-cell-history)))))
1901 (when (ses-warn-unsafe newval 'unsafep) 1906 (when (ses-warn-unsafe newval 'unsafep)
1902 (ses-begin-change) 1907 (ses-begin-change)
@@ -1917,13 +1922,13 @@ cell formula was unsafe and user declined confirmation."
1917 (cons (if (equal initial "\"") "\"\"" 1922 (cons (if (equal initial "\"") "\"\""
1918 (if (equal initial "(") "()" initial)) 2) 1923 (if (equal initial "(") "()" initial)) 2)
1919 ses-mode-edit-map 1924 ses-mode-edit-map
1920 t ;Convert to Lisp object 1925 t ; Convert to Lisp object.
1921 'ses-read-cell-history 1926 'ses-read-cell-history
1922 (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) 1927 (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula)
1923 (cadr curval) 1928 (cadr curval)
1924 curval)))))) 1929 curval))))))
1925 (when (ses-edit-cell row col newval) 1930 (when (ses-edit-cell row col newval)
1926 (ses-command-hook) ;Update cell widths before movement 1931 (ses-command-hook) ; Update cell widths before movement.
1927 (dolist (x ses-after-entry-functions) 1932 (dolist (x ses-after-entry-functions)
1928 (funcall x 1)))) 1933 (funcall x 1))))
1929 1934
@@ -1939,10 +1944,10 @@ have been used as formulas in this spreadsheet is available for completions."
1939 (list (car rowcol) 1944 (list (car rowcol)
1940 (cdr rowcol) 1945 (cdr rowcol)
1941 (if (string= newval "") 1946 (if (string= newval "")
1942 nil ;Don't create zero-length symbols! 1947 nil ; Don't create zero-length symbols!
1943 (list 'quote (intern newval)))))) 1948 (list 'quote (intern newval))))))
1944 (when (ses-edit-cell row col symb) 1949 (when (ses-edit-cell row col symb)
1945 (ses-command-hook) ;Update cell widths before movement 1950 (ses-command-hook) ; Update cell widths before movement.
1946 (dolist (x ses-after-entry-functions) 1951 (dolist (x ses-after-entry-functions)
1947 (funcall x 1)))) 1952 (funcall x 1))))
1948 1953
@@ -1970,7 +1975,7 @@ cells."
1970 (ses-check-curcell 'end) 1975 (ses-check-curcell 'end)
1971 (ses-begin-change) 1976 (ses-begin-change)
1972 (dotimes (x count) 1977 (dotimes (x count)
1973 (backward-char 1) ;Will signal 'beginning-of-buffer if appropriate 1978 (backward-char 1) ; Will signal 'beginning-of-buffer if appropriate.
1974 (ses-set-curcell) 1979 (ses-set-curcell)
1975 (let ((rowcol (ses-sym-rowcol ses--curcell))) 1980 (let ((rowcol (ses-sym-rowcol ses--curcell)))
1976 (ses-clear-cell (car rowcol) (cdr rowcol)))))) 1981 (ses-clear-cell (car rowcol) (cdr rowcol))))))
@@ -1990,13 +1995,13 @@ PROMPT should end with \": \". Result is t if operation was cancelled."
1990 (substring prompt 0 -2) 1995 (substring prompt 0 -2)
1991 default))) 1996 default)))
1992 (let ((new (read-from-minibuffer prompt 1997 (let ((new (read-from-minibuffer prompt
1993 nil ;Initial contents 1998 nil ; Initial contents.
1994 ses-mode-edit-map 1999 ses-mode-edit-map
1995 t ;Evaluate the result 2000 t ; Evaluate the result.
1996 'ses-read-printer-history 2001 'ses-read-printer-history
1997 (prin1-to-string default)))) 2002 (prin1-to-string default))))
1998 (if (equal new default) 2003 (if (equal new default)
1999 ;;User changed mind, decided not to change printer 2004 ;; User changed mind, decided not to change printer.
2000 (setq new t) 2005 (setq new t)
2001 (ses-printer-validate new) 2006 (ses-printer-validate new)
2002 (or (not new) 2007 (or (not new)
@@ -2197,7 +2202,7 @@ If COL is specified, the new column(s) get the specified WIDTH and PRINTER
2197 ;;ses-relocate-all) 2202 ;;ses-relocate-all)
2198 (ses-goto-data row col) 2203 (ses-goto-data row col)
2199 (insert ?\n)) 2204 (insert ?\n))
2200 ;;Insert column width and printer 2205 ;; Insert column width and printer.
2201 (setq widths (ses-vector-insert widths col width) 2206 (setq widths (ses-vector-insert widths col width)
2202 printers (ses-vector-insert printers col printer))) 2207 printers (ses-vector-insert printers col printer)))
2203 (ses-set-parameter 'ses--col-widths widths) 2208 (ses-set-parameter 'ses--col-widths widths)
@@ -2208,11 +2213,11 @@ If COL is specified, the new column(s) get the specified WIDTH and PRINTER
2208 (ses-reprint-all t) 2213 (ses-reprint-all t)
2209 (when (or (> (length (ses-call-printer printer)) 0) 2214 (when (or (> (length (ses-call-printer printer)) 0)
2210 (> (length (ses-call-printer ses--default-printer)) 0)) 2215 (> (length (ses-call-printer ses--default-printer)) 0))
2211 ;;Either column printer or global printer inserts some constant text 2216 ;; Either column printer or global printer inserts some constant text.
2212 ;;Reprint the new columns to insert that text. 2217 ;; Reprint the new columns to insert that text.
2213 (dotimes (x ses--numrows) 2218 (dotimes (x ses--numrows)
2214 (dotimes (y count) 2219 (dotimes (y count)
2215 ;Always nil here - this is a blank column 2220 ;; Always nil here --- this is a blank column.
2216 (1value (ses-print-cell-new-width x (+ y col)))))) 2221 (1value (ses-print-cell-new-width x (+ y col))))))
2217 (ses-setup))) 2222 (ses-setup)))
2218 (ses-jump-safe ses--curcell)) 2223 (ses-jump-safe ses--curcell))
@@ -2272,19 +2277,19 @@ from the current one."
2272inserts a new row if at bottom of print area. Repeat COUNT times." 2277inserts a new row if at bottom of print area. Repeat COUNT times."
2273 (interactive "p") 2278 (interactive "p")
2274 (ses-check-curcell 'end) 2279 (ses-check-curcell 'end)
2275 (setq deactivate-mark t) ;Doesn't combine well with ranges 2280 (setq deactivate-mark t) ; Doesn't combine well with ranges.
2276 (dotimes (x count) 2281 (dotimes (x count)
2277 (ses-set-curcell) 2282 (ses-set-curcell)
2278 (if (not ses--curcell) 2283 (if (not ses--curcell)
2279 (progn ;At bottom of print area 2284 (progn ; At bottom of print area.
2280 (barf-if-buffer-read-only) 2285 (barf-if-buffer-read-only)
2281 (ses-insert-row 1)) 2286 (ses-insert-row 1))
2282 (let ((col (cdr (ses-sym-rowcol ses--curcell)))) 2287 (let ((col (cdr (ses-sym-rowcol ses--curcell))))
2283 (when (/= 32 2288 (when (/= 32
2284 (char-before (next-single-property-change (point) 2289 (char-before (next-single-property-change (point)
2285 'intangible))) 2290 'intangible)))
2286 ;;We're already in last nonskipped cell on line. Need to create a 2291 ;; We're already in last nonskipped cell on line. Need to create a
2287 ;;new column. 2292 ;; new column.
2288 (barf-if-buffer-read-only) 2293 (barf-if-buffer-read-only)
2289 (ses-insert-column (- count x) 2294 (ses-insert-column (- count x)
2290 ses--numcols 2295 ses--numcols
@@ -2312,12 +2317,12 @@ inserts a new row if at bottom of print area. Repeat COUNT times."
2312 (read-from-minibuffer (format "Column %s width [currently %d]: " 2317 (read-from-minibuffer (format "Column %s width [currently %d]: "
2313 (ses-column-letter col) 2318 (ses-column-letter col)
2314 (ses-col-width col)) 2319 (ses-col-width col))
2315 nil ;No initial contents 2320 nil ; No initial contents.
2316 nil ;No override keymap 2321 nil ; No override keymap.
2317 t ;Convert to Lisp object 2322 t ; Convert to Lisp object.
2318 nil ;No history 2323 nil ; No history.
2319 (number-to-string 2324 (number-to-string
2320 (ses-col-width col))))))) ;Default value 2325 (ses-col-width col))))))) ; Default value.
2321 (if (< newwidth 1) 2326 (if (< newwidth 1)
2322 (error "Invalid column width")) 2327 (error "Invalid column width"))
2323 (ses-begin-change) 2328 (ses-begin-change)
@@ -2349,7 +2354,7 @@ hard to override how mouse-1 works."
2349 (if (not (and (eq major-mode 'ses-mode) 2354 (if (not (and (eq major-mode 'ses-mode)
2350 (eq (get-text-property beg 'read-only) 'ses) 2355 (eq (get-text-property beg 'read-only) 'ses)
2351 (eq (get-text-property (1- end) 'read-only) 'ses))) 2356 (eq (get-text-property (1- end) 'read-only) 'ses)))
2352 ad-do-it ;Normal copy-region-as-kill 2357 ad-do-it ; Normal copy-region-as-kill.
2353 (kill-new (ses-copy-region beg end)) 2358 (kill-new (ses-copy-region beg end))
2354 (if transient-mark-mode 2359 (if transient-mark-mode
2355 (setq deactivate-mark t)) 2360 (setq deactivate-mark t))
@@ -2400,17 +2405,17 @@ the corresponding data cell."
2400cells instead of deleting them." 2405cells instead of deleting them."
2401 (interactive "r") 2406 (interactive "r")
2402 (ses-check-curcell 'needrange) 2407 (ses-check-curcell 'needrange)
2403 ;;For some reason, the text-read-only error is not caught by 2408 ;; For some reason, the text-read-only error is not caught by `delete-region',
2404 ;;`delete-region', so we have to use subterfuge. 2409 ;; so we have to use subterfuge.
2405 (let ((buffer-read-only t)) 2410 (let ((buffer-read-only t))
2406 (1value (condition-case x 2411 (1value (condition-case x
2407 (noreturn (funcall (lookup-key (current-global-map) 2412 (noreturn (funcall (lookup-key (current-global-map)
2408 (this-command-keys)) 2413 (this-command-keys))
2409 beg end)) 2414 beg end))
2410 (buffer-read-only nil)))) ;The expected error 2415 (buffer-read-only nil)))) ; The expected error.
2411 ;;Because the buffer was marked read-only, the kill command turned itself 2416 ;; Because the buffer was marked read-only, the kill command turned itself
2412 ;;into a copy. Now we clear the cells or signal the error. First we 2417 ;; into a copy. Now we clear the cells or signal the error. First we check
2413 ;;check whether the buffer really is read-only. 2418 ;; whether the buffer really is read-only.
2414 (barf-if-buffer-read-only) 2419 (barf-if-buffer-read-only)
2415 (ses-begin-change) 2420 (ses-begin-change)
2416 (ses-dorange ses--curcell 2421 (ses-dorange ses--curcell
@@ -2437,7 +2442,7 @@ explicitly insert a symbol, or use the C-u prefix to treat all unmarked words
2437as symbols." 2442as symbols."
2438 (if (not (and (eq major-mode 'ses-mode) 2443 (if (not (and (eq major-mode 'ses-mode)
2439 (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) 2444 (eq (get-text-property (point) 'keymap) 'ses-mode-print-map)))
2440 ad-do-it ;Normal non-SES yank 2445 ad-do-it ; Normal non-SES yank.
2441 (ses-check-curcell 'end) 2446 (ses-check-curcell 'end)
2442 (push-mark (point)) 2447 (push-mark (point))
2443 (let ((text (current-kill (cond 2448 (let ((text (current-kill (cond
@@ -2450,7 +2455,7 @@ as symbols."
2450 text 2455 text
2451 0 2456 0
2452 (if (memq (aref text (1- (length text))) '(?\t ?\n)) 2457 (if (memq (aref text (1- (length text))) '(?\t ?\n))
2453 ;;Just one cell - delete final tab or newline 2458 ;; Just one cell --- delete final tab or newline.
2454 (1- (length text))) 2459 (1- (length text)))
2455 arg))) 2460 arg)))
2456 (if (consp arg) 2461 (if (consp arg)
@@ -2499,21 +2504,21 @@ formulas are to be inserted without relocation."
2499 pos (next-single-property-change pos 'ses text) 2504 pos (next-single-property-change pos 'ses text)
2500 x (ses-sym-rowcol (car last))) 2505 x (ses-sym-rowcol (car last)))
2501 (if (not last) 2506 (if (not last)
2502 ;;Newline - all remaining cells on row are skipped 2507 ;; Newline --- all remaining cells on row are skipped.
2503 (setq x (cons (- myrow rowincr) (+ needcols colincr -1)) 2508 (setq x (cons (- myrow rowincr) (+ needcols colincr -1))
2504 last (list nil nil nil) 2509 last (list nil nil nil)
2505 pos (1- pos))) 2510 pos (1- pos)))
2506 (if (/= (car x) (- myrow rowincr)) 2511 (if (/= (car x) (- myrow rowincr))
2507 (error "Cell row error")) 2512 (error "Cell row error"))
2508 (if (< (- mycol colincr) (cdr x)) 2513 (if (< (- mycol colincr) (cdr x))
2509 ;;Some columns were skipped 2514 ;; Some columns were skipped.
2510 (let ((oldcol mycol)) 2515 (let ((oldcol mycol))
2511 (while (< (- mycol colincr) (cdr x)) 2516 (while (< (- mycol colincr) (cdr x))
2512 (ses-clear-cell myrow mycol) 2517 (ses-clear-cell myrow mycol)
2513 (setq col (1+ col) 2518 (setq col (1+ col)
2514 mycol (1+ mycol))) 2519 mycol (1+ mycol)))
2515 (ses-print-cell myrow (1- oldcol)))) ;;This inserts *skip* 2520 (ses-print-cell myrow (1- oldcol)))) ;; This inserts *skip*.
2516 (when (car last) ;Skip this for *skip* cells 2521 (when (car last) ; Skip this for *skip* cells.
2517 (setq x (nth 2 last)) 2522 (setq x (nth 2 last))
2518 (unless (equal x (ses-cell-printer myrow mycol)) 2523 (unless (equal x (ses-cell-printer myrow mycol))
2519 (or (not x) 2524 (or (not x)
@@ -2542,12 +2547,12 @@ cons of ROW and COL). Treat plain symbols as strings unless ARG is a list."
2542 (error (cons nil from))))) 2547 (error (cons nil from)))))
2543 (cond 2548 (cond
2544 ((< (cdr val) (or to (length text))) 2549 ((< (cdr val) (or to (length text)))
2545 ;;Invalid sexp - leave it as a string 2550 ;; Invalid sexp --- leave it as a string.
2546 (setq val (substring text from to))) 2551 (setq val (substring text from to)))
2547 ((and (car val) (symbolp (car val))) 2552 ((and (car val) (symbolp (car val)))
2548 (if (consp arg) 2553 (if (consp arg)
2549 (setq val (list 'quote (car val))) ;Keep symbol 2554 (setq val (list 'quote (car val))) ; Keep symbol.
2550 (setq val (substring text from to)))) ;Treat symbol as text 2555 (setq val (substring text from to)))) ; Treat symbol as text.
2551 (t 2556 (t
2552 (setq val (car val)))) 2557 (setq val (car val))))
2553 (let ((row (car rowcol)) 2558 (let ((row (car rowcol))
@@ -2729,27 +2734,28 @@ The top row is row 1. Selecting row 0 displays the default header row."
2729 "Move point to last cell on line." 2734 "Move point to last cell on line."
2730 (interactive) 2735 (interactive)
2731 (ses-check-curcell 'end 'range) 2736 (ses-check-curcell 'end 'range)
2732 (when ses--curcell ;Otherwise we're at the bottom row, which is empty anyway 2737 (when ses--curcell ; Otherwise we're at the bottom row, which is empty
2738 ; anyway.
2733 (let ((col (1- ses--numcols)) 2739 (let ((col (1- ses--numcols))
2734 row rowcol) 2740 row rowcol)
2735 (if (symbolp ses--curcell) 2741 (if (symbolp ses--curcell)
2736 ;;Single cell 2742 ;; Single cell.
2737 (setq row (car (ses-sym-rowcol ses--curcell))) 2743 (setq row (car (ses-sym-rowcol ses--curcell)))
2738 ;;Range - use whichever end of the range the point is at 2744 ;; Range --- use whichever end of the range the point is at.
2739 (setq rowcol (ses-sym-rowcol (if (< (point) (mark)) 2745 (setq rowcol (ses-sym-rowcol (if (< (point) (mark))
2740 (car ses--curcell) 2746 (car ses--curcell)
2741 (cdr ses--curcell)))) 2747 (cdr ses--curcell))))
2742 ;;If range already includes the last cell in a row, point is actually 2748 ;; If range already includes the last cell in a row, point is actually
2743 ;;in the following row 2749 ;; in the following row.
2744 (if (<= (cdr rowcol) (1- col)) 2750 (if (<= (cdr rowcol) (1- col))
2745 (setq row (car rowcol)) 2751 (setq row (car rowcol))
2746 (setq row (1+ (car rowcol))) 2752 (setq row (1+ (car rowcol)))
2747 (if (= row ses--numrows) 2753 (if (= row ses--numrows)
2748 ;;Already at end - can't go anywhere 2754 ;;Already at end - can't go anywhere
2749 (setq col 0)))) 2755 (setq col 0))))
2750 (when (< row ses--numrows) ;Otherwise it's a range that includes last cell 2756 (when (< row ses--numrows) ; Otherwise it's a range that includes last cell.
2751 (while (eq (ses-cell-value row col) '*skip*) 2757 (while (eq (ses-cell-value row col) '*skip*)
2752 ;;Back to beginning of multi-column cell 2758 ;; Back to beginning of multi-column cell.
2753 (setq col (1- col))) 2759 (setq col (1- col)))
2754 (ses-goto-print row col))))) 2760 (ses-goto-print row col)))))
2755 2761
@@ -2801,7 +2807,7 @@ REVERSE order."
2801 (interactive "*e\nP") 2807 (interactive "*e\nP")
2802 (setq event (event-end event)) 2808 (setq event (event-end event))
2803 (select-window (posn-window event)) 2809 (select-window (posn-window event))
2804 (setq event (car (posn-col-row event))) ;Click column 2810 (setq event (car (posn-col-row event))) ; Click column.
2805 (let ((col 0)) 2811 (let ((col 0))
2806 (while (and (< col ses--numcols) (> event (ses-col-width col))) 2812 (while (and (< col ses--numcols) (> event (ses-col-width col)))
2807 (setq event (- event (ses-col-width col) 1) 2813 (setq event (- event (ses-col-width col) 1)
@@ -2816,7 +2822,7 @@ spreadsheet."
2816 (interactive "*") 2822 (interactive "*")
2817 (let (x) 2823 (let (x)
2818 (with-current-buffer (window-buffer minibuffer-scroll-window) 2824 (with-current-buffer (window-buffer minibuffer-scroll-window)
2819 (ses-command-hook) ;For ses-coverage 2825 (ses-command-hook) ; For ses-coverage.
2820 (ses-check-curcell 'needrange) 2826 (ses-check-curcell 'needrange)
2821 (setq x (cdr (macroexpand `(ses-range ,(car ses--curcell) 2827 (setq x (cdr (macroexpand `(ses-range ,(car ses--curcell)
2822 ,(cdr ses--curcell)))))) 2828 ,(cdr ses--curcell))))))
@@ -2828,7 +2834,7 @@ highlighted range in the spreadsheet."
2828 (interactive "*") 2834 (interactive "*")
2829 (let (x) 2835 (let (x)
2830 (with-current-buffer (window-buffer minibuffer-scroll-window) 2836 (with-current-buffer (window-buffer minibuffer-scroll-window)
2831 (ses-command-hook) ;For ses-coverage 2837 (ses-command-hook) ; For ses-coverage.
2832 (ses-check-curcell 'needrange) 2838 (ses-check-curcell 'needrange)
2833 (setq x (format "(ses-range %S %S)" 2839 (setq x (format "(ses-range %S %S)"
2834 (car ses--curcell) 2840 (car ses--curcell)
@@ -2940,9 +2946,9 @@ TEST is evaluated."
2940;; Standard print functions 2946;; Standard print functions
2941;;---------------------------------------------------------------------------- 2947;;----------------------------------------------------------------------------
2942 2948
2943;;These functions use the variables 'row' and 'col' that are 2949;; These functions use the variables 'row' and 'col' that are dynamically bound
2944;;dynamically bound by ses-print-cell. We define these variables at 2950;; by ses-print-cell. We define these variables at compile-time to make the
2945;;compile-time to make the compiler happy. 2951;; compiler happy.
2946(eval-when-compile 2952(eval-when-compile
2947 (dolist (x '(row col)) 2953 (dolist (x '(row col))
2948 (make-local-variable x) 2954 (make-local-variable x)
@@ -2960,10 +2966,10 @@ columns to include in width (default = 0)."
2960 (setq value (ses-call-printer printer value)) 2966 (setq value (ses-call-printer printer value))
2961 (dotimes (x span) 2967 (dotimes (x span)
2962 (setq width (+ width 1 (ses-col-width (+ col span (- x)))))) 2968 (setq width (+ width 1 (ses-col-width (+ col span (- x))))))
2963 ;; set column width 2969 ;; Set column width.
2964 (setq width (- width (string-width value))) 2970 (setq width (- width (string-width value)))
2965 (if (<= width 0) 2971 (if (<= width 0)
2966 value ;Too large for field, anyway 2972 value ; Too large for field, anyway.
2967 (setq half (make-string (/ width 2) fill)) 2973 (setq half (make-string (/ width 2) fill))
2968 (concat half value half 2974 (concat half value half
2969 (if (> (% width 2) 0) (char-to-string fill)))))) 2975 (if (> (% width 2) 0) (char-to-string fill))))))