tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

org-table: Fix "$<" constructs in formulas 

* lisp/org-table.el (org-table-recalculate): Expand "$<" without
  returning an error.  Small refactoring.

* testing/lisp/test-org-table.el (test-org-table/first-rc): New test.

Reported-by: Stefan Nobis <stefan-ml@snobis.de>
<http://permalink.gmane.org/gmane.emacs.orgmode/103693>
This commit is contained in:
Nicolas Goaziou 2015-12-18 22:30:41 +01:00
parent 5761580def
commit 713fe873b7
2 changed files with 36 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
lisp/org-table.el
View File

@ -3129,44 +3129,39 @@ known that the table will be realigned a little later anyway."
(org-table-analyze)
(let* ((eqlist (sort (org-table-get-stored-formulas)
(lambda (a b) (string< (car a) (car b)))))
(eqlist1 (copy-sequence eqlist))
(inhibit-redisplay (not debug-on-error))
(line-re org-table-dataline-regexp)
(log-first-time (current-time))
(log-last-time log-first-time)
(cnt 0)
beg end eqlcol eqlfield)
;; Insert constants in all formulas
;; Insert constants in all formulas.
(when eqlist
(org-table-save-field
(setq eqlist
(mapcar
(lambda (x)
(when (string-match "\\`@-?I+" (car x))
(user-error "Can't assign to hline relative reference"))
(when (string-match "\\`$[<>]" (car x))
(let ((old-lhs (car x)))
(setq x
(cons
(substring
(org-table-formula-handle-first/last-rc old-lhs)
1)
(cdr x)))
(when (assoc (car x) eqlist1)
(user-error "\"%s=\" formula tries to overwrite \
existing formula for column %s"
old-lhs
(car x)))))
(cons (org-table-formula-handle-first/last-rc (car x))
(org-table-formula-substitute-names
(org-table-formula-handle-first/last-rc (cdr x)))))
eqlist))
;; Split the equation list between column formulas and field
;; formulas.
;; Expand equations, then split the equation list between
;; column formulas and field formulas.
(dolist (eq eqlist)
(if (org-string-match-p "\\`\\$[0-9]+\\'" (car eq))
(push eq eqlcol)
(push eq eqlfield)))
(let* ((rhs (org-table-formula-substitute-names
(org-table-formula-handle-first/last-rc (cdr eq))))
(old-lhs (car eq))
(lhs
(org-table-formula-handle-first/last-rc
(cond
((string-match "\\`@-?I+" old-lhs)
(user-error "Can't assign to hline relative reference"))
((string-match "\\`$[<>]" old-lhs)
(let ((new (org-table-formula-handle-first/last-rc
old-lhs)))
(when (assoc new eqlist)
(user-error "\"%s=\" formula tries to overwrite \
existing formula for column %s"
old-lhs
new))
new))
(t old-lhs)))))
(if (org-string-match-p "\\`\\$[0-9]+\\'" lhs)
(push (cons lhs rhs) eqlcol)
(push (cons lhs rhs) eqlfield))))
(setq eqlcol (nreverse eqlcol))
;; Expand ranges in lhs of formulas
(setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))

12
testing/lisp/test-org-table.el
View File

@ -1835,6 +1835,18 @@ is t, then new columns should be added as needed"
(org-table-calc-current-TBLFM)
(buffer-string)))))
(ert-deftest test-org-table/first-rc ()
"Test \"$<\" constructs in formulas."
(should
(org-string-match-p
"| 1 | 2 |"
(org-test-with-temp-text
"| | 2 |
<point>#+TBLFM: $<=1"
(org-table-calc-current-TBLFM)
(buffer-string)))))
(provide 'test-org-table)
;;; test-org-table.el ends here