/[emacs]/emacs/lisp/ses.el
ViewVC logotype

Diff of /emacs/lisp/ses.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3.2.2 by miles, Mon Jun 28 07:28:45 2004 UTC revision 1.3.2.3 by miles, Wed Dec 8 05:02:14 2004 UTC
# Line 1  Line 1 
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    
# Line 23  Line 23 
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.
# Line 35  Line 38 
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"
# Line 66  Line 72 
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))
# Line 78  usually runs a cursor-movement function. Line 85  usually runs a cursor-movement function.
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.")
# Line 92  usually runs a cursor-movement function. Line 99  usually runs a cursor-movement function.
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
# Line 208  usually runs a cursor-movement function. Line 215  usually runs a cursor-movement function.
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
# Line 231  usually runs a cursor-movement function. Line 238  usually runs a cursor-movement function.
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
# Line 271  default printer and then modify its outp Line 274  default printer and then modify its outp
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
# Line 296  encountered an error during printing.  N Line 299  encountered an error during printing.  N
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))
# Line 355  PRINTER are deferred until first use." Line 363  PRINTER are deferred until first use."
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    
# Line 455  the same value." Line 463  the same value."
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
# Line 538  for this spreadsheet." Line 546  for this spreadsheet."
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)
# Line 570  and (eval ARG) and reset `ses-start-time Line 578  and (eval ARG) and reset `ses-start-time
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
# Line 634  processing for the current keystroke, un Line 642  processing for the current keystroke, un
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)
# Line 717  if the cell's value is unchanged if FORC Line 724  if the cell's value is unchanged if FORC
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))
# Line 772  argument is 'range.  A single cell is ap Line 779  argument is 'range.  A single cell is ap
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
# Line 948  cell (ROW,COL) has changed." Line 955  cell (ROW,COL) has changed."
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
# Line 971  ses--default-printer, ses--numrows, or s Line 980  ses--default-printer, ses--numrows, or s
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.
# Line 995  be set to VALUE." Line 1003  be set to VALUE."
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)
# Line 1041  buffer-local variables to data area.  Ne Line 1049  buffer-local variables to data area.  Ne
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
# Line 1284  to each symbol." Line 1292  to each symbol."
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
# Line 1308  cdr--its arglist." Line 1316  cdr--its arglist."
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
# Line 1353  stuff." Line 1361  stuff."
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
# Line 1363  execute cell formulas or print functions Line 1371  execute cell formulas or print functions
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))
# Line 1481  Narrows the buffer to show only the prin Line 1488  Narrows the buffer to show only the prin
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,
# Line 1494  Narrows the buffer to show only the prin Line 1501  Narrows the buffer to show only the prin
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
# Line 1639  narrows the buffer now." Line 1645  narrows the buffer now."
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))))
# Line 1694  current set of columns and window-scroll Line 1687  current set of columns and window-scroll
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."
# Line 1814  cells." Line 1807  cells."
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)
# Line 1830  cells." Line 1823  cells."
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))
# Line 1862  cells." Line 1855  cells."
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
# Line 1968  cells." Line 1961  cells."
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'.
# Line 2009  latter two cases, the function's result Line 2002  latter two cases, the function's result
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
# Line 2059  right-justified) or a list of one string Line 2052  right-justified) or a list of one string
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
# Line 2085  before current one." Line 2078  before current one."
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))
# Line 2122  current one." Line 2115  current one."
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))
# Line 2149  current one." Line 2141  current one."
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))
# Line 2181  the current column)." Line 2173  the current column)."
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)
# Line 2217  from the current one." Line 2208  from the current one."
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)))
# Line 2320  inserts a new row if at bottom of print Line 2311  inserts a new row if at bottom of print
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)
# Line 2654  WANT-FORMULAS is non-nil.  Newlines and Line 2645  WANT-FORMULAS is non-nil.  Newlines and
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."
# Line 2829  highlighted range in the spreadsheet." Line 2820  highlighted range in the spreadsheet."
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."
# Line 2862  is safe or user allows execution anyway. Line 2853  is safe or user allows execution anyway.
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
# Line 2880  alias for this macro!" Line 2871  alias for this macro!"
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)
# Line 2916  TEST is evaluated." Line 2907  TEST is evaluated."
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
# Line 2982  current column and continues until the n Line 2973  current column and continues until the n
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

Legend:
Removed from v.1.3.2.2  
changed lines
  Added in v.1.3.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26