From: Jan Tatarik Date: Sat, 22 Aug 2020 13:39:17 +0000 (+0200) Subject: gnus-icalendar does not understand multiple repeating days X-Git-Tag: emacs-28.0.90~6462 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5c715113efe91f4feb03e37b8b1287cd5afe9e94;p=emacs.git gnus-icalendar does not understand multiple repeating days * lisp/gnus/gnus-icalendar.el (gnus-icalendar-event:recurring-days): New function (bug#39782). (gnus-icalendar-event:org-timestamp): New function. (gnus-icalendar--find-day): Use them. (gnus-icalendar-event--org-timestamp): Ditto. --- diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index ab121f1f9ed..f13d4dec014 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -138,6 +138,22 @@ (or (match-string 1 rrule) default-interval))) +(cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event)) + "Return, when available, the week day numbers on which the EVENT recurs." + (let ((rrule (gnus-icalendar-event:recur event)) + (weekday-map '(("SU" . 0) + ("MO" . 1) + ("TU" . 2) + ("WE" . 3) + ("TH" . 4) + ("FR" . 5) + ("SA" . 6)))) + (when (string-match "BYDAY=\\([^;]+\\)" rrule) + (let ((bydays (split-string (match-string 1 rrule) ","))) + (seq-map + (lambda (x) (cdr (assoc x weekday-map))) + (seq-filter (lambda (x) (string-match "^[A-Z]\\{2\\}$" x)) bydays)))))) + (cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) @@ -401,21 +417,26 @@ Return nil for non-recurring EVENT." (when org-freq (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) -(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) - "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." - (let* ((start (gnus-icalendar-event:start-time event)) - (end (gnus-icalendar-event:end-time event)) - (start-date (format-time-string "%Y-%m-%d" start)) +(defun gnus-icalendar--find-day (start-date end-date day) + (let ((time-1-day 86400)) + (if (= (decoded-time-weekday (decode-time start-date)) + day) + (list start-date end-date) + (gnus-icalendar--find-day (time-add start-date time-1-day) + (time-add end-date time-1-day) + day)))) + +(defun gnus-icalendar-event--org-timestamp (start end org-repeat) + (let* ((start-date (format-time-string "%Y-%m-%d" start)) (start-time (format-time-string "%H:%M" start)) (start-at-midnight (string= start-time "00:00")) (end-date (format-time-string "%Y-%m-%d" end)) (end-time (format-time-string "%H:%M" end)) (end-at-midnight (string= end-time "00:00")) (start-end-date-diff - (time-to-number-of-days (time-subtract - (org-time-string-to-time end-date) - (org-time-string-to-time start-date)))) - (org-repeat (gnus-icalendar-event:org-repeat event)) + (time-to-number-of-days + (time-subtract (org-time-string-to-time end-date) + (org-time-string-to-time start-date)))) (repeat (if org-repeat (concat " " org-repeat) "")) (time-1-day 86400)) @@ -446,7 +467,31 @@ Return nil for non-recurring EVENT." ;; A .:. - A .:. -> A .:.-.:. ;; A .:. - B .:. ((zerop start-end-date-diff) (format "<%s %s-%s%s>" start-date start-time end-time repeat)) - (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time))))) + (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time)))) + ) + +(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) + "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." + ;; if org-repeat +1d or +1w and byday: generate one timestamp per + ;; byday, starting at start-date. Change +1d to +7d. + (let ((start (gnus-icalendar-event:start-time event)) + (end (gnus-icalendar-event:end-time event)) + (org-repeat (gnus-icalendar-event:org-repeat event)) + (recurring-days (gnus-icalendar-event:recurring-days event))) + (if (and (or (string= org-repeat "+1d") + (string= org-repeat "+1w")) + recurring-days) + (let ((repeat "+1w") + (dates (seq-sort-by + 'car + 'time-less-p + (seq-map (lambda (x) + (gnus-icalendar--find-day start end x)) + recurring-days)))) + (mapconcat (lambda (x) + (gnus-icalendar-event--org-timestamp (car x) (cadr x) + repeat)) dates "\n")) + (gnus-icalendar-event--org-timestamp start end org-repeat)))) (defun gnus-icalendar--format-summary-line (summary &optional location) (if location diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el new file mode 100644 index 00000000000..66b8c8099ac --- /dev/null +++ b/test/lisp/gnus/gnus-icalendar-tests.el @@ -0,0 +1,229 @@ +;;; gnus-icalendar-tests.el --- tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Jan Tatarik + +;; Author: Jan Tatarik +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'gnus-icalendar) + + +(defun gnus-icalendar-tests--get-ical-event (ical-string &optional participant) + "Return gnus-icalendar event for ICAL-STRING." + (let (event) + (with-temp-buffer + (insert ical-string) + (setq event (gnus-icalendar-event-from-buffer (buffer-name) participant))) + event)) + +(defun icalendar-tests--get-ical-event (ical-string) + "Return iCalendar event for ICAL-STRING." + (save-excursion + (with-temp-buffer + (insert ical-string) + (goto-char (point-min)) + (car (icalendar--read-element nil nil))))) + +(ert-deftest gnus-icalendar-parse () + "test" + (let ((event (gnus-icalendar-tests--get-ical-event " +BEGIN:VCALENDAR +PRODID:-//Google Inc//Google Calendar 70.9054//EN +VERSION:2.0 +CALSCALE:GREGORIAN +METHOD:REQUEST +BEGIN:VTIMEZONE +TZID:America/New_York +X-LIC-LOCATION:America/New_York +BEGIN:DAYLIGHT +TZOFFSETFROM:-0500 +TZOFFSETTO:-0400 +TZNAME:EDT +DTSTART:19700308T020000 +RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=2SU +END:DAYLIGHT +BEGIN:STANDARD +TZOFFSETFROM:-0400 +TZOFFSETTO:-0500 +TZNAME:EST +DTSTART:19701101T020000 +RRULE:FREQ=YEARLY;BYMONTH=11;BYDAY=1SU +END:STANDARD +END:VTIMEZONE +BEGIN:VEVENT +DTSTART;TZID=America/New_York:20201208T090000 +DTEND;TZID=America/New_York:20201208T100000 +DTSTAMP:20200728T182853Z +ORGANIZER;CN=Company Events:mailto:liveintent.com_3bm6fh805bme9uoeliqcle1sa + g@group.calendar.google.com +UID:iipdt88slddpeu7hheuu09sfmd@google.com +X-MICROSOFT-CDO-OWNERAPPTID:-362490173 +RECURRENCE-ID;TZID=America/New_York:20201208T091500 +CREATED:20200309T134939Z +DESCRIPTION:In this meeting\, we will cover topics from product and enginee + ring presentations and demos to new hire announcements to watching the late +LAST-MODIFIED:20200728T182852Z +LOCATION:New York-22-Town Hall Space (250) [Chrome Box] +SEQUENCE:4 +STATUS:CONFIRMED +SUMMARY:Townhall | All Company Meeting +TRANSP:OPAQUE +END:VEVENT +END:VCALENDAR +"))) + + (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) + (should (not (gnus-icalendar-event:recurring-p event))) + (should (string= (gnus-icalendar-event:start event) "2020-12-08 15:00")) + (with-slots (organizer summary description location end-time uid rsvp participation-type) event + (should (string= organizer "liveintent.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com")) + (should (string= summary "Townhall | All Company Meeting")) + (should (string= description "In this meeting\, we will cover topics from product and engineering presentations and demos to new hire announcements to watching the late")) + (should (string= location "New York-22-Town Hall Space (250) [Chrome Box]")) + (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-12-08 16:00")) + (should (string= uid "iipdt88slddpeu7hheuu09sfmd@google.com")) + (should (not rsvp)) +(should (eq participation-type 'non-participant))))) + +(ert-deftest gnus-icalendary-byday () + "" + (let ((event (gnus-icalendar-tests--get-ical-event " +BEGIN:VCALENDAR +PRODID:Zimbra-Calendar-Provider +VERSION:2.0 +METHOD:REQUEST +BEGIN:VTIMEZONE +TZID:America/New_York +BEGIN:STANDARD +DTSTART:16010101T020000 +TZOFFSETTO:-0500 +TZOFFSETFROM:-0400 +RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU +TZNAME:EST +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:16010101T020000 +TZOFFSETTO:-0400 +TZOFFSETFROM:-0500 +RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU +TZNAME:EDT +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +UID:903a5415-9067-4f63-b499-1b6205f49c88 +RRULE:FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR +SUMMARY:appointment every weekday\, start jul 24\, 2020\, end aug 24\, 2020 +ATTENDEE;CN=Mark Hershberger;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP + =TRUE:mailto:hexmode gmail.com +ORGANIZER;CN=Mark A. Hershberger:mailto:mah nichework.com +DTSTART;TZID=\"America/New_York\":20200724T090000 +DTEND;TZID=\"America/New_York\":20200724T093000 +STATUS:CONFIRMED +CLASS:PUBLIC +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +TRANSP:OPAQUE +LAST-MODIFIED:20200719T150815Z +DTSTAMP:20200719T150815Z +SEQUENCE:0 +DESCRIPTION:The following is a new meeting request: +BEGIN:VALARM +ACTION:DISPLAY +TRIGGER;RELATED=START:-PT5M +DESCRIPTION:Reminder +END:VALARM +END:VEVENT +END:VCALENDAR" (list "Mark Hershberger")))) + + (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) + (should (gnus-icalendar-event:recurring-p event)) + (should (string= (gnus-icalendar-event:recurring-interval event) "1")) + (should (string= (gnus-icalendar-event:start event) "2020-07-24 15:00")) + (with-slots (organizer summary description location end-time uid rsvp participation-type) event + (should (string= organizer "mah nichework.com")) + (should (string= summary "appointment every weekday\, start jul 24\, 2020\, end aug 24\, 2020")) + (should (string= description "The following is a new meeting request:")) + (should (null location)) + (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-07-24 15:30")) + (should (string= uid "903a5415-9067-4f63-b499-1b6205f49c88")) + (should rsvp) + (should (eq participation-type 'required))) + (should (equal (gnus-icalendar-event:recurring-days event) '(1 2 3 4 5))) + (should (string= (gnus-icalendar-event:org-timestamp event) "<2020-07-24 15:00-15:30 +1w> +<2020-07-27 15:00-15:30 +1w> +<2020-07-28 15:00-15:30 +1w> +<2020-07-29 15:00-15:30 +1w> +<2020-07-30 15:00-15:30 +1w>")) + )) + + +;; (VCALENDAR nil +;; ((PRODID nil "Zimbra-Calendar-Provider") +;; (VERSION nil "2.0") +;; (METHOD nil "REQUEST")) +;; ((VTIMEZONE nil +;; ((TZID nil "America/New_York")) +;; ((STANDARD nil +;; ((DTSTART nil "16010101T020000") +;; (TZOFFSETTO nil "-0500") +;; (TZOFFSETFROM nil "-0400") +;; (RRULE nil "FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU") +;; (TZNAME nil "EST")) +;; nil) +;; (DAYLIGHT nil +;; ((DTSTART nil "16010101T020000") +;; (TZOFFSETTO nil "-0400") +;; (TZOFFSETFROM nil "-0500") +;; (RRULE nil "FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU") +;; (TZNAME nil "EDT")) +;; nil))) +;; (VEVENT nil +;; ((UID nil "903a5415-9067-4f63-b499-1b6205f49c88") +;; (RRULE nil "FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR") +;; (SUMMARY nil "appointment every weekday, start jul 24, 2020, end aug 24, 2020") +;; (ATTENDEE +;; (CN "Mark Hershberger" ROLE "REQ-PARTICIPANT" PARTSTAT "NEEDS-ACTION" CN "Mark A. Hershberger") +;; "mailto:mah nichework.com") +;; (DTSTART +;; (TZID "America/New_York") +;; "20200724T090000") +;; (DTEND +;; (TZID "America/New_York") +;; "20200724T093000") +;; (STATUS nil "CONFIRMED") +;; (CLASS nil "PUBLIC") +;; (X-MICROSOFT-CDO-INTENDEDSTATUS nil "BUSY") +;; (TRANSP nil "OPAQUE") +;; (LAST-MODIFIED nil "20200719T150815Z") +;; (DTSTAMP nil "20200719T150815Z") +;; (SEQUENCE nil "0") +;; (DESCRIPTION nil "The following is a new meeting request:")) +;; ((VALARM nil +;; ((ACTION nil "DISPLAY") +;; (TRIGGER +;; (RELATED "START") +;; "-PT5M") +;; (DESCRIPTION nil "Reminder")) +;; nil))))) + +(provide 'gnus-icalendar-tests) +;;; gnus-icalendar-tests.el ends here