From: Max Nikulin <manikulin@gmail.com>
To: Marcin Borkowski <mbork@mbork.pl>
Cc: Org-Mode mailing list <emacs-orgmode@gnu.org>
Subject: [PATCH] org-clock.el: Fix week start != 1
Date: Tue, 25 Apr 2023 21:43:35 +0700 [thread overview]
Message-ID: <231c4429-2f11-baf5-5ade-1c4a053c21e1@gmail.com> (raw)
In-Reply-To: <87wn219ibd.fsf@mbork.pl>
[-- 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
next prev parent reply other threads:[~2023-04-25 14:44 UTC|newest]
Thread overview: 24+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-04-10 3:35 What is a week? Marcin Borkowski
2023-04-10 4:03 ` Marcin Borkowski
2023-04-10 6:04 ` Jude DaShiell
2023-04-10 7:46 ` Ihor Radchenko
2023-04-10 11:51 ` Max Nikulin
2023-04-10 12:07 ` Tim Landscheidt
2023-04-11 10:08 ` Ihor Radchenko
2023-04-24 15:47 ` Max Nikulin
2023-04-11 10:09 ` Ihor Radchenko
2023-04-11 11:34 ` Max Nikulin
2023-04-11 14:21 ` Marcin Borkowski
2023-04-23 17:57 ` Ihor Radchenko
2023-04-23 19:06 ` Marcin Borkowski
2023-04-23 19:18 ` Ihor Radchenko
2023-04-24 4:13 ` Marcin Borkowski
2023-04-24 6:26 ` Ihor Radchenko
2023-04-24 19:44 ` Marcin Borkowski
2023-04-24 20:05 ` Ihor Radchenko
2023-08-06 18:29 ` Bastien Guerry
2023-04-25 14:43 ` Max Nikulin [this message]
2023-05-07 8:06 ` [PATCH] org-clock.el: Fix week start != 1 Ihor Radchenko
2023-08-06 18:27 ` What is a week? Bastien
2023-04-24 15:13 ` Max Nikulin
2023-04-24 19:26 ` Marcin Borkowski
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=231c4429-2f11-baf5-5ade-1c4a053c21e1@gmail.com \
--to=manikulin@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=mbork@mbork.pl \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).