mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-08-24 19:02:52 +00:00
org-clock.el: Fix week start != 1
* lisp/org-clock.el (org-clock-special-range): Prevent returning previous week for `thisweek' KEY when WSTART is 0. Treat both 0 and 7 as Sunday. * testing/lisp/test-org-clock.el (test-org-clock/special-range): New test for `thisweek' and various WSTART arguments. It seems only the case of weeks starting on Monday was tested. Other variants caused shifted intervals. Bug report: Marcin Borkowski. What is a week? Mon, 10 Apr 2023 05:35:44 +0200. <https://list.orgmode.org/87h6to1ka7.fsf@mbork.pl>
This commit is contained in:
parent
8944124edf
commit
ed0cfbd7b5
|
@ -2389,7 +2389,7 @@ have priority."
|
|||
d (+ d shift)))
|
||||
((or `week `thisweek)
|
||||
(let* ((ws (or wstart 1))
|
||||
(diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))))
|
||||
(diff (+ (* -7 shift) (mod (+ dow 7 (- ws)) 7))))
|
||||
(setq m 0 h org-extend-today-until d (- d diff) d1 (+ 7 d))))
|
||||
((or `month `thismonth)
|
||||
(setq h org-extend-today-until m 0 d (or mstart 1)
|
||||
|
|
|
@ -1325,5 +1325,57 @@ Variables'."
|
|||
"<after> ")
|
||||
(org-clock-out))))))
|
||||
|
||||
;;; Helpers
|
||||
|
||||
(ert-deftest test-org-clock/special-range ()
|
||||
"Test `org-clock-special-range'."
|
||||
(let* ((cases
|
||||
'((("2023-04-23 Sun" "2023-04-24 Mon" "2023-04-25 Tue" "2023-04-26 Wed"
|
||||
"2023-04-27 Thu" "2023-04-28 Fri" "2023-04-29 Sat")
|
||||
thisweek 0
|
||||
"2023-04-23 Sun" "2023-04-30 Sun")
|
||||
(("2023-04-24 Mon" "2023-04-25 Tue" "2023-04-26 Wed"
|
||||
"2023-04-27 Thu" "2023-04-28 Fri" "2023-04-29 Sat" "2023-04-30 Sun")
|
||||
thisweek 1
|
||||
"2023-04-24 Mon" "2023-05-01 Mon")
|
||||
(("2023-04-24 Mon" "2023-04-25 Tue" "2023-04-26 Wed"
|
||||
"2023-04-27 Thu" "2023-04-28 Fri" "2023-04-29 Sat" "2023-04-30 Sun")
|
||||
thisweek nil ; Copy of 1.
|
||||
"2023-04-24 Mon" "2023-05-01 Mon")
|
||||
(("2023-04-22 Sat"
|
||||
"2023-04-23 Sun" "2023-04-24 Mon" "2023-04-25 Tue" "2023-04-26 Wed"
|
||||
"2023-04-27 Thu" "2023-04-28 Fri")
|
||||
thisweek 6
|
||||
"2023-04-22 Sat" "2023-04-29 Sat")
|
||||
(("2023-04-23 Sun" "2023-04-24 Mon" "2023-04-25 Tue" "2023-04-26 Wed"
|
||||
"2023-04-27 Thu" "2023-04-28 Fri" "2023-04-29 Sat")
|
||||
thisweek 7 ; Copy of 0.
|
||||
"2023-04-23 Sun" "2023-04-30 Sun")))
|
||||
(failed
|
||||
(delq
|
||||
nil
|
||||
(mapcar (lambda (params)
|
||||
(pcase-let ((`(,days ,key ,wstart ,begin ,end) params))
|
||||
(delq
|
||||
nil
|
||||
(mapcar (lambda (today)
|
||||
(let* ((ts-today (org-time-string-to-time today))
|
||||
(range (org-clock-special-range
|
||||
key ts-today nil wstart nil))
|
||||
(ts-begin (nth 0 range))
|
||||
(ts-end (nth 1 range))
|
||||
(expected-begin (org-time-string-to-time begin))
|
||||
(expected-end (org-time-string-to-time end)))
|
||||
(unless (and (equal ts-begin expected-begin)
|
||||
(equal ts-end expected-end))
|
||||
(format "%s..%s != %s..%s %s %s :wstart %s"
|
||||
begin end
|
||||
(format-time-string "%F" ts-begin)
|
||||
(format-time-string "%F" ts-end)
|
||||
today key wstart))))
|
||||
days))))
|
||||
cases))))
|
||||
(should-not failed)))
|
||||
|
||||
(provide 'test-org-clock)
|
||||
;;; test-org-clock.el end here
|
||||
|
|
Loading…
Reference in a new issue