RSVP handling.
[gnus] / lisp / gnus-icalendar.el
index cbb2855..56c56f3 100644 (file)
    (rsvp :initarg :rsvp
          :accessor gnus-icalendar-event:rsvp
          :initform nil
-         :type (or null boolean)))
+         :type (or null boolean))
+   (participation-required :initarg :participation-required
+         :accessor gnus-icalendar-event:participation-required
+         :initform t
+         :type (or null boolean))
+   (req-participants :initarg :req-participants
+         :accessor gnus-icalendar-event:req-participants
+         :initform nil
+         :type (or null t))
+   (opt-participants :initarg :opt-participants
+         :accessor gnus-icalendar-event:opt-participants
+         :initform nil
+         :type (or null t)))
   "generic iCalendar Event class")
 
 (defclass gnus-icalendar-event-request (gnus-icalendar-event)
 
       (gnus-icalendar-find-if #'attendee-prop-matches-p event-props))))
 
+(defun gnus-icalendar-event--get-attendee-names (ical)
+  (let* ((event (car (icalendar--all-events ical)))
+         (attendee-props (gnus-remove-if-not
+                          (lambda (p) (eq (car p) 'ATTENDEE))
+                          (caddr event))))
+
+    (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE))
+                 (attendee-name (prop) (plist-get (cadr prop) 'CN))
+                 (attendees-by-type (type)
+                   (gnus-remove-if-not
+                    (lambda (p) (string= (attendee-role p) type))
+                    attendee-props))
+                 (attendee-names-by-type (type)
+                    (mapcar #'attendee-name (attendees-by-type type))))
+
+      (list
+       (attendee-names-by-type "REQ-PARTICIPANT")
+       (attendee-names-by-type "OPT-PARTICIPANT")))))
 
 (defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email)
   (let* ((event (car (icalendar--all-events ical)))
          (method (caddr (assoc 'METHOD (caddr (car (nreverse ical))))))
          (attendee (when attendee-name-or-email
                      (gnus-icalendar-event--find-attendee ical attendee-name-or-email)))
+         (attendee-names (gnus-icalendar-event--get-attendee-names ical))
          (args (list :method method
                      :organizer organizer
                      :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART)
                      :end-time (gnus-icalendar-event--decode-datefield event 'DTEND)
                      :rsvp (string= (plist-get (cadr attendee) 'RSVP)
-                                    "TRUE")))
+                                    "TRUE")
+                     :participation-required (string= (plist-get (cadr attendee) 'ROLE)
+                                                      "REQ-PARTICIPANT")
+                     :req-participants (cdar attendee-names)
+                     :opt-participants (cadr attendee-names)))
          (event-class (cond
                        ((string= method "REQUEST") 'gnus-icalendar-event-request)
                        ((string= method "CANCEL") 'gnus-icalendar-event-cancel)
@@ -352,20 +387,56 @@ Return nil for non-recurring EVENT."
          (end (gnus-icalendar-event:end-time event))
          (start-date (format-time-string "%Y-%m-%d %a" 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 %a" end))
          (end-time (format-time-string "%H:%M" end))
+         (end-at-midnight (string= end-time "00:00"))
+         (start-end-date-diff (/ (float-time (time-subtract
+                                        (date-to-time end-date)
+                                        (date-to-time start-date)))
+                                 86400))
          (org-repeat (gnus-icalendar-event:org-repeat event))
-         (repeat (if org-repeat (concat " " org-repeat) "")))
-
-    (if (equal start-date end-date)
-        (format "<%s %s-%s%s>" start-date start-time end-time repeat)
-      (format "<%s %s>--<%s %s>" start-date start-time end-date end-time))))
+         (repeat (if org-repeat (concat " " org-repeat) ""))
+         (time-1-day '(0 86400)))
+
+    ;; NOTE: special care is needed with appointments ending at midnight
+    ;; (typically all-day events): the end time has to be changed to 23:59 to
+    ;; prevent org agenda showing the event on one additional day
+    (cond
+     ;; start/end midnight
+     ;; A 0:0 - A+1 0:0 -> A
+     ;; A 0:0 - A+n 0:0 -> A - A+n-1
+     ((and start-at-midnight end-at-midnight) (if (> start-end-date-diff 1)
+                                                  (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day))))
+                                                    (format "<%s>--<%s>" start-date end-ts))
+                                                (format "<%s%s>" start-date repeat)))
+     ;; end midnight
+     ;; A .:. - A+1 0:0 -> A .:.-23:59
+     ;; A .:. - A+n 0:0 -> A .:. - A_n-1
+     (end-at-midnight (if (= start-end-date-diff 1)
+                          (format "<%s %s-23:59%s>" start-date start-time repeat)
+                        (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day))))
+                          (format "<%s %s>--<%s>" start-date start-time end-ts))))
+     ;; start midnight
+     ;; A 0:0 - A .:. -> A 0:0-.:. (default 1)
+     ;; A 0:0 - A+n .:. -> A - A+n .:.
+     ((and start-at-midnight
+           (plusp start-end-date-diff)) (format "<%s>--<%s %s>" start-date end-date end-time))
+     ;; default
+     ;; 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)))))
 
 (defun gnus-icalendar--format-summary-line (summary &optional location)
   (if location
       (format "%s (%s)" summary location)
     (format "%s" summary)))
 
+
+(defun gnus-icalendar--format-participant-list (participants)
+  (mapconcat #'identity participants ", "))
+
 ;; TODO: make the template customizable
 (defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status)
   "Return string with new `org-mode' entry describing EVENT."
@@ -380,6 +451,9 @@ Return nil for non-recurring EVENT."
                       ("DT" . ,(gnus-icalendar-event:org-timestamp event))
                       ("ORGANIZER" . ,(gnus-icalendar-event:organizer event))
                       ("LOCATION" . ,(gnus-icalendar-event:location event))
+                      ("PARTICIPATION_REQUIRED" . ,(when (gnus-icalendar-event:participation-required event) "t"))
+                      ("REQ_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:req-participants event)))
+                      ("OPT_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:opt-participants event)))
                       ("RRULE" . ,(gnus-icalendar-event:recur event))
                       ("REPLY" . ,reply))))
 
@@ -438,7 +512,8 @@ is searched."
   (let ((file (gnus-icalendar-find-org-event-file event org-file)))
     (when file
       (with-current-buffer (find-file-noselect file)
-        (with-slots (uid summary description organizer location recur) event
+        (with-slots (uid summary description organizer location recur
+                         participation-required req-participants opt-participants) event
           (let ((event-pos (org-find-entry-with-id uid)))
             (when event-pos
               (goto-char event-pos)
@@ -480,6 +555,9 @@ is searched."
                 (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event))
                 (org-entry-put event-pos "ORGANIZER" organizer)
                 (org-entry-put event-pos "LOCATION" location)
+                (org-entry-put event-pos "PARTICIPATION_REQUIRED" (when participation-required "t"))
+                (org-entry-put event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants))
+                (org-entry-put event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants))
                 (org-entry-put event-pos "RRULE" recur)
                 (when reply-status (org-entry-put event-pos "REPLY"
                                                   (capitalize (symbol-name reply-status))))
@@ -546,7 +624,7 @@ is searched."
       (gnus-icalendar--update-org-event event reply-status)
     (gnus-icalendar:org-event-save event reply-status)))
 
-(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel))
+(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status)
   (when (gnus-icalendar-find-org-event-file event)
     (gnus-icalendar--cancel-org-event event)))
 
@@ -571,6 +649,22 @@ is searched."
   :type '(string)
   :group 'gnus-icalendar)
 
+(defcustom gnus-icalendar-additional-identities nil
+  "We need to know your identity to make replies to calendar requests work.
+
+Gnus will only offer you the Accept/Tentative/Decline buttons for
+calendar events if any of your identities matches at least one
+RSVP participant.
+
+Your identity is guessed automatically from the variables `user-full-name',
+`user-mail-address', and `gnus-ignored-from-addresses'.
+
+If you need even more aliases you can define them here.  It really
+only makes sense to define names or email addresses."
+
+  :type '(repeat string)
+  :group 'gnus-icalendar)
+
 (make-variable-buffer-local
  (defvar gnus-icalendar-reply-status nil))
 
@@ -584,8 +678,9 @@ is searched."
   (apply #'append
          (mapcar (lambda (x) (if (listp x) x (list x)))
                  (list user-full-name (regexp-quote user-mail-address)
-                       ; NOTE: this one can be a list
-                       gnus-ignored-from-addresses))))
+                       ; NOTE: these can be lists
+                       gnus-ignored-from-addresses ; already regexp-quoted
+                       (mapcar #'regexp-quote gnus-icalendar-additional-identities)))))
 
 ;; TODO: make the template customizable
 (defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status)
@@ -595,11 +690,13 @@ is searched."
                     (propertize (concat (car x) ":") 'face 'bold)
                     (cadr x))))
 
-    (with-slots (organizer summary description location recur uid method rsvp) event
+    (with-slots (organizer summary description location recur uid
+                           method rsvp participation-required) event
       (let ((headers `(("Summary" ,summary)
                       ("Location" ,(or location ""))
                       ("Time" ,(gnus-icalendar-event:org-timestamp event))
                       ("Organizer" ,organizer)
+                      ("Attendance" ,(if participation-required "Required" "Optional"))
                       ("Method" ,method))))
 
        (when (and (not (gnus-icalendar-event-reply-p event)) rsvp)
@@ -723,6 +820,18 @@ is searched."
                (when org-entry-exists-p
                  `("Show Org Entry" gnus-icalendar--show-org-event ,event))))))
 
+
+(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event-cancel))
+  (let ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)))
+
+    (delq nil (list
+               `("Show Agenda" gnus-icalendar-show-org-agenda ,event)
+               (when org-entry-exists-p
+                 `("Update Org Entry" gnus-icalendar-sync-event-to-org ,event))
+               (when org-entry-exists-p
+                 `("Show Org Entry" gnus-icalendar--show-org-event ,event))))))
+
+
 (defun gnus-icalendar-mm-inline (handle)
   (let ((event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities)))