mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-05 22:20:24 -08:00
Rewrite ses-set to be lexical-binding-proof.
This commit is contained in:
Vincent Belaïche
parent
6c2256f52e
commit
dec7539233
2 changed files with 262 additions and 229 deletions
270
lisp/ses.el
270
lisp/ses.el
|
|
@ -4069,142 +4069,148 @@ Use `math-format-value' as a printer for Calc objects."
|
||||||
#'ses--cell-value
|
#'ses--cell-value
|
||||||
(quote ,from) (quote ,to) ,(and rest `(quote ,rest))))
|
(quote ,from) (quote ,to) ,(and rest `(quote ,rest))))
|
||||||
|
|
||||||
(defun ses--setq-engine (arglist)
|
|
||||||
(let* (undo-list
|
|
||||||
undo-chunk
|
|
||||||
value
|
|
||||||
cell
|
|
||||||
old-value
|
|
||||||
old-formula
|
|
||||||
new-formula
|
|
||||||
old-ref
|
|
||||||
row col
|
|
||||||
x xrow xcol
|
|
||||||
sym
|
|
||||||
(setter 'sv))
|
|
||||||
(ses-initialize-Dijkstra-attempt)
|
|
||||||
(while arglist
|
|
||||||
(setq setter
|
|
||||||
(or (and (eq (car-safe arglist) ::)
|
|
||||||
(progn
|
|
||||||
(setq arglist (cdr arglist))
|
|
||||||
(or (consp arglist) (error "Missing setter after ::"))
|
|
||||||
(setq value (car arglist)
|
|
||||||
arglist (cdr arglist))
|
|
||||||
(pcase value
|
|
||||||
((or 'sv 'sf 'rcv 'rcf 'sfq 'rcfq)
|
|
||||||
(setq undo-list (append (list value ::) undo-list)))
|
|
||||||
(_ (error "Invalid setter %S" value)))
|
|
||||||
value))
|
|
||||||
setter))
|
|
||||||
(pcase setter
|
|
||||||
('sv
|
|
||||||
(setq sym (pop arglist)
|
|
||||||
value (pop arglist)
|
|
||||||
undo-chunk (list value sym)
|
|
||||||
value (eval value))
|
|
||||||
(or (ses-is-cell-sym-p sym)
|
|
||||||
(error "Not a SES cell symbol %S" sym))
|
|
||||||
(setq row (ses-sym-rowcol sym)
|
|
||||||
col (cdr row)
|
|
||||||
row (car row)
|
|
||||||
cell (ses-get-cell row col)
|
|
||||||
new-formula (if (atom value) value `(quote ,value)))
|
|
||||||
.
|
|
||||||
#1=(;; This is a simplified ses-cell-set-formula, as values don't have
|
|
||||||
;; reference lists
|
|
||||||
(setq old-formula (ses-cell-formula cell)
|
|
||||||
old-ref (ses-formula-references old-formula)
|
|
||||||
old-value (symbol-value sym))
|
|
||||||
(unless (and (equal old-value value)
|
|
||||||
(equal old-formula new-formula))
|
|
||||||
(let ((inhibit-quit t))
|
|
||||||
(set sym value)
|
|
||||||
(ses-set-cell row col 'formula new-formula)
|
|
||||||
(dolist (ref old-ref)
|
|
||||||
(setq x (ses-sym-rowcol ref))
|
|
||||||
(and (consp x)
|
|
||||||
(< (setq xrow (car x)) ses--numrows)
|
|
||||||
(< (setq xcol (cdr x)) ses--numcols)
|
|
||||||
(ses-set-cell xrow xcol 'references
|
|
||||||
(delq sym (ses-cell-references xrow xcol)))))
|
|
||||||
(ses-update-cells (ses-cell-references row col)))
|
|
||||||
(cl-pushnew (cons row col) ses--deferred-write :test #'equal)
|
|
||||||
(ses-print-cell row col))
|
|
||||||
(setq undo-list (append undo-chunk undo-list))))
|
|
||||||
|
|
||||||
('rcv
|
(defun ses--set-value (cell sym row col new-formula new-value)
|
||||||
(setq row (pop arglist)
|
;; This is a faster ses-cell-set-formula, as values don't have
|
||||||
col (pop arglist)
|
;; reference lists
|
||||||
value (pop arglist)
|
(let* ((old-formula (ses-cell-formula cell))
|
||||||
undo-chunk (list value col row)
|
(old-ref (ses-formula-references old-formula))
|
||||||
row (eval row)
|
(old-value (symbol-value sym))
|
||||||
col (eval col)
|
x xrow xcol)
|
||||||
value (eval value)
|
(unless (and (equal old-value new-value)
|
||||||
cell (ses-get-cell row col)
|
(equal old-formula new-formula))
|
||||||
sym (ses-cell-symbol cell)
|
(let ((inhibit-quit t))
|
||||||
new-formula (if (atom value) value `(quote ,value)))
|
(set sym new-value)
|
||||||
. #1#)
|
(ses-set-cell row col 'formula new-formula)
|
||||||
('sf
|
(dolist (ref old-ref)
|
||||||
(setq sym (pop arglist)
|
(setq x (ses-sym-rowcol ref))
|
||||||
new-formula (pop arglist)
|
(and (consp x)
|
||||||
undo-chunk (list new-formula sym))
|
(< (setq xrow (car x)) ses--numrows)
|
||||||
(or (ses-is-cell-sym-p sym)
|
(< (setq xcol (cdr x)) ses--numcols)
|
||||||
(error "Not a SES cell symbol %S" sym))
|
(ses-set-cell xrow xcol 'references
|
||||||
(setq row (ses-sym-rowcol sym)
|
(delq sym (ses-cell-references xrow xcol)))))
|
||||||
col (cdr row)
|
(ses-update-cells (ses-cell-references row col)))
|
||||||
row (car row)
|
(cl-pushnew (cons row col) ses--deferred-write :test #'equal)
|
||||||
cell (ses-get-cell row col))
|
(ses-print-cell row col))
|
||||||
.
|
;(push `(apply ses--set-value ,cell ,sym ,row ,col ,old-formula ,old-value) buffer-undo-list)
|
||||||
#2=((ses-cell-set-formula row col new-formula)
|
))
|
||||||
(ses-update-cells (prog1 ses--deferred-recalc
|
|
||||||
(setq ses--deferred-recalc nil)))
|
|
||||||
(ses-print-cell row col)
|
|
||||||
(ses-update-cells (ses-cell-references row col))
|
|
||||||
(setq undo-list (append undo-chunk undo-list))
|
|
||||||
))
|
|
||||||
('rcf
|
|
||||||
(setq row (pop arglist)
|
|
||||||
col (pop arglist)
|
|
||||||
new-formula (pop arglist)
|
|
||||||
undo-chunk (list new-formula col row)
|
|
||||||
row (eval row)
|
|
||||||
col (eval col)
|
|
||||||
cell (ses-get-cell row col)
|
|
||||||
sym (ses-cell-symbol cell))
|
|
||||||
. #2#)
|
|
||||||
('sfq
|
|
||||||
(setq sym (pop arglist)
|
|
||||||
new-formula (pop arglist)
|
|
||||||
undo-chunk (list new-formula sym))
|
|
||||||
(or (ses-is-cell-sym-p sym)
|
|
||||||
(error "Not a SES cell symbol %S" sym))
|
|
||||||
(setq row (ses-sym-rowcol sym)
|
|
||||||
col (cdr row)
|
|
||||||
row (car row)
|
|
||||||
new-formula (eval new-formula)
|
|
||||||
cell (ses-get-cell row col))
|
|
||||||
. #2#)
|
|
||||||
('rcfq
|
|
||||||
(setq row (pop arglist)
|
|
||||||
col (pop arglist)
|
|
||||||
new-formula (pop arglist)
|
|
||||||
undo-chunk (list new-formula col row)
|
|
||||||
row (eval row)
|
|
||||||
col (eval col)
|
|
||||||
new-formula (eval new-formula)
|
|
||||||
cell (ses-get-cell row col)
|
|
||||||
sym (ses-cell-symbol cell))
|
|
||||||
. #2#)
|
|
||||||
(_ (error "INTERNAL"))))
|
|
||||||
(ses-write-cells)
|
|
||||||
value))
|
|
||||||
|
|
||||||
(defmacro ses-setq (&rest args)
|
(defun ses--sv-set (sym value)
|
||||||
|
(let* ((rowcol (ses-sym-rowcol sym))
|
||||||
|
(col (cdr rowcol))
|
||||||
|
(row (car rowcol))
|
||||||
|
(cell (ses-get-cell row col))
|
||||||
|
(new-formula (if (atom value) value `(quote ,value))))
|
||||||
|
(ses--set-value cell sym row col new-formula value)))
|
||||||
|
|
||||||
|
(defun ses--rcv-set (row col value)
|
||||||
|
(let* ((cell (ses-get-cell row col))
|
||||||
|
(sym (ses-cell-symbol cell))
|
||||||
|
(new-formula (if (atom value) value `(quote ,value))))
|
||||||
|
(ses--set-value cell sym row col new-formula value)))
|
||||||
|
|
||||||
|
(defun ses--set-formula (cell sym row col new-formula)
|
||||||
|
;; This is a simplified ses-cell-set-formula, as values don't have
|
||||||
|
;; reference lists
|
||||||
|
(let* ((old-formula (ses-cell-formula cell)))
|
||||||
|
(ses-cell-set-formula row col new-formula)
|
||||||
|
(ses-update-cells (prog1 ses--deferred-recalc
|
||||||
|
(setq ses--deferred-recalc nil)))
|
||||||
|
(ses-print-cell row col)
|
||||||
|
(ses-update-cells (ses-cell-references row col))
|
||||||
|
; (push `(apply ses--set-formula ,cell ,sym ,row ,col ,old-formula) buffer-undo-list)
|
||||||
|
))
|
||||||
|
|
||||||
|
(defun ses--sf-set (sym formula)
|
||||||
|
(let* ((rowcol (ses-sym-rowcol sym))
|
||||||
|
(col (cdr rowcol))
|
||||||
|
(row (car rowcol))
|
||||||
|
(cell (ses-get-cell row col)))
|
||||||
|
(ses--set-formula cell sym row col formula)))
|
||||||
|
|
||||||
|
(defun ses--rcf-set (row col formula)
|
||||||
|
(let* ((cell (ses-get-cell row col))
|
||||||
|
(sym (ses-cell-symbol cell)))
|
||||||
|
(ses--set-formula cell sym row col formula)))
|
||||||
|
|
||||||
|
|
||||||
|
(defmacro ses-set (&rest args)
|
||||||
"Sets cells values or formulaes programmatically.
|
"Sets cells values or formulaes programmatically.
|
||||||
|
ARGS is a list of elements chunks that are processed. Each element chunk
|
||||||
|
is either a setter switch or setting a cell. Possible setters are 'sqv',
|
||||||
|
'sv', 'sf', 'sqf', 'sfq', 'sqfq', 'rcv', 'rcf' or 'rcfq'. Default setter
|
||||||
|
is 'sqv'. Setter can be switched by element chunk
|
||||||
|
|
||||||
ARGS is a list of elements that are processed "
|
:: NEW-SETTER
|
||||||
`(ses--setq-engine (quote ,args)))
|
|
||||||
|
In the setter id 's' means symbol, 'rc' means row-column, 's' or 'rc'
|
||||||
|
tells whether the cell is pointed at by a symbol or by coordinates. 'v'
|
||||||
|
means value, and 'f' means formula and this tells what is assigned to cell.
|
||||||
|
'q' tells whether the element is implicitely quoted or not.
|
||||||
|
|
||||||
|
So:
|
||||||
|
|
||||||
|
(set-set A1 1 :: sv 'A2 2 :: sqfq B1 (+ A1 A2) :: sqf B2 '(+ A1 A2))
|
||||||
|
|
||||||
|
will set A1 to value 1, A2 to value 2, B1 to formula A1+A2, and B2 to
|
||||||
|
formula A1+A2. The same settings can be done as:
|
||||||
|
|
||||||
|
(set-set :: rcv 0 0 1 1 0 2 :: rcfq 0 1 (+ A1 A2) :: rcf 1 1 '(+ A1 A2))
|
||||||
|
|
||||||
|
"
|
||||||
|
(let ((setter-id 'sqv)
|
||||||
|
(argsq `(,@args))
|
||||||
|
result
|
||||||
|
next-setter-id)
|
||||||
|
`(progn
|
||||||
|
(ses-initialize-Dijkstra-attempt) ; (ses-begin-change)
|
||||||
|
,@(progn
|
||||||
|
(while argsq
|
||||||
|
(setq next-setter-id (car argsq))
|
||||||
|
(if (eq next-setter-id ::)
|
||||||
|
(progn
|
||||||
|
(pop argsq)
|
||||||
|
(setq setter-id (or (pop argsq) (error "Expected setter id"))))
|
||||||
|
(cond
|
||||||
|
((eq setter-id 'sqfq)
|
||||||
|
(push `(ses--sf-set (quote ,(or (pop argsq) (error "expected symbol")))
|
||||||
|
(quote ,(or (pop argsq) (error "expected formula")))) result))
|
||||||
|
((eq setter-id 'rcfq)
|
||||||
|
(push `(ses--rcf-set
|
||||||
|
,(or (pop argsq) (error "expected row"))
|
||||||
|
,(or (pop argsq) (error "expected col"))
|
||||||
|
(quote ,(or (pop argsq) (error "expected formula")))) result))
|
||||||
|
|
||||||
|
((eq setter-id 'sqv)
|
||||||
|
(push `(ses--sv-set (quote ,(or (pop argsq) (error "expected symbol")))
|
||||||
|
,(or (pop argsq) (error "expected value"))) result))
|
||||||
|
((eq setter-id 'sv)
|
||||||
|
(push `(ses--sv-set ,(or (pop argsq) (error "expected symbol"))
|
||||||
|
,(or (pop argsq) (error "expected value"))) result))
|
||||||
|
((eq setter-id 'rcv)
|
||||||
|
(push `(ses--rcv-set
|
||||||
|
,(or (pop argsq) (error "expected row"))
|
||||||
|
,(or (pop argsq) (error "expected col"))
|
||||||
|
,(or (pop argsq) (error "expected value"))) result))
|
||||||
|
|
||||||
|
((eq setter-id 'sqf)
|
||||||
|
(push `(ses--sf-set (quote ,(or (pop argsq) (error "expected symbol")))
|
||||||
|
,(or (pop argsq) (error "expected formula"))) result))
|
||||||
|
((eq setter-id 'sf)
|
||||||
|
(push `(ses--sf-set ,(or (pop argsq) (error "expected symbol"))
|
||||||
|
,(or (pop argsq) (error "expected formula"))) result))
|
||||||
|
|
||||||
|
((eq setter-id 'sfq)
|
||||||
|
(push `(ses--sf-set ,(or (pop argsq) (error "expected symbol"))
|
||||||
|
(quote ,(or (pop argsq) (error "expected formula")))) result))
|
||||||
|
((eq setter-id 'rcf)
|
||||||
|
(push `(ses--rcf-set
|
||||||
|
,(or (pop argsq) (error "expected row"))
|
||||||
|
,(or (pop argsq) (error "expected col"))
|
||||||
|
,(or (pop argsq) (error "expected formula"))) result))
|
||||||
|
|
||||||
|
(t (error "Invalid setter id %S" setter-id)))))
|
||||||
|
(nreverse result)))))
|
||||||
|
|
||||||
(defun ses-delete-blanks (&rest args)
|
(defun ses-delete-blanks (&rest args)
|
||||||
"Return ARGS reversed, with the blank elements (nil and *skip*) removed."
|
"Return ARGS reversed, with the blank elements (nil and *skip*) removed."
|
||||||
|
|
|
||||||
|
|
@ -341,19 +341,19 @@ cell has to be rewritten to data area."
|
||||||
(>= x 4)))
|
(>= x 4)))
|
||||||
'(9 10))))
|
'(9 10))))
|
||||||
|
|
||||||
;; Tests for ses-setq
|
;; Tests for ses-set
|
||||||
|
|
||||||
(ert-deftest ses-setq-sv ()
|
(ert-deftest ses-set-sv ()
|
||||||
"Set values, cells denoted by symbol."
|
"Set values, cells denoted by symbol."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil))
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(ses-mode)
|
(ses-mode)
|
||||||
(ses-setq A1 1 B1 2
|
(ses-set A1 1 B1 2
|
||||||
A2 (+ A1 B1) B2 (+ B1 A2))
|
A2 (+ A1 B1) B2 (+ B1 A2))
|
||||||
(should (eq A2 3))
|
(should (eq A2 3))
|
||||||
(should (eq B2 5))
|
(should (eq B2 5))
|
||||||
(ses-setq A1 0)
|
(ses-set A1 0)
|
||||||
;; values are'nt changed because (+ A1 B1) and (+ B1 A2) are
|
;; values are'nt changed because (+ A1 B1) and (+ B1 A2) are
|
||||||
;; evaluated before being set to A2 and B2. So A2's formula is 3,
|
;; evaluated before being set to A2 and B2. So A2's formula is 3,
|
||||||
;; and B2's formula is 5
|
;; and B2's formula is 5
|
||||||
|
|
@ -361,30 +361,30 @@ cell has to be rewritten to data area."
|
||||||
(should (eq B2 5))
|
(should (eq B2 5))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(ert-deftest ses-setq-sv-sf ()
|
(ert-deftest ses-set-sqv-sqfq ()
|
||||||
"Set values and formulas, cells denoted by symbol."
|
"Set values and formulas, cells denoted by symbol."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil))
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(ses-mode)
|
(ses-mode)
|
||||||
(ses-setq A1 1 B1 2
|
(ses-set A1 1 B1 2
|
||||||
:: sf A2 (+ A1 B1) B2 (+ B1 A2))
|
:: sqfq A2 (+ A1 B1) B2 (+ B1 A2))
|
||||||
(should (eq A1 1))
|
(should (eq A1 1))
|
||||||
(should (eq B1 2))
|
(should (eq B1 2))
|
||||||
(should (eq A2 3))
|
(should (eq A2 3))
|
||||||
(should (eq B2 5))
|
(should (eq B2 5))
|
||||||
(ses-setq A1 0)
|
(ses-set A1 0)
|
||||||
(should (eq A2 2))
|
(should (eq A2 2))
|
||||||
(should (eq B2 4))
|
(should (eq B2 4))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(ert-deftest ses-setq-rcv ()
|
(ert-deftest ses-set-rcv ()
|
||||||
"Set values, cells denoted by coordinates."
|
"Set values, cells denoted by coordinates."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil))
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(ses-mode)
|
(ses-mode)
|
||||||
(ses-setq :: rcv
|
(ses-set :: rcv
|
||||||
0 0 1; A1 := 1
|
0 0 1; A1 := 1
|
||||||
0 1 2; B1 := 2
|
0 1 2; B1 := 2
|
||||||
1 0 (+ A1 B1); A2 := A1 + B1
|
1 0 (+ A1 B1); A2 := A1 + B1
|
||||||
|
|
@ -394,7 +394,7 @@ cell has to be rewritten to data area."
|
||||||
(should (eq B1 2))
|
(should (eq B1 2))
|
||||||
(should (eq A2 3))
|
(should (eq A2 3))
|
||||||
(should (eq B2 5))
|
(should (eq B2 5))
|
||||||
(ses-setq A1 0)
|
(ses-set A1 0)
|
||||||
(should (eq A1 0))
|
(should (eq A1 0))
|
||||||
;; values are'nt changed because (+ A1 B1) and (+ B1 A2) are
|
;; values are'nt changed because (+ A1 B1) and (+ B1 A2) are
|
||||||
;; evaluated before being set to A2 and B2. So A2's formula is 3,
|
;; evaluated before being set to A2 and B2. So A2's formula is 3,
|
||||||
|
|
@ -403,16 +403,16 @@ cell has to be rewritten to data area."
|
||||||
(should (eq B2 5))
|
(should (eq B2 5))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(ert-deftest ses-setq-rcv-rcf ()
|
(ert-deftest ses-set-rcv-rcfq ()
|
||||||
"Set values and formulas, cells denoted by coordinates."
|
"Set values and formulas, cells denoted by coordinates."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil))
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(ses-mode)
|
(ses-mode)
|
||||||
(ses-setq :: rcv
|
(ses-set :: rcv
|
||||||
0 0 1; A1 := 1
|
0 0 1; A1 := 1
|
||||||
0 1 2; B1 := 2
|
0 1 2; B1 := 2
|
||||||
:: rcf
|
:: rcfq
|
||||||
1 0 (+ A1 B1); A2 := A1 + B1
|
1 0 (+ A1 B1); A2 := A1 + B1
|
||||||
1 1 (+ B1 A2); B2 := B1 + A2
|
1 1 (+ B1 A2); B2 := B1 + A2
|
||||||
)
|
)
|
||||||
|
|
@ -420,105 +420,132 @@ cell has to be rewritten to data area."
|
||||||
(should (eq B1 2))
|
(should (eq B1 2))
|
||||||
(should (eq A2 3))
|
(should (eq A2 3))
|
||||||
(should (eq B2 5))
|
(should (eq B2 5))
|
||||||
(ses-setq A1 0)
|
(ses-set A1 0)
|
||||||
(should (eq A1 0))
|
(should (eq A1 0))
|
||||||
(should (eq A2 2))
|
(should (eq A2 2))
|
||||||
(should (eq B2 4))
|
(should (eq B2 4))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(ert-deftest ses-setq-rcxv ()
|
(ert-deftest ses-set-rcxv ()
|
||||||
"Set values, cells denoted by coordinates expressions."
|
"Set values, cells denoted by coordinates expressions."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil)
|
||||||
(cl-progv '(zero one) '(0 1)
|
(zero 0)
|
||||||
(with-temp-buffer
|
(one 1))
|
||||||
(ses-mode)
|
(with-temp-buffer
|
||||||
(ses-setq :: rcv
|
(ses-mode)
|
||||||
zero zero 1; A1 := 1
|
(ses-set :: rcv
|
||||||
zero one 2; B1 := 2
|
zero zero 1; A1 := 1
|
||||||
one zero (+ A1 B1); A2 := A1 + B1
|
zero one 2; B1 := 2
|
||||||
one one (+ B1 A2); B2 := B1 + A2
|
one zero (+ A1 B1); A2 := A1 + B1
|
||||||
)
|
one one (+ B1 A2); B2 := B1 + A2
|
||||||
(should (eq A2 3))
|
)
|
||||||
(should (eq B2 5))
|
(should (eq A2 3))
|
||||||
(ses-setq A1 0)
|
(should (eq B2 5))
|
||||||
(should (eq A1 0))
|
(ses-set A1 0)
|
||||||
;; values are'nt changed because (+ A1 B1) and (+ B1 A2) are
|
(should (eq A1 0))
|
||||||
;; evaluated before being set to A2 and B2. So A2's formula is 3,
|
;; values are'nt changed because (+ A1 B1) and (+ B1 A2) are
|
||||||
;; and B2's formula is 5
|
;; evaluated before being set to A2 and B2. So A2's formula is 3,
|
||||||
(should (eq A2 3))
|
;; and B2's formula is 5
|
||||||
(should (eq B2 5))))))
|
(should (eq A2 3))
|
||||||
|
(should (eq B2 5)))))
|
||||||
|
|
||||||
(ert-deftest ses-setq-rcxv-rcxf ()
|
(ert-deftest ses-set-rcxv-rcxfq ()
|
||||||
"Set values and formulas, cells denoted by coordinates expressions."
|
"Set values and formulas, cells denoted by coordinates expressions."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil)
|
||||||
(cl-progv '(zero one) '(0 1)
|
(zero 0)
|
||||||
(with-temp-buffer
|
(one 1))
|
||||||
(ses-mode)
|
(with-temp-buffer
|
||||||
(ses-setq :: rcv
|
(ses-mode)
|
||||||
zero zero 1; A1 := 1
|
(ses-set :: rcv
|
||||||
zero one 2; B1 := 2
|
zero zero 1; A1 := 1
|
||||||
:: rcf
|
zero one 2; B1 := 2
|
||||||
one zero (+ A1 B1); A2 := A1 + B1
|
:: rcfq
|
||||||
one one (+ B1 A2); B2 := B1 + A2
|
one zero (+ A1 B1); A2 := A1 + B1
|
||||||
)
|
one one (+ B1 A2); B2 := B1 + A2
|
||||||
(should (eq A2 3))
|
)
|
||||||
(should (eq B2 5))
|
(should (eq A2 3))
|
||||||
(ses-setq A1 0)
|
(should (eq B2 5))
|
||||||
(should (eq A1 0))
|
(ses-set A1 0)
|
||||||
(should (eq A2 2))
|
(should (eq A1 0))
|
||||||
(should (eq B2 4))))))
|
(should (eq A2 2))
|
||||||
|
(should (eq B2 4)))))
|
||||||
|
|
||||||
(ert-deftest ses-setq-sv-sfq ()
|
(ert-deftest ses-set-sqv-sqf ()
|
||||||
"Set values and formulas, formulas are expressions."
|
"Set values and formulas, formulas are expressions."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil)
|
||||||
(cl-progv
|
(A2-form '(+ A1 B1))
|
||||||
'(A2-form B2-form)
|
(B2-form '(+ B1 A2)))
|
||||||
'((+ A1 B1) (+ B1 A2))
|
(with-temp-buffer
|
||||||
(with-temp-buffer
|
(ses-mode)
|
||||||
(ses-mode)
|
(ses-set
|
||||||
(ses-setq
|
A1 1; A1 := 1
|
||||||
A1 1; A1 := 1
|
B1 2; B1 := 2
|
||||||
B1 2; B1 := 2
|
:: sqf
|
||||||
:: sfq
|
A2 A2-form; A2 := A1 + B1
|
||||||
A2 A2-form; A2 := A1 + B1
|
B2 B2-form; B2 := B1 + A2
|
||||||
B2 B2-form; B2 := B1 + A2
|
)
|
||||||
)
|
(should (eq A1 1))
|
||||||
(should (eq A1 1))
|
(should (eq B1 2))
|
||||||
(should (eq B1 2))
|
(should (eq A2 3))
|
||||||
(should (eq A2 3))
|
(should (eq B2 5))
|
||||||
(should (eq B2 5))
|
(ses-set A1 0)
|
||||||
(ses-setq A1 0)
|
(should (eq A1 0))
|
||||||
(should (eq A1 0))
|
(should (eq A2 2))
|
||||||
(should (eq A2 2))
|
(should (eq B2 4)))))
|
||||||
(should (eq B2 4))))))
|
|
||||||
|
|
||||||
(ert-deftest ses-setq-rcv-rcfq ()
|
(ert-deftest ses-set-rcv-rcf ()
|
||||||
"Set values and formulas, cells denoted by coordinates, formulas are expressions."
|
"Set values and formulas, cells denoted by coordinates, formulas are expressions."
|
||||||
(let ((ses-initial-size '(4 . 3))
|
(let ((ses-initial-size '(4 . 3))
|
||||||
(ses-after-entry-functions nil))
|
(ses-after-entry-functions nil)
|
||||||
(cl-progv
|
(A2-form '(+ A1 B1))
|
||||||
'(A2-form B2-form)
|
(B2-form '(+ B1 A2)))
|
||||||
'((+ A1 B1) (+ B1 A2))
|
(with-temp-buffer
|
||||||
(with-temp-buffer
|
(ses-mode)
|
||||||
(ses-mode)
|
(ses-set :: rcv
|
||||||
(ses-setq :: rcv
|
0 0 1; A1 := 1
|
||||||
0 0 1; A1 := 1
|
0 1 2; B1 := 2
|
||||||
0 1 2; B1 := 2
|
:: rcf
|
||||||
:: rcfq
|
1 0 A2-form; A2 := A1 + B1
|
||||||
1 0 A2-form; A2 := A1 + B1
|
1 1 B2-form; B2 := B1 + A2
|
||||||
1 1 B2-form; B2 := B1 + A2
|
)
|
||||||
)
|
(should (eq A1 1))
|
||||||
(should (eq A1 1))
|
(should (eq B1 2))
|
||||||
(should (eq B1 2))
|
(should (eq A2 3))
|
||||||
(should (eq A2 3))
|
(should (eq B2 5))
|
||||||
(should (eq B2 5))
|
(ses-set A1 0)
|
||||||
(ses-setq A1 0)
|
(should (eq A1 0))
|
||||||
(should (eq A1 0))
|
(should (eq A2 2))
|
||||||
(should (eq A2 2))
|
(should (eq B2 4)))))
|
||||||
(should (eq B2 4))))))
|
|
||||||
|
|
||||||
|
(ert-deftest ses-set-sv-sfq ()
|
||||||
|
"Set values and formulas, symbols expressions."
|
||||||
|
(let ((ses-initial-size '(4 . 3))
|
||||||
|
(ses-after-entry-functions nil)
|
||||||
|
(A1-sym 'A1)
|
||||||
|
(A2-sym 'A2))
|
||||||
|
(with-temp-buffer
|
||||||
|
(ses-mode)
|
||||||
|
(ses-set
|
||||||
|
:: sv
|
||||||
|
A1-sym 1; A1 := 1
|
||||||
|
'B1 2; B1 := 2
|
||||||
|
:: sf
|
||||||
|
A2-sym '(+ A1 B1); A2 := A1 + B1
|
||||||
|
:: sfq
|
||||||
|
'B2 (+ B1 A2); B2 := B1 + A2
|
||||||
|
)
|
||||||
|
(should (eq A1 1))
|
||||||
|
(should (eq B1 2))
|
||||||
|
(should (eq A2 3))
|
||||||
|
(should (eq B2 5))
|
||||||
|
(ses-set A1 0)
|
||||||
|
(should (eq A1 0))
|
||||||
|
(should (eq A2 2))
|
||||||
|
(should (eq B2 4)))))
|
||||||
|
|
||||||
(provide 'ses-tests)
|
(provide 'ses-tests)
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue