From 99e4d3c0afd438499ab55314d30a01da54b15d53 Mon Sep 17 00:00:00 2001 Message-ID: <99e4d3c0afd438499ab55314d30a01da54b15d53.1715594311.git.yantar92@posteo.net> From: Ihor Radchenko Date: Mon, 13 May 2024 11:36:09 +0300 Subject: [PATCH] Make m/y repeater intervals round down from non-existing calendar dates * lisp/org.el (org-repeat-round-time): New customization controlling the new behavior. It allows falling back to the historic rounding. (org-time-inc): New helper function to increment date by Xm/d/w/m/y. The new function, when `org-repeat-round-time' is non-nil, uses the closest earlier existing calendar date when repeater units are month or year. Otherwise, it relies upon Emacs' rounding of non-existing calendar dates being transferred to the next month's existing dates. (org-timestamp-change): Use the new helper function. (org-closest-date): Use the new helper function when computing the expected closest repeater date. * etc/ORG-NEWS (Repeater intervals in the units of month or year are now computed as in many other calendar apps): Document the change. Link: https://orgmode.org/list/87frvzodze.fsf@localhost --- etc/ORG-NEWS | 19 ++++++++ lisp/org.el | 127 ++++++++++++++++++++++++++++----------------------- 2 files changed, 88 insertions(+), 58 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 87b72ad12..8f4e51734 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -13,6 +13,25 @@ Please send Org bug reports to mailto:emacs-orgmode@gnu.org. * Version 9.7 (not released yet) ** Important announcements and breaking changes +*** Repeater intervals in the units of month or year are now computed as in many other calendar apps + +Previously, timestamps like [2024-05-31 Fri +1m], when the next month +does not have 31st day, were repeated to the first days of the +following month: [2024-07-01 Mon +1m]. Same for years, when the same +month next year does not have specified date. + +Now, the behavior is consistent with many common calendar apps - the +closest /existing/ earlier date is selected: [2024-05-31 Fri +1m] +repeats to [2024-06-30 Sun +1m]. + +The previous behavior can be restored by customizing new option - +~org-repeat-round-time~. + +Do note, however, that timestamps initially pointing to the last day +of the month will not remain on the last day of the following months: +[2024-05-31 Fri +1m] -> [2024-06-30 Sun +1m] -> [2024-07-30 Tue +1m] +(not the last day anymore). + *** ~org-create-file-search-functions~ can use ~org-list-store-props~ to suggest link description In Org <9.0, ~org-create-file-search-functions~ could set ~description~ diff --git a/lisp/org.el b/lisp/org.el index 598b4ca23..81ac307cf 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14951,7 +14951,7 @@ (defun org-diary-to-ical-string (frombuf) rtn)) (defun org-closest-date (start current prefer) - "Return closest date to CURRENT starting from START. + "Return closest absolute date to CURRENT starting from START. CURRENT and START are both time stamps. @@ -14961,12 +14961,19 @@ (defun org-closest-date (start current prefer) Only time stamps with a repeater are modified. Any other time stamp stay unchanged. In any case, return value is an absolute -day number." +day number. + +The return value is the number of days elapsed since the imaginary +Gregorian date Sunday, December 31, 1 BC, as returned by +`time-to-days'." (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start)) ;; No repeater. Do not shift time stamp. (time-to-days (org-time-string-to-time start)) - (let ((value (string-to-number (match-string 1 start))) - (type (match-string 2 start))) + (let* ((value (string-to-number (match-string 1 start))) + (type (match-string 2 start)) + (type-unit (pcase type + ("h" 'hour) ("d" 'day) ("w" 'week) + ("m" 'month) ("y" 'year)))) (if (= 0 value) ;; Repeater with a 0-value is considered as void. (time-to-days (org-time-string-to-time start)) @@ -14993,50 +15000,17 @@ (defun org-closest-date (start current prefer) (let ((value (if (equal type "w") (* 7 value) value))) (setf n1 (+ sday (* value (/ (- cday sday) value)))) (setf n2 (+ n1 value)))) - ("m" - (let* ((add-months - (lambda (d n) - ;; Add N months to gregorian date D, i.e., - ;; a list (MONTH DAY YEAR). Return a valid - ;; gregorian date. - (let ((m (+ (nth 0 d) n))) - (list (mod m 12) - (nth 1 d) - (+ (/ m 12) (nth 2 d)))))) - (months ; Complete months to TARGET. - (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base))) - (- (nth 0 target) (nth 0 base)) - ;; If START's day is greater than - ;; TARGET's, remove incomplete month. - (if (> (nth 1 target) (nth 1 base)) 0 -1)) - value) - value)) - (before (funcall add-months base months))) - (setf n1 (calendar-absolute-from-gregorian before)) - (setf n2 - (calendar-absolute-from-gregorian - (funcall add-months before value))))) - (_ - (let* ((d (nth 1 base)) - (m (nth 0 base)) - (y (nth 2 base)) - (years ; Complete years to TARGET. - (* (/ (- (nth 2 target) - y - ;; If START's month and day are - ;; greater than TARGET's, remove - ;; incomplete year. - (if (or (> (nth 0 target) m) - (and (= (nth 0 target) m) - (> (nth 1 target) d))) - 0 - 1)) - value) - value)) - (before (list m d (+ y years)))) - (setf n1 (calendar-absolute-from-gregorian before)) - (setf n2 (calendar-absolute-from-gregorian - (list m d (+ (nth 2 before) value))))))) + ((or "m" "y") + (let* ((running-date (org-parse-time-string start)) + (next-date (org-time-inc type-unit value running-date)) + (current-date (org-parse-time-string current))) + (while (not (time-less-p (org-encode-time current-date) + (org-encode-time next-date))) + (setq running-date next-date + next-date (org-time-inc type-unit value running-date))) + (setf n1 (time-to-days (org-encode-time running-date)) + n2 (time-to-days (org-encode-time next-date))))) + (_ (error "Unsupported repeater type: %S" type))) ;; Handle PREFER parameter, if any. (cond ((eq prefer 'past) (if (= cday n2) n2 n1)) @@ -15193,6 +15167,52 @@ (defun org-at-clock-log-p () (save-match-data (org-element-at-point)) 'clock))) +(defcustom org-repeat-round-time t + "When non-nil, adjust repeated date down if it points to non-existing date. + +For example, when the repeater is monthly, this option, when non-nil, +makes 31 May 2024 repeat to 30 June 2024 next month, adjusting the +date down to avoid non-existent June 31st. When nil, the same +repeater would instead repeat the date at July 1st, retaining the +extra day created by adding a monthly repeater." + :group 'org-time + :type 'boolean + :package-version '(Org . 9.7)) + +(defun org-time-inc (unit value time) + "Increment TIME by VALUE UNITs and return new decoded time. +TIME is decoded time, as returned by `decode-time'. +VALUE is a number. UNIT is one of symbols `second', `minute', `hour', +`day', `month', `year'." + (unless (memq unit '(second minute hour day month year)) + (error "org-time-inc: Unknown unit %S" unit)) + (let ((new-time + (decode-time + (org-encode-time + (list + (+ (if (eq unit 'second) value 0) (decoded-time-second time)) + (+ (if (eq unit 'minute) value 0) (decoded-time-minute time)) + (+ (if (eq unit 'hour) value 0) (decoded-time-hour time)) + (+ (if (eq unit 'day) value 0) (decoded-time-day time)) + (+ (if (eq unit 'month) value 0) (decoded-time-month time)) + (+ (if (eq unit 'year) value 0) (decoded-time-year time)) + (decoded-time-weekday time) + (if (memq unit '(day month year)) + nil ; Avoid auto-adjustments of time when jumping across DST. + (decoded-time-dst time)) + (decoded-time-zone time)))))) + (if (not org-repeat-round-time) new-time + (pcase unit + ((or `year `month) + (let ((target-year (when (eq unit 'year) (+ value (decoded-time-year time)))) + (target-month (when (eq unit 'month) (+ value (decoded-time-month time))))) + (when (> target-month 12) (setq target-month (mod target-month 12))) + (while (or (and target-year (not (equal (decoded-time-year new-time) target-year))) + (and target-month (not (equal (decoded-time-month new-time) target-month)))) + (setq new-time (org-time-inc 'day -1 new-time))) + new-time)) + (_ new-time))))) + (defvar org-clock-history) ; defined in org-clock.el (defvar org-clock-adjust-closest nil) ; defined in org-clock.el (defun org-timestamp-change (n &optional what updown suppress-tmp-delay) @@ -15259,16 +15279,7 @@ (defun org-timestamp-change (n &optional what updown suppress-tmp-delay) ;; argument is supplied - just use whatever is provided by the ;; prefix argument. (setq dm 1)) - (setq time - (org-encode-time - (apply #'list - (or (car time0) 0) - (+ (if (eq timestamp? 'minute) increment 0) (nth 1 time0)) - (+ (if (eq timestamp? 'hour) increment 0) (nth 2 time0)) - (+ (if (eq timestamp? 'day) increment 0) (nth 3 time0)) - (+ (if (eq timestamp? 'month) increment 0) (nth 4 time0)) - (+ (if (eq timestamp? 'year) increment 0) (nth 5 time0)) - (nthcdr 6 time0))))) + (setq time (org-encode-time (org-time-inc timestamp? increment time0)))) (when (and (memq timestamp? '(hour minute)) extra (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) -- 2.45.0