;;; 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)
(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))
+(put 'ses-cell-symbol 'safe-function t)
(defmacro ses-cell-formula (row &optional col)
"From a CELL or a pair (ROW,COL), get the function that computes its value."
(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)
(ses-formula-record formula)
(ses-set-cell row col 'formula formula))))
+
+(defun ses-repair-cell-reference-all ()
+ "Repair cell reference and warn if there was some reference corruption."
+ (interactive "*")
+ (let (errors)
+ ;; Step 1, reset :ses-repair-reference cell property in the whole sheet.
+ (dotimes (row ses--numrows)
+ (dotimes (col ses--numcols)
+ (let ((references (ses-cell-property-pop :ses-repair-reference
+ row col)))
+ (when references
+ (push (list
+ (ses-cell-symbol row col)
+ :corrupt-property
+ references) errors)))))
+
+ ;; Step 2, build new.
+ (dotimes (row ses--numrows)
+ (dotimes (col ses--numcols)
+ (let* ((cell (ses-get-cell row col))
+ (sym (ses-cell-symbol cell))
+ (formula (ses-cell-formula cell))
+ (new-ref (ses-formula-references formula)))
+ (dolist (ref new-ref)
+ (let* ((rowcol (ses-sym-rowcol ref))
+ (h (ses-cell-property-get-handle :ses-repair-reference
+ (car rowcol) (cdr rowcol))))
+ (unless (memq ref (ses-cell-property-handle-car h))
+ (ses-cell-property-handle-setcar
+ h
+ (cons sym
+ (ses-cell-property-handle-car h)))))))))
+
+ ;; Step 3, overwrite with check.
+ (dotimes (row ses--numrows)
+ (dotimes (col ses--numcols)
+ (let* ((cell (ses-get-cell row col))
+ (irrelevant (ses-cell-references cell))
+ (new-ref (ses-cell-property-pop :ses-repair-reference cell))
+ missing)
+ (dolist (ref new-ref)
+ (if (memq ref irrelevant)
+ (setq irrelevant (delq ref irrelevant))
+ (push ref missing)))
+ (ses-set-cell row col 'references new-ref)
+ (when (or missing irrelevant)
+ (push `( ,(ses-cell-symbol cell)
+ ,@(and missing (list :missing missing))
+ ,@(and irrelevant (list :irrelevant irrelevant)))
+ errors)))))
+ (if errors
+ (warn "----------------------------------------------------------------
+Some reference where corrupted.
+
+The following is a list of where each element ELT is such
+that (car ELT) is the reference of cell CELL with corruption,
+and (cdr ELT) is a property list where
+
+* property `:corrupt-property' means that
+ property `:ses-repair-reference' of cell CELL was initially non
+ nil,
+
+* property `:missing' is a list of missing references
+
+* property `:irrelevant' is a list of non needed references
+
+%S" errors)
+ (message "No reference corruption found"))))
+
(defun ses-calculate-cell (row col force)
"Calculate and print the value for cell (ROW,COL) using the cell's formula
function and print functions, if any. Result is nil for normal operation, or
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