mirrors/org-mode
0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 18:00:49 +00:00
Code Releases Activity

org-clock: Handle DST in clocktable

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

27
lisp/org-clock.el
View file

@ -2681,6 +2681,15 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(if (= level 1) ""
(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)
"Step through the range to make a number of clock tables."
(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))
(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)
@ -2715,16 +2723,19 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(if (eq step0 'week)
(let ((dow (nth 6 (decode-time (seconds-to-time ts)))))
(if (<= dow ws) ts
(- ts (* 86400 (- dow ws)))))
(org-clocktable-increment-day ts ; decrement
(- ws dow))))
ts))
(while (< tsb te)
(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)))))
(let* ((start-time (seconds-to-time (max tsb ts)))
(dow (nth 6 (decode-time (seconds-to-time tsb))))
(days-to-skip (cond ((eq step0 'day) 1)
;; else 'week:
((= dow ws) 7)
(t (- ws dow)))))
(setq tsb (time-to-seconds (org-clocktable-increment-day tsb
days-to-skip)))
(insert "\n"
(if (eq step0 'day) "Daily report: "
"Weekly report starting on: ")

21
testing/lisp/test-org-clock.el
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"))
(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"))))))
;; 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 ()
"Test assignment of clock time to days in presence of \"org-extend-today-until\"."