=== modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2014-01-02 09:32:20 +0000 +++ doc/misc/ChangeLog 2014-01-02 13:05:09 +0000 @@ -1,3 +1,7 @@ +2014-01-02 Vincent Belaïche + + * ses.texi: Add documentation for local printer functions. + 2014-01-02 Aidan Gauland * eshell.text (Command Basics): Removed `Command basics' chapter. === modified file 'doc/misc/ses.texi' --- doc/misc/ses.texi 2014-01-01 08:31:29 +0000 +++ doc/misc/ses.texi 2014-01-02 13:04:52 +0000 @@ -434,6 +434,13 @@ 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 === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-01-01 07:43:34 +0000 +++ lisp/ChangeLog 2014-01-02 13:21:18 +0000 @@ -1,3 +1,31 @@ +2014-01-02 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 (no local printers) and 3 (may have local printers). + (silence compiler): 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. + 2013-12-31 Eli Zaretskii * international/mule-conf.el: Unify the charset indian-is13194. === modified file 'lisp/ses.el' --- lisp/ses.el 2014-01-01 07:43:34 +0000 +++ lisp/ses.el 2014-01-02 13:19:48 +0000 @@ -238,6 +238,10 @@ "\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.") @@ -271,11 +275,17 @@ ;; Local variables and constants ;;---------------------------------------------------------------------------- -(eval-and-compile +(eval-and-compile ; silence compiler (defconst ses-localvars '(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 @@ -298,7 +308,20 @@ ((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 @@ -310,10 +333,21 @@ (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 @@ -354,6 +388,30 @@ 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)) @@ -371,6 +429,10 @@ "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." @@ -550,6 +612,29 @@ (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." @@ -663,6 +748,8 @@ "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")) @@ -1260,7 +1347,13 @@ (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)) @@ -1333,6 +1426,22 @@ (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 ) + (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. @@ -1342,13 +1451,7 @@ ;; 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 @@ -1734,29 +1837,38 @@ (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) + (ses-set-parameter 'ses--file-format 3) (message "Upgrading from SES-1 file format"))) - (or (= ses--file-format 2) + (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) @@ -1767,7 +1879,22 @@ (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) @@ -1780,6 +1907,8 @@ (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))) @@ -1804,8 +1933,7 @@ (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) @@ -2389,8 +2517,10 @@ ;;---------------------------------------------------------------------------- (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 "") @@ -2410,6 +2540,7 @@ (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)) @@ -3343,6 +3474,71 @@ (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 ;;---------------------------------------------------------------------------- @@ -3352,6 +3548,7 @@ (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))