From c5e8254b9c89ac866df057fa3acd2dc44e3989ae Mon Sep 17 00:00:00 2001 From: Ulf Jasper Date: Wed, 2 Sep 2020 19:58:56 +0200 Subject: [PATCH] Apply icalendar.el patch by Thomas Plass . Fix bug#34315. * lisp/calendar/icalendar.el (icalendar--convert-tz-offset): No DST when RDATE is present. * lisp/calendar/icalendar.el (icalendar--parse-vtimezone): Use `icalendar--get-most-recent-observance'. * (icalendar--get-most-recent-observance): New. * (icalendar--decode-isodatetime): Add parameters source-zone, result-zone. * (icalendar--decode-isoduration): Fix decoding days. * test/lisp/calendar/icalendar-tests.el (icalendar--decode-isoduration): Add testcases. --- lisp/calendar/icalendar.el | 56 ++++++++++++++++++++------- test/lisp/calendar/icalendar-tests.el | 18 ++++----- 2 files changed, 52 insertions(+), 22 deletions(-) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index d76c1105031..dab277487e2 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -515,9 +515,10 @@ The strings are suitable for assembling into a TZ variable." (let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist)))) (offsetfrom (car (cddr (assq 'TZOFFSETFROM alist)))) (rrule-value (car (cddr (assq 'RRULE alist)))) + (rdate-p (and (assq 'RDATE alist) t)) (dtstart (car (cddr (assq 'DTSTART alist)))) - (no-dst (equal offsetto offsetfrom))) - ;; FIXME: for now we only handle RRULE and not RDATE here. + (no-dst (or rdate-p (equal offsetto offsetfrom)))) + ;; FIXME: the presence of an RDATE is assumed to denote the first day of the year (when (and offsetto dtstart (or rrule-value no-dst)) (let* ((rrule (icalendar--split-value rrule-value)) (freq (cadr (assq 'FREQ rrule))) @@ -561,12 +562,13 @@ The strings are suitable for assembling into a TZ variable." (defun icalendar--parse-vtimezone (alist) "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING). +Consider only the most recent date specification. Return nil if timezone cannot be parsed." (let* ((tz-id (icalendar--convert-string-for-import (icalendar--get-event-property alist 'TZID))) - (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT)))) + (daylight (cadr (cdar (icalendar--get-most-recent-observance alist 'DAYLIGHT)))) (day (and daylight (icalendar--convert-tz-offset daylight t))) - (standard (cadr (cdar (icalendar--get-children alist 'STANDARD)))) + (standard (cadr (cdar (icalendar--get-most-recent-observance alist 'STANDARD)))) (std (and standard (icalendar--convert-tz-offset standard nil)))) (if (and tz-id std) (cons tz-id @@ -575,6 +577,28 @@ Return nil if timezone cannot be parsed." "," (cdr day) "," (cdr std)) (car std)))))) +(defun icalendar--get-most-recent-observance (alist sub-comp) + "Return the latest observance for SUB-COMP DAYLIGHT or STANDARD. +ALIST is a VTIMEZONE potentially containing historical records." +;FIXME?: "most recent" should be relative to a given date + (let ((components (icalendar--get-children alist sub-comp))) + (list + (car + (sort components + #'(lambda (a b) + (let* ((get-recent (lambda (n) + (car + (sort + (delq nil + (mapcar (lambda (p) + (and (memq (car p) '(DTSTART RDATE)) + (car (cddr p)))) + n)) + 'string-greaterp)))) + (a-recent (funcall get-recent (car (cddr a)))) + (b-recent (funcall get-recent (car (cddr b))))) + (string-greaterp a-recent b-recent)))))))) + (defun icalendar--convert-all-timezones (icalendar) "Convert all timezones in the ICALENDAR into an alist. Each element of the alist is a cons (ID . TZ-STRING), @@ -594,15 +618,18 @@ ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'." (cdr (assoc id zone-map))))) (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift - zone) + source-zone + result-zone) "Return ISODATETIMESTRING in format like `decode-time'. Converts from ISO-8601 to Emacs representation. If ISODATETIMESTRING specifies UTC time (trailing letter Z) the decoded time is given in the local time zone! If optional parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT days. -ZONE, if provided, is the timezone, in any format understood by `encode-time'. - +SOURCE-ZONE, if provided, is the timezone for decoding the time, +in any format understood by `encode-time'. +RESULT-ZONE, if provided, is the timezone for encoding the result +in any format understood by `decode-time'. FIXME: multiple comma-separated values should be allowed!" (icalendar--dmsg isodatetimestring) (if isodatetimestring @@ -624,7 +651,10 @@ FIXME: multiple comma-separated values should be allowed!" (when (and (> (length isodatetimestring) 15) ;; UTC specifier present (char-equal ?Z (aref isodatetimestring 15))) - (setq zone t)) + (setq source-zone t + ;; decode to local time unless result-zone is explicitly given, + ;; i.e. do not decode to UTC, i.e. do not (setq result-zone t) + )) ;; shift if necessary (if day-shift (let ((mdy (calendar-gregorian-from-absolute @@ -637,9 +667,9 @@ FIXME: multiple comma-separated values should be allowed!" ;; create the decoded date-time ;; FIXME!?! (let ((decoded-time (list second minute hour day month year - nil -1 zone))) + nil -1 source-zone))) (condition-case nil - (decode-time (encode-time decoded-time)) + (decode-time (encode-time decoded-time) result-zone) (error (message "Cannot decode \"%s\"" isodatetimestring) ;; Hope for the best.... @@ -685,9 +715,9 @@ FIXME: multiple comma-separated values should be allowed!" (setq days (1- days)))) ((match-beginning 4) ;days and time (if (match-beginning 5) - (setq days (* 7 (read (substring isodurationstring - (match-beginning 6) - (match-end 6)))))) + (setq days (read (substring isodurationstring + (match-beginning 6) + (match-end 6))))) (if (match-beginning 7) (setq hours (read (substring isodurationstring (match-beginning 8) diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 2beab614c87..bce7de769e0 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -590,25 +590,25 @@ END:VEVENT (should (equal '(0 0 0 7 0 0) (icalendar--decode-isoduration "P7D"))) - ;; testcase: 7 days, one second -- to be fixed with bug#34315 - ;; (should (equal '(1 0 0 7 0 0) - ;; (icalendar--decode-isoduration "P7DT1S"))) + ;; testcase: 7 days, one second -- see bug#34315 + (should (equal '(1 0 0 7 0 0) + (icalendar--decode-isoduration "P7DT1S"))) ;; testcase: 3 hours, 2 minutes, one second (should (equal '(1 2 3 0 0 0) (icalendar--decode-isoduration "PT3H2M1S"))) - ;; testcase: 99 days, 3 hours, 2 minutes, one second -- to be fixed with bug#34315 - ;; (should (equal '(1 2 3 99 0 0) - ;; (icalendar--decode-isoduration "P99DT3H2M1S"))) + ;; testcase: 99 days, 3 hours, 2 minutes, one second -- see bug#34315 + (should (equal '(1 2 3 99 0 0) + (icalendar--decode-isoduration "P99DT3H2M1S"))) ;; testcase: 2 weeks (should (equal '(0 0 0 14 0 0) (icalendar--decode-isoduration "P2W"))) - ;; testcase: rfc2445, section 4.3.6: 15 days, 5 hours and 20 seconds -- to be fixed with bug#34315 - ;; (should (equal '(20 0 5 15 0 0) - ;; (icalendar--decode-isoduration "P15DT5H0M20S"))) + ;; testcase: rfc2445, section 4.3.6: 15 days, 5 hours and 20 seconds -- see bug#34315 + (should (equal '(20 0 5 15 0 0) + (icalendar--decode-isoduration "P15DT5H0M20S"))) ;; testcase: rfc2445, section 4.3.6: 7 weeks (should (equal '(0 0 0 49 0 0) -- 2.39.2