org-clock: Handle DST in clocktable

* lisp/org-clock.el (org-clocktable-steps): new fn
  org-clocktable-increment-day to add/subtract days that are not
  exactly 24 hours
* testing/lisp/test-org-clock.el (test-org-clock/clocktable/step): Add
  test for DST.
This commit is contained in:
Kevin Brubeck Unhammer 2018-11-01 13:59:09 +01:00 committed by Nicolas Goaziou
parent 67cea44c9f
commit 17deb1c7eb
2 changed files with 39 additions and 9 deletions

View File

@ -2681,6 +2681,15 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(if (= level 1) "" (if (= level 1) ""
(concat "\\_" (make-string (* 2 (1- level)) ?\s)))) (concat "\\_" (make-string (* 2 (1- level)) ?\s))))
(defun org-clocktable-increment-day (ts &optional n)
"Increment day in TS by N (defaulting to 1).
The TS argument has the same type as the return values of
`float-time' or `current-time'."
(let ((tsd (decode-time ts)))
(cl-incf (nth 3 tsd) (or n 1))
(setf (nth 8 tsd) nil) ; no time zone: increasing day skips one whole day
(apply 'encode-time tsd)))
(defun org-clocktable-steps (params) (defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables." "Step through the range to make a number of clock tables."
(let* ((ts (plist-get params :tstart)) (let* ((ts (plist-get params :tstart))
@ -2688,7 +2697,6 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(ws (plist-get params :wstart)) (ws (plist-get params :wstart))
(ms (plist-get params :mstart)) (ms (plist-get params :mstart))
(step0 (plist-get params :step)) (step0 (plist-get params :step))
(step (cdr (assq step0 '((day . 86400) (week . 604800)))))
(stepskip0 (plist-get params :stepskip0)) (stepskip0 (plist-get params :stepskip0))
(block (plist-get params :block)) (block (plist-get params :block))
cc tsb) cc tsb)
@ -2715,16 +2723,19 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(if (eq step0 'week) (if (eq step0 'week)
(let ((dow (nth 6 (decode-time (seconds-to-time ts))))) (let ((dow (nth 6 (decode-time (seconds-to-time ts)))))
(if (<= dow ws) ts (if (<= dow ws) ts
(- ts (* 86400 (- dow ws))))) (org-clocktable-increment-day ts ; decrement
(- ws dow))))
ts)) ts))
(while (< tsb te) (while (< tsb te)
(unless (bolp) (insert "\n")) (unless (bolp) (insert "\n"))
(let ((start-time (seconds-to-time (max tsb ts)))) (let* ((start-time (seconds-to-time (max tsb ts)))
(cl-incf tsb (let ((dow (nth 6 (decode-time (seconds-to-time tsb))))) (dow (nth 6 (decode-time (seconds-to-time tsb))))
(if (or (eq step0 'day) (days-to-skip (cond ((eq step0 'day) 1)
(= dow ws)) ;; else 'week:
step ((= dow ws) 7)
(* 86400 (- ws dow))))) (t (- ws dow)))))
(setq tsb (time-to-seconds (org-clocktable-increment-day tsb
days-to-skip)))
(insert "\n" (insert "\n"
(if (eq step0 'day) "Daily report: " (if (eq step0 'day) "Daily report: "
"Weekly report starting on: ") "Weekly report starting on: ")

View File

@ -977,7 +977,26 @@ CLOCK: [2017-12-27 Wed 08:00]--[2017-12-27 Wed 16:00] => 8:00"
(let ((system-time-locale "en_US")) (let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents (test-org-clock-clocktable-contents
(concat ":step day :tstart \"<2017-12-25 Mon>\" " (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"))))))
;; Regression test: Respect DST
(should
(equal "
Daily report: [2018-10-29 Mon]
| Headline | Time |
|--------------+--------|
| *Total time* | *8:00* |
|--------------+--------|
| Foo | 8:00 |
"
(org-test-with-temp-text
"* Foo
CLOCK: [2018-10-29 Mon 08:00]--[2018-10-29 Mon 16:00] => 8:00"
(let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents
(concat ":step day "
":stepskip0 t "
":tstart \"2018-10-01\" "
":tend \"2018-11-01\"")))))))
(ert-deftest test-org-clock/clocktable/extend-today-until () (ert-deftest test-org-clock/clocktable/extend-today-until ()
"Test assignment of clock time to days in presence of \"org-extend-today-until\"." "Test assignment of clock time to days in presence of \"org-extend-today-until\"."