From 4f11561b823531010b1dcc67ee5cfd4f248b8e61 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Vincent=20Bela=C3=AFche?= Date: Thu, 12 Jun 2014 08:04:48 +0200 Subject: [PATCH] Adding support for SES local printer functions --- doc/misc/ChangeLog | 4 + doc/misc/ses.texi | 7 ++ lisp/ChangeLog | 28 ++++++ lisp/ses.el | 244 ++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 260 insertions(+), 23 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 23fa29a7c1f..2ded8898fdc 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,7 @@ +2014-06-12 Vincent Belaïche + + * ses.texi: Adding documentation for SES local printer functions. + 2014-06-12 Glenn Morris * Makefile.in: Use GNU Make features to reduce duplication. diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 9deb09c2ba0..48511221442 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -435,6 +435,13 @@ Centering with dashes and spill-over. Centering with tildes (~) and spill-over. @end table +You can define printer function local to a sheet with command +@code{ses-define-local-printer}. For instance define printer +@samp{foo} to @code{"%.2f"} and then use symbol @samp{foo} as a +printer function. Then, if you call again +@code{ses-define-local-printer} on @samp{foo} to redefine it as +@code{"%.3f"} all the cells using printer @samp{foo} will be reprinted +accordingly. @node Clearing cells @section Clearing cells diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9d91fd3b2f3..4b3f0a44dbd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,31 @@ +2014-06-12 Vincent Belaïche + + * ses.el (ses-initial-global-parameters-re): New defconst, a + specific regexp is needed now that ses.el can handle both + file-format 2 --- ie. no local printers --- and 3 --- i.e. may have local printers. + (ses-localvars): Add local variables needed for local printer + handling. + (ses-set-localvars): Handle hashmap initialisation. + (ses-paramlines-plist): Add param-line for number of local printers. + (ses-paramfmt-plist): New defconst, needed for code factorization + between functions `ses-set-parameter' and + `ses-file-format-extend-paramter-list' + (ses-make-local-printer-info): New defsubst. + (ses-locprn-get-compiled, ses-locprn-compiled-aset) + (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number) + (ses-cell-printer-aset): New defmacro. + (ses-local-printer-compile): New defun. + (ses-local-printer): New defmacro. + (ses-printer-validate, ses-call-printer): Add support for local + printer functions. + (ses-file-format-extend-paramter-list): New defun. + (ses-set-parameter): Use const `ses-paramfmt-plist' for code factorization. + (ses-load): Add support for local + printer functions. + (ses-read-printer): Update docstring and add support for local printer functions. + (ses-refresh-local-printer, ses-define-local-printer): New defun. + (ses-safe-printer): Add support for local printer functions. + 2014-06-12 Ivan Andrus * ffap.el (ffap-lax-url): New var (bug#17723). diff --git a/lisp/ses.el b/lisp/ses.el index 1626147dab4..c7c39e0a5eb 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -239,6 +239,10 @@ Each function is called with ARG=1." "\n( ;Global parameters (these are read first)\n 2 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n" "Initial contents for the three-element list at the bottom of the data area.") +(defconst ses-initial-global-parameters-re + "\n( ;Global parameters (these are read first)\n [23] ;SES file-format\n [0-9]+ ;numrows\n [0-9]+ ;numcols\n\\( [0-9]+ ;numlocprn\n\\)?)\n\n" + "Match Global parameters for .") + (defconst ses-initial-file-trailer ";; Local Variables:\n;; mode: ses\n;; End:\n" "Initial contents for the file-trailer area at the bottom of the file.") @@ -277,6 +281,12 @@ default printer and then modify its output.") '(ses--blank-line ses--cells ses--col-printers ses--col-widths ses--curcell ses--curcell-overlay ses--default-printer + (ses--local-printer-hashmap . :hashmap) + ;; the list is there to remember the order of local printers like there + ;; are written to the SES filen which service the hashmap does not + ;; provide. + ses--local-printer-list + (ses--numlocprn . 0); count of local printers ses--deferred-narrow ses--deferred-recalc ses--deferred-write ses--file-format ses--named-cell-hashmap @@ -299,7 +309,20 @@ default printer and then modify its output.") ((symbolp x) (set (make-local-variable x) nil)) ((consp x) - (set (make-local-variable (car x)) (cdr x))) + (cond + ((integerp (cdr x)) + (set (make-local-variable (car x)) (cdr x))) + ((eq (cdr x) :hashmap) + (set (make-local-variable (car x)) + (if (boundp (car x)) + (let ((xv (symbol-value (car x)))) + (if (hash-table-p xv) + (clrhash xv) + (warn "Unexpected value of symbol %S, should be a hash table" x) + (make-hash-table :test 'eq))) + (make-hash-table :test 'eq)))) + (t (error "Unexpected initializer `%S' in list `ses-localvars' for entry %S" + (cdr x) (car x)) ) )) (t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))) (eval-when-compile ; silence compiler @@ -311,10 +334,21 @@ default printer and then modify its output.") (defconst ses-paramlines-plist '(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3 ses--header-row -2 ses--file-format 1 ses--numrows 2 - ses--numcols 3) + ses--numcols 3 ses--numlocprn 4) "Offsets from 'Global parameters' line to various parameter lines in the data area of a spreadsheet.") +(defconst ses-paramfmt-plist + '(ses--col-widths "(ses-column-widths %S)" + ses--col-printers "(ses-column-printers %S)" + ses--default-printer "(ses-default-printer %S)" + ses--header-row "(ses-header-row %S)" + ses--file-format " %S ;SES file-format" + ses--numrows " %S ;numrows" + ses--numcols " %S ;numcols" + ses--numlocprn " %S ;numlocprn") + "Formats of 'Global parameters' various parameters in the data +area of a spreadsheet.") ;; ;; "Side-effect variables". They are set in one function, altered in @@ -355,6 +389,30 @@ when to emit a progress message.") property-list) (vector symbol formula printer references property-list)) +(defsubst ses-make-local-printer-info (def &optional compiled-def number) + (let ((v (vector def + (or compiled-def (ses-local-printer-compile def)) + (or number ses--numlocprn) + nil))) + (push v ses--local-printer-list) + (aset v 3 ses--local-printer-list) + v)) + +(defmacro ses-locprn-get-compiled (locprn) + `(aref ,locprn 1)) + +(defmacro ses-locprn-compiled-aset (locprn compiled) + `(aset ,locprn 1 ,compiled)) + +(defmacro ses-locprn-get-def (locprn) + `(aref ,locprn 0)) + +(defmacro ses-locprn-def-aset (locprn def) + `(aset ,locprn 0 ,def)) + +(defmacro ses-locprn-get-number (locprn) + `(aref ,locprn 2)) + (defmacro ses-cell-symbol (row &optional col) "From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1." `(aref ,(if col `(ses-get-cell ,row ,col) row) 0)) @@ -372,6 +430,10 @@ when to emit a progress message.") "From a CELL or a pair (ROW,COL), get the function that prints its value." `(aref ,(if col `(ses-get-cell ,row ,col) row) 2)) +(defmacro ses-cell-printer-aset (cell printer) + "From a CELL set the printer that prints its value." + `(aset ,cell 2 ,printer)) + (defmacro ses-cell-references (row &optional col) "From a CELL or a pair (ROW,COL), get the list of symbols for cells whose functions refer to its value." @@ -551,6 +613,29 @@ PRINTER are deferred until first use." (set sym value) sym) +(defun ses-local-printer-compile (printer) + "Convert local printer function into faster printer +definition." + (cond + ((functionp printer) printer) + ((stringp printer) + `(lambda (x) (format ,printer x))) + (t (error "Invalid printer %S" printer)))) + +(defmacro ses-local-printer (printer-name printer-def) + "Define a local printer with name PRINTER-NAME and definition +PRINTER-DEF. Return the printer info." + (or + (and (symbolp printer-name) + (ses-printer-validate printer-def)) + (error "Invalid local printer definition")) + (and (gethash printer-name ses--local-printer-hashmap) + (error "Duplicate printer definition %S" printer-name)) + (add-to-list 'ses-read-printer-history (symbol-name printer-name)) + (puthash printer-name + (ses-make-local-printer-info (ses-safe-printer printer-def)) + ses--local-printer-hashmap)) + (defmacro ses-column-widths (widths) "Load the vector of column widths from the spreadsheet file. This is a macro to prevent propagate-on-load viruses." @@ -664,6 +749,8 @@ is a vector--if a symbol, the new vector is assigned as the symbol's value." "Signal an error if PRINTER is not a valid SES cell printer." (or (not printer) (stringp printer) + ;; printer is a local printer + (and (symbolp printer) (gethash printer ses--local-printer-hashmap)) (functionp printer) (and (stringp (car-safe printer)) (not (cdr printer))) (error "Invalid printer function")) @@ -1261,7 +1348,13 @@ printer signaled one (and \"%s\" is used as the default printer), else nil." (format (car printer) value) "")) (t - (setq value (funcall printer (or value ""))) + (setq value (funcall + (or (and (symbolp printer) + (let ((locprn (gethash printer ses--local-printer-hashmap))) + (and locprn + (ses-locprn-get-compiled locprn)))) + printer) + (or value ""))) (if (stringp value) value (or (stringp (car-safe value)) @@ -1334,6 +1427,23 @@ ses--default-printer, ses--numrows, or ses--numcols." (goto-char ses--params-marker) (forward-line def)))) +(defun ses-file-format-extend-paramter-list (new-file-format) + "Extend the global parameters list when file format is updated +from 2 to 3. This happens when local printer function are added +to a sheet that was created with SES version 2. This is not +undoable. Return nil when there was no change, and non nil otherwise." + (save-excursion + (cond + ((and (= ses--file-format 2) (= 3 new-file-format)) + (ses-set-parameter 'ses--file-format 3) + (message "Upgrading from SES-2 to SES-3 file format") + (ses-widen) + (goto-char ses--params-marker) + (forward-line (plist-get ses-paramlines-plist 'ses--numlocprn )) + (insert (format (plist-get ses-paramfmt-plist 'ses--numlocprn) ses--numlocprn) + ?\n) + t) ))) + (defun ses-set-parameter (def value &optional elem) "Set parameter DEF to VALUE (with undo) and write the value to the data area. See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped. @@ -1343,13 +1453,7 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE." ;; in case one of them is being changed. (ses-goto-data def) (let ((inhibit-read-only t) - (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" - ses--col-printers "(ses-column-printers %S)" - ses--default-printer "(ses-default-printer %S)" - ses--header-row "(ses-header-row %S)" - ses--file-format " %S ;SES file-format" - ses--numrows " %S ;numrows" - ses--numcols " %S ;numcols") + (fmt (plist-get ses-paramfmt-plist def)) oldval) (if elem @@ -1735,29 +1839,38 @@ Does not execute cell formulas or print functions." (search-backward ";; Local Variables:\n" nil t) (backward-list 1) (setq ses--params-marker (point-marker)) - (let ((params (ignore-errors (read (current-buffer))))) - (or (and (= (safe-length params) 3) + (let* ((params (ignore-errors (read (current-buffer)))) + (params-len (safe-length params))) + (or (and (>= params-len 3) + (<= params-len 4) (numberp (car params)) (numberp (cadr params)) (>= (cadr params) 0) (numberp (nth 2 params)) - (> (nth 2 params) 0)) + (> (nth 2 params) 0) + (or (<= params-len 3) + (let ((numlocprn (nth 3 params))) + (and (integerp numlocprn) (>= numlocprn 0))))) (error "Invalid SES file")) (setq ses--file-format (car params) ses--numrows (cadr params) - ses--numcols (nth 2 params)) + ses--numcols (nth 2 params) + ses--numlocprn (or (nth 3 params) 0)) (when (= ses--file-format 1) (let (buffer-undo-list) ; This is not undoable. (ses-goto-data 'ses--header-row) (insert "(ses-header-row 0)\n") - (ses-set-parameter 'ses--file-format 2) - (message "Upgrading from SES-1 file format"))) - (or (= ses--file-format 2) + (ses-set-parameter 'ses--file-format 3) + (message "Upgrading from SES-1 to SES-2 file format"))) + (or (<= ses--file-format 3) (error "This file needs a newer version of the SES library code")) ;; Initialize cell array. (setq ses--cells (make-vector ses--numrows nil)) (dotimes (row ses--numrows) - (aset ses--cells row (make-vector ses--numcols nil)))) + (aset ses--cells row (make-vector ses--numcols nil))) + ;; initialize local printer map. + (clrhash ses--local-printer-hashmap)) + ;; Skip over print area, which we assume is correct. (goto-char (point-min)) (forward-line ses--numrows) @@ -1768,7 +1881,22 @@ Does not execute cell formulas or print functions." (forward-char (1- (length ses-print-data-boundary))) ;; Initialize printer and symbol lists. (mapc 'ses-printer-record ses-standard-printer-functions) - (setq ses--symbolic-formulas nil) + (setq ses--symbolic-formulas nil) + + ;; Load local printer definitions. + ;; This must be loaded *BEFORE* cells and column printers because the latters + ;; may call them. + (save-excursion + (forward-line (* ses--numrows (1+ ses--numcols))) + (let ((numlocprn ses--numlocprn)) + (setq ses--numlocprn 0) + (dotimes (lp numlocprn) + (let ((x (read (current-buffer)))) + (or (and (looking-at-p "\n") + (eq (car-safe x) 'ses-local-printer) + (eval x)) + (error "local printer-def error")) + (setq ses--numlocprn (1+ ses--numlocprn)))))) ;; Load cell definitions. (dotimes (row ses--numrows) (dotimes (col ses--numcols) @@ -1781,6 +1909,8 @@ Does not execute cell formulas or print functions." (eval x))) (or (looking-at-p "\n\n") (error "Missing blank line between rows"))) + ;; Skip local printer function declaration --- that were already loaded. + (forward-line (+ 2 ses--numlocprn)) ;; Load global parameters. (let ((widths (read (current-buffer))) (n1 (char-after (point))) @@ -1805,8 +1935,7 @@ Does not execute cell formulas or print functions." (1value (eval head-row))) ;; Should be back at global-params. (forward-char 1) - (or (looking-at-p (replace-regexp-in-string "1" "[0-9]+" - ses-initial-global-parameters)) + (or (looking-at-p ses-initial-global-parameters-re) (error "Problem with column-defs or global-params")) ;; Check for overall newline count in definitions area. (forward-line 3) @@ -2390,8 +2519,10 @@ cells." ;;---------------------------------------------------------------------------- (defun ses-read-printer (prompt default) - "Common code for `ses-read-cell-printer', `ses-read-column-printer', and `ses-read-default-printer'. -PROMPT should end with \": \". Result is t if operation was canceled." + "Common code for functions `ses-read-cell-printer', `ses-read-column-printer', +`ses-read-default-printer' and `ses-define-local-printer'. +PROMPT should end with \": \". Result is t if operation was +canceled." (barf-if-buffer-read-only) (if (eq default t) (setq default "") @@ -2411,6 +2542,7 @@ PROMPT should end with \": \". Result is t if operation was canceled." (or (not new) (stringp new) (stringp (car-safe new)) + (and (symbolp new) (gethash new ses--local-printer-hashmap)) (ses-warn-unsafe new 'unsafep-function) (setq new t))) new)) @@ -3344,6 +3476,71 @@ highlighted range in the spreadsheet." (symbol-name new-name))) (force-mode-line-update))) +(defun ses-refresh-local-printer (name compiled-value) + "Refresh printout of spreadsheet for all cells with printer + defined to local printer named NAME using the value COMPILED-VALUE for this printer" + (message "Refreshing cells using printer %S" name) + (let (new-print) + (dotimes (row ses--numrows) + (dotimes (col ses--numcols) + (let ((cell-printer (ses-cell-printer row col))) + (when (eq cell-printer name) + (unless new-print + (setq new-print t) + (ses-begin-change)) + (ses-print-cell row col))))))) + +(defun ses-define-local-printer (printer-name) + "Define a local printer with name PRINTER-NAME." + (interactive "*SEnter printer name: ") + (let* ((cur-printer (gethash printer-name ses--local-printer-hashmap)) + (default (and (vectorp cur-printer) (ses-locprn-get-def cur-printer))) + printer-def-text + create-printer + (new-printer (ses-read-printer (format "Enter definition of printer %S: " printer-name) default))) + (cond + ;; cancelled operation => do nothing + ((eq new-printer t)) + ;; no change => do nothing + ((and (vectorp cur-printer) (equal new-printer default))) + ;; re-defined printer + ((vectorp cur-printer) + (setq create-printer 0) + (ses-locprn-def-aset cur-printer new-printer) + (ses-refresh-local-printer + printer-name + (ses-locprn-compiled-aset cur-printer (ses-local-printer-compile new-printer)))) + ;; new definition + (t + (setq create-printer 1) + (puthash printer-name + (setq cur-printer + (ses-make-local-printer-info new-printer)) + ses--local-printer-hashmap))) + (when create-printer + (setq printer-def-text + (concat + "(ses-local-printer " + (symbol-name printer-name) + " " + (prin1-to-string (ses-locprn-get-def cur-printer)) + ")")) + (save-excursion + (ses-goto-data ses--numrows + (ses-locprn-get-number cur-printer)) + (let ((inhibit-read-only t)) + ;; Special undo since it's outside the narrowed buffer. + (let (buffer-undo-list) + (if (= create-printer 0) + (delete-region (point) (line-end-position)) + (insert ?\n) + (backward-char)) + (insert printer-def-text) + (when (= create-printer 1) + (ses-file-format-extend-paramter-list 3) + (ses-set-parameter 'ses--numlocprn (+ ses--numlocprn create-printer))) ))))) ) + + ;;---------------------------------------------------------------------------- ;; Checking formulas for safety ;;---------------------------------------------------------------------------- @@ -3353,6 +3550,7 @@ highlighted range in the spreadsheet." (if (or (stringp printer) (stringp (car-safe printer)) (not printer) + (and (symbolp printer) (gethash printer ses--local-printer-hashmap)) (ses-warn-unsafe printer 'unsafep-function)) printer 'ses-unsafe)) -- 2.39.2