diff options
| -rw-r--r-- | lisp/gnus/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/gnus/gnus-icalendar.el | 56 |
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 @@ | |||
| 1 | 2013-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 | |||
| 1 | 2013-11-13 Jan Tatarik <jan.tatarik@gmail.com> | 9 | 2013-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) |