Browse Source

org-table.el: Implement computation of durations with "T" flag

* install/git/org-mode/lisp/org-table.el
(org-table-time-string-to-seconds)
(org-table-time-seconds-to-string): New functions.
(org-table-eval-formula): Implement the "T" (time) flag for
computing durations.
Bastien Guerry 14 years ago
parent
commit
12687ad200
1 changed files with 38 additions and 8 deletions
  1. 38 8
      lisp/org-table.el

+ 38 - 8
lisp/org-table.el

@@ -2391,7 +2391,7 @@ not overwrite the stored one."
 	   (modes (copy-sequence org-calc-default-modes))
 	   (modes (copy-sequence org-calc-default-modes))
 	   (numbers nil) ; was a variable, now fixed default
 	   (numbers nil) ; was a variable, now fixed default
 	   (keep-empty nil)
 	   (keep-empty nil)
-	   n form form0 bw fmt x ev orig c lispp literal)
+	   n form form0 bw fmt x ev orig c lispp literal duration)
       ;; Parse the format string.  Since we have a lot of modes, this is
       ;; Parse the format string.  Since we have a lot of modes, this is
       ;; a lot of work.  However, I think calc still uses most of the time.
       ;; a lot of work.  However, I think calc still uses most of the time.
       (if (string-match ";" formula)
       (if (string-match ";" formula)
@@ -2410,8 +2410,11 @@ not overwrite the stored one."
 						   (?s . sci) (?e . eng))))
 						   (?s . sci) (?e . eng))))
 				   n))))
 				   n))))
 	      (setq fmt (replace-match "" t t fmt)))
 	      (setq fmt (replace-match "" t t fmt)))
-	    (if (string-match "[NT]" fmt)
-		(setq numbers (equal (match-string 0 fmt) "N")
+	    (if (string-match "T" fmt)
+		(setq duration t numbers t
+		      fmt (replace-match "" t t fmt)))
+	    (if (string-match "N" fmt)
+		(setq numbers t
 		      fmt (replace-match "" t t fmt)))
 		      fmt (replace-match "" t t fmt)))
 	    (if (string-match "L" fmt)
 	    (if (string-match "L" fmt)
 		(setq literal t
 		(setq literal t
@@ -2428,10 +2431,14 @@ not overwrite the stored one."
 	  (setq formula (org-table-formula-substitute-names formula)))
 	  (setq formula (org-table-formula-substitute-names formula)))
       (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
       (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
       (while (> ndown 0)
       (while (> ndown 0)
-	(setq fields (org-split-string
-		      (org-no-properties
-		       (buffer-substring (point-at-bol) (point-at-eol)))
-		      " *| *"))
+	(setq fields 
+	      (mapcar (lambda (cell)
+			(let ((duration (org-table-time-string-to-seconds cell)))
+			  (if duration (number-to-string duration) cell)))
+		      (org-split-string
+		       (org-no-properties
+			(buffer-substring (point-at-bol) (point-at-eol)))
+		       " *| *")))
 	(if (eq numbers t)
 	(if (eq numbers t)
 	    (setq fields (mapcar
 	    (setq fields (mapcar
 			  (lambda (x) (number-to-string (string-to-number x)))
 			  (lambda (x) (number-to-string (string-to-number x)))
@@ -2504,7 +2511,9 @@ not overwrite the stored one."
 	    (setq ev (condition-case nil
 	    (setq ev (condition-case nil
 			 (eval (eval (read form)))
 			 (eval (eval (read form)))
 		       (error "#ERROR"))
 		       (error "#ERROR"))
-		  ev (if (numberp ev) (number-to-string ev) ev))
+		  ev (if (numberp ev) (number-to-string ev) ev)
+		  ev (if duration (org-table-time-seconds-to-string 
+				   (string-to-number ev))))
 	  (or (fboundp 'calc-eval)
 	  (or (fboundp 'calc-eval)
 	      (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
 	      (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
 	  (setq ev (calc-eval (cons form modes)
 	  (setq ev (calc-eval (cons form modes)
@@ -3192,6 +3201,27 @@ For example:  28 -> AB."
 	    n (/ (1- n) 26)))
 	    n (/ (1- n) 26)))
     s))
     s))
 
 
+(defun org-table-time-string-to-seconds (s)
+  "Convert a time string into numerical duration in seconds."
+  (cond
+   ((and (stringp s)
+	 (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
+    (let ((hour (string-to-number (match-string 1 s)))
+	  (min (string-to-number (match-string 2 s)))
+	  (sec (string-to-number (match-string 3 s))))
+      (+ (* hour 3600) (* min 60) sec)))
+   ((and (stringp s)
+	 (string-match "\\([0-9]+\\):\\([0-9]+\\)" s))
+    (let ((min (string-to-number (match-string 1 s)))
+	  (sec (string-to-number (match-string 2 s))))
+      (+ (* min 60) sec)))))
+
+(defun org-table-time-seconds-to-string (secs)
+  "Convert a number of seconds to a time string."
+  (cond ((>= secs 3600) (format-seconds "%h:%.2m:%.2s" secs))
+	((>= secs 60) (format-seconds "%m:%.2s" secs))
+	(t (format-seconds "%s" secs))))
+
 (defun org-table-fedit-convert-buffer (function)
 (defun org-table-fedit-convert-buffer (function)
   "Convert all references in this buffer, using FUNCTION."
   "Convert all references in this buffer, using FUNCTION."
   (let ((line (org-current-line)))
   (let ((line (org-current-line)))