diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 8352f5abb..20bffbfbe 100644 --- a/lisp/org-clock.el +++ b/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) diff --git a/testing/lisp/test-org-clock.el b/testing/lisp/test-org-clock.el index 4f73dbcf7..1388c50df 100644 --- a/testing/lisp/test-org-clock.el +++ b/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