diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-05-11 01:20:37 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-05-11 01:20:37 +0200 |
commit | c0dec9a8bcfd4bf3bceb330348a4d01e35c2ae25 (patch) | |
tree | 53c56d2d97ec3c49aaae16b460834fcff4b6f978 | |
parent | 56d9834acc66fd50ef6f24eab9e85b7d80452261 (diff) | |
download | org-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.el | 46 | ||||
-rw-r--r-- | testing/lisp/test-org-table.el | 41 |
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 |