mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 04:21:24 +00:00
; 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.
This commit is contained in:
Michael R. Mauger
parent
90f8f27a58
commit
d2383702a2
4 changed files with 442 additions and 100 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <rwl@recursewithless.net>
|
||||
;; Created: December 2024
|
||||
|
|
|
|||
|
|
@ -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 <rwl@recursewithless.net>
|
||||
;; 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:
|
||||
|
|
|
|||
Loading…
Reference in a new issue