summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2015-05-11 01:20:37 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2015-05-11 01:20:37 +0200
commitc0dec9a8bcfd4bf3bceb330348a4d01e35c2ae25 (patch)
tree53c56d2d97ec3c49aaae16b460834fcff4b6f978
parent56d9834acc66fd50ef6f24eab9e85b7d80452261 (diff)
downloadorg-mode-c0dec9a8bcfd4bf3bceb330348a4d01e35c2ae25.tar.gz
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>
-rw-r--r--lisp/org-table.el46
-rw-r--r--testing/lisp/test-org-table.el41
2 files changed, 68 insertions, 19 deletions
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 89f8733..8a6e22b 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -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.
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index e619cbc..a8f4ff2 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -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