diff options
author | Vincent Belaïche <vincentb1@users.sourceforge.net> | 2016-07-28 17:41:21 +0200 |
---|---|---|
committer | Vincent Belaïche <vincentb1@users.sourceforge.net> | 2016-07-28 17:41:21 +0200 |
commit | 41b28dea8587c13b0bc59c1ec70b65afab3aeeca (patch) | |
tree | df194b2e078802337f57ad8af0e709bd994d84ee /lisp | |
parent | 3f4f21b406a56d504c03a9bab3ac0949d8774c17 (diff) | |
download | emacs-41b28dea8587c13b0bc59c1ec70b65afab3aeeca.tar.gz |
Enable addition of local printers from a mode hook.
* doc/misc/ses.texi (Printer functions): Split the node into 5
sub-nodes + add some extra documentation.
(Various kinds of printer functions): Make an itemisation to
disintguish better the 3 types of printers, give an example of
lambda printer definition.
(Standard printer functions): Add documentation for ses-prin1
printer function.
(Local printer functions): Add documentation for creating
local printers programmatically from a hook.
(Writing a lambda printer function): Add documentation about
anti-stackoverflow precautions to take when you call the
standard printer functions from inside a local printer.
* lisp/ses.el (ses-standard-printer-functions): Add ses-prin1
among standard printer function, and update docstring
accordingly.
(ses-call-printer, ses-export-tab): Call `ses-prin1' instead
of prin1-to-string.
(ses-define-local-printer): Add definition to arguments so
that a local printer can be defined programmatically from a
mode hook. Make docstring more substantial. Use completing
read for local printer name input. Plus some minor
optimization.
(ses-define-if-new-local-printer): New defsubst.
(ses-center, ses-center-span, ses-dashfill)
(ses-dashfill-span, ses-tildefill-span): Allow to pass printer
as an optional argument to superseed column printer/default
spreadsheet printer.
(ses-prin1): New defun.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/ses.el | 125 |
1 files changed, 90 insertions, 35 deletions
diff --git a/lisp/ses.el b/lisp/ses.el index 305027c73bb..9d278b6d222 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -275,12 +275,15 @@ Each function is called with ARG=1." "Display properties to create a raised box for cells in the header line.") (defconst ses-standard-printer-functions - '(ses-center ses-center-span ses-dashfill ses-dashfill-span - ses-tildefill-span) - "List of print functions to be included in initial history of printer -functions. None of these standard-printer functions is suitable for use as a -column printer or a global-default printer because they invoke the column or -default printer and then modify its output.") + '(ses-center + ses-center-span ses-dashfill ses-dashfill-span + ses-tildefill-span + ses-prin1) + "List of print functions to be included in initial history of +printer functions. None of these standard-printer functions, +except function `ses-prin1', is suitable for use as a column +printer or a global-default printer because they invoke the +column or default printer and then modify its output.") ;;---------------------------------------------------------------------------- @@ -1328,7 +1331,7 @@ printer signaled one (and \"%s\" is used as the default printer), else nil." (car value)))) (error (setq ses-call-printer-return signal) - (prin1-to-string value t)))) + (ses-prin1 value)))) (defun ses-adjust-print-width (col change) "Insert CHANGE spaces in front of column COL, or at end of line if @@ -3232,7 +3235,7 @@ is non-nil. Newlines and tabs in the export text are escaped." (when (eq (car-safe item) 'quote) (push "'" result) (setq item (cadr item))) - (setq item (prin1-to-string item t)) + (setq item (ses-prin1 item)) (setq item (replace-regexp-in-string "\t" "\\\\t" item)) (push item result) (cond @@ -3531,34 +3534,67 @@ Uses the value COMPILED-VALUE for this printer." (ses-begin-change)) (ses-print-cell row col))))))) -(defun ses-define-local-printer (name) - "Define a local printer with name NAME." - (interactive "*SEnter printer name: ") + +(defun ses-define-local-printer (name definition) + "Define a local printer with name NAME and definition DEFINITION. + +NAME shall be a symbol. Use TAB to complete over existing local +printer names. + +DEFINITION shall be either a string formatter, e.g.: + + \"%.2f\" or (\"%.2f\") for left alignment. + +or a lambda expression, e.g. for formatting in ISO format dates +created with a '(calcFunc-date YEAR MONTH DAY)' formula: + + (lambda (x) + (cond + ((null val) \"\") + ((eq (car-safe x) 'date) + (let ((calc-format-date '(X YYYY \"-\" MM \"-\" DD))) + (math-format-date x))) + (t (ses-center-span val ?# 'ses-prin1)))) + +If NAME is already used to name a local printer function, then +the current definition is proposed as default value, and the +function is redefined." + (interactive + (let (name def already-defined-names) + (maphash (lambda (key val) (push (symbol-name key) already-defined-names)) + ses--local-printer-hashmap) + (setq name (completing-read "Enter printer name: " already-defined-names)) + (when (string= name "") + (error "Invalid printer name")) + (setq name (intern name)) + (let* ((cur-printer (gethash name ses--local-printer-hashmap)) + (default (and cur-printer (ses--locprn-def cur-printer)))) + (setq def (ses-read-printer (format "Enter definition of printer %S: " name) + default))) + (list name def))) + (let* ((cur-printer (gethash name ses--local-printer-hashmap)) - (default (and (vectorp cur-printer) (ses--locprn-def cur-printer))) - create-printer - (new-def - (ses-read-printer (format "Enter definition of printer %S: " name) - default))) + (default (and cur-printer (ses--locprn-def cur-printer))) + create-printer) (cond ;; cancelled operation => do nothing - ((eq new-def t)) + ((eq definition t)) ;; no change => do nothing - ((and (vectorp cur-printer) (equal new-def default))) + ((and cur-printer (equal definition default))) ;; re-defined printer - ((vectorp cur-printer) + (cur-printer (setq create-printer 0) - (setf (ses--locprn-def cur-printer) new-def) + (setf (ses--locprn-def cur-printer) definition) (ses-refresh-local-printer name (setf (ses--locprn-compiled cur-printer) - (ses-local-printer-compile new-def)))) + (ses-local-printer-compile definition)))) ;; new definition (t (setq create-printer 1) (puthash name (setq cur-printer - (ses-make-local-printer-info new-def)) + (ses-make-local-printer-info definition)) ses--local-printer-hashmap))) (when create-printer (let ((printer-def-text @@ -3582,8 +3618,18 @@ Uses the value COMPILED-VALUE for this printer." (when (= create-printer 1) (ses-file-format-extend-parameter-list 3) (ses-set-parameter 'ses--numlocprn - (+ ses--numlocprn create-printer)))))))))) + (1+ ses--numlocprn)))))))))) +(defsubst ses-define-if-new-local-printer (name def) + "Same as function `ses-define-if-new-local-printer', except +that the definition occurs only when the local printer does not +already exists. + +Function `ses-define-if-new-local-printer' is not interactive, it +is intended for mode hooks to programatically automatically add +local printers." + (unless (gethash name ses--local-printer-hashmap) + (ses-define-local-printer name def))) ;;---------------------------------------------------------------------------- ;; Checking formulas for safety @@ -3794,13 +3840,16 @@ either (ses-range BEG END) or (list ...). The TEST is evaluated." ;; Standard print functions ;;---------------------------------------------------------------------------- -(defun ses-center (value &optional span fill) +(defun ses-center (value &optional span fill printer) "Print VALUE, centered within column. FILL is the fill character for centering (default = space). SPAN indicates how many additional rightward columns to include -in width (default = 0)." - (let ((printer (or (ses-col-printer ses--col) ses--default-printer)) - (width (ses-col-width ses--col)) +in width (default = 0). +PRINTER is the printer to use for printing the value, default is the +column printer if any, or the spreadsheet the spreadsheet default +printer otherwise." + (setq printer (or printer (ses-col-printer ses--col) ses--default-printer)) + (let ((width (ses-col-width ses--col)) half) (or fill (setq fill ?\s)) (or span (setq span 0)) @@ -3815,7 +3864,7 @@ in width (default = 0)." (concat half value half (if (> (% width 2) 0) (char-to-string fill)))))) -(defun ses-center-span (value &optional fill) +(defun ses-center-span (value &optional fill printer) "Print VALUE, centered within the span that starts in the current column and continues until the next nonblank column. FILL specifies the fill character (default = space)." @@ -3823,22 +3872,28 @@ FILL specifies the fill character (default = space)." (while (and (< end ses--numcols) (memq (ses-cell-value ses--row end) '(nil *skip*))) (setq end (1+ end))) - (ses-center value (- end ses--col 1) fill))) + (ses-center value (- end ses--col 1) fill printer))) -(defun ses-dashfill (value &optional span) +(defun ses-dashfill (value &optional span printer) "Print VALUE centered using dashes. SPAN indicates how many rightward columns to include in width (default = 0)." - (ses-center value span ?-)) + (ses-center value span ?- printer)) -(defun ses-dashfill-span (value) +(defun ses-dashfill-span (value &optional printer) "Print VALUE, centered using dashes within the span that starts in the current column and continues until the next nonblank column." - (ses-center-span value ?-)) + (ses-center-span value ?- printer)) -(defun ses-tildefill-span (value) +(defun ses-tildefill-span (value &optional printer) "Print VALUE, centered using tildes within the span that starts in the current column and continues until the next nonblank column." - (ses-center-span value ?~)) + (ses-center-span value ?~ printer)) + +(defun ses-prin1 (value) + "Shorthand for '(prin1-to-string VALUE t)'. +Usefull to handle the default behaviour in custom lambda based +printer functions." + (prin1-to-string value t)) (defun ses-unsafe (_value) "Substitute for an unsafe formula or printer." |