aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJan Tatarik2013-11-15 00:07:54 +0000
committerKatsumi Yamaoka2013-11-15 00:07:54 +0000
commit8ef7141bbe65aec2eb5313ff19729b67d371c1e6 (patch)
tree5cce6feba9827e5cf8541ddf3f3349fbf4ebbdf2
parent583626623762e31836984a5acfa4c88bddc28d4f (diff)
downloademacs-8ef7141bbe65aec2eb5313ff19729b67d371c1e6.tar.gz
emacs-8ef7141bbe65aec2eb5313ff19729b67d371c1e6.zip
lisp/gnus/gnus-icalendar.el (gnus-icalendar-event->gnus-calendar, gnus-icalendar-event-from-ical, gnus-icalendar-event->org-entry, gnus-icalendar--update-org-event): Required/optional participation, list of attendees synced to org
-rw-r--r--lisp/gnus/ChangeLog8
-rw-r--r--lisp/gnus/gnus-icalendar.el56
2 files changed, 60 insertions, 4 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index e47573d5d6b..9a6ea149753 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,11 @@
12013-11-15 Jan Tatarik <jan.tatarik@gmail.com>
2
3 * gnus-icalendar.el (gnus-icalendar-event->gnus-calendar)
4 (gnus-icalendar-event-from-ical)
5 (gnus-icalendar-event->org-entry)
6 (gnus-icalendar--update-org-event): Required/optional participation,
7 list of attendees synced to org.
8
12013-11-13 Jan Tatarik <jan.tatarik@gmail.com> 92013-11-13 Jan Tatarik <jan.tatarik@gmail.com>
2 10
3 * gnus-icalendar.el (gnus-icalendar-event:sync-to-org) 11 * gnus-icalendar.el (gnus-icalendar-event:sync-to-org)
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 064ba84cadc..a8277635f3e 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -91,7 +91,19 @@
91 (rsvp :initarg :rsvp 91 (rsvp :initarg :rsvp
92 :accessor gnus-icalendar-event:rsvp 92 :accessor gnus-icalendar-event:rsvp
93 :initform nil 93 :initform nil
94 :type (or null boolean))) 94 :type (or null boolean))
95 (participation-required :initarg :participation-required
96 :accessor gnus-icalendar-event:participation-required
97 :initform t
98 :type (or null boolean))
99 (req-participants :initarg :req-participants
100 :accessor gnus-icalendar-event:req-participants
101 :initform nil
102 :type (or null t))
103 (opt-participants :initarg :opt-participants
104 :accessor gnus-icalendar-event:opt-participants
105 :initform nil
106 :type (or null t)))
95 "generic iCalendar Event class") 107 "generic iCalendar Event class")
96 108
97(defclass gnus-icalendar-event-request (gnus-icalendar-event) 109(defclass gnus-icalendar-event-request (gnus-icalendar-event)
@@ -151,6 +163,24 @@
151 163
152 (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) 164 (gnus-icalendar-find-if #'attendee-prop-matches-p event-props))))
153 165
166(defun gnus-icalendar-event--get-attendee-names (ical)
167 (let* ((event (car (icalendar--all-events ical)))
168 (attendee-props (gnus-remove-if-not
169 (lambda (p) (eq (car p) 'ATTENDEE))
170 (caddr event))))
171
172 (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE))
173 (attendee-name (prop) (plist-get (cadr prop) 'CN))
174 (attendees-by-type (type)
175 (gnus-remove-if-not
176 (lambda (p) (string= (attendee-role p) type))
177 attendee-props))
178 (attendee-names-by-type (type)
179 (mapcar #'attendee-name (attendees-by-type type))))
180
181 (list
182 (attendee-names-by-type "REQ-PARTICIPANT")
183 (attendee-names-by-type "OPT-PARTICIPANT")))))
154 184
155(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) 185(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email)
156 (let* ((event (car (icalendar--all-events ical))) 186 (let* ((event (car (icalendar--all-events ical)))
@@ -165,12 +195,17 @@
165 (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) 195 (method (caddr (assoc 'METHOD (caddr (car (nreverse ical))))))
166 (attendee (when attendee-name-or-email 196 (attendee (when attendee-name-or-email
167 (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) 197 (gnus-icalendar-event--find-attendee ical attendee-name-or-email)))
198 (attendee-names (gnus-icalendar-event--get-attendee-names ical))
168 (args (list :method method 199 (args (list :method method
169 :organizer organizer 200 :organizer organizer
170 :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART) 201 :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART)
171 :end-time (gnus-icalendar-event--decode-datefield event 'DTEND) 202 :end-time (gnus-icalendar-event--decode-datefield event 'DTEND)
172 :rsvp (string= (plist-get (cadr attendee) 'RSVP) 203 :rsvp (string= (plist-get (cadr attendee) 'RSVP)
173 "TRUE"))) 204 "TRUE")
205 :participation-required (string= (plist-get (cadr attendee) 'ROLE)
206 "REQ-PARTICIPANT")
207 :req-participants (cdar attendee-names)
208 :opt-participants (cadr attendee-names)))
174 (event-class (cond 209 (event-class (cond
175 ((string= method "REQUEST") 'gnus-icalendar-event-request) 210 ((string= method "REQUEST") 'gnus-icalendar-event-request)
176 ((string= method "CANCEL") 'gnus-icalendar-event-cancel) 211 ((string= method "CANCEL") 'gnus-icalendar-event-cancel)
@@ -366,6 +401,10 @@ Return nil for non-recurring EVENT."
366 (format "%s (%s)" summary location) 401 (format "%s (%s)" summary location)
367 (format "%s" summary))) 402 (format "%s" summary)))
368 403
404
405(defun gnus-icalendar--format-participant-list (participants)
406 (mapconcat #'identity participants ", "))
407
369;; TODO: make the template customizable 408;; TODO: make the template customizable
370(defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) 409(defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status)
371 "Return string with new `org-mode' entry describing EVENT." 410 "Return string with new `org-mode' entry describing EVENT."
@@ -380,6 +419,9 @@ Return nil for non-recurring EVENT."
380 ("DT" . ,(gnus-icalendar-event:org-timestamp event)) 419 ("DT" . ,(gnus-icalendar-event:org-timestamp event))
381 ("ORGANIZER" . ,(gnus-icalendar-event:organizer event)) 420 ("ORGANIZER" . ,(gnus-icalendar-event:organizer event))
382 ("LOCATION" . ,(gnus-icalendar-event:location event)) 421 ("LOCATION" . ,(gnus-icalendar-event:location event))
422 ("PARTICIPATION_REQUIRED" . ,(when (gnus-icalendar-event:participation-required event) "t"))
423 ("REQ_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:req-participants event)))
424 ("OPT_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:opt-participants event)))
383 ("RRULE" . ,(gnus-icalendar-event:recur event)) 425 ("RRULE" . ,(gnus-icalendar-event:recur event))
384 ("REPLY" . ,reply)))) 426 ("REPLY" . ,reply))))
385 427
@@ -438,7 +480,8 @@ is searched."
438 (let ((file (gnus-icalendar-find-org-event-file event org-file))) 480 (let ((file (gnus-icalendar-find-org-event-file event org-file)))
439 (when file 481 (when file
440 (with-current-buffer (find-file-noselect file) 482 (with-current-buffer (find-file-noselect file)
441 (with-slots (uid summary description organizer location recur) event 483 (with-slots (uid summary description organizer location recur
484 participation-required req-participants opt-participants) event
442 (let ((event-pos (org-find-entry-with-id uid))) 485 (let ((event-pos (org-find-entry-with-id uid)))
443 (when event-pos 486 (when event-pos
444 (goto-char event-pos) 487 (goto-char event-pos)
@@ -480,6 +523,9 @@ is searched."
480 (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event)) 523 (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event))
481 (org-entry-put event-pos "ORGANIZER" organizer) 524 (org-entry-put event-pos "ORGANIZER" organizer)
482 (org-entry-put event-pos "LOCATION" location) 525 (org-entry-put event-pos "LOCATION" location)
526 (org-entry-put event-pos "PARTICIPATION_REQUIRED" (when participation-required "t"))
527 (org-entry-put event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants))
528 (org-entry-put event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants))
483 (org-entry-put event-pos "RRULE" recur) 529 (org-entry-put event-pos "RRULE" recur)
484 (when reply-status (org-entry-put event-pos "REPLY" 530 (when reply-status (org-entry-put event-pos "REPLY"
485 (capitalize (symbol-name reply-status)))) 531 (capitalize (symbol-name reply-status))))
@@ -595,11 +641,13 @@ is searched."
595 (propertize (concat (car x) ":") 'face 'bold) 641 (propertize (concat (car x) ":") 'face 'bold)
596 (cadr x)))) 642 (cadr x))))
597 643
598 (with-slots (organizer summary description location recur uid method rsvp) event 644 (with-slots (organizer summary description location recur uid
645 method rsvp participation-required) event
599 (let ((headers `(("Summary" ,summary) 646 (let ((headers `(("Summary" ,summary)
600 ("Location" ,(or location "")) 647 ("Location" ,(or location ""))
601 ("Time" ,(gnus-icalendar-event:org-timestamp event)) 648 ("Time" ,(gnus-icalendar-event:org-timestamp event))
602 ("Organizer" ,organizer) 649 ("Organizer" ,organizer)
650 ("Attendance" ,(if participation-required "Required" "Optional"))
603 ("Method" ,method)))) 651 ("Method" ,method))))
604 652
605 (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) 653 (when (and (not (gnus-icalendar-event-reply-p event)) rsvp)