X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5e5d49b6d4b736e96be98d8e392c846bbc803142..52bedd34385bf6434d60d884b306e5883fb656d9:/lisp/ses.el diff --git a/lisp/ses.el b/lisp/ses.el index 2e6c24ab5e..9b2048eae8 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -56,6 +56,7 @@ ;;; Code: (require 'unsafep) +(eval-when-compile (require 'cl)) ;;---------------------------------------------------------------------------- @@ -272,18 +273,18 @@ default printer and then modify its output.") (eval-and-compile (defconst ses-localvars '(ses--blank-line ses--cells ses--col-printers - ses--col-widths (ses--curcell . nil) ses--curcell-overlay + ses--col-widths ses--curcell ses--curcell-overlay ses--default-printer - ses--deferred-narrow (ses--deferred-recalc - . nil) (ses--deferred-write . nil) ses--file-format + ses--deferred-narrow ses--deferred-recalc + ses--deferred-write ses--file-format (ses--header-hscroll . -1) ; Flag for "initial recalc needed" ses--header-row ses--header-string ses--linewidth ses--numcols ses--numrows ses--symbolic-formulas - ses--data-marker ses--params-marker (ses--Dijkstra-attempt-nb - . 0) ses--Dijkstra-weight-bound + ses--data-marker ses--params-marker (ses--Dijkstra-attempt-nb . 0) + ses--Dijkstra-weight-bound ;; Global variables that we override mode-line-process next-line-add-newlines transient-mark-mode) - "Buffer-local variables used by SES.")) + "Buffer-local variables used by SES.") (defun ses-set-localvars () "Set buffer-local and initialize some SES variables." @@ -292,8 +293,11 @@ default printer and then modify its output.") ((symbolp x) (set (make-local-variable x) nil)) ((consp x) - (set (make-local-variable (car x)) (cdr x))) - (error "Unexpected elements `%S' in list `ses-localvars'")))) + (set (make-local-variable (car x)) (cdr x))) + (t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))) + +(eval-when-compile ; silence compiler + (ses-set-localvars)) ;;; This variable is documented as being permitted in file-locals: (put 'ses--symbolic-formulas 'safe-local-variable 'consp) @@ -670,9 +674,9 @@ for this spreadsheet." (put sym 'ses-cell (cons xrow xcol)) (make-local-variable sym))))) -;;We do not delete the ses-cell properties for the cell-variables, in case a -;;formula that refers to this cell is in the kill-ring and is later pasted -;;back in. +;; We do not delete the ses-cell properties for the cell-variables, in +;; case a formula that refers to this cell is in the kill-ring and is +;; later pasted back in. (defun ses-destroy-cell-variable-range (minrow maxrow mincol maxcol) "Destroy buffer-local variables for cells. This is undoable." (let (sym) @@ -1170,17 +1174,19 @@ The variable `ses-call-printer-return' is set to t if the printer used parenthesis to request left-justification, or the error-signal if the printer signaled one (and \"%s\" is used as the default printer), else nil." (setq ses-call-printer-return nil) - (unless value - (setq value "")) (condition-case signal (cond ((stringp printer) - (format printer value)) + (if value + (format printer value) + "")) ((stringp (car-safe printer)) (setq ses-call-printer-return t) - (format (car printer) value)) + (if value + (format (car printer) value) + "")) (t - (setq value (funcall printer value)) + (setq value (funcall printer (or value ""))) (if (stringp value) value (or (stringp (car-safe value)) @@ -1495,7 +1501,7 @@ if the range was altered." (funcall field (ses-sym-rowcol min)))) ;; This range has changed size. (setq ses-relocate-return 'range)) - (list 'ses-range min max)))) + `(ses-range ,min ,max ,@(cdddr range))))) (defun ses-relocate-all (minrow mincol rowincr colincr) "Alter all cell values, symbols, formulas, and reference-lists to relocate @@ -3171,15 +3177,128 @@ is safe or user allows execution anyway. Always returns t if ;; Standard formulas ;;---------------------------------------------------------------------------- -(defmacro ses-range (from to) - "Expands to a list of cell-symbols for the range. The range automatically -expands to include any new row or column inserted into its middle. The SES -library code specifically looks for the symbol `ses-range', so don't create an -alias for this macro!" - (let (result) +(defun ses--clean-! (&rest x) + "Clean by delq list X from any occurrence of `nil' or `*skip*'." + (delq nil (delq '*skip* x))) + +(defun ses--clean-_ (x y) + "Clean list X by replacing by Y any occurrence of `nil' or `*skip*'. + +This will change X by making setcar on its cons cells." + (let ((ret x) ret-elt) + (while ret + (setq ret-elt (car ret)) + (when (memq ret-elt '(nil *skip*)) + (setcar ret y)) + (setq ret (cdr ret)))) + x) + +(defmacro ses-range (from to &rest rest) + "Expands to a list of cell-symbols for the range going from +FROM up to TO. The range automatically expands to include any +new row or column inserted into its middle. The SES library code +specifically looks for the symbol `ses-range', so don't create an +alias for this macro! + +By passing in REST some flags one can configure the way the range +is read and how it is formatted. + +In the sequel we assume that cells A1, B1, A2 B2 have respective values +1 2 3 and 4 for examplication. + +Readout direction is specified by a `>v', '`>^', `', `v<', `^>', `^<' flag. For historical reasons, in absence +of such a flag, a default direction of `^<' is assumed. This +way `(ses-range A1 B2 ^>)' will evaluate to `(1 3 2 4)', +while `(ses-range A1 B2 >^)' will evaluate to (3 4 1 2). + +If the range is one row, then `>' can be used as a shorthand to +`>v' or `>^', and `<' to `' or `v<', and `^' to `^>' or `v<'. + +A `!' flag will remove all cells whose value is nil or `*skip*'. + +A `_' flag will replace nil or `*skip*' by the value following +the `_' flag. If the `_' flag is the last argument, then they are +replaced by integer 0. + +A `*', `*1' or `*2' flag will vectorize the range in the sense of +Calc. See info node `(Calc) Top'. Flag `*' will output either a +vector or a matrix depending on the number of rows, `*1' will +flatten the result to a one row vector, and `*2' will make a +matrix whatever the number of rows. + +Warning: interaction with Calc is expermimental and may produce +confusing results if you are not aware of Calc data format. Use +`math-format-value' as a printer for Calc objects." + (let (result-row + result + (prev-row -1) + (reorient-x nil) + (reorient-y nil) + transpose vectorize + (clean 'list)) (ses-dorange (cons from to) - (push (ses-cell-symbol row col) result)) - (cons 'list result))) + (when (/= prev-row row) + (push result-row result) + (setq result-row nil)) + (push (ses-cell-symbol row col) result-row) + (setq prev-row row)) + (push result-row result) + (while rest + (let ((x (pop rest))) + (case x + ((>v) (setq transpose nil reorient-x nil reorient-y nil)) + ((>^)(setq transpose nil reorient-x nil reorient-y t)) + ((<^)(setq transpose nil reorient-x t reorient-y t)) + (()(setq transpose t reorient-x nil reorient-y t)) + ((^>)(setq transpose t reorient-x nil reorient-y nil)) + ((^<)(setq transpose t reorient-x t reorient-y nil)) + ((v<)(setq transpose t reorient-x t reorient-y t)) + ((* *2 *1) (setq vectorize x)) + ((!) (setq clean 'ses--clean-!)) + ((_) (setq clean `(lambda (&rest x) (ses--clean-_ x ,(if rest (pop rest) 0))))) + (t + (cond + ; shorthands one row + ((and (null (cddr result)) (memq x '(> <))) + (push (intern (concat (symbol-name x) "v")) rest)) + ; shorthands one col + ((and (null (cdar result)) (memq x '(v ^))) + (push (intern (concat (symbol-name x) ">")) rest)) + (t (error "Unexpected flag `%S' in ses-range" x))))))) + (if reorient-y + (setcdr (last result 2) nil) + (setq result (cdr (nreverse result)))) + (unless reorient-x + (setq result (mapcar 'nreverse result))) + (when transpose + (let ((ret (mapcar (lambda (x) (list x)) (pop result))) iter) + (while result + (setq iter ret) + (dolist (elt (pop result)) + (setcar iter (cons elt (car iter))) + (setq iter (cdr iter)))) + (setq result ret))) + + (flet ((vectorize-*1 + (clean result) + (cons clean (cons (quote 'vec) (apply 'append result)))) + (vectorize-*2 + (clean result) + (cons clean (cons (quote 'vec) (mapcar (lambda (x) + (cons clean (cons (quote 'vec) x))) + result))))) + (case vectorize + ((nil) (cons clean (apply 'append result))) + ((*1) (vectorize-*1 clean result)) + ((*2) (vectorize-*2 clean result)) + ((*) (if (cdr result) + (vectorize-*2 clean result) + (vectorize-*1 clean result))))))) (defun ses-delete-blanks (&rest args) "Return ARGS reversed, with the blank elements (nil and *skip*) removed." @@ -3229,10 +3348,8 @@ TEST is evaluated." ;; These functions use the variables 'row' and 'col' that are dynamically bound ;; by ses-print-cell. We define these variables at compile-time to make the ;; compiler happy. -(eval-when-compile - (dolist (x '(row col)) - (make-local-variable x) - (set x nil))) +(defvar row) +(defvar col) (defun ses-center (value &optional span fill) "Print VALUE, centered within column. FILL is the fill character for