1 |
;;; ses.el -- Simple Emacs Spreadsheet |
;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*- |
2 |
|
|
3 |
;; Copyright (C) 2002,03,04 Free Software Foundation, Inc. |
;; Copyright (C) 2002,03,04 Free Software Foundation, Inc. |
4 |
|
|
23 |
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
24 |
;; Boston, MA 02111-1307, USA. |
;; Boston, MA 02111-1307, USA. |
25 |
|
|
26 |
|
;;; Commentary: |
27 |
|
|
28 |
;;; To-do list: |
;;; To-do list: |
29 |
|
|
30 |
;; * Use $ or … for truncated fields |
;; * Use $ or … for truncated fields |
31 |
;; * Add command to make a range of columns be temporarily invisible. |
;; * Add command to make a range of columns be temporarily invisible. |
32 |
;; * Allow paste of one cell to a range of cells -- copy formula to each. |
;; * Allow paste of one cell to a range of cells -- copy formula to each. |
38 |
;; * Left-margin column for row number. |
;; * Left-margin column for row number. |
39 |
;; * Move a row by dragging its number in the left-margin. |
;; * Move a row by dragging its number in the left-margin. |
40 |
|
|
41 |
|
|
42 |
|
;;; Code: |
43 |
|
|
44 |
(require 'unsafep) |
(require 'unsafep) |
45 |
|
|
46 |
|
|
47 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
48 |
;;;; User-customizable variables |
;; User-customizable variables |
49 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
50 |
|
|
51 |
(defgroup ses nil |
(defgroup ses nil |
52 |
"Simple Emacs Spreadsheet" |
"Simple Emacs Spreadsheet" |
72 |
function)) |
function)) |
73 |
|
|
74 |
(defcustom ses-after-entry-functions '(forward-char) |
(defcustom ses-after-entry-functions '(forward-char) |
75 |
"Things to do after entering a value into a cell. An abnormal hook that |
"Things to do after entering a value into a cell. |
76 |
usually runs a cursor-movement function. Each function is called with ARG=1." |
An abnormal hook that usually runs a cursor-movement function. |
77 |
|
Each function is called with ARG=1." |
78 |
:group 'ses |
:group 'ses |
79 |
:type 'hook |
:type 'hook |
80 |
:options '(forward-char backward-char next-line previous-line)) |
:options '(forward-char backward-char next-line previous-line)) |
85 |
:type 'hook) |
:type 'hook) |
86 |
|
|
87 |
|
|
88 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
89 |
;;;; Global variables and constants |
;; Global variables and constants |
90 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
91 |
|
|
92 |
(defvar ses-read-cell-history nil |
(defvar ses-read-cell-history nil |
93 |
"List of formulas that have been typed in.") |
"List of formulas that have been typed in.") |
99 |
"Context menu when mouse-3 is used on the header-line in an SES buffer." |
"Context menu when mouse-3 is used on the header-line in an SES buffer." |
100 |
'("SES header row" |
'("SES header row" |
101 |
["Set current row" ses-set-header-row t] |
["Set current row" ses-set-header-row t] |
102 |
["Unset row" ses-unset-header-row (> header-row 0)])) |
["Unset row" ses-unset-header-row (> ses--header-row 0)])) |
103 |
|
|
104 |
(defconst ses-mode-map |
(defconst ses-mode-map |
105 |
(let ((keys `("\C-c\M-\C-l" ses-reconstruct-all |
(let ((keys `("\C-c\M-\C-l" ses-reconstruct-all |
215 |
map)) |
map)) |
216 |
|
|
217 |
(defconst ses-print-data-boundary "\n\014\n" |
(defconst ses-print-data-boundary "\n\014\n" |
218 |
"Marker string denoting the boundary between print area and data area") |
"Marker string denoting the boundary between print area and data area.") |
219 |
|
|
220 |
(defconst ses-initial-global-parameters |
(defconst ses-initial-global-parameters |
221 |
"\n( ;Global parameters (these are read first)\n 2 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n" |
"\n( ;Global parameters (these are read first)\n 2 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n" |
222 |
"Initial contents for the three-element list at the bottom of the data area") |
"Initial contents for the three-element list at the bottom of the data area.") |
223 |
|
|
224 |
(defconst ses-initial-file-trailer |
(defconst ses-initial-file-trailer |
225 |
";;; Local Variables:\n;;; mode: ses\n;;; End:\n" |
";; Local Variables:\n;; mode: ses\n;; End:\n" |
226 |
"Initial contents for the file-trailer area at the bottom of the file.") |
"Initial contents for the file-trailer area at the bottom of the file.") |
227 |
|
|
228 |
(defconst ses-initial-file-contents |
(defconst ses-initial-file-contents |
238 |
ses-initial-file-trailer) |
ses-initial-file-trailer) |
239 |
"The initial contents of an empty spreadsheet.") |
"The initial contents of an empty spreadsheet.") |
240 |
|
|
|
(defconst ses-cell-size 4 |
|
|
"A cell consists of a SYMBOL, a FORMULA, a PRINTER-function, and a list of |
|
|
REFERENCES.") |
|
|
|
|
241 |
(defconst ses-paramlines-plist |
(defconst ses-paramlines-plist |
242 |
'(ses--col-widths 2 ses--col-printers 3 ses--default-printer 4 |
'(ses--col-widths 2 ses--col-printers 3 ses--default-printer 4 |
243 |
ses--header-row 5 ses--file-format 8 ses--numrows 9 |
ses--header-row 5 ses--file-format 8 ses--numrows 9 |
274 |
(set x nil))) |
(set x nil))) |
275 |
|
|
276 |
|
|
277 |
;;; |
;; |
278 |
;;; "Side-effect variables". They are set in one function, altered in |
;; "Side-effect variables". They are set in one function, altered in |
279 |
;;; another as a side effect, then read back by the first, as a way of |
;; another as a side effect, then read back by the first, as a way of |
280 |
;;; passing back more than one value. These declarations are just to make |
;; passing back more than one value. These declarations are just to make |
281 |
;;; the compiler happy, and to conform to standard Emacs-Lisp practice (I |
;; the compiler happy, and to conform to standard Emacs-Lisp practice (I |
282 |
;;; think the make-local-variable trick above is cleaner). |
;; think the make-local-variable trick above is cleaner). |
283 |
;;; |
;; |
284 |
|
|
285 |
(defvar ses-relocate-return nil |
(defvar ses-relocate-return nil |
286 |
"Set by `ses-relocate-formula' and `ses-relocate-range', read by |
"Set by `ses-relocate-formula' and `ses-relocate-range', read by |
299 |
when to emit a progress message.") |
when to emit a progress message.") |
300 |
|
|
301 |
|
|
302 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
303 |
;;;; Macros |
;; Macros |
304 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
305 |
|
|
306 |
(defmacro ses-get-cell (row col) |
(defmacro ses-get-cell (row col) |
307 |
"Return the cell structure that stores information about cell (ROW,COL)." |
"Return the cell structure that stores information about cell (ROW,COL)." |
308 |
`(aref (aref ses--cells ,row) ,col)) |
`(aref (aref ses--cells ,row) ,col)) |
309 |
|
|
310 |
|
;; We might want to use defstruct here, but cells are explicitly used as |
311 |
|
;; arrays in ses-set-cell, so we'd need to fix this first. --Stef |
312 |
|
(defsubst ses-make-cell (&optional symbol formula printer references) |
313 |
|
(vector symbol formula printer references)) |
314 |
|
|
315 |
(defmacro ses-cell-symbol (row &optional col) |
(defmacro ses-cell-symbol (row &optional col) |
316 |
"From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1." |
"From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1." |
317 |
`(aref ,(if col `(ses-get-cell ,row ,col) row) 0)) |
`(aref ,(if col `(ses-get-cell ,row ,col) row) 0)) |
363 |
(setq printer `(ses-safe-printer ,printer))) |
(setq printer `(ses-safe-printer ,printer))) |
364 |
(aset (aref ses--cells (car rowcol)) |
(aset (aref ses--cells (car rowcol)) |
365 |
(cdr rowcol) |
(cdr rowcol) |
366 |
(vector sym formula printer references))) |
(ses-make-cell sym formula printer references))) |
367 |
(set sym value) |
(set sym value) |
368 |
sym) |
sym) |
369 |
|
|
463 |
form) |
form) |
464 |
|
|
465 |
|
|
466 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
467 |
;;;; Utility functions |
;; Utility functions |
468 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
469 |
|
|
470 |
(defun ses-vector-insert (array idx new) |
(defun ses-vector-insert (array idx new) |
471 |
"Create a new vector which is one larger than ARRAY and has NEW inserted |
"Create a new vector which is one larger than ARRAY and has NEW inserted |
546 |
(put sym 'ses-cell (cons xrow xcol)) |
(put sym 'ses-cell (cons xrow xcol)) |
547 |
(make-local-variable sym))))) |
(make-local-variable sym))))) |
548 |
|
|
549 |
;;;We do not delete the ses-cell properties for the cell-variables, in case a |
;;We do not delete the ses-cell properties for the cell-variables, in case a |
550 |
;;;formula that refers to this cell is in the kill-ring and is later pasted |
;;formula that refers to this cell is in the kill-ring and is later pasted |
551 |
;;;back in. |
;;back in. |
552 |
(defun ses-destroy-cell-variable-range (minrow maxrow mincol maxcol) |
(defun ses-destroy-cell-variable-range (minrow maxrow mincol maxcol) |
553 |
"Destroy buffer-local variables for cells. This is undoable." |
"Destroy buffer-local variables for cells. This is undoable." |
554 |
(let (sym) |
(let (sym) |
578 |
nil) |
nil) |
579 |
|
|
580 |
|
|
581 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
582 |
;;;; The cells |
;; The cells |
583 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
584 |
|
|
585 |
(defun ses-set-cell (row col field val) |
(defun ses-set-cell (row col field val) |
586 |
"Install VAL as the contents for field FIELD (named by a quoted symbol) of |
"Install VAL as the contents for field FIELD (named by a quoted symbol) of |
642 |
the old and FORCE is nil." |
the old and FORCE is nil." |
643 |
(let ((cell (ses-get-cell row col)) |
(let ((cell (ses-get-cell row col)) |
644 |
formula-error printer-error) |
formula-error printer-error) |
645 |
(let ((symbol (ses-cell-symbol cell)) |
(let ((oldval (ses-cell-value cell)) |
|
(oldval (ses-cell-value cell)) |
|
646 |
(formula (ses-cell-formula cell)) |
(formula (ses-cell-formula cell)) |
647 |
newval) |
newval) |
648 |
(if (eq (car-safe formula) 'ses-safe-formula) |
(if (eq (car-safe formula) 'ses-safe-formula) |
724 |
(goto-char pos))) |
(goto-char pos))) |
725 |
|
|
726 |
|
|
727 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
728 |
;;;; The print area |
;; The print area |
729 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
730 |
|
|
731 |
(defun ses-in-print-area () |
(defun ses-in-print-area () |
732 |
"Returns t if point is in print area of spreadsheet." |
"Returns t if point is in print area of spreadsheet." |
733 |
(eq (get-text-property (point) 'keymap) 'ses-mode-print-map)) |
(eq (get-text-property (point) 'keymap) 'ses-mode-print-map)) |
734 |
|
|
735 |
;;;We turn off point-motion-hooks and explicitly position the cursor, in case |
;;We turn off point-motion-hooks and explicitly position the cursor, in case |
736 |
;;;the intangible properties have gotten screwed up (e.g., when |
;;the intangible properties have gotten screwed up (e.g., when |
737 |
;;;ses-goto-print is called during a recursive ses-print-cell). |
;;ses-goto-print is called during a recursive ses-print-cell). |
738 |
(defun ses-goto-print (row col) |
(defun ses-goto-print (row col) |
739 |
"Move point to print area for cell (ROW,COL)." |
"Move point to print area for cell (ROW,COL)." |
740 |
(let ((inhibit-point-motion-hooks t)) |
(let ((inhibit-point-motion-hooks t)) |
779 |
(error "Need a range")))) |
(error "Need a range")))) |
780 |
|
|
781 |
(defun ses-print-cell (row col) |
(defun ses-print-cell (row col) |
782 |
"Format and print the value of cell (ROW,COL) to the print area, using the |
"Format and print the value of cell (ROW,COL) to the print area. |
783 |
cell's printer function. If the cell's new print form is too wide, it will |
Use the cell's printer function. If the cell's new print form is too wide, |
784 |
spill over into the following cell, but will not run off the end of the row |
it will spill over into the following cell, but will not run off the end of the |
785 |
or overwrite the next non-nil field. Result is nil for normal operation, or |
row or overwrite the next non-nil field. Result is nil for normal operation, |
786 |
the error signal if the printer function failed and the cell was formatted |
or the error signal if the printer function failed and the cell was formatted |
787 |
with \"%s\". If the cell's value is *skip*, nothing is printed because the |
with \"%s\". If the cell's value is *skip*, nothing is printed because the |
788 |
preceding cell has spilled over." |
preceding cell has spilled over." |
789 |
(catch 'ses-print-cell |
(catch 'ses-print-cell |
955 |
(ses-print-cell (car rowcol) (cdr rowcol))))) |
(ses-print-cell (car rowcol) (cdr rowcol))))) |
956 |
|
|
957 |
|
|
958 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
959 |
;;;; The data area |
;; The data area |
960 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
961 |
|
|
962 |
|
(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size))) |
963 |
|
|
964 |
(defun ses-goto-data (def &optional col) |
(defun ses-goto-data (def &optional col) |
965 |
"Move point to data area for (DEF,COL). If DEF is a row |
"Move point to data area for (DEF,COL). If DEF is a row |
966 |
number, COL is the column number for a data cell -- otherwise DEF |
number, COL is the column number for a data cell -- otherwise DEF |
967 |
is one of the symbols ses--col-widths, ses--col-printers, |
is one of the symbols ses--col-widths, ses--col-printers, |
968 |
ses--default-printer, ses--numrows, or ses--numcols." |
ses--default-printer, ses--numrows, or ses--numcols." |
969 |
(if (< (point-max) (buffer-size)) |
(if (ses-narrowed-p) |
970 |
(setq ses--deferred-narrow t)) |
(setq ses--deferred-narrow t)) |
971 |
(widen) |
(widen) |
972 |
(let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong |
(let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong |
980 |
(forward-line (+ (* ses--numrows (+ ses--numcols 2)) def))))) |
(forward-line (+ (* ses--numrows (+ ses--numcols 2)) def))))) |
981 |
|
|
982 |
(defun ses-set-parameter (def value &optional elem) |
(defun ses-set-parameter (def value &optional elem) |
983 |
"Sets parameter DEF to VALUE (with undo) and writes the value to the data |
"Set parameter DEF to VALUE (with undo) and write the value to the data area. |
984 |
area. See `ses-goto-data' for meaning of DEF. Newlines in the data |
See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped. |
985 |
are escaped. If ELEM is specified, it is the array subscript within DEF to |
If ELEM is specified, it is the array subscript within DEF to be set to VALUE." |
|
be set to VALUE." |
|
986 |
(save-excursion |
(save-excursion |
987 |
;;We call ses-goto-data early, using the old values of numrows and |
;;We call ses-goto-data early, using the old values of numrows and |
988 |
;;numcols in case one of them is being changed. |
;;numcols in case one of them is being changed. |
1003 |
(insert (format fmt (symbol-value def)))))) |
(insert (format fmt (symbol-value def)))))) |
1004 |
|
|
1005 |
(defun ses-write-cells () |
(defun ses-write-cells () |
1006 |
"`ses--deferred-write' is a list of (ROW,COL) for cells to be written from |
"Write cells in `ses--deferred-write' from local variables to data area. |
1007 |
buffer-local variables to data area. Newlines in the data are escaped." |
Newlines in the data are escaped." |
1008 |
(let* ((inhibit-read-only t) |
(let* ((inhibit-read-only t) |
1009 |
(print-escape-newlines t) |
(print-escape-newlines t) |
1010 |
rowcol row col cell sym formula printer text) |
rowcol row col cell sym formula printer text) |
1049 |
(message " ")))) |
(message " ")))) |
1050 |
|
|
1051 |
|
|
1052 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1053 |
;;;; Formula relocation |
;; Formula relocation |
1054 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1055 |
|
|
1056 |
(defun ses-formula-references (formula &optional result-so-far) |
(defun ses-formula-references (formula &optional result-so-far) |
1057 |
"Produce a list of symbols for cells that this formula's value |
"Produce a list of symbols for cells that this formula's value |
1292 |
(message nil)))) |
(message nil)))) |
1293 |
|
|
1294 |
|
|
1295 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1296 |
;;;; Undo control |
;; Undo control |
1297 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1298 |
|
|
1299 |
(defadvice undo-more (around ses-undo-more activate preactivate) |
(defadvice undo-more (around ses-undo-more activate preactivate) |
1300 |
"Define a meaning for conses in buffer-undo-list whose car is a symbol |
"Define a meaning for conses in buffer-undo-list whose car is a symbol |
1316 |
ad-do-it |
ad-do-it |
1317 |
;;Here is some extra code for SES mode. |
;;Here is some extra code for SES mode. |
1318 |
(setq ses--deferred-narrow |
(setq ses--deferred-narrow |
1319 |
(or ses--deferred-narrow (< (point-max) (buffer-size)))) |
(or ses--deferred-narrow (ses-narrowed-p))) |
1320 |
(widen) |
(widen) |
1321 |
(condition-case x |
(condition-case x |
1322 |
ad-do-it |
ad-do-it |
1361 |
t)) |
t)) |
1362 |
|
|
1363 |
|
|
1364 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1365 |
;;;; Startup for major mode |
;; Startup for major mode |
1366 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1367 |
|
|
1368 |
(defun ses-load () |
(defun ses-load () |
1369 |
"Parse the current buffer and sets up buffer-local variables. Does not |
"Parse the current buffer and sets up buffer-local variables. Does not |
1371 |
(widen) |
(widen) |
1372 |
;;Read our global parameters, which should be a 3-element list |
;;Read our global parameters, which should be a 3-element list |
1373 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1374 |
(search-backward ";;; Local Variables:\n" nil t) |
(search-backward ";; Local Variables:\n" nil t) |
1375 |
(backward-list 1) |
(backward-list 1) |
1376 |
(let ((params (condition-case nil (read (current-buffer)) (error nil))) |
(let ((params (condition-case nil (read (current-buffer)) (error nil)))) |
|
sym) |
|
1377 |
(or (and (= (safe-length params) 3) |
(or (and (= (safe-length params) 3) |
1378 |
(numberp (car params)) |
(numberp (car params)) |
1379 |
(numberp (cadr params)) |
(numberp (cadr params)) |
1488 |
(put-text-property pos end 'intangible sym))) |
(put-text-property pos end 'intangible sym))) |
1489 |
;;Adding these properties did not actually alter the text |
;;Adding these properties did not actually alter the text |
1490 |
(unless was-modified |
(unless was-modified |
1491 |
(set-buffer-modified-p nil) |
(restore-buffer-modified-p nil) |
1492 |
(buffer-disable-undo) |
(buffer-disable-undo) |
1493 |
(buffer-enable-undo))) |
(buffer-enable-undo))) |
1494 |
;;Create the underlining overlay. It's impossible for (point) to be 2, |
;;Create the underlining overlay. It's impossible for (point) to be 2, |
1501 |
overlay, remove special text properties." |
overlay, remove special text properties." |
1502 |
(widen) |
(widen) |
1503 |
(let ((inhibit-read-only t) |
(let ((inhibit-read-only t) |
1504 |
(was-modified (buffer-modified-p)) |
(was-modified (buffer-modified-p))) |
|
end) |
|
1505 |
;;Delete read-only, keymap, and intangible properties |
;;Delete read-only, keymap, and intangible properties |
1506 |
(set-text-properties (point-min) (point-max) nil) |
(set-text-properties (point-min) (point-max) nil) |
1507 |
;;Delete overlay |
;;Delete overlay |
1645 |
(message (error-message-string err)))) |
(message (error-message-string err)))) |
1646 |
nil) ;Make coverage-tester happy |
nil) ;Make coverage-tester happy |
1647 |
|
|
|
(defun ses-header-string-left-offset () |
|
|
"Number of characters in left fringe and left scrollbar (if any)." |
|
|
(let ((left-fringe (round (or (frame-parameter nil 'left-fringe) 0) |
|
|
(frame-char-width))) |
|
|
(left-scrollbar (if (not (eq (frame-parameter nil |
|
|
'vertical-scroll-bars) |
|
|
'left)) |
|
|
0 |
|
|
(let ((x (frame-parameter nil 'scroll-bar-width))) |
|
|
;;Non-toolkil bar is always 14 pixels? |
|
|
(unless x (setq x 14)) |
|
|
;;Always round up |
|
|
(ceiling x (frame-char-width)))))) |
|
|
(+ left-fringe left-scrollbar))) |
|
|
|
|
1648 |
(defun ses-create-header-string () |
(defun ses-create-header-string () |
1649 |
"Sets up `ses--header-string' as the buffer's header line, based on the |
"Set up `ses--header-string' as the buffer's header line. |
1650 |
current set of columns and window-scroll position." |
Based on the current set of columns and `window-hscroll' position." |
1651 |
(let* ((left-offset (ses-header-string-left-offset)) |
(let ((totwidth (- (window-hscroll))) |
1652 |
(totwidth (- left-offset (window-hscroll))) |
result width x) |
|
result width result x) |
|
1653 |
;;Leave room for the left-side fringe and scrollbar |
;;Leave room for the left-side fringe and scrollbar |
1654 |
(push (make-string left-offset ? ) result) |
(push (propertize " " 'display '((space :align-to 0))) result) |
1655 |
(dotimes (col ses--numcols) |
(dotimes (col ses--numcols) |
1656 |
(setq width (ses-col-width col) |
(setq width (ses-col-width col) |
1657 |
totwidth (+ totwidth width 1)) |
totwidth (+ totwidth width 1)) |
1658 |
(if (= totwidth (+ left-offset 1)) |
(if (= totwidth 1) |
1659 |
;;Scrolled so intercolumn space is leftmost |
;;Scrolled so intercolumn space is leftmost |
1660 |
(push " " result)) |
(push " " result)) |
1661 |
(when (> totwidth (+ left-offset 1)) |
(when (> totwidth 1) |
1662 |
(if (> ses--header-row 0) |
(if (> ses--header-row 0) |
1663 |
(save-excursion |
(save-excursion |
1664 |
(ses-goto-print (1- ses--header-row) col) |
(ses-goto-print (1- ses--header-row) col) |
1665 |
(setq x (buffer-substring-no-properties (point) |
(setq x (buffer-substring-no-properties (point) |
1666 |
(+ (point) width))) |
(+ (point) width))) |
1667 |
(if (>= width (- totwidth left-offset)) |
;; Strip trailing space. |
1668 |
(setq x (substring x (- width totwidth left-offset -1)))) |
(if (string-match "[ \t]+\\'" x) |
1669 |
(push (propertize x 'face ses-box-prop) result)) |
(setq x (substring x 0 (match-beginning 0)))) |
1670 |
(setq x (ses-column-letter col)) |
;; Cut off excess text. |
1671 |
|
(if (>= (length x) totwidth) |
1672 |
|
(setq x (substring x 0 (- totwidth -1))))) |
1673 |
|
(setq x (ses-column-letter col))) |
1674 |
(push (propertize x 'face ses-box-prop) result) |
(push (propertize x 'face ses-box-prop) result) |
1675 |
(push (propertize (make-string (- width (length x)) ?.) |
(push (propertize "." |
1676 |
'display `((space :align-to ,(1- totwidth))) |
'display `((space :align-to ,(1- totwidth))) |
1677 |
'face ses-box-prop) |
'face ses-box-prop) |
1678 |
result)) |
result) |
1679 |
;;Allow the following space to be squished to make room for the 3-D box |
;;Allow the following space to be squished to make room for the 3-D box |
1680 |
;;Coverage test ignores properties, thinks this is always a space! |
;;Coverage test ignores properties, thinks this is always a space! |
1681 |
(push (1value (propertize " " 'display `((space :align-to ,totwidth)))) |
(push (1value (propertize " " 'display `((space :align-to ,totwidth)))) |
1687 |
(setq ses--header-string (apply 'concat (nreverse result))))) |
(setq ses--header-string (apply 'concat (nreverse result))))) |
1688 |
|
|
1689 |
|
|
1690 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1691 |
;;;; Redisplay and recalculation |
;; Redisplay and recalculation |
1692 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1693 |
|
|
1694 |
(defun ses-jump (sym) |
(defun ses-jump (sym) |
1695 |
"Move point to cell SYM." |
"Move point to cell SYM." |
1807 |
(interactive "*") |
(interactive "*") |
1808 |
(ses-begin-change) |
(ses-begin-change) |
1809 |
;;Reconstruct reference lists. |
;;Reconstruct reference lists. |
1810 |
(let (refs x yrow ycol) |
(let (x yrow ycol) |
1811 |
;;Delete old reference lists |
;;Delete old reference lists |
1812 |
(ses-dotimes-msg (row ses--numrows) "Deleting references..." |
(ses-dotimes-msg (row ses--numrows) "Deleting references..." |
1813 |
(dotimes (col ses--numcols) |
(dotimes (col ses--numcols) |
1823 |
(cons (ses-cell-symbol row col) |
(cons (ses-cell-symbol row col) |
1824 |
(ses-cell-references yrow ycol))))))) |
(ses-cell-references yrow ycol))))))) |
1825 |
;;Delete everything and reconstruct basic data area |
;;Delete everything and reconstruct basic data area |
1826 |
(if (< (point-max) (buffer-size)) |
(if (ses-narrowed-p) |
1827 |
(setq ses--deferred-narrow t)) |
(setq ses--deferred-narrow t)) |
1828 |
(widen) |
(widen) |
1829 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
1830 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1831 |
(if (search-backward ";;; Local Variables:\n" nil t) |
(if (search-backward ";; Local Variables:\n" nil t) |
1832 |
(delete-region (point-min) (point)) |
(delete-region (point-min) (point)) |
1833 |
;;Buffer is quite screwed up - can't even save the user-specified locals |
;;Buffer is quite screwed up - can't even save the user-specified locals |
1834 |
(delete-region (point-min) (point-max)) |
(delete-region (point-min) (point-max)) |
1855 |
(goto-char (point-min))) |
(goto-char (point-min))) |
1856 |
|
|
1857 |
|
|
1858 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1859 |
;;;; Input of cell formulas |
;; Input of cell formulas |
1860 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1861 |
|
|
1862 |
(defun ses-edit-cell (row col newval) |
(defun ses-edit-cell (row col newval) |
1863 |
"Display current cell contents in minibuffer, for editing. Returns nil if |
"Display current cell contents in minibuffer, for editing. Returns nil if |
1961 |
(ses-clear-cell (car rowcol) (cdr rowcol)))))) |
(ses-clear-cell (car rowcol) (cdr rowcol)))))) |
1962 |
|
|
1963 |
|
|
1964 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1965 |
;;;; Input of cell-printer functions |
;; Input of cell-printer functions |
1966 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
1967 |
|
|
1968 |
(defun ses-read-printer (prompt default) |
(defun ses-read-printer (prompt default) |
1969 |
"Common code for `ses-read-cell-printer', `ses-read-column-printer', and `ses-read-default-printer'. |
"Common code for `ses-read-cell-printer', `ses-read-column-printer', and `ses-read-default-printer'. |
2002 |
right-justified) or a list of one string (will be left-justified)." |
right-justified) or a list of one string (will be left-justified)." |
2003 |
(interactive |
(interactive |
2004 |
(let ((default t) |
(let ((default t) |
2005 |
prompt x) |
x) |
2006 |
(ses-check-curcell 'range) |
(ses-check-curcell 'range) |
2007 |
;;Default is none if not all cells in range have same printer |
;;Default is none if not all cells in range have same printer |
2008 |
(catch 'ses-read-cell-printer |
(catch 'ses-read-cell-printer |
2052 |
(ses-reprint-all t))) |
(ses-reprint-all t))) |
2053 |
|
|
2054 |
|
|
2055 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2056 |
;;;; Spreadsheet size adjustments |
;; Spreadsheet size adjustments |
2057 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2058 |
|
|
2059 |
(defun ses-insert-row (count) |
(defun ses-insert-row (count) |
2060 |
"Insert a new row before the current one. With prefix, insert COUNT rows |
"Insert a new row before the current one. With prefix, insert COUNT rows |
2078 |
;;the call to ses-relocate-all. |
;;the call to ses-relocate-all. |
2079 |
(setq newrow (make-vector ses--numcols nil)) |
(setq newrow (make-vector ses--numcols nil)) |
2080 |
(dotimes (col ses--numcols) |
(dotimes (col ses--numcols) |
2081 |
(aset newrow col (make-vector ses-cell-size nil))) |
(aset newrow col (ses-make-cell))) |
2082 |
(setq ses--cells (ses-vector-insert ses--cells row newrow)) |
(setq ses--cells (ses-vector-insert ses--cells row newrow)) |
2083 |
(push `(ses-vector-delete ses--cells ,row 1) buffer-undo-list) |
(push `(ses-vector-delete ses--cells ,row 1) buffer-undo-list) |
2084 |
(insert ses--blank-line)) |
(insert ses--blank-line)) |
2115 |
(or (> count 0) (signal 'args-out-of-range nil)) |
(or (> count 0) (signal 'args-out-of-range nil)) |
2116 |
(let ((inhibit-quit t) |
(let ((inhibit-quit t) |
2117 |
(inhibit-read-only t) |
(inhibit-read-only t) |
2118 |
(row (car (ses-sym-rowcol ses--curcell))) |
(row (car (ses-sym-rowcol ses--curcell)))) |
|
pos) |
|
2119 |
(setq count (min count (- ses--numrows row))) |
(setq count (min count (- ses--numrows row))) |
2120 |
(ses-begin-change) |
(ses-begin-change) |
2121 |
(ses-set-parameter 'ses--numrows (- ses--numrows count)) |
(ses-set-parameter 'ses--numrows (- ses--numrows count)) |
2141 |
(ses-jump-safe ses--curcell)) |
(ses-jump-safe ses--curcell)) |
2142 |
|
|
2143 |
(defun ses-insert-column (count &optional col width printer) |
(defun ses-insert-column (count &optional col width printer) |
2144 |
"Insert a new column before COL (default is the current one). With prefix, |
"Insert a new column before COL (default is the current one). |
2145 |
insert COUNT columns before current one. If COL is specified, the new |
With prefix, insert COUNT columns before current one. |
2146 |
column(s) get the specified WIDTH and PRINTER (otherwise they're taken from |
If COL is specified, the new column(s) get the specified WIDTH and PRINTER |
2147 |
the current column)." |
\(otherwise they're taken from the current column)." |
2148 |
(interactive "*p") |
(interactive "*p") |
2149 |
(ses-check-curcell) |
(ses-check-curcell) |
2150 |
(or (> count 0) (signal 'args-out-of-range nil)) |
(or (> count 0) (signal 'args-out-of-range nil)) |
2173 |
(setq has-skip t)) |
(setq has-skip t)) |
2174 |
(ses-aset-with-undo ses--cells row |
(ses-aset-with-undo ses--cells row |
2175 |
(ses-vector-insert (aref ses--cells row) |
(ses-vector-insert (aref ses--cells row) |
2176 |
col |
col (ses-make-cell))) |
|
(make-vector ses-cell-size nil))) |
|
2177 |
;;Insert empty lines in cell data area (will be replaced by |
;;Insert empty lines in cell data area (will be replaced by |
2178 |
;;ses-relocate-all) |
;;ses-relocate-all) |
2179 |
(ses-goto-data row col) |
(ses-goto-data row col) |
2208 |
(inhibit-read-only t) |
(inhibit-read-only t) |
2209 |
(rowcol (ses-sym-rowcol ses--curcell)) |
(rowcol (ses-sym-rowcol ses--curcell)) |
2210 |
(width 0) |
(width 0) |
2211 |
new col origrow has-skip) |
col origrow has-skip) |
2212 |
(setq origrow (car rowcol) |
(setq origrow (car rowcol) |
2213 |
col (cdr rowcol) |
col (cdr rowcol) |
2214 |
count (min count (- ses--numcols col))) |
count (min count (- ses--numcols col))) |
2311 |
(ses-print-cell-new-width row col)))) |
(ses-print-cell-new-width row col)))) |
2312 |
|
|
2313 |
|
|
2314 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2315 |
;;;; Cut and paste, import and export |
;; Cut and paste, import and export |
2316 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2317 |
|
|
2318 |
(defadvice copy-region-as-kill (around ses-copy-region-as-kill |
(defadvice copy-region-as-kill (around ses-copy-region-as-kill |
2319 |
activate preactivate) |
activate preactivate) |
2645 |
(kill-new result))) |
(kill-new result))) |
2646 |
|
|
2647 |
|
|
2648 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2649 |
;;;; Other user commands |
;; Other user commands |
2650 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2651 |
|
|
2652 |
(defun ses-unset-header-row () |
(defun ses-unset-header-row () |
2653 |
"Select the default header row." |
"Select the default header row." |
2820 |
(ses-insert-ses-range)) |
(ses-insert-ses-range)) |
2821 |
|
|
2822 |
|
|
2823 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2824 |
;;;; Checking formulas for safety |
;; Checking formulas for safety |
2825 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2826 |
|
|
2827 |
(defun ses-safe-printer (printer) |
(defun ses-safe-printer (printer) |
2828 |
"Returns PRINTER if safe, or the substitute printer `ses-unsafe' otherwise." |
"Returns PRINTER if safe, or the substitute printer `ses-unsafe' otherwise." |
2853 |
formula checker))))) |
formula checker))))) |
2854 |
|
|
2855 |
|
|
2856 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2857 |
;;;; Standard formulas |
;; Standard formulas |
2858 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2859 |
|
|
2860 |
(defmacro ses-range (from to) |
(defmacro ses-range (from to) |
2861 |
"Expands to a list of cell-symbols for the range. The range automatically |
"Expands to a list of cell-symbols for the range. The range automatically |
2871 |
"Return ARGS reversed, with the blank elements (nil and *skip*) removed." |
"Return ARGS reversed, with the blank elements (nil and *skip*) removed." |
2872 |
(let (result) |
(let (result) |
2873 |
(dolist (cur args) |
(dolist (cur args) |
2874 |
(and cur (not (eq cur '*skip*)) |
(unless (memq cur '(nil *skip*)) |
2875 |
(push cur result))) |
(push cur result))) |
2876 |
result)) |
result)) |
2877 |
|
|
2878 |
(defun ses+ (&rest args) |
(defun ses+ (&rest args) |
2907 |
(put x 'side-effect-free t)) |
(put x 'side-effect-free t)) |
2908 |
|
|
2909 |
|
|
2910 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2911 |
;;;; Standard print functions |
;; Standard print functions |
2912 |
;;;---------------------------------------------------------------------------- |
;;---------------------------------------------------------------------------- |
2913 |
|
|
2914 |
;;These functions use the variables 'row' and 'col' that are |
;;These functions use the variables 'row' and 'col' that are |
2915 |
;;dynamically bound by ses-print-cell. We define these varables at |
;;dynamically bound by ses-print-cell. We define these varables at |
2973 |
|
|
2974 |
(provide 'ses) |
(provide 'ses) |
2975 |
|
|
2976 |
;;; arch-tag: 88c1ccf0-4293-4824-8c5d-0757b52217f3 |
;; arch-tag: 88c1ccf0-4293-4824-8c5d-0757b52217f3 |
2977 |
;; ses.el ends here. |
;;; ses.el ends here |