Browse Source

org-clock: Consider hours when splitting the table with :steps

* lisp/org-clock.el (org-clocktable-steps): Check time when :tstart
  and :tend are defined.
* testing/lisp/test-org-clock.el (test-org-clock/clocktable/step): Add
  tests.

Reported-by: savoie@nsidc.org
<http://lists.gnu.org/r/emacs-orgmode/2018-01/msg00227.html>
Nicolas Goaziou 1 year ago
parent
commit
8c7a14a850
2 changed files with 74 additions and 44 deletions
  1. 37 38
      lisp/org-clock.el
  2. 37 6
      testing/lisp/test-org-clock.el

+ 37 - 38
lisp/org-clock.el

@@ -2694,16 +2694,15 @@ LEVEL is an integer.  Indent by two spaces per level above 1."
 
 (defun org-clocktable-steps (params)
   "Step through the range to make a number of clock tables."
-  (let* ((p1 (copy-sequence params))
-	 (ts (plist-get p1 :tstart))
-	 (te (plist-get p1 :tend))
-	 (ws (plist-get p1 :wstart))
-	 (ms (plist-get p1 :mstart))
-	 (step0 (plist-get p1 :step))
-	 (step (cdr (assoc step0 '((day . 86400) (week . 604800)))))
-	 (stepskip0 (plist-get p1 :stepskip0))
-	 (block (plist-get p1 :block))
-	 cc step-time tsb)
+  (let* ((ts (plist-get params :tstart))
+	 (te (plist-get params :tend))
+	 (ws (plist-get params :wstart))
+	 (ms (plist-get params :mstart))
+	 (step0 (plist-get params :step))
+	 (step (cdr (assq step0 '((day . 86400) (week . 604800)))))
+	 (stepskip0 (plist-get params :stepskip0))
+	 (block (plist-get params :block))
+	 cc tsb)
     (when block
       (setq cc (org-clock-special-range block nil t ws ms)
 	    ts (car cc)
@@ -2726,37 +2725,37 @@ LEVEL is an integer.  Indent by two spaces per level above 1."
     (setq tsb
 	  (if (eq step0 'week)
 	      (let ((dow (nth 6 (decode-time (seconds-to-time ts)))))
-		(if (< dow ws) ts
+		(if (<= dow ws) ts
 		  (- ts (* 86400 (- dow ws)))))
 	    ts))
-    (setq p1 (plist-put p1 :header ""))
-    (setq p1 (plist-put p1 :step nil))
-    (setq p1 (plist-put p1 :block nil))
     (while (< tsb te)
-      (or (bolp) (insert "\n"))
-      (setq p1 (plist-put p1 :tstart (format-time-string
-				      (org-time-stamp-format nil t)
-				      (seconds-to-time (max tsb ts)))))
-      (cl-incf tsb (let ((dow (nth 6 (decode-time (seconds-to-time tsb)))))
-		     (if (or (eq step0 'day)
-			     (= dow ws))
-			 step
-		       (* 86400 (- ws dow)))))
-      (setq p1 (plist-put p1 :tend (format-time-string
-				    (org-time-stamp-format nil t)
-				    (seconds-to-time (min te tsb)))))
-      (insert "\n" (if (eq step0 'day) "Daily report: "
-		     "Weekly report starting on: ")
-	      (plist-get p1 :tstart) "\n")
-      (setq step-time (org-dblock-write:clocktable p1))
-      (re-search-forward "^[ \t]*#\\+END:")
-      (when (and (equal step-time 0) stepskip0)
-	;; Remove the empty table
-	(delete-region (point-at-bol)
-		       (save-excursion
-			 (re-search-backward "^\\(Daily\\|Weekly\\) report"
-					     nil t)
-			 (point))))
+      (unless (bolp) (insert "\n"))
+      (let ((start-time (seconds-to-time (max tsb ts))))
+	(cl-incf tsb (let ((dow (nth 6 (decode-time (seconds-to-time tsb)))))
+		       (if (or (eq step0 'day)
+			       (= dow ws))
+			   step
+			 (* 86400 (- ws dow)))))
+	(insert "\n"
+		(if (eq step0 'day) "Daily report: "
+		  "Weekly report starting on: ")
+		(format-time-string (org-time-stamp-format nil t) start-time)
+		"\n")
+	(let ((table-begin (line-beginning-position 0))
+	      (step-time
+	       (org-dblock-write:clocktable
+		(org-combine-plists
+		 params
+		 (list
+		  :header "" :step nil :block nil
+		  :tstart (format-time-string (org-time-stamp-format t t)
+					      start-time)
+		  :tend (format-time-string (org-time-stamp-format t t)
+					    (seconds-to-time (min te tsb))))))))
+	  (re-search-forward "^[ \t]*#\\+END:")
+	  (when (and stepskip0 (equal step-time 0))
+	    ;; Remove the empty table
+	    (delete-region (line-beginning-position) table-begin))))
       (end-of-line 0))))
 
 (defun org-clock-get-table-data (file params)

+ 37 - 6
testing/lisp/test-org-clock.el

@@ -840,14 +840,14 @@ Weekly report starting on: [2017-09-25 Mon]
 | *Total time* | *1:00* |
 |--------------+--------|
 | Foo          | 1:00   |"
-    (org-test-with-temp-text
-	"* Foo
+	  (org-test-with-temp-text
+	      "* Foo
 CLOCK: [2017-09-30 Sat 12:00]--[2017-09-30 Sat 13:00] =>  1:00
 CLOCK: [2017-10-01 Sun 11:00]--[2017-10-01 Sun 13:00] =>  2:00
 CLOCK: [2017-10-02 Mon 11:00]--[2017-10-02 Mon 14:00] =>  3:00"
-      (let ((system-time-locale "en_US"))
-	(test-org-clock-clocktable-contents
-	    ":step week :block 2017-09 :stepskip0 t")))))
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  ":step week :block 2017-09 :stepskip0 t")))))
   (should
    (equal "
 Weekly report starting on: [2017-10-01 Sun]
@@ -931,7 +931,38 @@ CLOCK: [2017-10-08 Sun 09:00]--[2017-10-08 Sun 13:00] =>  4:00
 CLOCK: [2017-10-09 Mon 09:00]--[2017-10-09 Mon 14:00] =>  5:00"
 	    (let ((system-time-locale "en_US"))
 	      (test-org-clock-clocktable-contents
-		  ":step day :block 2017-W40"))))))
+		  ":step day :block 2017-W40")))))
+  ;; Regression test: take :tstart and :tend hours into consideration.
+  (should
+   (equal "
+Weekly report starting on: [2017-12-25 Mon]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |"
+	  (org-test-with-temp-text
+	      "* Foo
+CLOCK: [2017-12-27 Wed 08:00]--[2017-12-27 Wed 16:00] =>  8:00"
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  (concat ":step week :tstart \"<2017-12-25 Mon>\" "
+			  ":tend \"<2017-12-27 Wed 23:59>\""))))))
+  (should
+   (equal "
+Daily report: [2017-12-27 Wed]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |"
+	  (org-test-with-temp-text
+	      "* Foo
+CLOCK: [2017-12-27 Wed 08:00]--[2017-12-27 Wed 16:00] =>  8:00"
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  (concat ":step day :tstart \"<2017-12-25 Mon>\" "
+			  ":tend \"<2017-12-27 Wed 23:59>\" :stepskip0 t")))))))
 
 (provide 'test-org-clock)
 ;;; test-org-clock.el end here