From eb1b0f8e7458a775664dc4dc38d38e14c462fba9 Mon Sep 17 00:00:00 2001 From: Max Nikulin Date: Tue, 25 Apr 2023 21:25:16 +0700 Subject: [PATCH] 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. --- lisp/org-clock.el | 2 +- testing/lisp/test-org-clock.el | 52 ++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 1 deletion(-) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 053050adb..b30018aac 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -2389,7 +2389,7 @@ (defun org-clock-special-range (key &optional time as-strings wstart mstart) 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) diff --git a/testing/lisp/test-org-clock.el b/testing/lisp/test-org-clock.el index 7d8123e1f..fb16f8ffe 100644 --- a/testing/lisp/test-org-clock.el +++ b/testing/lisp/test-org-clock.el @@ -1311,5 +1311,57 @@ (ert-deftest test-org-clock/mode-line () " ") (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 -- 2.25.1