From 100edaccd160c4e9e5a7dc06291eb0802e20e78e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 13 Oct 2018 16:22:43 +0200 Subject: [PATCH] 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 | 5 +- etc/ORG-NEWS | 1 + lisp/org-clock.el | 142 +++++++++++++++++++-------------- testing/lisp/test-org-clock.el | 106 +++++++++++++++++++++++- 4 files changed, 189 insertions(+), 65 deletions(-) diff --git a/doc/org-manual.org b/doc/org-manual.org index 84b7c7e83..636faaf99 100644 --- a/doc/org-manual.org +++ b/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= :: diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index aa1b774c4..fb02bdec8 100644 --- a/etc/ORG-NEWS +++ b/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-~, ~S-~, ~S-~, and ~S-~ now move cells in the corresponding direction by swapping with the adjacent cell. diff --git a/lisp/org-clock.el b/lisp/org-clock.el index ca05dfd71..3024df35b 100644 --- a/lisp/org-clock.el +++ b/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) diff --git a/testing/lisp/test-org-clock.el b/testing/lisp/test-org-clock.el index abb3637bd..3dcf25c5c 100644 --- a/testing/lisp/test-org-clock.el +++ b/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\"."