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.

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."