Implement `month' and `year' steps in clock tables

* doc/org-manual.org (The clock table): Update manual.
* lisp/org-clock.el (org-clocktable-steps): Rewrite function.  Add
  `month' and `year' steps.
* testing/lisp/test-org-clock.el (test-org-clock/clocktable/step): Add
  tests.

doc/org-manual.org

@@ -6616,8 +6616,9 @@ be selected:
 
 - =:step= ::
 
-     Set to ~week~ or ~day~ to split the table into chunks.  To use
-     this, ~:block~ or ~:tstart~, ~:tend~ are needed.
+     Set to =day=, =week=, =month= or =year= to split the table into
+     chunks.  To use this, either =:block=, or =:tstart= and =:tend=
+     are required.
 
 - =:stepskip0= ::
 

etc/ORG-NEWS

@@ -47,6 +47,7 @@ system than the main Org document.  For example:
 ,#+INCLUDE: "myfile.cmd" src cmd :coding cp850-dos
 #+end_example
 
+*** New values in clock tables' step: =month= and =year=
 *** New cell movement functions in tables
 ~S-<UP>~, ~S-<DOWN>~, ~S-<RIGHT>~, and ~S-<LEFT>~ now move cells in
 the corresponding direction by swapping with the adjacent cell.

lisp/org-clock.el

