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

org-table: Fix durations extracted from node properties 

* lisp/org-table.el (org-table-formula-substitute-names): Convert
  durations when needed.  Refactor code.

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

Reported-by: Daniele Pizzolli <dan@toel.it>
<http://permalink.gmane.org/gmane.emacs.orgmode/97252>
This commit is contained in:
Nicolas Goaziou 2015-05-11 01:20:37 +02:00
parent 56d9834acc
commit c0dec9a8bc
2 changed files with 68 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lisp/org-table.el
View File

@ -3417,25 +3417,33 @@ borders of the table using the @< @> $< $> makers."
(defun org-table-formula-substitute-names (f)
"Replace $const with values in string F."
(let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
;; First, check for column names
(while (setq start (string-match org-table-column-name-regexp f start))
(setq start (1+ start))
(setq a (assoc (match-string 1 f) org-table-column-names))
(setq f (replace-match (concat "$" (cdr a)) t t f)))
;; Parameters and constants
(setq start 0)
(while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" f start))
(if (match-end 2)
(setq start (match-end 2))
(setq start (1+ start))
(if (setq a (save-match-data
(org-table-get-constant (match-string 1 f))))
(setq f (replace-match
(concat (if pp "(") a (if pp ")")) t t f)))))
(if org-table-formula-debug
(put-text-property 0 (length f) :orig-formula f1 f))
f))
(let ((start 0)
(pp (/= (string-to-char f) ?'))
(duration (org-string-match-p ";.*[Tt].*\\'" f))
(new (replace-regexp-in-string ; Check for column names.
org-table-column-name-regexp
(lambda (m)
(concat "$" (cdr (assoc (match-string 1 m)
org-table-column-names))))
f t t)))
;; Parameters and constants.
(while (setq start
(string-match
"\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)"
new start))
(if (match-end 2) (setq start (match-end 2))
(incf start)
;; When a duration is expected, convert value on the fly.
(let ((value
(save-match-data
(let ((v (org-table-get-constant (match-string 1 new))))
(if (and (org-string-nw-p v) duration)
(org-table-time-string-to-seconds v)
v)))))
(when value
(setq new (replace-match
(concat (and pp "(") value (and pp ")")) t t new))))))
(if org-table-formula-debug (org-propertize new :orig-formula f)) new))
(defun org-table-get-constant (const)
"Find the value for a parameter or constant in a formula.

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

@ -1722,6 +1722,47 @@ is t, then new columns should be added as needed"
1
"#+TBLFM: $3=15")))
(ert-deftest test-org-table/duration ()
"Test durations in table formulas."
;; Durations in cells.
(should
(string-match "| 2:12 | 1:47 | 03:59:00 |"
(org-test-with-temp-text "
| 2:12 | 1:47 | |
<point>#+TBLFM: @1$3=$1+$2;T"
(org-table-calc-current-TBLFM)
(buffer-string))))
(should
(string-match "| 3:02:20 | -2:07:00 | 0.92 |"
(org-test-with-temp-text "
| 3:02:20 | -2:07:00 | |
<point>#+TBLFM: @1$3=$1+$2;t"
(org-table-calc-current-TBLFM)
(buffer-string))))
;; Durations set through properties.
(should
(string-match "| 16:00:00 |"
(org-test-with-temp-text "* H
:PROPERTIES:
:time_constant: 08:00:00
:END:
| |
<point>#+TBLFM: $1=2*$PROP_time_constant;T"
(org-table-calc-current-TBLFM)
(buffer-string))))
(should
(string-match "| 16.00 |"
(org-test-with-temp-text "* H
:PROPERTIES:
:time_constant: 08:00:00
:END:
| |
<point>#+TBLFM: $1=2*$PROP_time_constant;t"
(org-table-calc-current-TBLFM)
(buffer-string)))))
(provide 'test-org-table)
;;; test-org-table.el ends here