Re: [Emacs-diffs] trunk r115838: Add support for local printer functions in SES.

[Stefan Monnier]

Please undo this commit.  We're in feature freeze, so it'll have to wait
for the trunk to unfreeze before you can install it (probably around
early February).


        Stefan


>>>>> "Vincent" == Vincent Belaïche <address@hidden> writes:

> ------------------------------------------------------------
> revno: 115838
> revision-id: address@hidden
> parent: address@hidden
> committer: Vincent Belaïche  <address@hidden>
> branch nick: trunk
> timestamp: Thu 2014-01-02 22:05:34 +0100
> message:
>   Add support for local printer functions in SES.
> modified:
>   doc/misc/ChangeLog             
> changelog-20091113204419-o5vbwnq5f7feedwu-6331
>   doc/misc/ses.texi              ses.texi-20091113204419-o5vbwnq5f7feedwu-6319
>   lisp/ChangeLog                 
> changelog-20091113204419-o5vbwnq5f7feedwu-1432
>   lisp/ses.el                    ses.el-20091113204419-o5vbwnq5f7feedwu-2447

> === modified file 'doc/misc/ChangeLog'
> --- a/doc/misc/ChangeLog      2014-01-02 20:17:19 +0000
> +++ b/doc/misc/ChangeLog      2014-01-02 21:05:34 +0000
> @@ -2,6 +2,10 @@
 
>       * eshell.text (top): Fix incorrect info filename in an xref.
 
> +2014-01-02  Vincent Belaïche  <address@hidden>
> +
> +     * ses.texi: Add documentation for local printer functions.
> +
>  2014-01-02  Glenn Morris  <address@hidden>
 
>       * Makefile.in (cc_mode_deps): Rename from (typo) ccmode_deps.

> === modified file 'doc/misc/ses.texi'
> --- a/doc/misc/ses.texi       2014-01-01 08:31:29 +0000
> +++ b/doc/misc/ses.texi       2014-01-02 21:05:34 +0000
> @@ -434,6 +434,13 @@
>  Centering with tildes (~) and spill-over.
>  @end table
 
> +You can define printer function local to a sheet with command
> address@hidden For instance define printer
> address@hidden to @code{"%.2f"} and then use symbol @samp{foo} as a
> +printer function. Then, if you call again
> address@hidden on @samp{foo} to redefine it as
> address@hidden"%.3f"} all the cells using printer @samp{foo} will be reprinted
> +accordingly.
 
>  @node Clearing cells
>  @section Clearing cells

> === modified file 'lisp/ChangeLog'
> --- a/lisp/ChangeLog  2014-01-01 07:43:34 +0000
> +++ b/lisp/ChangeLog  2014-01-02 21:05:34 +0000
> @@ -1,3 +1,31 @@
> +2014-01-02  Vincent Belaïche  <address@hidden>
> +
> +     * 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  <address@hidden>
 
>       * international/mule-conf.el: Unify the charset indian-is13194.

> === modified file 'lisp/ses.el'
> --- a/lisp/ses.el     2014-01-01 07:43:34 +0000
> +++ b/lisp/ses.el     2014-01-02 21:05:34 +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))



> _______________________________________________
> Emacs-diffs mailing list
> address@hidden
> https://lists.gnu.org/mailman/listinfo/emacs-diffs