From: "Vincent Belaïche" <vincent.b.1@hotmail.fr>
To: emacs-devel@gnu.org , Stefan Monnier <monnier@iro.umontreal.ca>
Subject: Addition of SES local printer functions.
Date: Thu, 02 Jan 2014 14:31:09 +0100 [thread overview]
Message-ID: <80ppoaqzmq.fsf@gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 830 bytes --]
Hello & happy new year,
I have implemented a new function into SES. Attached is the patch (from
bzr diff). The implementation was already discussed with Stefan a few
months ago.
This change is not small, as it implies that file-format is raised from
2 to 3 when a local printer function is added.
For some reason the commit does not work --- I get this:
-----------------------------------------------------------------------
Connected (version 2.0, client OpenSSH_5.9)
Authentication (publickey) successful!
Secsh channel 1 opened.
bzr: ERROR: Conflicts detected in working tree. Use "bzr conflicts" to list, "bzr resolve FILE" to resolve.
-----------------------------------------------------------------------
bzr conflicts does not work --- probably m version of bazaar is outdated.
Feedback is welcome.
Vincent.
[-- Attachment #2: ses-local-printers.txt --]
[-- Type: text/plain, Size: 18596 bytes --]
=== 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 <vincentb1@users.sourceforge.net>
+
+ * ses.texi: Add documentation for local printer functions.
+
2014-01-02 Aidan Gauland <aidalgol@amuri.net>
* 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 <vincentb1@users.sourceforge.net>
+
+ * 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 <eliz@gnu.org>
* 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))
next reply other threads:[~2014-01-02 13:31 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-01-02 13:31 Vincent Belaïche [this message]
2014-01-02 19:35 ` Addition of SES local printer functions Glenn Morris
2014-01-02 21:07 ` Stefan Monnier
-- strict thread matches above, loose matches on Subject: below --
2014-01-02 20:23 Vincent Belaïche
2014-01-02 21:01 ` Eli Zaretskii
2014-01-02 21:11 Vincent Belaïche
2014-01-02 21:36 ` Óscar Fuentes
2014-01-03 0:20 ` Glenn Morris
2014-01-02 22:59 Vincent Belaïche
2014-01-02 23:09 ` Óscar Fuentes
2014-01-02 23:08 Vincent Belaïche
2014-01-03 0:27 ` Glenn Morris
2014-01-03 2:45 ` Stefan Monnier
2014-01-03 3:18 ` Glenn Morris
2014-01-03 5:14 ` Stefan Monnier
2014-01-03 20:31 ` Glenn Morris
2014-01-03 7:56 ` Eli Zaretskii
2014-01-03 9:40 ` Vincent Belaïche
2014-01-03 10:34 ` Eli Zaretskii
2014-01-03 12:44 Vincent Belaïche
2014-01-03 13:55 ` Eli Zaretskii
2014-01-03 14:24 ` Vincent Belaïche
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=80ppoaqzmq.fsf@gmail.com \
--to=vincent.b.1@hotmail.fr \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.