Commit | Line | Data |
---|---|---|
89cccc2f G |
1 | ;;; gnus-icalendar.el --- reply to iCalendar meeting requests |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2013-2014 Free Software Foundation, Inc. |
89cccc2f G |
4 | |
5 | ;; Author: Jan Tatarik <Jan.Tatarik@gmail.com> | |
6 | ;; Keywords: mail, icalendar, org | |
7 | ||
8 | ;; This program is free software; you can redistribute it and/or modify | |
9 | ;; it under the terms of the GNU General Public License as published by | |
10 | ;; the Free Software Foundation, either version 3 of the License, or | |
11 | ;; (at your option) any later version. | |
12 | ||
13 | ;; This program is distributed in the hope that it will be useful, | |
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;; GNU General Public License for more details. | |
17 | ||
18 | ;; You should have received a copy of the GNU General Public License | |
19 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | ;;; Commentary: | |
22 | ||
23 | ;; To install: | |
24 | ;; (require 'gnus-icalendar) | |
25 | ;; (gnus-icalendar-setup) | |
26 | ||
27 | ;; to enable optional iCalendar->Org sync functionality | |
28 | ;; NOTE: both the capture file and the headline(s) inside must already exist | |
29 | ;; (setq gnus-icalendar-org-capture-file "~/org/notes.org") | |
30 | ;; (setq gnus-icalendar-org-capture-headline '("Calendar")) | |
31 | ;; (gnus-icalendar-org-setup) | |
32 | ||
33 | ||
34 | ;;; Code: | |
35 | ||
36 | (require 'icalendar) | |
37 | (require 'eieio) | |
9ab16aab | 38 | (require 'gmm-utils) |
89cccc2f G |
39 | (require 'mm-decode) |
40 | (require 'gnus-sum) | |
0462bf34 | 41 | (require 'gnus-art) |
89cccc2f G |
42 | |
43 | (eval-when-compile (require 'cl)) | |
44 | ||
45 | (defun gnus-icalendar-find-if (pred seq) | |
46 | (catch 'found | |
47 | (while seq | |
48 | (when (funcall pred (car seq)) | |
49 | (throw 'found (car seq))) | |
50 | (pop seq)))) | |
51 | ||
52 | ;;; | |
53 | ;;; ical-event | |
54 | ;;; | |
55 | ||
56 | (defclass gnus-icalendar-event () | |
57 | ((organizer :initarg :organizer | |
58 | :accessor gnus-icalendar-event:organizer | |
59 | :initform "" | |
60 | :type (or null string)) | |
61 | (summary :initarg :summary | |
62 | :accessor gnus-icalendar-event:summary | |
63 | :initform "" | |
64 | :type (or null string)) | |
65 | (description :initarg :description | |
66 | :accessor gnus-icalendar-event:description | |
67 | :initform "" | |
68 | :type (or null string)) | |
69 | (location :initarg :location | |
70 | :accessor gnus-icalendar-event:location | |
71 | :initform "" | |
72 | :type (or null string)) | |
62dfefa0 JT |
73 | (start-time :initarg :start-time |
74 | :accessor gnus-icalendar-event:start-time | |
89cccc2f | 75 | :initform "" |
62dfefa0 JT |
76 | :type (or null t)) |
77 | (end-time :initarg :end-time | |
78 | :accessor gnus-icalendar-event:end-time | |
89cccc2f | 79 | :initform "" |
62dfefa0 | 80 | :type (or null t)) |
89cccc2f G |
81 | (recur :initarg :recur |
82 | :accessor gnus-icalendar-event:recur | |
83 | :initform "" | |
84 | :type (or null string)) | |
85 | (uid :initarg :uid | |
86 | :accessor gnus-icalendar-event:uid | |
87 | :type string) | |
88 | (method :initarg :method | |
89 | :accessor gnus-icalendar-event:method | |
90 | :initform "PUBLISH" | |
91 | :type (or null string)) | |
92 | (rsvp :initarg :rsvp | |
93 | :accessor gnus-icalendar-event:rsvp | |
94 | :initform nil | |
8ef7141b | 95 | :type (or null boolean)) |
42e51060 JT |
96 | (participation-type :initarg :participation-type |
97 | :accessor gnus-icalendar-event:participation-type | |
98 | :initform 'non-participant | |
99 | :type (or null t)) | |
8ef7141b JT |
100 | (req-participants :initarg :req-participants |
101 | :accessor gnus-icalendar-event:req-participants | |
102 | :initform nil | |
103 | :type (or null t)) | |
104 | (opt-participants :initarg :opt-participants | |
105 | :accessor gnus-icalendar-event:opt-participants | |
106 | :initform nil | |
107 | :type (or null t))) | |
89cccc2f G |
108 | "generic iCalendar Event class") |
109 | ||
110 | (defclass gnus-icalendar-event-request (gnus-icalendar-event) | |
111 | nil | |
112 | "iCalendar class for REQUEST events") | |
113 | ||
114 | (defclass gnus-icalendar-event-cancel (gnus-icalendar-event) | |
115 | nil | |
116 | "iCalendar class for CANCEL events") | |
117 | ||
118 | (defclass gnus-icalendar-event-reply (gnus-icalendar-event) | |
119 | nil | |
120 | "iCalendar class for REPLY events") | |
121 | ||
122 | (defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) | |
123 | "Return t if EVENT is recurring." | |
124 | (not (null (gnus-icalendar-event:recur event)))) | |
125 | ||
126 | (defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) | |
127 | "Return recurring frequency of EVENT." | |
128 | (let ((rrule (gnus-icalendar-event:recur event))) | |
129 | (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) | |
130 | (match-string 1 rrule))) | |
131 | ||
132 | (defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) | |
133 | "Return recurring interval of EVENT." | |
134 | (let ((rrule (gnus-icalendar-event:recur event)) | |
135 | (default-interval 1)) | |
136 | ||
137 | (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) | |
138 | (or (match-string 1 rrule) | |
139 | default-interval))) | |
140 | ||
62dfefa0 JT |
141 | (defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) |
142 | (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) | |
89cccc2f | 143 | |
62dfefa0 JT |
144 | (defun gnus-icalendar-event--decode-datefield (ical field) |
145 | (let* ((date (icalendar--get-event-property ical field)) | |
146 | (date-props (icalendar--get-event-property-attributes ical field)) | |
147 | (tz (plist-get date-props 'TZID))) | |
89cccc2f | 148 | |
62dfefa0 | 149 | (date-to-time (timezone-make-date-arpa-standard date nil tz)))) |
89cccc2f G |
150 | |
151 | (defun gnus-icalendar-event--find-attendee (ical name-or-email) | |
152 | (let* ((event (car (icalendar--all-events ical))) | |
153 | (event-props (caddr event))) | |
9ab16aab | 154 | (gmm-labels ((attendee-name (att) (plist-get (cadr att) 'CN)) |
89cccc2f G |
155 | (attendee-email (att) |
156 | (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) | |
157 | (attendee-prop-matches-p (prop) | |
158 | (and (eq (car prop) 'ATTENDEE) | |
159 | (or (member (attendee-name prop) name-or-email) | |
160 | (let ((att-email (attendee-email prop))) | |
161 | (gnus-icalendar-find-if (lambda (email) | |
162 | (string-match email att-email)) | |
163 | name-or-email)))))) | |
164 | ||
165 | (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) | |
166 | ||
8ef7141b JT |
167 | (defun gnus-icalendar-event--get-attendee-names (ical) |
168 | (let* ((event (car (icalendar--all-events ical))) | |
169 | (attendee-props (gnus-remove-if-not | |
170 | (lambda (p) (eq (car p) 'ATTENDEE)) | |
171 | (caddr event)))) | |
172 | ||
173 | (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) | |
5fd1888b JT |
174 | (attendee-name (prop) |
175 | (or (plist-get (cadr prop) 'CN) | |
176 | (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) | |
8ef7141b JT |
177 | (attendees-by-type (type) |
178 | (gnus-remove-if-not | |
179 | (lambda (p) (string= (attendee-role p) type)) | |
180 | attendee-props)) | |
181 | (attendee-names-by-type (type) | |
182 | (mapcar #'attendee-name (attendees-by-type type)))) | |
183 | ||
184 | (list | |
185 | (attendee-names-by-type "REQ-PARTICIPANT") | |
186 | (attendee-names-by-type "OPT-PARTICIPANT"))))) | |
89cccc2f G |
187 | |
188 | (defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) | |
189 | (let* ((event (car (icalendar--all-events ical))) | |
89cccc2f G |
190 | (organizer (replace-regexp-in-string |
191 | "^.*MAILTO:" "" | |
192 | (or (icalendar--get-event-property event 'ORGANIZER) ""))) | |
193 | (prop-map '((summary . SUMMARY) | |
194 | (description . DESCRIPTION) | |
195 | (location . LOCATION) | |
196 | (recur . RRULE) | |
197 | (uid . UID))) | |
198 | (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) | |
199 | (attendee (when attendee-name-or-email | |
200 | (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) | |
8ef7141b | 201 | (attendee-names (gnus-icalendar-event--get-attendee-names ical)) |
42e51060 JT |
202 | (role (plist-get (cadr attendee) 'ROLE)) |
203 | (participation-type (pcase role | |
204 | ("REQ-PARTICIPANT" 'required) | |
205 | ("OPT-PARTICIPANT" 'optional) | |
206 | (_ 'non-participant))) | |
89cccc2f G |
207 | (args (list :method method |
208 | :organizer organizer | |
62dfefa0 JT |
209 | :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART) |
210 | :end-time (gnus-icalendar-event--decode-datefield event 'DTEND) | |
42e51060 JT |
211 | :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") |
212 | :participation-type participation-type | |
213 | :req-participants (car attendee-names) | |
8ef7141b | 214 | :opt-participants (cadr attendee-names))) |
ec956438 JT |
215 | (event-class (cond |
216 | ((string= method "REQUEST") 'gnus-icalendar-event-request) | |
217 | ((string= method "CANCEL") 'gnus-icalendar-event-cancel) | |
218 | ((string= method "REPLY") 'gnus-icalendar-event-reply) | |
219 | (t 'gnus-icalendar-event)))) | |
89cccc2f | 220 | |
9ab16aab | 221 | (gmm-labels ((map-property (prop) |
89cccc2f G |
222 | (let ((value (icalendar--get-event-property event prop))) |
223 | (when value | |
224 | ;; ugly, but cannot get | |
225 | ;;replace-regexp-in-string work with "\\" as | |
226 | ;;REP, plus we should also handle "\\;" | |
227 | (replace-regexp-in-string | |
228 | "\\\\," "," | |
229 | (replace-regexp-in-string | |
230 | "\\\\n" "\n" (substring-no-properties value)))))) | |
231 | (accumulate-args (mapping) | |
232 | (destructuring-bind (slot . ical-property) mapping | |
233 | (setq args (append (list | |
234 | (intern (concat ":" (symbol-name slot))) | |
235 | (map-property ical-property)) | |
236 | args))))) | |
237 | ||
238 | (mapc #'accumulate-args prop-map) | |
239 | (apply 'make-instance event-class args)))) | |
240 | ||
241 | (defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) | |
242 | "Parse RFC5545 iCalendar in buffer BUF and return an event object. | |
243 | ||
244 | Return a gnus-icalendar-event object representing the first event | |
245 | contained in the invitation. Return nil for calendars without an event entry. | |
246 | ||
247 | ATTENDEE-NAME-OR-EMAIL is a list of strings that will be matched | |
248 | against the event's attendee names and emails. Invitation rsvp | |
249 | status will be retrieved from the first matching attendee record." | |
250 | (let ((ical (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) | |
251 | (goto-char (point-min)) | |
252 | (icalendar--read-element nil nil)))) | |
253 | ||
254 | (when ical | |
255 | (gnus-icalendar-event-from-ical ical attendee-name-or-email)))) | |
256 | ||
257 | ;;; | |
258 | ;;; gnus-icalendar-event-reply | |
259 | ;;; | |
260 | ||
261 | (defun gnus-icalendar-event--build-reply-event-body (ical-request status identities) | |
262 | (let ((summary-status (capitalize (symbol-name status))) | |
263 | (attendee-status (upcase (symbol-name status))) | |
264 | reply-event-lines) | |
9ab16aab | 265 | (gmm-labels ((update-summary (line) |
89cccc2f G |
266 | (if (string-match "^[^:]+:" line) |
267 | (replace-match (format "\\&%s: " summary-status) t nil line) | |
268 | line)) | |
269 | (update-dtstamp () | |
270 | (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) | |
271 | (attendee-matches-identity (line) | |
272 | (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) | |
273 | identities)) | |
274 | (update-attendee-status (line) | |
275 | (when (and (attendee-matches-identity line) | |
276 | (string-match "\\(PARTSTAT=\\)[^;]+" line)) | |
277 | (replace-match (format "\\1%s" attendee-status) t nil line))) | |
278 | (process-event-line (line) | |
279 | (when (string-match "^\\([^;:]+\\)" line) | |
280 | (let* ((key (match-string 0 line)) | |
281 | ;; NOTE: not all of the below fields are mandatory, | |
282 | ;; but they are often present in other clients' | |
283 | ;; replies. Can be helpful for debugging, too. | |
ec956438 JT |
284 | (new-line |
285 | (cond | |
286 | ((string= key "ATTENDEE") (update-attendee-status line)) | |
287 | ((string= key "SUMMARY") (update-summary line)) | |
288 | ((string= key "DTSTAMP") (update-dtstamp)) | |
a99f655b GM |
289 | ((member key '("ORGANIZER" "DTSTART" "DTEND" |
290 | "LOCATION" "DURATION" "SEQUENCE" | |
291 | "RECURRENCE-ID" "UID")) line) | |
ec956438 | 292 | (t nil)))) |
89cccc2f G |
293 | (when new-line |
294 | (push new-line reply-event-lines)))))) | |
295 | ||
296 | (mapc #'process-event-line (split-string ical-request "\n")) | |
297 | ||
298 | (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) | |
299 | reply-event-lines) | |
300 | (error "Could not find an event attendee matching given identity")) | |
301 | ||
302 | (mapconcat #'identity `("BEGIN:VEVENT" | |
303 | ,@(nreverse reply-event-lines) | |
304 | "END:VEVENT") | |
305 | "\n")))) | |
306 | ||
307 | (defun gnus-icalendar-event-reply-from-buffer (buf status identities) | |
308 | "Build a calendar event reply for request contained in BUF. | |
309 | The reply will have STATUS (`accepted', `tentative' or `declined'). | |
310 | The reply will be composed for attendees matching any entry | |
311 | on the IDENTITIES list." | |
9ab16aab | 312 | (gmm-labels ((extract-block (blockname) |
89cccc2f G |
313 | (save-excursion |
314 | (let ((block-start-re (format "^BEGIN:%s" blockname)) | |
315 | (block-end-re (format "^END:%s" blockname)) | |
316 | start) | |
317 | (when (re-search-forward block-start-re nil t) | |
318 | (setq start (line-beginning-position)) | |
319 | (re-search-forward block-end-re) | |
320 | (buffer-substring-no-properties start (line-end-position))))))) | |
321 | ||
322 | (let (zone event) | |
323 | (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) | |
324 | (goto-char (point-min)) | |
325 | (setq zone (extract-block "VTIMEZONE") | |
326 | event (extract-block "VEVENT"))) | |
327 | ||
328 | (when event | |
329 | (let ((contents (list "BEGIN:VCALENDAR" | |
330 | "METHOD:REPLY" | |
331 | "PRODID:Gnus" | |
332 | "VERSION:2.0" | |
333 | zone | |
334 | (gnus-icalendar-event--build-reply-event-body event status identities) | |
335 | "END:VCALENDAR"))) | |
336 | ||
337 | (mapconcat #'identity (delq nil contents) "\n")))))) | |
338 | ||
339 | ;;; | |
340 | ;;; gnus-icalendar-org | |
341 | ;;; | |
342 | ;;; TODO: this is an optional feature, and it's only available with org-mode | |
343 | ;;; 7+, so will need to properly handle emacsen with no/outdated org-mode | |
344 | ||
345 | (require 'org) | |
346 | (require 'org-capture) | |
347 | ||
348 | (defgroup gnus-icalendar-org nil | |
349 | "Settings for Calendar Event gnus/org integration." | |
bb098075 | 350 | :version "24.4" |
89cccc2f G |
351 | :group 'gnus-icalendar |
352 | :prefix "gnus-icalendar-org-") | |
353 | ||
354 | (defcustom gnus-icalendar-org-capture-file nil | |
355 | "Target Org file for storing captured calendar events." | |
ae3f0661 | 356 | :type '(choice (const nil) file) |
89cccc2f G |
357 | :group 'gnus-icalendar-org) |
358 | ||
359 | (defcustom gnus-icalendar-org-capture-headline nil | |
360 | "Target outline in `gnus-icalendar-org-capture-file' for storing captured events." | |
361 | :type '(repeat string) | |
362 | :group 'gnus-icalendar-org) | |
363 | ||
364 | (defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org" | |
365 | "Org-mode template name." | |
366 | :type '(string) | |
367 | :group 'gnus-icalendar-org) | |
368 | ||
369 | (defcustom gnus-icalendar-org-template-key "#" | |
370 | "Org-mode template hotkey." | |
371 | :type '(string) | |
372 | :group 'gnus-icalendar-org) | |
373 | ||
374 | (defvar gnus-icalendar-org-enabled-p nil) | |
375 | ||
376 | ||
377 | (defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) | |
378 | "Return `org-mode' timestamp repeater string for recurring EVENT. | |
379 | Return nil for non-recurring EVENT." | |
380 | (when (gnus-icalendar-event:recurring-p event) | |
381 | (let* ((freq-map '(("HOURLY" . "h") | |
382 | ("DAILY" . "d") | |
383 | ("WEEKLY" . "w") | |
384 | ("MONTHLY" . "m") | |
385 | ("YEARLY" . "y"))) | |
386 | (org-freq (cdr (assoc (gnus-icalendar-event:recurring-freq event) freq-map)))) | |
387 | ||
388 | (when org-freq | |
389 | (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) | |
390 | ||
391 | (defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) | |
392 | "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." | |
393 | (let* ((start (gnus-icalendar-event:start-time event)) | |
394 | (end (gnus-icalendar-event:end-time event)) | |
62dfefa0 JT |
395 | (start-date (format-time-string "%Y-%m-%d %a" start)) |
396 | (start-time (format-time-string "%H:%M" start)) | |
680f4ae6 | 397 | (start-at-midnight (string= start-time "00:00")) |
62dfefa0 JT |
398 | (end-date (format-time-string "%Y-%m-%d %a" end)) |
399 | (end-time (format-time-string "%H:%M" end)) | |
680f4ae6 JT |
400 | (end-at-midnight (string= end-time "00:00")) |
401 | (start-end-date-diff (/ (float-time (time-subtract | |
402 | (date-to-time end-date) | |
403 | (date-to-time start-date))) | |
404 | 86400)) | |
89cccc2f | 405 | (org-repeat (gnus-icalendar-event:org-repeat event)) |
680f4ae6 JT |
406 | (repeat (if org-repeat (concat " " org-repeat) "")) |
407 | (time-1-day '(0 86400))) | |
408 | ||
409 | ;; NOTE: special care is needed with appointments ending at midnight | |
410 | ;; (typically all-day events): the end time has to be changed to 23:59 to | |
411 | ;; prevent org agenda showing the event on one additional day | |
412 | (cond | |
413 | ;; start/end midnight | |
414 | ;; A 0:0 - A+1 0:0 -> A | |
415 | ;; A 0:0 - A+n 0:0 -> A - A+n-1 | |
416 | ((and start-at-midnight end-at-midnight) (if (> start-end-date-diff 1) | |
417 | (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day)))) | |
418 | (format "<%s>--<%s>" start-date end-ts)) | |
419 | (format "<%s%s>" start-date repeat))) | |
420 | ;; end midnight | |
421 | ;; A .:. - A+1 0:0 -> A .:.-23:59 | |
422 | ;; A .:. - A+n 0:0 -> A .:. - A_n-1 | |
423 | (end-at-midnight (if (= start-end-date-diff 1) | |
424 | (format "<%s %s-23:59%s>" start-date start-time repeat) | |
425 | (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day)))) | |
426 | (format "<%s %s>--<%s>" start-date start-time end-ts)))) | |
427 | ;; start midnight | |
428 | ;; A 0:0 - A .:. -> A 0:0-.:. (default 1) | |
429 | ;; A 0:0 - A+n .:. -> A - A+n .:. | |
430 | ((and start-at-midnight | |
431 | (plusp start-end-date-diff)) (format "<%s>--<%s %s>" start-date end-date end-time)) | |
432 | ;; default | |
433 | ;; A .:. - A .:. -> A .:.-.:. | |
434 | ;; A .:. - B .:. | |
435 | ((zerop start-end-date-diff) (format "<%s %s-%s%s>" start-date start-time end-time repeat)) | |
436 | (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time))))) | |
89cccc2f | 437 | |
0f755e30 JT |
438 | (defun gnus-icalendar--format-summary-line (summary &optional location) |
439 | (if location | |
440 | (format "%s (%s)" summary location) | |
441 | (format "%s" summary))) | |
442 | ||
8ef7141b JT |
443 | |
444 | (defun gnus-icalendar--format-participant-list (participants) | |
445 | (mapconcat #'identity participants ", ")) | |
446 | ||
89cccc2f G |
447 | ;; TODO: make the template customizable |
448 | (defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) | |
449 | "Return string with new `org-mode' entry describing EVENT." | |
450 | (with-temp-buffer | |
451 | (org-mode) | |
452 | (with-slots (organizer summary description location | |
453 | recur uid) event | |
454 | (let* ((reply (if reply-status (capitalize (symbol-name reply-status)) | |
455 | "Not replied yet")) | |
456 | (props `(("ICAL_EVENT" . "t") | |
457 | ("ID" . ,uid) | |
89cccc2f G |
458 | ("ORGANIZER" . ,(gnus-icalendar-event:organizer event)) |
459 | ("LOCATION" . ,(gnus-icalendar-event:location event)) | |
42e51060 | 460 | ("PARTICIPATION_TYPE" . ,(symbol-name (gnus-icalendar-event:participation-type event))) |
8ef7141b JT |
461 | ("REQ_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:req-participants event))) |
462 | ("OPT_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:opt-participants event))) | |
89cccc2f G |
463 | ("RRULE" . ,(gnus-icalendar-event:recur event)) |
464 | ("REPLY" . ,reply)))) | |
465 | ||
0f755e30 JT |
466 | (insert (format "* %s\n\n" |
467 | (gnus-icalendar--format-summary-line summary location))) | |
89cccc2f G |
468 | (mapc (lambda (prop) |
469 | (org-entry-put (point) (car prop) (cdr prop))) | |
470 | props)) | |
471 | ||
472 | (when description | |
473 | (save-restriction | |
474 | (narrow-to-region (point) (point)) | |
5fd1888b JT |
475 | (insert (gnus-icalendar-event:org-timestamp event) |
476 | "\n\n" | |
477 | description) | |
89cccc2f G |
478 | (indent-region (point-min) (point-max) 2) |
479 | (fill-region (point-min) (point-max)))) | |
480 | ||
481 | (buffer-string)))) | |
482 | ||
483 | (defun gnus-icalendar--deactivate-org-timestamp (ts) | |
484 | (replace-regexp-in-string "[<>]" | |
ec956438 JT |
485 | (lambda (m) (cond ((string= m "<") "[") |
486 | ((string= m ">") "]"))) | |
89cccc2f G |
487 | ts)) |
488 | ||
489 | (defun gnus-icalendar-find-org-event-file (event &optional org-file) | |
490 | "Return the name of the file containing EVENT org entry. | |
491 | Return nil when not found. | |
492 | ||
493 | All org agenda files are searched for the EVENT entry. When | |
494 | the optional ORG-FILE argument is specified, only that one file | |
495 | is searched." | |
496 | (let ((uid (gnus-icalendar-event:uid event)) | |
497 | (files (or org-file (org-agenda-files t 'ifmode)))) | |
9ab16aab | 498 | (gmm-labels |
89cccc2f G |
499 | ((find-event-in (file) |
500 | (org-check-agenda-file file) | |
501 | (with-current-buffer (find-file-noselect file) | |
502 | (let ((event-pos (org-find-entry-with-id uid))) | |
503 | (when (and event-pos | |
504 | (string= (cdr (assoc "ICAL_EVENT" (org-entry-properties event-pos))) | |
505 | "t")) | |
506 | (throw 'found file)))))) | |
507 | ||
508 | (gnus-icalendar-find-if #'find-event-in files)))) | |
509 | ||
510 | ||
511 | (defun gnus-icalendar--show-org-event (event &optional org-file) | |
512 | (let ((file (gnus-icalendar-find-org-event-file event org-file))) | |
513 | (when file | |
514 | (switch-to-buffer (find-file file)) | |
515 | (goto-char (org-find-entry-with-id (gnus-icalendar-event:uid event))) | |
516 | (org-show-entry)))) | |
517 | ||
518 | ||
519 | (defun gnus-icalendar--update-org-event (event reply-status &optional org-file) | |
520 | (let ((file (gnus-icalendar-find-org-event-file event org-file))) | |
521 | (when file | |
522 | (with-current-buffer (find-file-noselect file) | |
8ef7141b | 523 | (with-slots (uid summary description organizer location recur |
42e51060 | 524 | participation-type req-participants opt-participants) event |
89cccc2f G |
525 | (let ((event-pos (org-find-entry-with-id uid))) |
526 | (when event-pos | |
527 | (goto-char event-pos) | |
528 | ||
529 | ;; update the headline, keep todo, priority and tags, if any | |
530 | (save-excursion | |
531 | (let* ((priority (org-entry-get (point) "PRIORITY")) | |
532 | (headline (delq nil (list | |
533 | (org-entry-get (point) "TODO") | |
534 | (when priority (format "[#%s]" priority)) | |
0f755e30 | 535 | (gnus-icalendar--format-summary-line summary location) |
89cccc2f G |
536 | (org-entry-get (point) "TAGS"))))) |
537 | ||
538 | (re-search-forward "^\\*+ " (line-end-position)) | |
539 | (delete-region (point) (line-end-position)) | |
540 | (insert (mapconcat #'identity headline " ")))) | |
541 | ||
542 | ;; update props and description | |
543 | (let ((entry-end (org-entry-end-position)) | |
544 | (entry-outline-level (org-outline-level))) | |
545 | ||
546 | ;; delete body of the entry, leave org drawers intact | |
547 | (save-restriction | |
548 | (org-narrow-to-element) | |
549 | (goto-char entry-end) | |
550 | (re-search-backward "^[\t ]*:END:") | |
551 | (forward-line) | |
552 | (delete-region (point) entry-end)) | |
553 | ||
554 | ;; put new event description in the entry body | |
555 | (when description | |
556 | (save-restriction | |
557 | (narrow-to-region (point) (point)) | |
5fd1888b JT |
558 | (insert "\n" |
559 | (gnus-icalendar-event:org-timestamp event) | |
560 | "\n\n" | |
561 | (replace-regexp-in-string "[\n]+$" "\n" description) | |
562 | "\n") | |
89cccc2f G |
563 | (indent-region (point-min) (point-max) (1+ entry-outline-level)) |
564 | (fill-region (point-min) (point-max)))) | |
565 | ||
566 | ;; update entry properties | |
5fd1888b JT |
567 | (gmm-labels |
568 | ((update-org-entry (position property value) | |
569 | (if (or (null value) | |
570 | (string= value "")) | |
571 | (org-entry-delete position property) | |
572 | (org-entry-put position property value)))) | |
573 | ||
574 | (update-org-entry event-pos "ORGANIZER" organizer) | |
575 | (update-org-entry event-pos "LOCATION" location) | |
576 | (update-org-entry event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) | |
577 | (update-org-entry event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) | |
578 | (update-org-entry event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) | |
579 | (update-org-entry event-pos "RRULE" recur) | |
580 | (update-org-entry event-pos "REPLY" | |
581 | (if reply-status (capitalize (symbol-name reply-status)) | |
582 | "Not replied yet"))) | |
89cccc2f G |
583 | (save-buffer))))))))) |
584 | ||
585 | ||
586 | (defun gnus-icalendar--cancel-org-event (event &optional org-file) | |
587 | (let ((file (gnus-icalendar-find-org-event-file event org-file))) | |
588 | (when file | |
589 | (with-current-buffer (find-file-noselect file) | |
590 | (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:uid event)))) | |
591 | (when event-pos | |
592 | (let ((ts (org-entry-get event-pos "DT"))) | |
593 | (when ts | |
594 | (org-entry-put event-pos "DT" (gnus-icalendar--deactivate-org-timestamp ts)) | |
595 | (save-buffer))))))))) | |
596 | ||
597 | ||
598 | (defun gnus-icalendar--get-org-event-reply-status (event &optional org-file) | |
599 | (let ((file (gnus-icalendar-find-org-event-file event org-file))) | |
600 | (when file | |
601 | (save-excursion | |
602 | (with-current-buffer (find-file-noselect file) | |
603 | (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:uid event)))) | |
604 | (org-entry-get event-pos "REPLY"))))))) | |
605 | ||
606 | ||
607 | (defun gnus-icalendar-insinuate-org-templates () | |
608 | (unless (gnus-icalendar-find-if (lambda (x) (string= (cadr x) gnus-icalendar-org-template-name)) | |
609 | org-capture-templates) | |
610 | (setq org-capture-templates | |
611 | (append `((,gnus-icalendar-org-template-key | |
612 | ,gnus-icalendar-org-template-name | |
613 | entry | |
614 | (file+olp ,gnus-icalendar-org-capture-file ,@gnus-icalendar-org-capture-headline) | |
615 | "%i" | |
616 | :immediate-finish t)) | |
617 | org-capture-templates)) | |
618 | ||
619 | ;; hide the template from interactive template selection list | |
620 | ;; (org-capture) | |
621 | ;; NOTE: doesn't work when capturing from string | |
622 | ;; (when (boundp 'org-capture-templates-contexts) | |
623 | ;; (push `(,gnus-icalendar-org-template-key "" ((in-mode . "gnus-article-mode"))) | |
624 | ;; org-capture-templates-contexts)) | |
625 | )) | |
626 | ||
627 | (defun gnus-icalendar:org-event-save (event reply-status) | |
628 | (with-temp-buffer | |
629 | (org-capture-string (gnus-icalendar-event->org-entry event reply-status) | |
630 | gnus-icalendar-org-template-key))) | |
631 | ||
632 | (defun gnus-icalendar-show-org-agenda (event) | |
633 | (let* ((time-delta (time-subtract (gnus-icalendar-event:end-time event) | |
634 | (gnus-icalendar-event:start-time event))) | |
635 | (duration-days (1+ (/ (+ (* (car time-delta) (expt 2 16)) | |
636 | (cadr time-delta)) | |
637 | 86400)))) | |
638 | ||
639 | (org-agenda-list nil (gnus-icalendar-event:start event) duration-days))) | |
640 | ||
641 | (defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) | |
642 | (if (gnus-icalendar-find-org-event-file event) | |
643 | (gnus-icalendar--update-org-event event reply-status) | |
644 | (gnus-icalendar:org-event-save event reply-status))) | |
645 | ||
0f755e30 | 646 | (defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status) |
89cccc2f G |
647 | (when (gnus-icalendar-find-org-event-file event) |
648 | (gnus-icalendar--cancel-org-event event))) | |
649 | ||
650 | (defun gnus-icalendar-org-setup () | |
651 | (if (and gnus-icalendar-org-capture-file gnus-icalendar-org-capture-headline) | |
652 | (progn | |
653 | (gnus-icalendar-insinuate-org-templates) | |
654 | (setq gnus-icalendar-org-enabled-p t)) | |
655 | (message "Cannot enable Calendar->Org: missing capture file, headline"))) | |
656 | ||
657 | ;;; | |
658 | ;;; gnus-icalendar | |
659 | ;;; | |
660 | ||
661 | (defgroup gnus-icalendar nil | |
662 | "Settings for inline display of iCalendar invitations." | |
bb098075 | 663 | :version "24.4" |
89cccc2f G |
664 | :group 'gnus-article |
665 | :prefix "gnus-icalendar-") | |
666 | ||
667 | (defcustom gnus-icalendar-reply-bufname "*CAL*" | |
668 | "Buffer used for building iCalendar invitation reply." | |
669 | :type '(string) | |
670 | :group 'gnus-icalendar) | |
671 | ||
680f4ae6 JT |
672 | (defcustom gnus-icalendar-additional-identities nil |
673 | "We need to know your identity to make replies to calendar requests work. | |
674 | ||
675 | Gnus will only offer you the Accept/Tentative/Decline buttons for | |
676 | calendar events if any of your identities matches at least one | |
677 | RSVP participant. | |
678 | ||
679 | Your identity is guessed automatically from the variables `user-full-name', | |
680 | `user-mail-address', and `gnus-ignored-from-addresses'. | |
681 | ||
682 | If you need even more aliases you can define them here. It really | |
683 | only makes sense to define names or email addresses." | |
684 | ||
685 | :type '(repeat string) | |
686 | :group 'gnus-icalendar) | |
687 | ||
89cccc2f G |
688 | (make-variable-buffer-local |
689 | (defvar gnus-icalendar-reply-status nil)) | |
690 | ||
691 | (make-variable-buffer-local | |
692 | (defvar gnus-icalendar-event nil)) | |
693 | ||
694 | (make-variable-buffer-local | |
695 | (defvar gnus-icalendar-handle nil)) | |
696 | ||
88312cfc JT |
697 | (defun gnus-icalendar-identities () |
698 | "Return list of regexp-quoted names and email addresses belonging to the user. | |
699 | ||
700 | These will be used to retrieve the RSVP information from ical events." | |
89cccc2f G |
701 | (apply #'append |
702 | (mapcar (lambda (x) (if (listp x) x (list x))) | |
703 | (list user-full-name (regexp-quote user-mail-address) | |
680f4ae6 JT |
704 | ; NOTE: these can be lists |
705 | gnus-ignored-from-addresses ; already regexp-quoted | |
706 | (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) | |
89cccc2f G |
707 | |
708 | ;; TODO: make the template customizable | |
709 | (defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status) | |
710 | "Format an overview of EVENT details." | |
9ab16aab | 711 | (gmm-labels ((format-header (x) |
89cccc2f G |
712 | (format "%-12s%s" |
713 | (propertize (concat (car x) ":") 'face 'bold) | |
714 | (cadr x)))) | |
715 | ||
8ef7141b | 716 | (with-slots (organizer summary description location recur uid |
42e51060 | 717 | method rsvp participation-type) event |
89cccc2f | 718 | (let ((headers `(("Summary" ,summary) |
0f755e30 | 719 | ("Location" ,(or location "")) |
89cccc2f G |
720 | ("Time" ,(gnus-icalendar-event:org-timestamp event)) |
721 | ("Organizer" ,organizer) | |
42e51060 JT |
722 | ("Attendance" ,(if (eq participation-type 'non-participant) |
723 | "You are not listed as an attendee" | |
724 | (capitalize (symbol-name participation-type)))) | |
89cccc2f G |
725 | ("Method" ,method)))) |
726 | ||
727 | (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) | |
728 | (setq headers (append headers | |
729 | `(("Status" ,(or reply-status "Not replied yet")))))) | |
730 | ||
731 | (concat | |
732 | (mapconcat #'format-header headers "\n") | |
733 | "\n\n" | |
734 | description))))) | |
735 | ||
736 | (defmacro gnus-icalendar-with-decoded-handle (handle &rest body) | |
737 | "Execute BODY in buffer containing the decoded contents of HANDLE." | |
738 | (let ((charset (make-symbol "charset"))) | |
739 | `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) | |
740 | (with-temp-buffer | |
741 | (mm-insert-part ,handle) | |
742 | (when (string= ,charset "utf-8") | |
743 | (mm-decode-coding-region (point-min) (point-max) 'utf-8)) | |
744 | ||
745 | ,@body)))) | |
746 | ||
747 | ||
748 | (defun gnus-icalendar-event-from-handle (handle &optional attendee-name-or-email) | |
749 | (gnus-icalendar-with-decoded-handle handle | |
750 | (gnus-icalendar-event-from-buffer (current-buffer) attendee-name-or-email))) | |
751 | ||
752 | (defun gnus-icalendar-insert-button (text callback data) | |
753 | ;; FIXME: the gnus-mime-button-map keymap does not make sense for this kind | |
754 | ;; of button. | |
755 | (let ((start (point))) | |
756 | (gnus-add-text-properties | |
757 | start | |
758 | (progn | |
759 | (insert "[ " text " ]") | |
760 | (point)) | |
761 | `(gnus-callback | |
762 | ,callback | |
763 | keymap ,gnus-mime-button-map | |
764 | face ,gnus-article-button-face | |
765 | gnus-data ,data)) | |
766 | (widget-convert-button 'link start (point) | |
767 | :action 'gnus-widget-press-button | |
768 | :button-keymap gnus-widget-button-keymap))) | |
769 | ||
770 | (defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) | |
771 | (let ((message-signature nil)) | |
772 | (with-current-buffer gnus-summary-buffer | |
773 | (gnus-summary-reply) | |
774 | (message-goto-body) | |
775 | (mml-insert-multipart "alternative") | |
776 | (mml-insert-empty-tag 'part 'type "text/plain") | |
777 | (mml-attach-buffer buffer-name "text/calendar; method=REPLY; charset=UTF-8") | |
778 | (message-goto-subject) | |
779 | (delete-region (line-beginning-position) (line-end-position)) | |
780 | (insert "Subject: " subject) | |
781 | (message-send-and-exit)))) | |
782 | ||
783 | (defun gnus-icalendar-reply (data) | |
784 | (let* ((handle (car data)) | |
785 | (status (cadr data)) | |
786 | (event (caddr data)) | |
787 | (reply (gnus-icalendar-with-decoded-handle handle | |
788 | (gnus-icalendar-event-reply-from-buffer | |
88312cfc | 789 | (current-buffer) status (gnus-icalendar-identities))))) |
89cccc2f G |
790 | |
791 | (when reply | |
9ab16aab | 792 | (gmm-labels ((fold-icalendar-buffer () |
89cccc2f G |
793 | (goto-char (point-min)) |
794 | (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t) | |
795 | (replace-match "\\1\n \\2") | |
796 | (goto-char (line-beginning-position))))) | |
797 | (let ((subject (concat (capitalize (symbol-name status)) | |
798 | ": " (gnus-icalendar-event:summary event)))) | |
799 | ||
800 | (with-current-buffer (get-buffer-create gnus-icalendar-reply-bufname) | |
801 | (delete-region (point-min) (point-max)) | |
802 | (insert reply) | |
803 | (fold-icalendar-buffer) | |
804 | (gnus-icalendar-send-buffer-by-mail (buffer-name) subject)) | |
805 | ||
806 | ;; Back in article buffer | |
807 | (setq-local gnus-icalendar-reply-status status) | |
808 | (when gnus-icalendar-org-enabled-p | |
809 | (gnus-icalendar--update-org-event event status) | |
810 | ;; refresh article buffer to update the reply status | |
811 | (with-current-buffer gnus-summary-buffer | |
812 | (gnus-summary-show-article)))))))) | |
813 | ||
814 | (defun gnus-icalendar-sync-event-to-org (event) | |
815 | (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) | |
816 | ||
817 | (defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) | |
818 | (when (gnus-icalendar-event:rsvp event) | |
819 | `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) | |
820 | ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) | |
821 | ("Decline" gnus-icalendar-reply (,handle declined ,event))))) | |
822 | ||
823 | (defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) | |
824 | "No buttons for REPLY events." | |
825 | nil) | |
826 | ||
827 | (defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event)) | |
828 | (or (when gnus-icalendar-org-enabled-p | |
829 | (gnus-icalendar--get-org-event-reply-status event)) | |
830 | "Not replied yet")) | |
831 | ||
832 | (defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) | |
833 | "No reply status for REPLY events." | |
834 | nil) | |
835 | ||
836 | ||
837 | (defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event)) | |
838 | (let* ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)) | |
839 | (export-button-text (if org-entry-exists-p "Update Org Entry" "Export to Org"))) | |
840 | ||
841 | (delq nil (list | |
842 | `("Show Agenda" gnus-icalendar-show-org-agenda ,event) | |
843 | (when (gnus-icalendar-event-request-p event) | |
844 | `(,export-button-text gnus-icalendar-sync-event-to-org ,event)) | |
845 | (when org-entry-exists-p | |
846 | `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) | |
847 | ||
0f755e30 JT |
848 | |
849 | (defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event-cancel)) | |
850 | (let ((org-entry-exists-p (gnus-icalendar-find-org-event-file event))) | |
851 | ||
852 | (delq nil (list | |
853 | `("Show Agenda" gnus-icalendar-show-org-agenda ,event) | |
854 | (when org-entry-exists-p | |
855 | `("Update Org Entry" gnus-icalendar-sync-event-to-org ,event)) | |
856 | (when org-entry-exists-p | |
857 | `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) | |
858 | ||
859 | ||
89cccc2f | 860 | (defun gnus-icalendar-mm-inline (handle) |
88312cfc | 861 | (let ((event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities)))) |
89cccc2f G |
862 | |
863 | (setq gnus-icalendar-reply-status nil) | |
864 | ||
865 | (when event | |
9ab16aab | 866 | (gmm-labels ((insert-button-group (buttons) |
89cccc2f G |
867 | (when buttons |
868 | (mapc (lambda (x) | |
869 | (apply 'gnus-icalendar-insert-button x) | |
870 | (insert " ")) | |
871 | buttons) | |
872 | (insert "\n\n")))) | |
873 | ||
874 | (insert-button-group | |
875 | (gnus-icalendar-event:inline-reply-buttons event handle)) | |
876 | ||
877 | (when gnus-icalendar-org-enabled-p | |
878 | (insert-button-group (gnus-icalendar-event:inline-org-buttons event))) | |
879 | ||
880 | (setq gnus-icalendar-event event | |
881 | gnus-icalendar-handle handle) | |
882 | ||
883 | (insert (gnus-icalendar-event->gnus-calendar | |
884 | event | |
885 | (gnus-icalendar-event:inline-reply-status event))))))) | |
886 | ||
887 | (defun gnus-icalendar-save-part (handle) | |
888 | (let (event) | |
889 | (when (and (equal (car (mm-handle-type handle)) "text/calendar") | |
88312cfc | 890 | (setq event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities)))) |
89cccc2f G |
891 | |
892 | (gnus-icalendar-event:sync-to-org event)))) | |
893 | ||
894 | ||
895 | (defun gnus-icalendar-save-event () | |
896 | "Save the Calendar event in the text/calendar part under point." | |
897 | (interactive) | |
898 | (gnus-article-check-buffer) | |
899 | (let ((data (get-text-property (point) 'gnus-data))) | |
900 | (when data | |
901 | (gnus-icalendar-save-part data)))) | |
902 | ||
903 | (defun gnus-icalendar-reply-accept () | |
904 | "Accept invitation in the current article." | |
905 | (interactive) | |
906 | (with-current-buffer gnus-article-buffer | |
907 | (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event)) | |
908 | (setq-local gnus-icalendar-reply-status 'accepted))) | |
909 | ||
910 | (defun gnus-icalendar-reply-tentative () | |
911 | "Send tentative response to invitation in the current article." | |
912 | (interactive) | |
913 | (with-current-buffer gnus-article-buffer | |
914 | (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event)) | |
915 | (setq-local gnus-icalendar-reply-status 'tentative))) | |
916 | ||
917 | (defun gnus-icalendar-reply-decline () | |
918 | "Decline invitation in the current article." | |
919 | (interactive) | |
920 | (with-current-buffer gnus-article-buffer | |
921 | (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event)) | |
922 | (setq-local gnus-icalendar-reply-status 'declined))) | |
923 | ||
924 | (defun gnus-icalendar-event-export () | |
925 | "Export calendar event to `org-mode', or update existing agenda entry." | |
926 | (interactive) | |
927 | (with-current-buffer gnus-article-buffer | |
928 | (gnus-icalendar-sync-event-to-org gnus-icalendar-event)) | |
929 | ;; refresh article buffer in case the reply had been sent before initial org | |
930 | ;; export | |
931 | (with-current-buffer gnus-summary-buffer | |
932 | (gnus-summary-show-article))) | |
933 | ||
934 | (defun gnus-icalendar-event-show () | |
935 | "Display `org-mode' agenda entry related to the calendar event." | |
936 | (interactive) | |
937 | (gnus-icalendar--show-org-event | |
938 | (with-current-buffer gnus-article-buffer | |
939 | gnus-icalendar-event))) | |
940 | ||
941 | (defun gnus-icalendar-event-check-agenda () | |
942 | "Display `org-mode' agenda for days between event start and end dates." | |
943 | (interactive) | |
944 | (gnus-icalendar-show-org-agenda | |
945 | (with-current-buffer gnus-article-buffer gnus-icalendar-event))) | |
946 | ||
a99f655b GM |
947 | (defvar gnus-mime-action-alist) ; gnus-art |
948 | ||
89cccc2f G |
949 | (defun gnus-icalendar-setup () |
950 | (add-to-list 'mm-inlined-types "text/calendar") | |
951 | (add-to-list 'mm-automatic-display "text/calendar") | |
952 | (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) | |
953 | ||
954 | (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map) | |
955 | "a" gnus-icalendar-reply-accept | |
956 | "t" gnus-icalendar-reply-tentative | |
957 | "d" gnus-icalendar-reply-decline | |
958 | "c" gnus-icalendar-event-check-agenda | |
959 | "e" gnus-icalendar-event-export | |
960 | "s" gnus-icalendar-event-show) | |
961 | ||
962 | (require 'gnus-art) | |
963 | (add-to-list 'gnus-mime-action-alist | |
964 | (cons "save calendar event" 'gnus-icalendar-save-event) | |
965 | t)) | |
966 | ||
967 | (provide 'gnus-icalendar) | |
968 | ||
969 | ;;; gnus-icalendar.el ends here |