From d2383702a24da8c9bfddb7234f2caa9d23a86541 Mon Sep 17 00:00:00 2001 From: "Michael R. Mauger" Date: Thu, 7 May 2026 22:11:36 -0400 Subject: [PATCH] ; Generate legacy diary-sexp when importing icalendar * lisp/calendar/diary-icalendar.el: Generate legacy diary-sexp (di:vevent-skeleton): Separate date and time formatting. (di:vevent-skeleton, di:vjournal-skeleton, di:vtodo-skeleton): Use `indent-rigidly' in place of `indent-code-rigidly'. (di:format-time-range): Handle time periods crossing midnight. (di:calendar-date, di:block-sexp): New functions. (di:format-block-sexp): Modified to use above. (di:recur-by-date-only, di:calculate-recur-end-date) (di:diary-yearly-sexp, di:diary-monthly-sexp) (di:diary-weekly-sexp, di:diary-daily-sexp) (di:diary-sexp): New functions to generate legacy diary-sexp. (di:format-rrule-sexp): Modified to use above. (di:format-entry): Added `ical-date' and `ical-time' dynamic vars. (diary-rrule): Don't prepend entry-time if already present. Where: di: => diary-icalendar- * lisp/calendar/diary-lib.el: Format count/ordinal in entries. (diary-list-entries-2, diary-mark-sexp-entries) (diary-list-sexp-entries) (diary-fancy-font-lock-fontify-region-function): Replace `looking-at' with `looking-at-p'. (diary-list-sexp-entries): Capture multi-line diary sexp. (diary-months-between): New function to calculate the number of months between two diary dates. Used by di:diary-monthly-sexp. (diary--replace-count-or-ordinal-string) (diary--replace-count-or-ordinal-format) (diary-format-count-and-ordinal): Safely format count and ordinal. (diary-anniversary, diary-cyclic): Modified to use above. * lisp/calendar/icalendar-recur.el: Update copyright. * lisp/calendar/icalendar-utils.el: Update copyright (icalendar-date/time-to-date): Make implementation consistent. --- lisp/calendar/diary-icalendar.el | 356 ++++++++++++++++++++++++++----- lisp/calendar/diary-lib.el | 176 +++++++++++---- lisp/calendar/icalendar-recur.el | 2 +- lisp/calendar/icalendar-utils.el | 8 +- 4 files changed, 442 insertions(+), 100 deletions(-) diff --git a/lisp/calendar/diary-icalendar.el b/lisp/calendar/diary-icalendar.el index bc58e7b5924..d82a5ad08ef 100644 --- a/lisp/calendar/diary-icalendar.el +++ b/lisp/calendar/diary-icalendar.el @@ -44,6 +44,7 @@ (require 'cal-dst) (require 'diary-lib) (require 'skeleton) +(require 'cl-seq) (require 'seq) (require 'rx) (require 'pp) @@ -1138,7 +1139,8 @@ attendee's address matches the regexp in '(nil (when (or ical-nonmarking (equal ical-transparency "TRANSPARENT")) diary-nonmarking-symbol) - (or ical-rrule-sexp ical-start-to-end ical-start) & " " + (or ical-rrule-sexp ical-date) & " " + ical-time & " " ical-summary "\n" @ ; start of body (for indentation) (when ical-location "Location: ") ical-location @@ -1159,7 +1161,7 @@ attendee's address matches the regexp in (start (pop skeleton-positions))) ;; TODO: should diary define a customizable indentation level? ;; For now, we use 1 because that's what icalendar.el chose - (indent-code-rigidly start end 1) + (indent-rigidly start end 1) nil) ; Don't insert return value (when ical-importing "\n")))) @@ -1189,7 +1191,7 @@ attendee's address matches the regexp in @ ; end of body (let* ((end (pop skeleton-positions)) (start (pop skeleton-positions))) - (indent-code-rigidly start end 1) + (indent-rigidly start end 1) nil) ; Don't insert return value (when ical-importing "\n")))) @@ -1222,7 +1224,7 @@ attendee's address matches the regexp in @ ; end of body (let* ((end (pop skeleton-positions)) (start (pop skeleton-positions))) - (indent-code-rigidly start end 1) + (indent-rigidly start end 1) nil) ; Don't insert return value (when ical-importing "\n")))) @@ -1419,49 +1421,55 @@ range instead.) The date is only formatted once, and the time is formatted as a range, like: STARTDATE STARTTIME-ENDTIME If OMIT-START-DATE is non-nil, STARTDATE will be omitted." - (when (equal (ical:date/time-to-date start) (ical:date/time-to-date end)) + (when (or (equal (ical:date/time-to-date start) (ical:date/time-to-date end)) + (< (decoded-time-period (ical:duration-between start end)) + (* 24 60 60))) ;; duration less than a day (format "%s%s-%s" (if omit-start-date "" (concat (di:format-date start) " ")) (di:format-time-as-local start) (di:format-time-as-local end)))) -(defun di:format-block-sexp (start end) - "Format a `diary-block' diary S-expression between START and END. +(defun di:calendar-date (date) + "Create a DATE list as calendar date list of desired style. -START and END may be `icalendar-date' or `icalendar-date-time' -values. If they are date-times, only the date parts will be considered. -Returns a string like \"%%(diary-block ...)\" with the arguments properly -ordered for the current value of `calendar-date-style'." - (unless (cl-typep start 'ical:date) - (setq start (ical:date-time-to-date start))) - (unless (cl-typep end 'ical:date) - (setq end (ical:date-time-to-date end))) - (concat - diary-sexp-entry-symbol - (apply #'format "(diary-block %d %d %d %d %d %d)" - (cl-case calendar-date-style - ;; M/D/Y - (american (list (calendar-extract-month start) - (calendar-extract-day start) - (calendar-extract-year start) - (calendar-extract-month end) - (calendar-extract-day end) - (calendar-extract-year end))) - ;; D/M/Y - (european (list (calendar-extract-day start) - (calendar-extract-month start) - (calendar-extract-year start) - (calendar-extract-day end) - (calendar-extract-month end) - (calendar-extract-year end))) - ;; Y/M/D - (iso (list (calendar-extract-year start) - (calendar-extract-month start) - (calendar-extract-day start) - (calendar-extract-year end) - (calendar-extract-month end) - (calendar-extract-day end))))))) +DATE may be a `icalendar-date' or `icalendar-date-time' value. If it is +a date-time, only the date parts will be considered. Returns a list +with elements properly ordered for the current value of +`calendar-date-style'. DATE may also be a list consisting of date +values and t as wildcards." + (when-let* ((dt (or (ical:date/time-to-date date) + (take 3 date))) ;; wildcard date list + (year (calendar-extract-year dt)) + (mon (calendar-extract-month dt)) + (day (calendar-extract-day dt))) + (cl-case calendar-date-style + (american (list mon day year)) ;; M/D/Y + (european (list day mon year)) ;; D/M/Y + (iso (list year mon day)) ;; Y/M/D + ))) + +(defun di:block-sexp (start end) + "Create a `diary-block/-date' diary S-expression between START and END. + +START and END may be `icalendar-date' or `icalendar-date-time' values. +If they are date-times, only the date parts will be considered. If +START and END are the same date, then return a date expression, +otherwise use `diary-block'. The dates are written in proper order for +`calendar-date-style'." + (let ((s (di:calendar-date start)) + (e (di:calendar-date end))) + (if (equal s e) + (di:format-date start) + `(diary-block ,@s ,@e)))) + +(defun di:format-block-sexp (start end) + "Format diary s-exp string from block sexp using START and END." + (let ((block-sexp (di:block-sexp start end))) + (cond + ((stringp block-sexp) block-sexp) + (t (concat diary-sexp-entry-symbol + (prin1-to-string block-sexp)))))) (defun di:format-time-block-sexp (start end) "Format a `diary-time-block' diary S-expression for times between START and END." @@ -1469,6 +1477,211 @@ ordered for the current value of `calendar-date-style'." diary-sexp-entry-symbol (format "(diary-time-block :start '%s :end '%s)" start end))) +(defun di:recur-by-date-only (rrule) + "The RRULE recurrence only varies by date; the time (if any) is constant." + (and (memq (icr:freq rrule) '(YEARLY MONTHLY WEEKLY DAILY)) + (not (cl-find-if + (lambda (byunit) (icr:by* byunit rrule)) + '( BYSECOND BYMINUTE BYHOUR + BYDAY BYMONTHDAY BYYEARDAY + BYWEEKNO BYMONTH BYSETPOS + WKST ))) + t)) + +(defun di:calculate-recur-end-date (dtstart dur-value rrule) + "Calculate the end date from DTSTART, DUR-VALUE and the RRULE values. + +The end date is either RRULE.UNTIL, an offset from the DTSTART based on +RRULE.INTERVAL and RRULE.COUNT, an offset from the DTSTART based on +DUR-VALUE, or just fallback on forever. If this function returns a nil +end date, then we can't easily replicate the RRULE using legacy diary +sexps." + ; (setq dur-value (mapcar (lambda (a) (or a 0)) dur-value)) + (cond + ((icr:until rrule) (icr:until rrule)) + ((icr:count rrule) + ;; TODO: Handle BY* specifications for calculating the end date + ;; with COUNT + (unless (cl-find-if + (lambda (byunit) (icr:by* byunit rrule)) + '( BYSECOND BYMINUTE BYHOUR + BYDAY BYMONTHDAY BYYEARDAY + BYWEEKNO BYMONTH SYSETPOS + WKST )) + ;; If we have COUNT, INTERVAL, and UNIT, calculate the end date + ;; from DTSTART. Otherwise, use the end-of-time + (when-let* ((count-val (icr:count rrule)) + (interval-val (icr:interval-size rrule)) + (unit (cl-case (icr:freq rrule) + (YEARLY :year) + (MONTHLY :month) + (WEEKLY :week) + (DAILY :day)))) + (ical:date-add (ical:date/time-to-date dtstart) + unit + (* interval-val (1- count-val)))))) + ;; If the duration is multiple days, then calculate the end date + ;; based on that. + ;; (NOTE: These may not come thru as a recur, so must be handled by + ;; ical-date) + ((and dur-value + (> (decoded-time-period dur-value) (* 24 60 60))) ;; duration longer than a day + (ical:date/time-to-date + (ical:date/time-add-duration dtstart dur-value))) + ;; Forever + (t '(12 31 9999)))) + +(defun di:diary-yearly-sexp (dtstart interval _foreverp block-sexp rdates-sexp exdates-sexp) + "Create a yearly event that starts on DTSTART on every INTERVAL years. + +The BLOCK-SEXP will limit how long the event occurs. The RDATES-SEXP +and EXDATES-SEXP include or exclude dates from the recurrence." + (with-no-warnings (defvar date)) + (let* ((anniv-sexp `(diary-anniversary ,@(di:calendar-date dtstart))) + (interval-sexp + (cl-case interval + (1 nil) + (2 (let* ((odd-even (if (evenp (calendar-extract-year dtstart)) + #'evenp #'oddp))) + `((,odd-even (calendar-extract-year date))))) + (t `((= (% (calendar-extract-year date) ,interval) + ,(% (calendar-extract-year dtstart) interval))))))) + (if (or interval-sexp block-sexp rdates-sexp exdates-sexp) + `(and ,anniv-sexp + ,@interval-sexp + ,@block-sexp + ,@rdates-sexp + ,@exdates-sexp) + anniv-sexp))) + +(defun di:diary-monthly-sexp (dtstart interval _foreverp block-sexp rdates-sexp exdates-sexp) + "Create a monthly event that starts on DTSTART on every INTERVAL months. + +The BLOCK-SEXP will limit how long the event occurs. The RDATES-SEXP +and EXDATES-SEXP include or exclude dates from the recurrence. + +When INTERVAL is a divisor of 12, the list of matching months is easily +determined. For other INTERVAL values, the match must be calculated +based on the calculated number of months." + (with-no-warnings (defvar date)) + (let* ((day (calendar-extract-day dtstart)) + (mon (calendar-extract-month dtstart)) + (interval-sexp + (cl-case interval + (1 t) + (2 (if (evenp mon) + '(quote (2 4 6 8 10 12)) + '(quote (1 3 5 7 9 11)))) + (3 (cl-case (% mon 3) + (0 '(quote (3 6 9 12))) + (1 '(quote (1 4 7 10))) + (2 '(quote (2 5 8 11))))) + (4 (cl-case (% mon 4) + (0 '(quote (4 8 12))) + (1 '(quote (1 5 9))) + (2 '(quote (2 6 10))) + (3 '(quote (3 7 11))))) + (6 (cl-case (% mon 6) + (0 '(quote (6 12))) + (1 '(quote (1 7))) + (2 '(quote (2 8))) + (3 '(quote (3 9))) + (4 '(quote (4 10))) + (5 '(quote (5 11))))) + (12 mon) + (t + `(zerop (% (diary-months-between ,(di:calendar-date dtstart) date) ,interval))))) + (date-sexp `(diary-date ,@(di:calendar-date `(,interval-sexp ,day t))))) + (if (or block-sexp rdates-sexp exdates-sexp) + `(and ,date-sexp + ,@block-sexp + ,@rdates-sexp + ,@exdates-sexp) + date-sexp))) + +(defun di:diary-weekly-sexp (dtstart interval _foreverp block-sexp rdates-sexp exdates-sexp) + "Create a weekly event that starts on DTSTART on every INTERVAL weeks. + +The BLOCK-SEXP will limit how long the event occurs. The RDATES-SEXP +and EXDATES-SEXP include or exclude dates from the recurrence." + (let ((cyclic-sexp `(diary-cyclic ,(* interval 7) + ,@(di:calendar-date dtstart)))) + (if (or block-sexp rdates-sexp exdates-sexp) + `(and ,cyclic-sexp + ,@block-sexp + ,@rdates-sexp + ,@exdates-sexp) + cyclic-sexp))) + +(defun di:diary-daily-sexp (dtstart interval foreverp block-sexp rdates-sexp exdates-sexp) + "Create a daily event that starts on DTSTART on every INTERVAL days. + +The BLOCK-SEXP will limit how long the event occurs. The RDATES-SEXP +and EXDATES-SEXP include or exclude dates from the recurrence. + +When the INTERVAL is every day and the event does not occur FOREVERP, +then `daily-block' will properly constrain the event. Otherwise, +`diary-cyclic' and `diary-block' must be combined." + (let* ((cyclic-sexp `(diary-cyclic ,interval ,@(di:calendar-date dtstart))) + (daily-sexp (if (= interval 1) + (if foreverp (list cyclic-sexp) block-sexp) + (cons cyclic-sexp block-sexp)))) + (if (or rdates-sexp exdates-sexp) + `(and ,@daily-sexp + ,@rdates-sexp + ,@exdates-sexp) + (if (= 1 (length daily-sexp)) + (car daily-sexp) + `(and ,@daily-sexp))))) + +(defun di:diary-sexp (rrule exdates rdates dtstart dur-value) + "Create an sexp using `diary-*' functions for recurrence. + +Where RRULE is an alist, EXDATES are a list of excluded dates, RDATES +are a list of included dates, DTSTART is when the recurrence starts, and +DUR-VALUE is the duration of a single instance." + (let* ((dtend (di:calculate-recur-end-date dtstart dur-value rrule)) + (foreverp (= (calendar-extract-year dtend) 9999))) + (or + (when (and dtstart dtend + (di:recur-by-date-only rrule)) + (let* ((block-sexp (unless foreverp (list (di:block-sexp dtstart dtend)))) + (interval-val (icr:interval-size rrule)) + (rdates-sexp (mapcar + (lambda (dt) + `(diary-date ,@(di:calendar-date dt))) + rdates)) + (exdates-sexp (mapcar + (lambda (dt) + `(not (diary-date ,@(di:calendar-date dt)))) + exdates)) + (sexp-func (cl-case (icr:freq rrule) + ;; Yearly recur (diary-anniversary) + (YEARLY #'di:diary-yearly-sexp) + ;; Monthly repeat (diary-date, diary-block) + (MONTHLY #'di:diary-monthly-sexp) + ;; Weekly repeat (diary-cyclic) + (WEEKLY #'di:diary-weekly-sexp) + ;; Daily repeat (diary-cyclic/diary-block) + (DAILY #'di:diary-daily-sexp)))) + + (funcall sexp-func + dtstart interval-val foreverp + block-sexp rdates-sexp exdates-sexp))) + + ;; General repetition (diary-rrule) + `(diary-rrule + ,@(when rrule + (list :rule `(quote ,rrule))) + ,@(when dtstart + (list :start `(quote ,dtstart))) + ,@(when dur-value + (list :duration `(quote ,dur-value))) + ,@(when rdates + (list :include `(quote ,rdates))) + ,@(when exdates + (list :exclude `(quote ,exdates))))))) + (defun di:format-rrule-sexp (component) "Format the recurrence rule data in COMPONENT as a diary S-expression. @@ -1502,26 +1715,14 @@ the event." (dur-value (cond (duration duration) (dtend (unless (equal dtstart dtend) (ical:duration-between dtstart dtend))) - (t nil))) - (arg-plist nil)) + (t nil)))) - (when exdates - (setq arg-plist (plist-put arg-plist :exclude `(quote ,exdates)))) - (when rdates - (setq arg-plist (plist-put arg-plist :include `(quote ,rdates)))) - (when dtstart - (setq arg-plist (plist-put arg-plist :start `(quote ,dtstart)))) - (when dur-value - (setq arg-plist (plist-put arg-plist :duration `(quote ,dur-value)))) - (when rrule - ;; TODO: make this prettier to look at? - (setq arg-plist (append (list :rule `(quote ,rrule)) arg-plist))) - ;; TODO: timezones?? - - (setq arg-plist (cons 'diary-rrule arg-plist)) (string-trim ; removing trailing \n added by pp (concat diary-sexp-entry-symbol - (with-output-to-string (pp arg-plist))))))) + (let* (print-level print-length) + (pp-to-string + (di:diary-sexp rrule exdates rdates + dtstart dur-value)))))))) ;; This function puts all of the above together to format individual ;; iCalendar components as diary entries. The final formatting is done @@ -1636,6 +1837,40 @@ Returns a string containing the diary entry." description-nodes "\n\n") (ical:trimp description))) + (ical-date + (cond + ((not dtstart) nil) + ((or (not dtend) (equal dtstart dtend)) + (di:format-date dtstart-local)) + ((and (bound-and-true-p ical-importing) + (cl-typep dtstart 'ical:date) + (cl-typep dtend 'ical:date)) + ;; Importing two dates: + ;; %%(diary-block ...) + (di:format-block-sexp + dtstart-local + ;; DTEND is an exclusive bound, while + ;; diary-block needs an inclusive bound, so + ;; subtract a day: + (ical:date-add dtend-local :day -1))) + ((and (bound-and-true-p ical-importing) + (equal (ical:date/time-to-date dtstart-local) + (ical:date/time-to-date dtend-local))) + ;; Importing, start and end times on same day: + ;; DATE HH:MM-HH:MM + (di:format-date dtstart-local)) + ((bound-and-true-p ical-importing) + ;; Importing at least one date-time, on different days: + ;; %%(diary-time-block :start ... :end ...) + (di:format-block-sexp dtstart-local + (ical:date-add (ical:date/time-to-date dtend-local) :day -1))))) + (ical-time + ;; If we are not using diary-rrule, check if we need times + (when (or (and is-recurring (di:recur-by-date-only rrule)) + (not is-recurring)) + (if dtend-local + (di:format-time-range dtstart-local dtend-local t) + (di:format-time-as-local dtstart start-tzname)))) (ical-start (when dtstart (if (bound-and-true-p ical-importing) @@ -1671,7 +1906,8 @@ Returns a string containing the diary entry." (ical:date/time-to-date dtend-local))) ;; Importing, start and end times on same day: ;; DATE HH:MM-HH:MM - (di:format-time-range dtstart-local dtend-local)) + (di:format-time-range dtstart-local dtend-local + is-recurring)) ((bound-and-true-p ical-importing) ;; Importing at least one date-time, on different days: ;; %%(diary-time-block :start ... :end ...) @@ -3580,7 +3816,9 @@ values (of the same type as START)." start (ical:date/time-add-duration start duration)) (di:format-time-as-local start))) - (date-entry (concat entry-time " " entry))) + (date-entry (if (string-prefix-p entry-time entry) + entry + (concat entry-time " " entry)))) (when (memq (ical:recur-freq date-rule) '(HOURLY MINUTELY SECONDLY)) (setf (alist-get 'FREQ date-rule) 'DAILY) (setf (alist-get 'INTERVAL date-rule) 1) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index e693a3c0d2b..9ffb1f20855 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -666,32 +666,32 @@ any entries were found." (if backup (re-search-backward "\\<" nil t)) ;; regexp moves us past the end of date, onto the next line. ;; Trailing whitespace after date not allowed (see diary-file). - (if (and (bolp) (not (looking-at "[ \t]"))) + (if (and (bolp) (not (looking-at-p "[ \t]"))) ;; Diary entry that consists only of date. (backward-char 1) ;; Found a nonempty diary entry--make it ;; visible and add it to the list. - (setq date-start (line-end-position 0)) - ;; Actual entry starts on the next-line? - (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) - (setq entry-found t - entry-start (point)) - (forward-line 1) - (while (looking-at "[ \t]") ; continued entry - (forward-line 1)) - (unless (and (eobp) (not (bolp))) - (backward-char 1)) - (unless list-only - (remove-overlays date-start (point) 'invisible 'diary)) - (setq temp (diary-pull-attrs - (buffer-substring-no-properties - entry-start (point)) - globattr)) - (diary-add-to-list - (or gdate date) (car temp) - (buffer-substring-no-properties - (1+ date-start) (1- entry-start)) - (copy-marker entry-start) (cadr temp)))))) + (setq date-start (line-end-position 0)) + ;; Actual entry starts on the next-line? + (if (looking-at-p "[ \t]*\n[ \t]") (forward-line 1)) + (setq entry-found t + entry-start (point)) + (forward-line 1) + (while (looking-at-p "[ \t]") ; continued entry + (forward-line 1)) + (unless (and (eobp) (not (bolp))) + (backward-char 1)) + (unless list-only + (remove-overlays date-start (point) 'invisible 'diary)) + (setq temp (diary-pull-attrs + (buffer-substring-no-properties + entry-start (point)) + globattr)) + (diary-add-to-list + (or gdate date) (car temp) + (buffer-substring-no-properties + (1+ date-start) (1- entry-start)) + (copy-marker entry-start) (cadr temp)))))) entry-found))) (defvar original-date) ; from diary-list-entries @@ -1460,7 +1460,7 @@ is marked. See the documentation for the function `diary-list-sexp-entries'." (forward-sexp) (setq sexp (buffer-substring-no-properties sexp-start (point))) (forward-char 1) - (if (and (bolp) (not (looking-at "[ \t]"))) + (if (and (bolp) (not (looking-at-p "[ \t]"))) ;; Diary entry consists only of the sexp. (progn (backward-char 1) @@ -1468,7 +1468,7 @@ is marked. See the documentation for the function `diary-list-sexp-entries'." (setq entry-start (point)) ;; Find end of entry. (forward-line 1) - (while (looking-at "[ \t]") + (while (looking-at-p "[ \t]") (forward-line 1)) (if (bolp) (backward-char 1)) (setq entry (buffer-substring-no-properties entry-start (point)))) @@ -1739,22 +1739,21 @@ best if they are non-marking." (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) (while (re-search-forward s-entry nil t) (backward-char 1) - (setq sexp-start (point)) + (setq sexp-start (point) + line-start (line-end-position 0)) (forward-sexp) (setq sexp (buffer-substring-no-properties sexp-start (point)) - line-start (line-end-position 0) - specifier - (buffer-substring-no-properties (1+ line-start) (point)) + specifier (buffer-substring-no-properties (1+ line-start) (point)) entry-start (1+ line-start)) (forward-char 1) - (if (and (bolp) (not (looking-at "[ \t]"))) + (if (and (bolp) (not (looking-at-p "[ \t]"))) ;; Diary entry consists only of the sexp. (progn (backward-char 1) (setq entry "")) (setq entry-start (point)) (forward-line 1) - (while (looking-at "[ \t]") + (while (looking-at-p "[ \t]") (forward-line 1)) (if (bolp) (backward-char 1)) (setq entry (buffer-substring-no-properties entry-start (point)))) @@ -1912,6 +1911,91 @@ highlighting the day in the calendar." "th" (aref ["th" "st" "nd" "rd"] (% n 10)))) +(defun diary--replace-count-or-ordinal-string (str) + "Replace the match region with STR and return the new end offset." + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (replace-region-contents beg end str) + (+ beg (length str)))) + +(defun diary--replace-count-or-ordinal-format (&rest args) + "Format the current match data with ARGS, and replace the match data. + +Return the offset of the end of the replacement." + (let* ((spec (match-string-no-properties 0)) + (str (apply #'format spec args))) + (diary--replace-count-or-ordinal-string str))) + +(defun diary-format-count-and-ordinal (entry count) + "Format `%d' in ENTRY with COUNT and then `%s' with ordinal. + +The formats specifiers must be in that order. Any embedded URL's, with +escape encoding, are skipped." + + (let* ((ordinal (diary-ordinal-suffix count)) + (format-spec-re "\\(?:[ #+0-]+\\)?\\(?:[[:digit:]]+\\)?\\(?:\\.[[:digit:]]+\\)?") + (count-re (concat "%" format-spec-re "d")) + (count-n-re (concat "%1\\$" format-spec-re "d")) + (ordinal-re (concat "%" format-spec-re "s")) + (ordinal-n-re (concat "%2\\$" format-spec-re "s")) + (formatted-count nil) + (formatted-ordinal nil) + (start (point-min)) + (case-fold-search nil)) + (with-temp-buffer + (insert entry) + (while (progn + (goto-char start) + (re-search-forward "%" nil t)) + (setq start (match-beginning 0)) + (goto-char start) + (setq start + (cond* + ;; Protect embedded URLs with percent escapes + ((bind-and* + (url-bounds (thing-at-point-bounds-of-url-at-point)) + (beg-url (car url-bounds)) + (end-url (cdr url-bounds)) + (url-str (buffer-substring-no-properties beg-url end-url)) + (new-url (replace-regexp-in-string "%%" "%" url-str))) + (set-match-data (list beg-url end-url)) + (diary--replace-count-or-ordinal-string new-url)) + + ;; Protect double percents + ((looking-at "%%") + (diary--replace-count-or-ordinal-string "%")) + + ;; Replace %d (count) if we haven't replaced one yet + ((and (looking-at count-re) + (not formatted-count)) + (setq formatted-count t) + (diary--replace-count-or-ordinal-format count)) + + ;; Replace %s (ordinal) if we've replaced count already + ((and (looking-at ordinal-re) + formatted-count + (not formatted-ordinal)) + (setq formatted-ordinal t) + (diary--replace-count-or-ordinal-format ordinal)) + + ;; Replace %1$d (explicit count) every time + ((looking-at count-n-re) + (setq formatted-count t + formatted-ordinal t) + (diary--replace-count-or-ordinal-format count)) + + ;; Replace %2$s (explicit ordinal) every time + ((looking-at ordinal-n-re) + (setq formatted-count t + formatted-ordinal t) + (diary--replace-count-or-ordinal-format count ordinal)) + + ;; Ignore the percent sign + (t + (1+ start))))) + ;; Return the formatted string + (buffer-string)))) + ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. (defun diary-anniversary (month day &optional year mark) "Anniversary diary entry. @@ -1938,7 +2022,27 @@ string to use when highlighting the day in the calendar." (setq mm 3 dd 1)) (and (> diff 0) (calendar-date-equal (list mm dd y) date) - (cons mark (format entry diff (diary-ordinal-suffix diff)))))) + (cons mark (diary-format-count-and-ordinal entry diff))))) + +(defun diary-months-between (date1 date2) + "Calculate the number of months between DATE1 and DATE2." + (let* ((ddate1 (apply #'diary-make-date date1)) + (mm1 (calendar-extract-month ddate1)) + (yy1 (calendar-extract-year ddate1)) + (ddate2 (apply #'diary-make-date date2)) + (mm2 (calendar-extract-month ddate2)) + (yy2 (calendar-extract-year ddate2))) + ;; Make sure mm1/yy1 <= mm2/yy2 + (when (or (> yy1 yy2) + (and (= yy1 yy2) + (> mm1 mm2))) + (setq mm1 (prog1 mm2 (setq mm2 mm1)) + yy1 (prog1 yy2 (setq yy2 yy1)))) + (if (= yy1 yy2) + (- mm2 mm1) + (+ (- 12 mm1) + mm2 + (* 12 (- yy2 yy1 1)))))) ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. (defun diary-cyclic (n month day year &optional mark) @@ -1960,7 +2064,7 @@ string to use when highlighting the day in the calendar." (diary-make-date month day year)))) (cycle (/ diff n))) (and (>= diff 0) (zerop (% diff n)) - (cons mark (format entry cycle (diary-ordinal-suffix cycle)))))) + (cons mark (diary-format-count-and-ordinal entry cycle))))) ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. (defun diary-offset (sexp days) @@ -2410,14 +2514,14 @@ Needed to handle multiline keyword in `diary-fancy-font-lock-keywords'. Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." (goto-char beg) (forward-line 0) - (if (looking-at "=+$") (forward-line -1)) - (while (and (looking-at " +[^ ]") + (if (looking-at-p "=+$") (forward-line -1)) + (while (and (looking-at-p " +[^ ]") (zerop (forward-line -1)))) (goto-char end) (forward-line 0) - (while (and (looking-at " +[^ ]") + (while (and (looking-at-p " +[^ ]") (zerop (forward-line 1)))) - (if (looking-at "=+$") + (if (looking-at-p "=+$") (setq end (line-beginning-position 2))) (font-lock-default-fontify-region beg end verbose)) diff --git a/lisp/calendar/icalendar-recur.el b/lisp/calendar/icalendar-recur.el index fcebbc9c6f0..423a54ecf61 100644 --- a/lisp/calendar/icalendar-recur.el +++ b/lisp/calendar/icalendar-recur.el @@ -1,6 +1,6 @@ ;;; icalendar-recur.el --- Support for iCalendar recurrences and time zones -*- lexical-binding: t; -*- -;; Copyright (C) 2024 Richard Lawrence +;; Copyright (C) 2024-2026 Free Software Foundation, Inc. ;; Author: Richard Lawrence ;; Created: December 2024 diff --git a/lisp/calendar/icalendar-utils.el b/lisp/calendar/icalendar-utils.el index 565901940f0..a7e1d65d85d 100644 --- a/lisp/calendar/icalendar-utils.el +++ b/lisp/calendar/icalendar-utils.el @@ -1,6 +1,6 @@ ;;; icalendar-utils.el --- iCalendar utility functions -*- lexical-binding: t; -*- -;; Copyright (C) 2024 Richard Lawrence +;; Copyright (C) 2024-2026 Free Software Foundation, Inc. ;; Author: Richard Lawrence ;; Created: January 2025 @@ -135,9 +135,9 @@ arguments." "Extract a Gregorian date from DT. An `icalendar-date' value is returned unchanged. An `icalendar-date-time' value is converted to an `icalendar-date'." - (if (cl-typep dt 'ical:date) - dt - (ical:date-time-to-date dt))) + (cl-typecase dt + (ical:date dt) + (ical:date-time (ical:date-time-to-date dt)))) ;; Type-aware accessors for date/time slots that work for both ical:date ;; and ical:date-time: