From c0dec9a8bcfd4bf3bceb330348a4d01e35c2ae25 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Mon, 11 May 2015 01:20:37 +0200
Subject: [PATCH] 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>
---
 lisp/org-table.el              | 46 ++++++++++++++++++++--------------
 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 89f8733dc..8a6e22b67 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 e619cbc3d..a8f4ff2c2 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