[PATCH] org-clock.el: Fix week start != 1

[Max Nikulin <manikulin@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 290 bytes --]

On 25/04/2023 02:44, Marcin Borkowski wrote:
> And I assume that FSF might want to look
> at my contract, which is in Polish

I had an impression that an FSF form signed by your employer is enough, 
but I may be wrong.

Could you, please, test if the attached patch works correctly for you?

[-- Attachment #2: 0001-org-clock.el-Fix-week-start-1.patch --]
[-- Type: text/x-patch, Size: 4615 bytes --]

From eb1b0f8e7458a775664dc4dc38d38e14c462fba9 Mon Sep 17 00:00:00 2001
From: Max Nikulin <manikulin@gmail.com>
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.
<https://list.orgmode.org/87h6to1ka7.fsf@mbork.pl>
---
 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 ()
                      "<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
-- 
2.25.1