@@ -2682,69 +2682,87 @@ LEVEL is an integer.  Indent by two spaces per level above 1."
     (concat "\\_" (make-string (* 2 (1- level)) ?\s))))
 
 (defun org-clocktable-steps (params)
-  "Step through the range to make a number of clock tables."
-  (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)
-	    te (nth 1 cc)))
-    (cond
-     ((numberp ts)
-      ;; If ts is a number, it's an absolute day number from
-      ;; org-agenda.
-      (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts)))
-	(setq ts (float-time (encode-time 0 0 0 day month year)))))
-     (ts
-      (setq ts (float-time (apply #'encode-time (org-parse-time-string ts))))))
-    (cond
-     ((numberp te)
-      ;; Likewise for te.
-      (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te)))
-	(setq te (float-time (encode-time 0 0 0 day month year)))))
-     (te
-      (setq te (float-time (apply #'encode-time (org-parse-time-string te))))))
-    (setq tsb
-	  (if (eq step0 'week)
-	      (let ((dow (nth 6 (decode-time (seconds-to-time ts)))))
-		(if (<= dow ws) ts
-		  (- ts (* 86400 (- dow ws)))))
-	    ts))
-    (while (< tsb te)
+  "Create one ore more clock tables, according to PARAMS.
+Step through the range specifications in plist PARAMS to make
+a number of clock tables."
+  (let* ((ignore-empty-tables (plist-get params :stepskip0))
+         (step (plist-get params :step))
+         (step-header
+          (pcase step
+            (`day "Daily report: ")
+            (`week "Weekly report starting on: ")
+            (`month "Monthly report starting on: ")
+            (`year "Annual report starting on: ")
+            (_ (user-error "Unknown `:step' specification: %S" step))))
+         (week-start (or (plist-get params :wstart) 1))
+         (month-start (or (plist-get params :mstart) 1))
+         (range
+          (pcase (plist-get params :block)
+            (`nil nil)
+            (range
+             (org-clock-special-range range nil t week-start month-start))))
+         ;; For both START and END, any number is an absolute day
+         ;; number from Agenda.  Otherwise, consider value to be an Org
+         ;; timestamp string.  The `:block' property has precedence
+         ;; over `:tstart' and `:tend'.
+         (start
+          (apply #'encode-time
+                 (pcase (if range (car range) (plist-get params :tstart))
+                   ((and (pred numberp) n)
+                    (pcase-let
+                        ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
+                      (list 0 0 org-extend-today-until d m y)))
+                   (timestamp (org-parse-time-string timestamp)))))
+         (end
+          (apply #'encode-time
+                 (pcase (if range (nth 1 range) (plist-get params :tend))
+                   ((and (pred numberp) n)
+                    (pcase-let
+                        ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
+                      (list 0 0 org-extend-today-until d m y)))
+                   (timestamp (org-parse-time-string timestamp))))))
+    (while (time-less-p start end)
       (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))))
+      ;; Insert header before each clock table.
+      (insert "\n"
+              step-header
+              (format-time-string (org-time-stamp-format nil t) start)
+	      "\n")
+      ;; Compute NEXT, which is the end of the current clock table,
+      ;; according to step.
+      (let* ((next
+              (apply #'encode-time
+                     (pcase-let
+                         ((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
+                       (pcase step
+                         (`day (list 0 0 org-extend-today-until (1+ d) m y))
+                         (`week
+                          (let ((offset (if (= dow week-start) 7
+                                          (mod (- week-start dow) 7))))
+                            (list 0 0 org-extend-today-until (+ d offset) m y)))
+                         (`month (list 0 0 0 month-start (1+ m) y))
+                         (`year (list 0 0 org-extend-today-until 1 1 (1+ y)))))))
+             (table-begin (line-beginning-position 0))
+	     (step-time
+              ;; Write clock table between START and NEXT.
+	      (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)
+		             :tend (format-time-string
+                                    (org-time-stamp-format t t)
+                                    ;; Never include clocks past END.
+                                    (if (time-less-p end next) end next)))))))
+	(let ((case-fold-search t)) (re-search-forward "^[ \t]*#\\+END:"))
+	;; Remove the table if it is empty and `:stepskip0' is
+	;; non-nil.
+	(when (and ignore-empty-tables (equal step-time 0))
+	  (delete-region (line-beginning-position) table-begin))
+        (setq start next))
       (end-of-line 0))))
 
 (defun org-clock-get-table-data (file params)

testing/lisp/test-org-clock.el

@@ -977,7 +977,111 @@ 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")))))))
+			  ":tend \"<2017-12-27 Wed 23:59>\" :stepskip0 t"))))))
+  ;; Test :step week", without or with ":wstart" parameter.
+  (should
+   (equal "
+Weekly report starting on: [2012-03-26 Mon]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |
+
+Weekly report starting on: [2012-04-02 Mon]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |
+"
+	  (org-test-with-temp-text
+	      "* Foo
+CLOCK: [2012-03-29 Thu 08:00]--[2012-03-29 Thu 16:00] =>  8:00
+CLOCK: [2012-04-03 Thu 08:00]--[2012-04-03 Thu 16:00] =>  8:00"
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  ":step week :block 2012 :stepskip0 t")))))
+  (should
+   (equal "
+Weekly report starting on: [2012-03-29 Thu]
+| Headline     | Time    |
+|--------------+---------|
+| *Total time* | *16:00* |
+|--------------+---------|
+| Foo          | 16:00   |
+"
+	  (org-test-with-temp-text
+	      "* Foo
+CLOCK: [2012-03-29 Thu 08:00]--[2012-03-29 Thu 16:00] =>  8:00
+CLOCK: [2012-04-03 Thu 08:00]--[2012-04-03 Thu 16:00] =>  8:00"
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  ":step week :wstart 4 :block 2012 :stepskip0 t")))))
+  ;; Test ":step month" without and with ":mstart".
+  (should
+   (equal "
+Monthly report starting on: [2014-03-01 Sat]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |
+
+Monthly report starting on: [2014-04-01 Tue]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |
+"
+	  (org-test-with-temp-text
+	      "* Foo
+CLOCK: [2014-03-04 Tue 08:00]--[2014-03-04 Tue 16:00] =>  8:00
+CLOCK: [2014-04-03 Thu 08:00]--[2014-04-03 Thu 16:00] =>  8:00"
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  ":step month :block 2014 :stepskip0 t")))))
+  (should
+   (equal "
+Monthly report starting on: [2014-03-04 Tue]
+| Headline     | Time    |
+|--------------+---------|
+| *Total time* | *16:00* |
+|--------------+---------|
+| Foo          | 16:00   |
+"
+	  (org-test-with-temp-text
+	      "* Foo
+CLOCK: [2014-03-04 Tue 08:00]--[2014-03-04 Tue 16:00] =>  8:00
+CLOCK: [2014-04-03 Thu 08:00]--[2014-04-03 Thu 16:00] =>  8:00"
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  ":step month :mstart 4 :block 2014 :stepskip0 t")))))
+  ;; Test ":step year".
+  (should
+   (equal "
+Annual report starting on: [2012-01-01 Sun]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |
+
+Annual report starting on: [2014-01-01 Wed]
+| Headline     | Time   |
+|--------------+--------|
+| *Total time* | *8:00* |
+|--------------+--------|
+| Foo          | 8:00   |
+"
+	  (org-test-with-temp-text
+	      "* Foo
+CLOCK: [2012-03-29 Thu 08:00]--[2012-03-29 Thu 16:00] =>  8:00
+CLOCK: [2014-03-04 Tue 08:00]--[2014-03-04 Tue 16:00] =>  8:00"
+	    (let ((system-time-locale "en_US"))
+	      (test-org-clock-clocktable-contents
+		  ":step year :block untilnow :stepskip0 t"))))))
 
 (ert-deftest test-org-clock/clocktable/extend-today-until ()
   "Test assignment of clock time to days in presence of \"org-extend-today-until\"."