Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 12:31:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

; Generate legacy diary-sexp when importing icalendar

Browse source 
* 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.
This commit is contained in:
Michael R. Mauger 2026-05-07 22:11:36 -04:00
parent 90f8f27a58
commit d2383702a2
4 changed files with 442 additions and 100 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

356
lisp/calendar/diary-icalendar.el
View file

@ -44,6 +44,7 @@
(require 'cal-dst) (require 'cal-dst)
(require 'diary-lib) (require 'diary-lib)
(require 'skeleton) (require 'skeleton)
(require 'cl-seq)
(require 'seq) (require 'seq)
(require 'rx) (require 'rx)
(require 'pp) (require 'pp)
@ -1138,7 +1139,8 @@ attendee's address matches the regexp in
'(nil '(nil
(when (or ical-nonmarking (equal ical-transparency "TRANSPARENT")) (when (or ical-nonmarking (equal ical-transparency "TRANSPARENT"))
diary-nonmarking-symbol) diary-nonmarking-symbol)
(or ical-rrule-sexp ical-start-to-end ical-start) & " " (or ical-rrule-sexp ical-date) & " "
ical-time & " "
ical-summary "\n" ical-summary "\n"
@ ; start of body (for indentation) @ ; start of body (for indentation)
(when ical-location "Location: ") ical-location (when ical-location "Location: ") ical-location
@ -1159,7 +1161,7 @@ attendee's address matches the regexp in
(start (pop skeleton-positions))) (start (pop skeleton-positions)))
;; TODO: should diary define a customizable indentation level? ;; TODO: should diary define a customizable indentation level?
;; For now, we use 1 because that's what icalendar.el chose ;; 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 nil) ; Don't insert return value
(when ical-importing "\n")))) (when ical-importing "\n"))))
@ -1189,7 +1191,7 @@ attendee's address matches the regexp in
@ ; end of body @ ; end of body
(let* ((end (pop skeleton-positions)) (let* ((end (pop skeleton-positions))
(start (pop skeleton-positions))) (start (pop skeleton-positions)))
(indent-code-rigidly start end 1) (indent-rigidly start end 1)
nil) ; Don't insert return value nil) ; Don't insert return value
(when ical-importing "\n")))) (when ical-importing "\n"))))
@ -1222,7 +1224,7 @@ attendee's address matches the regexp in
@ ; end of body @ ; end of body
(let* ((end (pop skeleton-positions)) (let* ((end (pop skeleton-positions))
(start (pop skeleton-positions))) (start (pop skeleton-positions)))
(indent-code-rigidly start end 1) (indent-rigidly start end 1)
nil) ; Don't insert return value nil) ; Don't insert return value
(when ical-importing "\n")))) (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: The date is only formatted once, and the time is formatted as a range, like:
STARTDATE STARTTIME-ENDTIME STARTDATE STARTTIME-ENDTIME
If OMIT-START-DATE is non-nil, STARTDATE will be omitted." 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" (format "%s%s-%s"
(if omit-start-date "" (if omit-start-date ""
(concat (di:format-date start) " ")) (concat (di:format-date start) " "))
(di:format-time-as-local start) (di:format-time-as-local start)
(di:format-time-as-local end)))) (di:format-time-as-local end))))
(defun di:format-block-sexp (start end) (defun di:calendar-date (date)
"Format a `diary-block' diary S-expression between START and END. "Create a DATE list as calendar date list of desired style.
START and END may be `icalendar-date' or `icalendar-date-time' DATE may be a `icalendar-date' or `icalendar-date-time' value. If it is
values. If they are date-times, only the date parts will be considered. a date-time, only the date parts will be considered. Returns a list
Returns a string like \"%%(diary-block ...)\" with the arguments properly with elements properly ordered for the current value of
ordered for the current value of `calendar-date-style'." `calendar-date-style'. DATE may also be a list consisting of date
(unless (cl-typep start 'ical:date) values and t as wildcards."
(setq start (ical:date-time-to-date start))) (when-let* ((dt (or (ical:date/time-to-date date)
(unless (cl-typep end 'ical:date) (take 3 date))) ;; wildcard date list
(setq end (ical:date-time-to-date end))) (year (calendar-extract-year dt))
(concat (mon (calendar-extract-month dt))
diary-sexp-entry-symbol (day (calendar-extract-day dt)))
(apply #'format "(diary-block %d %d %d %d %d %d)" (cl-case calendar-date-style
(cl-case calendar-date-style (american (list mon day year)) ;; M/D/Y
;; M/D/Y (european (list day mon year)) ;; D/M/Y
(american (list (calendar-extract-month start) (iso (list year mon day)) ;; Y/M/D
(calendar-extract-day start) )))
(calendar-extract-year start)
(calendar-extract-month end) (defun di:block-sexp (start end)
(calendar-extract-day end) "Create a `diary-block/-date' diary S-expression between START and END.
(calendar-extract-year end)))
;; D/M/Y START and END may be `icalendar-date' or `icalendar-date-time' values.
(european (list (calendar-extract-day start) If they are date-times, only the date parts will be considered. If
(calendar-extract-month start) START and END are the same date, then return a date expression,
(calendar-extract-year start) otherwise use `diary-block'. The dates are written in proper order for
(calendar-extract-day end) `calendar-date-style'."
(calendar-extract-month end) (let ((s (di:calendar-date start))
(calendar-extract-year end))) (e (di:calendar-date end)))
;; Y/M/D (if (equal s e)
(iso (list (calendar-extract-year start) (di:format-date start)
(calendar-extract-month start) `(diary-block ,@s ,@e))))
(calendar-extract-day start)
(calendar-extract-year end) (defun di:format-block-sexp (start end)
(calendar-extract-month end) "Format diary s-exp string from block sexp using START and END."
(calendar-extract-day 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) (defun di:format-time-block-sexp (start end)
"Format a `diary-time-block' diary S-expression for times between START and 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 diary-sexp-entry-symbol
(format "(diary-time-block :start '%s :end '%s)" start end))) (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) (defun di:format-rrule-sexp (component)
"Format the recurrence rule data in COMPONENT as a diary S-expression. "Format the recurrence rule data in COMPONENT as a diary S-expression.
@ -1502,26 +1715,14 @@ the event."
(dur-value (cond (duration duration) (dur-value (cond (duration duration)
(dtend (unless (equal dtstart dtend) (dtend (unless (equal dtstart dtend)
(ical:duration-between dtstart dtend))) (ical:duration-between dtstart dtend)))
(t nil))) (t nil))))
(arg-plist 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 (string-trim ; removing trailing \n added by pp
(concat diary-sexp-entry-symbol (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 ;; This function puts all of the above together to format individual
;; iCalendar components as diary entries. The final formatting is done ;; iCalendar components as diary entries. The final formatting is done
@ -1636,6 +1837,40 @@ Returns a string containing the diary entry."
description-nodes description-nodes
"\n\n") "\n\n")
(ical:trimp description))) (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 (ical-start
(when dtstart (when dtstart
(if (bound-and-true-p ical-importing) (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))) (ical:date/time-to-date dtend-local)))
;; Importing, start and end times on same day: ;; Importing, start and end times on same day:
;; DATE HH:MM-HH:MM ;; 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) ((bound-and-true-p ical-importing)
;; Importing at least one date-time, on different days: ;; Importing at least one date-time, on different days:
;; %%(diary-time-block :start ... :end ...) ;; %%(diary-time-block :start ... :end ...)
@ -3580,7 +3816,9 @@ values (of the same type as START)."
start start
(ical:date/time-add-duration start duration)) (ical:date/time-add-duration start duration))
(di:format-time-as-local start))) (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)) (when (memq (ical:recur-freq date-rule) '(HOURLY MINUTELY SECONDLY))
(setf (alist-get 'FREQ date-rule) 'DAILY) (setf (alist-get 'FREQ date-rule) 'DAILY)
(setf (alist-get 'INTERVAL date-rule) 1) (setf (alist-get 'INTERVAL date-rule) 1)

176
lisp/calendar/diary-lib.el
View file

@ -666,32 +666,32 @@ any entries were found."
(if backup (re-search-backward "\\<" nil t)) (if backup (re-search-backward "\\<" nil t))
;; regexp moves us past the end of date, onto the next line. ;; regexp moves us past the end of date, onto the next line.
;; Trailing whitespace after date not allowed (see diary-file). ;; 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. ;; Diary entry that consists only of date.
(backward-char 1) (backward-char 1)
;; Found a nonempty diary entry--make it ;; Found a nonempty diary entry--make it
;; visible and add it to the list. ;; visible and add it to the list.
(setq date-start (line-end-position 0)) (setq date-start (line-end-position 0))
;; Actual entry starts on the next-line? ;; Actual entry starts on the next-line?
(if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) (if (looking-at-p "[ \t]*\n[ \t]") (forward-line 1))
(setq entry-found t (setq entry-found t
entry-start (point)) entry-start (point))
(forward-line 1) (forward-line 1)
(while (looking-at "[ \t]") ; continued entry (while (looking-at-p "[ \t]") ; continued entry
(forward-line 1)) (forward-line 1))
(unless (and (eobp) (not (bolp))) (unless (and (eobp) (not (bolp)))
(backward-char 1)) (backward-char 1))
(unless list-only (unless list-only
(remove-overlays date-start (point) 'invisible 'diary)) (remove-overlays date-start (point) 'invisible 'diary))
(setq temp (diary-pull-attrs (setq temp (diary-pull-attrs
(buffer-substring-no-properties (buffer-substring-no-properties
entry-start (point)) entry-start (point))
globattr)) globattr))
(diary-add-to-list (diary-add-to-list
(or gdate date) (car temp) (or gdate date) (car temp)
(buffer-substring-no-properties (buffer-substring-no-properties
(1+ date-start) (1- entry-start)) (1+ date-start) (1- entry-start))
(copy-marker entry-start) (cadr temp)))))) (copy-marker entry-start) (cadr temp))))))
entry-found))) entry-found)))
(defvar original-date) ; from diary-list-entries (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) (forward-sexp)
(setq sexp (buffer-substring-no-properties sexp-start (point))) (setq sexp (buffer-substring-no-properties sexp-start (point)))
(forward-char 1) (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. ;; Diary entry consists only of the sexp.
(progn (progn
(backward-char 1) (backward-char 1)
@ -1468,7 +1468,7 @@ is marked. See the documentation for the function `diary-list-sexp-entries'."
(setq entry-start (point)) (setq entry-start (point))
;; Find end of entry. ;; Find end of entry.
(forward-line 1) (forward-line 1)
(while (looking-at "[ \t]") (while (looking-at-p "[ \t]")
(forward-line 1)) (forward-line 1))
(if (bolp) (backward-char 1)) (if (bolp) (backward-char 1))
(setq entry (buffer-substring-no-properties entry-start (point)))) (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 '()))) (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(while (re-search-forward s-entry nil t) (while (re-search-forward s-entry nil t)
(backward-char 1) (backward-char 1)
(setq sexp-start (point)) (setq sexp-start (point)
line-start (line-end-position 0))
(forward-sexp) (forward-sexp)
(setq sexp (buffer-substring-no-properties sexp-start (point)) (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)) entry-start (1+ line-start))
(forward-char 1) (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. ;; Diary entry consists only of the sexp.
(progn (progn
(backward-char 1) (backward-char 1)
(setq entry "")) (setq entry ""))
(setq entry-start (point)) (setq entry-start (point))
(forward-line 1) (forward-line 1)
(while (looking-at "[ \t]") (while (looking-at-p "[ \t]")
(forward-line 1)) (forward-line 1))
(if (bolp) (backward-char 1)) (if (bolp) (backward-char 1))
(setq entry (buffer-substring-no-properties entry-start (point)))) (setq entry (buffer-substring-no-properties entry-start (point))))
@ -1912,6 +1911,91 @@ highlighting the day in the calendar."
"th" "th"
(aref ["th" "st" "nd" "rd"] (% n 10)))) (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. ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-anniversary (month day &optional year mark) (defun diary-anniversary (month day &optional year mark)
"Anniversary diary entry. "Anniversary diary entry.
@ -1938,7 +2022,27 @@ string to use when highlighting the day in the calendar."
(setq mm 3 (setq mm 3
dd 1)) dd 1))
(and (> diff 0) (calendar-date-equal (list mm dd y) date) (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. ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-cyclic (n month day year &optional mark) (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)))) (diary-make-date month day year))))
(cycle (/ diff n))) (cycle (/ diff n)))
(and (>= diff 0) (zerop (% 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. ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-offset (sexp days) (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." Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
(goto-char beg) (goto-char beg)
(forward-line 0) (forward-line 0)
(if (looking-at "=+$") (forward-line -1)) (if (looking-at-p "=+$") (forward-line -1))
(while (and (looking-at " +[^ ]") (while (and (looking-at-p " +[^ ]")
(zerop (forward-line -1)))) (zerop (forward-line -1))))
(goto-char end) (goto-char end)
(forward-line 0) (forward-line 0)
(while (and (looking-at " +[^ ]") (while (and (looking-at-p " +[^ ]")
(zerop (forward-line 1)))) (zerop (forward-line 1))))
(if (looking-at "=+$") (if (looking-at-p "=+$")
(setq end (line-beginning-position 2))) (setq end (line-beginning-position 2)))
(font-lock-default-fontify-region beg end verbose)) (font-lock-default-fontify-region beg end verbose))

2
lisp/calendar/icalendar-recur.el
View file

@ -1,6 +1,6 @@
;;; icalendar-recur.el --- Support for iCalendar recurrences and time zones -*- lexical-binding: t; -*- ;;; 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 <rwl@recursewithless.net> ;; Author: Richard Lawrence <rwl@recursewithless.net>
;; Created: December 2024 ;; Created: December 2024

8
lisp/calendar/icalendar-utils.el
View file

@ -1,6 +1,6 @@
;;; icalendar-utils.el --- iCalendar utility functions -*- lexical-binding: t; -*- ;;; 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 <rwl@recursewithless.net> ;; Author: Richard Lawrence <rwl@recursewithless.net>
;; Created: January 2025 ;; Created: January 2025
@ -135,9 +135,9 @@ arguments."
"Extract a Gregorian date from DT. "Extract a Gregorian date from DT.
An `icalendar-date' value is returned unchanged. An `icalendar-date' value is returned unchanged.
An `icalendar-date-time' value is converted to an `icalendar-date'." An `icalendar-date-time' value is converted to an `icalendar-date'."
(if (cl-typep dt 'ical:date) (cl-typecase dt
dt (ical:date dt)
(ical:date-time-to-date dt))) (ical:date-time (ical:date-time-to-date dt))))
;; Type-aware accessors for date/time slots that work for both ical:date ;; Type-aware accessors for date/time slots that work for both ical:date
;; and ical:date-time: ;; and ical:date-time: