From 74750e269b978b5a18329642d4370fdea2b536c1 Mon Sep 17 00:00:00 2001 From: Richard Lawrence Date: Sun, 28 Dec 2025 15:03:09 +0100 Subject: Some minor code improvements in iCalendar library * lisp/calendar/icalendar-mode.el: Update file header. Fix error display in 'icalendar-errors-mode': * lisp/calendar/icalendar.el (icalendar-error-regexp): Fix to allow " *UNFOLDED:" prefix in buffer names. (Extra colon was breaking match.) (icalendar-format-error): Suppress this prefix preferentially in long buffer names. Add declarations to some iCalendar macros: * lisp/calendar/icalendar-macs.el (icalendar-with-node-value) (icalendar-with-child-of) (icalendar-with-param-of) (icalendar-with-node-children) (icalendar-with-node-value) (icalendar-with-param) * lisp/calendar/icalendar-ast.el (icalendar-make-property) (icalendar-make-component) (icalendar-make-node-from-templates): Add (declare ...) forms. Add `icalendar-trimp' to icalendar-utils.el: * lisp/calendar/icalendar-utils.el (icalendar-trimp): New function. * lisp/calendar/diary-icalendar.el (diary-icalendar-format-entry) (diary-icalendar-parse-attendees-and-organizer) (diary-icalendar-parse-location) (diary-icalendar-parse-url) (diary-icalendar-parse-uid): Use it to replace diary-icalendar--nonempty. (diary-icalendar--nonempty): Remove. Move VTIMEZONE creation to icalendar-recur.el: The following changes move `diary-icalendar-current-tz-to-vtimezone' and associated code to icalendar-recur.el. Library users are likely to need this function, so it makes sense to keep it with other time zone-related code in that file, instead of having them depend on diary-icalendar. * lisp/calendar/icalendar-recur.el (icalendar-tz-data-insufficient) (icalendar-tz-unsupported): New error types. (icalendar-recur-current-tz-to-vtimezone): Rename from `diary-icalendar-current-tz-to-vtimezone'; signal new error types. (icalendar-recur--tz-warning): Rename from `diary-icalendar--tz-warning'. (icalendar-recur--emacs-local-tzid): Rename from `diary-icalendar--emacs-local-tzid'. (icalendar-recur--tz-info-sexp-p): Rename from `diary-icalendar--tz-info-sexp-p'. * lisp/calendar/diary-icalendar.el (diary-icalendar-current-tz-to-vtimezone): Reimplement with `icalendar-recur-current-tz-to-vtimezone'. (diary-icalendar--tz-warning) (diary-icalendar--emacs-local-tzid) (diary-icalendar--tz-info-sexp-p): Renamed and moved; see above. (diary-time-zone-export-strategy): Update validation function name. --- lisp/calendar/diary-icalendar.el | 168 +++++---------------------------------- lisp/calendar/icalendar-ast.el | 9 ++- lisp/calendar/icalendar-macs.el | 11 ++- lisp/calendar/icalendar-mode.el | 5 +- lisp/calendar/icalendar-recur.el | 157 +++++++++++++++++++++++++++++++++++- lisp/calendar/icalendar-utils.el | 5 ++ lisp/calendar/icalendar.el | 6 +- 7 files changed, 205 insertions(+), 156 deletions(-) diff --git a/lisp/calendar/diary-icalendar.el b/lisp/calendar/diary-icalendar.el index 640e063268a..eed53bfd700 100644 --- a/lisp/calendar/diary-icalendar.el +++ b/lisp/calendar/diary-icalendar.el @@ -673,32 +673,6 @@ recurring events for several years beyond the start time." :version "31.1" :type 'integer) -(defun di:-tz-info-sexp-p (_ sexp) - "Validate that SEXP gives time zone info like from `calendar-current-time-zone'." - (and (listp sexp) - (length= sexp 8) - (let ((utc-diff (nth 0 sexp)) - (dst-offset (nth 1 sexp)) - (std-zone (nth 2 sexp)) - (dst-zone (nth 3 sexp)) - (dst-starts (nth 4 sexp)) - (dst-ends (nth 5 sexp)) - (dst-starts-time (nth 6 sexp)) - (dst-ends-time (nth 7 sexp))) - (and - (integerp utc-diff) (< (abs utc-diff) (* 60 24)) - (integerp dst-offset) (< (abs utc-diff) (* 60 24)) - (stringp std-zone) - (stringp dst-zone) - (or (and (listp dst-starts) (memq 'year (flatten-list dst-starts))) - (and (null dst-starts) (equal std-zone dst-zone))) - (or (and (listp dst-ends) (memq 'year (flatten-list dst-ends))) - (and (null dst-ends) (equal std-zone dst-zone))) - (or (and (integerp dst-starts-time) (< (abs dst-starts-time) (* 60 24))) - (null dst-starts-time)) - (or (and (integerp dst-ends-time) (< (abs dst-ends-time) (* 60 24))) - (null dst-ends-time)))))) - (defcustom di:time-zone-export-strategy 'local "Strategy to use for exporting clock times in diary files. @@ -741,7 +715,7 @@ the events you are exporting." (const :tag "Convert local times to UTC" to-utc) (const :tag "Use floating times" floating) (sexp :tag "User-provided TZ information" - :match di:-tz-info-sexp-p + :match icr:-tz-info-sexp-p :type-error "See `calendar-current-time-zone' for format")) :link '(url-link "https://www.rfc-editor.org/rfc/rfc5545#section-3.3.5")) @@ -989,12 +963,6 @@ new code." ;;; Other utilities -(defsubst di:-nonempty (s) - "Ensure that string S is nonempty once trimmed: return the trimmed S, or nil." - (when (and s (stringp s)) - (let ((trimmed (string-trim s))) - (unless (equal "" trimmed) trimmed)))) - (defconst di:entry-regexp (rx line-start (group-n 1 ; first line of entry @@ -1660,10 +1628,10 @@ Returns a string containing the diary entry." (if (eq 'icalendar-vjournal component-type) (mapconcat (lambda (node) - (di:-nonempty (ical:text-to-string (ical:ast-node-value node)))) + (ical:trimp (ical:text-to-string (ical:ast-node-value node)))) description-nodes "\n\n") - (di:-nonempty description))) + (ical:trimp description))) (ical-start (when dtstart (if (bound-and-true-p ical-importing) @@ -1748,7 +1716,7 @@ Returns a string containing the diary entry." (when (and dtstart due-dt (bound-and-true-p ical-importing)) (di:format-time-block-sexp dtstart-local due-dt))) (ical-importing (bound-and-true-p ical-importing)) - (ical-location (or (di:-nonempty location) + (ical-location (or (ical:trimp location) (when geo (di:format-geo-coordinates geo)))) (ical-nonmarking nonmarking) (ical-organizer (di:format-attendee organizer-node)) @@ -1757,11 +1725,11 @@ Returns a string containing the diary entry." (ical-rrule-sexp (when (and is-recurring (bound-and-true-p ical-importing)) (di:format-rrule-sexp component))) - (ical-status (when status (di:-nonempty (downcase status)))) - (ical-summary (di:-nonempty summary)) + (ical-status (when status (ical:trimp (downcase status)))) + (ical-summary (ical:trimp summary)) (ical-transparency transp) - (ical-uid (di:-nonempty uid)) - (ical-url (di:-nonempty url))) + (ical-uid (ical:trimp uid)) + (ical-url (ical:trimp url))) (with-temp-buffer (cl-case (ical:ast-node-type component) (ical:vevent @@ -2108,7 +2076,7 @@ parsed as an `icalendar-organizer' node, or otherwise as an (unless (string-match ":" addr) ; URI scheme already present (setq addr (concat "mailto:" addr))) (when cn - (setq cn (di:-nonempty cn))) + (setq cn (ical:trimp cn))) (if (string-match di:organizer-regexp (buffer-substring (line-beginning-position) (line-end-position))) @@ -2130,7 +2098,7 @@ this node, or nil." (goto-char (point-min)) (when (and di:location-regexp (re-search-forward di:location-regexp nil t)) - (ical:make-property ical:location (di:-nonempty (match-string 1))))) + (ical:make-property ical:location (ical:trimp (match-string 1))))) (defun di:parse-class () "Parse `icalendar-class' node from entry. @@ -2166,7 +2134,7 @@ Searches the entry in the current restriction for an URL matching (goto-char (point-min)) (when (and di:url-regexp (re-search-forward di:url-regexp nil t)) - (ical:make-property ical:url (di:-nonempty (match-string 1))))) + (ical:make-property ical:url (ical:trimp (match-string 1))))) (defun di:parse-uid () "Parse `icalendar-uid' node from entry. @@ -2177,7 +2145,7 @@ Searches the entry in the current restriction for a UID matching (goto-char (point-min)) (when (and di:uid-regexp (re-search-forward di:uid-regexp nil t)) - (ical:make-property ical:uid (di:-nonempty (match-string 1))))) + (ical:make-property ical:uid (ical:trimp (match-string 1))))) (defun di:parse-summary-and-description () "Parse summary and description nodes from current restriction. @@ -3136,112 +3104,18 @@ times according to `diary-icalendar-time-zone-export-strategy'." ;;; Time zone handling during export: -(defconst di:-tz-warning - "This time zone information was inferred from incomplete system information; it should be correct for the date-times within this calendar file referencing this zone, but you should not rely on it more widely.") - -(defconst di:-emacs-local-tzid - "Emacs_Local_") - (defun di:current-tz-to-vtimezone (&optional tz tzid start-year) "Convert TZ to an `icalendar-vtimezone'. -TZ defaults to the output of `calendar-current-time-zone'; if specified, -it should be a list of the same form as that function returns. - -TZID, if specified, should be a string to identify this time zone; it -defaults to `diary-icalendar--emacs-local-tzid' plus the name of the -standard observance according to `calendar-current-time-zone'. - -START-YEAR, if specified, should be an integer giving the year in which -to start the observances in the time zone. It defaults to 1970." - (when (and tz (not (di:-tz-info-sexp-p nil tz))) - (di:signal-export-error - (format "Invalid time zone data: %s.\n%s." tz - "Check the value of `diary-icalendar-time-zone-export-strategy'"))) - (let* ((tzdata (or tz (calendar-current-time-zone))) - (std-offset (* 60 (nth 0 tzdata))) - (dst-offset (+ std-offset - (* 60 (nth 1 tzdata)))) - (std-name (nth 2 tzdata)) - (dst-name (nth 3 tzdata)) - (dst-starts (nth 4 tzdata)) - (dst-ends (nth 5 tzdata)) - (dst-start-minutes (nth 6 tzdata)) - (dst-end-minutes (nth 7 tzdata))) - - (unless (and std-offset - (or (equal std-name dst-name) - (and dst-starts dst-ends dst-start-minutes dst-end-minutes))) - (di:signal-export-error - "Insufficient time zone information to create VTIMEZONE")) - - (if (equal std-name dst-name) - ;; Local time zone doesn't use DST: - (ical:make-vtimezone - (ical:tzid (or tzid (concat di:-emacs-local-tzid std-name))) - (ical:make-standard - (ical:tzname std-name) - (ical:dtstart (ical:make-date-time :year (or start-year 1970) - :month 1 :day 1 - :hour 0 :minute 0 :second 0)) - (ical:tzoffsetfrom std-offset) - (ical:tzoffsetto std-offset) - (ical:comment di:-tz-warning))) - - ;; Otherwise we can provide both STANDARD and DAYLIGHT subcomponents: - (let* ((std->dst-rule - (if (eq (car dst-starts) 'calendar-nth-named-day) - `((FREQ YEARLY) - (BYMONTH (,(nth 3 dst-starts))) - (BYDAY (,(cons (nth 2 dst-starts) - (nth 1 dst-starts))))) - ;; The only other rules that `calendar-current-time-zone' - ;; can return are based on the Persian calendar, which we - ;; cannot express in an `icalendar-recur' value, at least - ;; pending an implementation of RFC 7529 - (di:signal-export-error - (format "Unable to export DST rule for current time zone: %s" - dst-starts)))) - (dst-start-date (calendar-dlet ((year (or start-year 1970))) - (eval dst-starts))) - (dst-start - (ical:date-to-date-time dst-start-date - :hour (/ dst-start-minutes 60) - :minute (mod dst-start-minutes 60) - :second 0)) - (dst->std-rule - (if (eq (car dst-ends) 'calendar-nth-named-day) - `((FREQ YEARLY) - (BYMONTH (,(nth 3 dst-ends))) - (BYDAY (,(cons (nth 2 dst-ends) - (nth 1 dst-ends))))) - (di:signal-export-error - (format "Unable to export DST rule for current time zone: %s" - dst-ends)))) - (std-start-date (calendar-dlet ((year (1- (or start-year 1970)))) - (eval dst-ends))) - (std-start - (ical:date-to-date-time std-start-date - :hour (/ dst-end-minutes 60) - :minute (mod dst-end-minutes 60) - :second 0))) - - (ical:make-vtimezone - (ical:tzid (or tzid (concat di:-emacs-local-tzid std-name))) - (ical:make-standard - (ical:tzname std-name) - (ical:dtstart std-start) - (ical:rrule dst->std-rule) - (ical:tzoffsetfrom dst-offset) - (ical:tzoffsetto std-offset) - (ical:comment di:-tz-warning)) - (ical:make-daylight - (ical:tzname dst-name) - (ical:dtstart dst-start) - (ical:rrule std->dst-rule) - (ical:tzoffsetfrom std-offset) - (ical:tzoffsetto dst-offset) - (ical:comment di:-tz-warning))))))) +See `icalendar-recur-current-tz-to-vtimezone' for arguments' meanings. +This function wraps that one, but signals `icalendar-diary-export-error' +instead if TZ cannot be converted." + (condition-case err + (icr:current-tz-to-vtimezone tz tzid start-year) + ((ical:tz-insufficient-data ical:tz-unsupported) + (di:signal-export-error + (format "Unable to export time zone data: %s.\n%s." tz + "Check the value of `diary-icalendar-time-zone-export-strategy'"))))) ;;; Parsing complete diary entries: diff --git a/lisp/calendar/icalendar-ast.el b/lisp/calendar/icalendar-ast.el index 795d9dde65a..a84e28d36c1 100644 --- a/lisp/calendar/icalendar-ast.el +++ b/lisp/calendar/icalendar-ast.el @@ -490,7 +490,8 @@ The resulting syntax node is checked for validity by `icalendar-ast-node-valid-p' before it is returned." ;; TODO: support `ical:other-property', maybe like ;; (ical:other-property "X-NAME" value ...) - (declare (debug (symbolp form form &rest form))) + (declare (debug (symbolp form form &rest form)) + (indent 2)) (unless (ical:property-type-symbol-p type) (error "Not an iCalendar property type: %s" type)) (let ((value-types (cons (get type 'ical:default-type) @@ -553,7 +554,8 @@ properties. The resulting syntax node is checked for validity by `icalendar-ast-node-valid-p' before it is returned." - (declare (debug (symbolp form &rest form))) + (declare (debug (symbolp form &rest form)) + (indent 1)) ;; TODO: support `ical:other-component', maybe like ;; (ical:other-component (:x-name "X-NAME") templates ...) (unless (ical:component-type-symbol-p type) @@ -660,7 +662,8 @@ For example, an iCalendar VEVENT could be written like this: Before the constructed node is returned, it is validated by `icalendar-ast-node-valid-p'." - (declare (debug (symbolp form &rest form))) + (declare (debug (symbolp form &rest form)) + (indent 1)) (cond ((not (ical:type-symbol-p type)) (error "Not an iCalendar type symbol: %s" type)) diff --git a/lisp/calendar/icalendar-macs.el b/lisp/calendar/icalendar-macs.el index fe99cef14bc..852b48012a7 100644 --- a/lisp/calendar/icalendar-macs.el +++ b/lisp/calendar/icalendar-macs.el @@ -830,7 +830,8 @@ Each binding in BINDINGS should be a list of one of the following forms: nodes), or the :value-nodes themselves (if they are not). It is a compile-time error to use the singular keywords with a TYPE that takes multiple values, or the plural keywords with a TYPE that does not." - (declare (indent 2)) + (declare (debug (symbolp form form &rest form)) + (indent 2)) ;; Static checks on the bindings prevent various annoying bugs: (dolist (b bindings) (let ((type (car b)) @@ -1003,6 +1004,8 @@ is equivalent to BINDINGS are passed on to `icalendar-with-node-children' and will be available in BODY; see its docstring for their form." + (declare (debug (symbolp form &optional form &rest form)) + (indent 2)) (let ((vn (gensym "icalendar-node")) (val (gensym "icalendar-value")) (is-list (gensym "is-list"))) @@ -1066,6 +1069,8 @@ node's value. If PARAMETER's value is not a syntax node, then `value' is bound directly to PARAMETER's value, and `value-type' and `value-node' are bound to nil." + (declare (debug (symbolp form &rest form)) + (indent 1)) `(ical:with-node-value ,parameter nil ,@body)) (defmacro ical:with-child-of (node type &optional bindings &rest body) @@ -1084,6 +1089,8 @@ is equivalent to (icalendar-with-child-of some-node some-type nil value) See `icalendar-with-node-children' for the form of BINDINGS." + (declare (debug (symbolp form form &optional form &rest form)) + (indent 3)) (let ((child (gensym "icalendar-node"))) `(let ((,child (ical:ast-node-first-child-of ,type ,node))) (ical:with-node-value ,child ,bindings ,@body)))) @@ -1116,6 +1123,8 @@ symbol `value'; thus (icalendar-with-param-of some-property some-type) is equivalent to (icalendar-with-param-of some-property some-type nil value)" + (declare (debug (symbolp form form &rest form)) + (indent 2)) `(ical:with-child-of ,node ,type nil ,@body)) (provide 'icalendar-macs) diff --git a/lisp/calendar/icalendar-mode.el b/lisp/calendar/icalendar-mode.el index 2fc2aec44ff..c68a912d296 100644 --- a/lisp/calendar/icalendar-mode.el +++ b/lisp/calendar/icalendar-mode.el @@ -1,10 +1,12 @@ ;;; icalendar-mode.el --- Major mode for iCalendar format -*- lexical-binding: t; -*- ;;; -;; Copyright (C) 2024 Richard Lawrence +;; Copyright (C) 2024 Free Software Foundation, Inc. ;; Author: Richard Lawrence +;; Created: October 2024 ;; Keywords: calendar +;; Human-Keywords: calendar, iCalendar ;; This file is part of GNU Emacs. @@ -598,7 +600,6 @@ folding and syntax highlighting. Consider using `visual-line-mode' in ;; TODO: mode-specific menu and context menus ;; TODO: eldoc integration ;; TODO: completion of keywords - ;; TODO: hook for folding in change-major-mode-hook? (progn (setq font-lock-defaults '(ical:font-lock-keywords nil t)))) diff --git a/lisp/calendar/icalendar-recur.el b/lisp/calendar/icalendar-recur.el index 2f9045f278e..e3bee0923a9 100644 --- a/lisp/calendar/icalendar-recur.el +++ b/lisp/calendar/icalendar-recur.el @@ -76,6 +76,7 @@ (require 'icalendar-utils) (require 'cl-lib) (require 'calendar) +(require 'cal-dst) (require 'simple) (require 'seq) (eval-when-compile '(require 'icalendar-macs)) @@ -1478,6 +1479,14 @@ UTC offsets local to that time zone." (define-error 'ical:tz-no-observance "No observance found for date-time" 'ical:error) +(define-error 'ical:tz-data-insufficient + "Insufficient time zone data to create VTIMEZONE" + 'ical:error) + +(define-error 'ical:tz-unsupported + "Time zone rules not expressible as iCalendar RRULE" + 'ical:error) + ;; In RFC5545 Section 3.3.10, we read: "If the computed local start time ;; of a recurrence instance does not exist ... the time of the ;; recurrence instance is interpreted in the same manner as an explicit @@ -1983,7 +1992,153 @@ observance." (observance (car obs/onset))) (ical:with-property-of observance 'ical:tzname))) - +(defconst icr:-tz-warning + "This time zone information was inferred from incomplete system information; it should be correct for the date-times within this calendar file referencing this zone, but you should not rely on it more widely.") + +(defconst icr:-emacs-local-tzid + "Emacs_Local_") + +(defun icr:-tz-info-sexp-p (_ sexp) + "Validate that SEXP gives time zone info like from `calendar-current-time-zone'." + (and (listp sexp) + (length= sexp 8) + (let ((utc-diff (nth 0 sexp)) + (dst-offset (nth 1 sexp)) + (std-zone (nth 2 sexp)) + (dst-zone (nth 3 sexp)) + (dst-starts (nth 4 sexp)) + (dst-ends (nth 5 sexp)) + (dst-starts-time (nth 6 sexp)) + (dst-ends-time (nth 7 sexp))) + (and + (integerp utc-diff) (< (abs utc-diff) (* 60 24)) + (integerp dst-offset) (< (abs utc-diff) (* 60 24)) + (stringp std-zone) + (stringp dst-zone) + (or (and (listp dst-starts) (memq 'year (flatten-list dst-starts))) + (and (null dst-starts) (equal std-zone dst-zone))) + (or (and (listp dst-ends) (memq 'year (flatten-list dst-ends))) + (and (null dst-ends) (equal std-zone dst-zone))) + (or (and (integerp dst-starts-time) (< (abs dst-starts-time) (* 60 24))) + (null dst-starts-time)) + (or (and (integerp dst-ends-time) (< (abs dst-ends-time) (* 60 24))) + (null dst-ends-time)))))) + +(defun icr:current-tz-to-vtimezone (&optional tz tzid start-year) + "Convert TZ to an `icalendar-vtimezone'. + +TZ defaults to the output of `calendar-current-time-zone'; if specified, +it should be a list of the same form as that function returns. +Depending on TZ, this function might signal the following errors: + +`icalendar-tz-data-insufficient' if the data in TZ is not complete + enough to determine time zone rules. +`icalendar-tz-unsupported' if the data in TZ cannot be expressed as an + RFC5545 `icalendar-rrule' property. + +TZID, if specified, should be a string to identify this time zone; it +defaults to `icalendar-recur--emacs-local-tzid' plus the name of the +standard observance according to `calendar-current-time-zone'. + +START-YEAR, if specified, should be an integer giving the year in which +to start the observances in the time zone. It defaults to 1970." + (when (and tz (not (icr:-tz-info-sexp-p nil tz))) + (signal 'ical:tz-data-insufficient + (list :tz tz + :level 2 + :message + "Badly formed TZ data; see `calendar-current-time-zone'"))) + (let* ((tzdata (or tz (calendar-current-time-zone))) + (std-offset (* 60 (nth 0 tzdata))) + (dst-offset (+ std-offset + (* 60 (nth 1 tzdata)))) + (std-name (nth 2 tzdata)) + (dst-name (nth 3 tzdata)) + (dst-starts (nth 4 tzdata)) + (dst-ends (nth 5 tzdata)) + (dst-start-minutes (nth 6 tzdata)) + (dst-end-minutes (nth 7 tzdata))) + + (unless (and std-offset + (or (equal std-name dst-name) + (and dst-starts dst-ends dst-start-minutes dst-end-minutes))) + (signal 'ical:tz-data-insufficient + (list :tz tz :level 2 + :message "Unable to create VTIMEZONE from TZ"))) + + (if (equal std-name dst-name) + ;; Local time zone doesn't use DST: + (ical:make-vtimezone + (ical:tzid (or tzid (concat icr:-emacs-local-tzid std-name))) + (ical:make-standard + (ical:tzname std-name) + (ical:dtstart (ical:make-date-time :year (or start-year 1970) + :month 1 :day 1 + :hour 0 :minute 0 :second 0)) + (ical:tzoffsetfrom std-offset) + (ical:tzoffsetto std-offset) + (ical:comment icr:-tz-warning))) + + ;; Otherwise we can provide both STANDARD and DAYLIGHT subcomponents: + (let* ((std->dst-rule + (if (eq (car dst-starts) 'calendar-nth-named-day) + `((FREQ YEARLY) + (BYMONTH (,(nth 3 dst-starts))) + (BYDAY (,(cons (nth 2 dst-starts) + (nth 1 dst-starts))))) + ;; The only other rules that `calendar-current-time-zone' + ;; can return are based on the Persian calendar, which we + ;; cannot express in an `icalendar-recur' value, at least + ;; pending an implementation of RFC 7529 + (signal 'ical:tz-unsupported + (list :tz tz + :level 2 + :message + (format "Unable to export DST rule for time zone: %s" + dst-starts))))) + (dst-start-date (calendar-dlet ((year (or start-year 1970))) + (eval dst-starts))) + (dst-start + (ical:date-to-date-time dst-start-date + :hour (/ dst-start-minutes 60) + :minute (mod dst-start-minutes 60) + :second 0)) + (dst->std-rule + (if (eq (car dst-ends) 'calendar-nth-named-day) + `((FREQ YEARLY) + (BYMONTH (,(nth 3 dst-ends))) + (BYDAY (,(cons (nth 2 dst-ends) + (nth 1 dst-ends))))) + (signal 'ical:tz-unsupported + (list :tz tz + :level 2 + :message + (format "Unable to export DST rule for time zone: %s" + dst-ends))))) + (std-start-date (calendar-dlet ((year (1- (or start-year 1970)))) + (eval dst-ends))) + (std-start + (ical:date-to-date-time std-start-date + :hour (/ dst-end-minutes 60) + :minute (mod dst-end-minutes 60) + :second 0))) + + (ical:make-vtimezone + (ical:tzid (or tzid (concat icr:-emacs-local-tzid std-name))) + (ical:make-standard + (ical:tzname std-name) + (ical:dtstart std-start) + (ical:rrule dst->std-rule) + (ical:tzoffsetfrom dst-offset) + (ical:tzoffsetto std-offset) + (ical:comment icr:-tz-warning)) + (ical:make-daylight + (ical:tzname dst-name) + (ical:dtstart dst-start) + (ical:rrule std->dst-rule) + (ical:tzoffsetfrom std-offset) + (ical:tzoffsetto dst-offset) + (ical:comment icr:-tz-warning))))))) (provide 'icalendar-recur) diff --git a/lisp/calendar/icalendar-utils.el b/lisp/calendar/icalendar-utils.el index 28d98304d78..3f8e9d085c2 100644 --- a/lisp/calendar/icalendar-utils.el +++ b/lisp/calendar/icalendar-utils.el @@ -82,6 +82,11 @@ COMPONENT can be any component node." (ical:with-param-of property 'ical:tzidparam nil value)) ;; String manipulation +(defun ical:trimp (s &optional trim-left trim-right) + "Like `string-trim', but return nil if the trimmed string is empty." + (when (and s (stringp s)) + (let ((trimmed (string-trim s trim-left trim-right))) + (unless (equal "" trimmed) trimmed)))) (defun ical:strip-mailto (s) "Remove \"mailto:\" case-insensitively from the start of S." diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index d617e1eb8c5..2e00408564e 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -405,7 +405,7 @@ ERR-BUFFER defaults to the buffer returned by `icalendar-error-buffer'." (group "(" (or (group-n 3 "ERROR") (group-n 4 "WARNING") (group-n 5 "INFO")) ")")) - (group-n 1 (zero-or-more (not ":"))) ":" + (group-n 1 (zero-or-one " *UNFOLDED:") (zero-or-more (not ":"))) ":" (zero-or-one (group-n 2 (one-or-more digit))) ":") "Regexp to match iCalendar errors. @@ -455,7 +455,9 @@ data in ERROR-PLIST, if `icalendar-debug-level' is error-plist)))) ;; Make sure buffer name doesn't take too much space: (when (< 8 (length name)) - (put-text-property 9 (length name) 'display "..." name)) + (if (equal " *UNFOLDED:" (substring name 0 11)) + (put-text-property 0 11 'display "..." name) + (put-text-property 9 (length name) 'display "..." name))) (format "(%s)%s:%s: %s\n%s" level name pos message debug-info))) (defun ical:handle-generic-error (err-data &optional err-buffer) -- cgit v1.2.1