;;; Code:
(require 'unsafep)
+(eval-when-compile (require 'cl))
;;----------------------------------------------------------------------------
(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."
((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)
(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)
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))
(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
;; 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', `<^',
+`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 `<v' or `<^'.
+
+If the range is one column, then `v' can be used as a shorthand to
+`v>' 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))
+ ((<v)(setq transpose nil reorient-x t reorient-y nil))
+ ((v>)(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."
;; 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
HCoop / bpt / emacs.git / blobdiff