X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-icalendar.el;h=a9e4a24c93b0038296c11ae872374567806294ab;hb=54b3844ec0d9b1fd25b4f00f927853ff72ba5274;hp=56c56f3dd466975da7b23edd257058ff63fb8bfd;hpb=cf9036b65fbe4cadd057d7449381b54292772caf;p=gnus diff --git a/lisp/gnus-icalendar.el b/lisp/gnus-icalendar.el index 56c56f3dd..a9e4a24c9 100644 --- a/lisp/gnus-icalendar.el +++ b/lisp/gnus-icalendar.el @@ -1,6 +1,6 @@ ;;; gnus-icalendar.el --- reply to iCalendar meeting requests -;; Copyright (C) 2013 Free Software Foundation, Inc. +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. ;; Author: Jan Tatarik ;; Keywords: mail, icalendar, org @@ -38,6 +38,7 @@ (require 'gmm-utils) (require 'mm-decode) (require 'gnus-sum) +(require 'gnus-art) (eval-when-compile (require 'cl)) @@ -92,10 +93,10 @@ :accessor gnus-icalendar-event:rsvp :initform nil :type (or null boolean)) - (participation-required :initarg :participation-required - :accessor gnus-icalendar-event:participation-required - :initform t - :type (or null boolean)) + (participation-type :initarg :participation-type + :accessor gnus-icalendar-event:participation-type + :initform 'non-participant + :type (or null t)) (req-participants :initarg :req-participants :accessor gnus-icalendar-event:req-participants :initform nil @@ -140,12 +141,13 @@ (defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) -(defun gnus-icalendar-event--decode-datefield (ical field) - (let* ((date (icalendar--get-event-property ical field)) - (date-props (icalendar--get-event-property-attributes ical field)) - (tz (plist-get date-props 'TZID))) - - (date-to-time (timezone-make-date-arpa-standard date nil tz)))) +(defun gnus-icalendar-event--decode-datefield (event field zone-map) + (let* ((dtdate (icalendar--get-event-property event field)) + (dtdate-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + event field) zone-map)) + (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone))) + (apply 'encode-time dtdate-dec))) (defun gnus-icalendar-event--find-attendee (ical name-or-email) (let* ((event (car (icalendar--all-events ical))) @@ -170,7 +172,9 @@ (caddr event)))) (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) - (attendee-name (prop) (plist-get (cadr prop) 'CN)) + (attendee-name (prop) + (or (plist-get (cadr prop) 'CN) + (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) (attendees-by-type (type) (gnus-remove-if-not (lambda (p) (string= (attendee-role p) type)) @@ -196,15 +200,19 @@ (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)) + (role (plist-get (cadr attendee) 'ROLE)) + (participation-type (pcase role + ("REQ-PARTICIPANT" 'required) + ("OPT-PARTICIPANT" 'optional) + (_ 'non-participant))) + (zone-map (icalendar--convert-all-timezones 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") - :participation-required (string= (plist-get (cadr attendee) 'ROLE) - "REQ-PARTICIPANT") - :req-participants (cdar attendee-names) + :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map) + :end-time (gnus-icalendar-event--decode-datefield event 'DTEND zone-map) + :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") + :participation-type participation-type + :req-participants (car attendee-names) :opt-participants (cadr attendee-names))) (event-class (cond ((string= method "REQUEST") 'gnus-icalendar-event-request) @@ -341,6 +349,7 @@ on the IDENTITIES list." (defgroup gnus-icalendar-org nil "Settings for Calendar Event gnus/org integration." + :version "24.4" :group 'gnus-icalendar :prefix "gnus-icalendar-org-") @@ -448,10 +457,9 @@ Return nil for non-recurring EVENT." "Not replied yet")) (props `(("ICAL_EVENT" . "t") ("ID" . ,uid) - ("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")) + ("PARTICIPATION_TYPE" . ,(symbol-name (gnus-icalendar-event:participation-type event))) ("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)) @@ -466,7 +474,9 @@ Return nil for non-recurring EVENT." (when description (save-restriction (narrow-to-region (point) (point)) - (insert description) + (insert (gnus-icalendar-event:org-timestamp event) + "\n\n" + description) (indent-region (point-min) (point-max) 2) (fill-region (point-min) (point-max)))) @@ -513,7 +523,7 @@ is searched." (when file (with-current-buffer (find-file-noselect file) (with-slots (uid summary description organizer location recur - participation-required req-participants opt-participants) event + participation-type req-participants opt-participants) event (let ((event-pos (org-find-entry-with-id uid))) (when event-pos (goto-char event-pos) @@ -547,20 +557,31 @@ is searched." (when description (save-restriction (narrow-to-region (point) (point)) - (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" description) "\n") + (insert "\n" + (gnus-icalendar-event:org-timestamp event) + "\n\n" + (replace-regexp-in-string "[\n]+$" "\n" description) + "\n") (indent-region (point-min) (point-max) (1+ entry-outline-level)) (fill-region (point-min) (point-max)))) ;; update entry properties - (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)))) + (gmm-labels + ((update-org-entry (position property value) + (if (or (null value) + (string= value "")) + (org-entry-delete position property) + (org-entry-put position property value)))) + + (update-org-entry event-pos "ORGANIZER" organizer) + (update-org-entry event-pos "LOCATION" location) + (update-org-entry event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) + (update-org-entry event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) + (update-org-entry event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) + (update-org-entry event-pos "RRULE" recur) + (update-org-entry event-pos "REPLY" + (if reply-status (capitalize (symbol-name reply-status)) + "Not replied yet"))) (save-buffer))))))))) @@ -641,6 +662,7 @@ is searched." (defgroup gnus-icalendar nil "Settings for inline display of iCalendar invitations." + :version "24.4" :group 'gnus-article :prefix "gnus-icalendar-") @@ -656,8 +678,9 @@ 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'. +Your identity is guessed automatically from the variables +`user-full-name', `user-mail-address', +`gnus-ignored-from-addresses' and `message-alternative-emails'. If you need even more aliases you can define them here. It really only makes sense to define names or email addresses." @@ -674,12 +697,16 @@ only makes sense to define names or email addresses." (make-variable-buffer-local (defvar gnus-icalendar-handle nil)) -(defvar gnus-icalendar-identities +(defun gnus-icalendar-identities () + "Return list of regexp-quoted names and email addresses belonging to the user. + +These will be used to retrieve the RSVP information from ical events." (apply #'append (mapcar (lambda (x) (if (listp x) x (list x))) (list user-full-name (regexp-quote user-mail-address) ; NOTE: these can be lists gnus-ignored-from-addresses ; already regexp-quoted + message-alternative-emails ; (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) ;; TODO: make the template customizable @@ -691,12 +718,14 @@ only makes sense to define names or email addresses." (cadr x)))) (with-slots (organizer summary description location recur uid - method rsvp participation-required) event + method rsvp participation-type) event (let ((headers `(("Summary" ,summary) ("Location" ,(or location "")) ("Time" ,(gnus-icalendar-event:org-timestamp event)) ("Organizer" ,organizer) - ("Attendance" ,(if participation-required "Required" "Optional")) + ("Attendance" ,(if (eq participation-type 'non-participant) + "You are not listed as an attendee" + (capitalize (symbol-name participation-type)))) ("Method" ,method)))) (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) @@ -761,7 +790,7 @@ only makes sense to define names or email addresses." (event (caddr data)) (reply (gnus-icalendar-with-decoded-handle handle (gnus-icalendar-event-reply-from-buffer - (current-buffer) status gnus-icalendar-identities)))) + (current-buffer) status (gnus-icalendar-identities))))) (when reply (gmm-labels ((fold-icalendar-buffer () @@ -833,7 +862,7 @@ only makes sense to define names or email addresses." (defun gnus-icalendar-mm-inline (handle) - (let ((event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities))) + (let ((event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities)))) (setq gnus-icalendar-reply-status nil) @@ -862,7 +891,7 @@ only makes sense to define names or email addresses." (defun gnus-icalendar-save-part (handle) (let (event) (when (and (equal (car (mm-handle-type handle)) "text/calendar") - (setq event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities))) + (setq event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities)))) (gnus-icalendar-event:sync-to-org event))))