aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-03-29 08:46:29 -0400
committerStefan Monnier2019-03-29 08:46:29 -0400
commitfc2da0db49fad772f4497a9dc1ffb5722fc6cc1e (patch)
tree9f91845b5027c99045d6c437043e77d523381045
parent14e9a428c5e555c590629b4eeec7e754d7e7ae77 (diff)
downloademacs-fc2da0db49fad772f4497a9dc1ffb5722fc6cc1e.tar.gz
emacs-fc2da0db49fad772f4497a9dc1ffb5722fc6cc1e.zip
Gnus: Automatically render text/calendar in a human-friendly way
* lisp/gnus/mm-decode.el (mm-inline-media-tests): Add text/calendar entry. Use (fboundp 'device-sound-enabled-p) rather than fishing for features. (mm-automatic-display): Add text/calendar entry. * lisp/gnus/gnus-icalendar.el: Use lexical-binding. Remove redundant :group args. (gnus-icalendar-mm-inline): Add autoload cookie.
-rw-r--r--lisp/gnus/gnus-icalendar.el58
-rw-r--r--lisp/gnus/mm-decode.el38
2 files changed, 47 insertions, 49 deletions
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 062dd1b2917..28020a1fd0b 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -1,4 +1,4 @@
1;;; gnus-icalendar.el --- reply to iCalendar meeting requests 1;;; gnus-icalendar.el --- reply to iCalendar meeting requests -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2013-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
4 4
@@ -244,7 +244,7 @@
244 (map-property ical-property)) 244 (map-property ical-property))
245 args))))) 245 args)))))
246 (mapc #'accumulate-args prop-map) 246 (mapc #'accumulate-args prop-map)
247 (apply 'make-instance event-class args)))) 247 (apply #'make-instance event-class args))))
248 248
249(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) 249(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email)
250 "Parse RFC5545 iCalendar in buffer BUF and return an event object. 250 "Parse RFC5545 iCalendar in buffer BUF and return an event object.
@@ -301,7 +301,8 @@ status will be retrieved from the first matching attendee record."
301 ((string= key "DTSTAMP") (update-dtstamp)) 301 ((string= key "DTSTAMP") (update-dtstamp))
302 ((member key '("ORGANIZER" "DTSTART" "DTEND" 302 ((member key '("ORGANIZER" "DTSTART" "DTEND"
303 "LOCATION" "DURATION" "SEQUENCE" 303 "LOCATION" "DURATION" "SEQUENCE"
304 "RECURRENCE-ID" "UID")) line) 304 "RECURRENCE-ID" "UID"))
305 line)
305 (t nil)))) 306 (t nil))))
306 (when new-line 307 (when new-line
307 (push new-line reply-event-lines)))))) 308 (push new-line reply-event-lines))))))
@@ -352,9 +353,9 @@ on the IDENTITIES list."
352 353
353;;; 354;;;
354;;; gnus-icalendar-org 355;;; gnus-icalendar-org
355;;; 356;;
356;;; TODO: this is an optional feature, and it's only available with org-mode 357;; TODO: this is an optional feature, and it's only available with org-mode
357;;; 7+, so will need to properly handle emacsen with no/outdated org-mode 358;; 7+, so will need to properly handle emacsen with no/outdated org-mode
358 359
359(require 'org) 360(require 'org)
360(require 'org-capture) 361(require 'org-capture)
@@ -367,23 +368,19 @@ on the IDENTITIES list."
367 368
368(defcustom gnus-icalendar-org-capture-file nil 369(defcustom gnus-icalendar-org-capture-file nil
369 "Target Org file for storing captured calendar events." 370 "Target Org file for storing captured calendar events."
370 :type '(choice (const nil) file) 371 :type '(choice (const nil) file))
371 :group 'gnus-icalendar-org)
372 372
373(defcustom gnus-icalendar-org-capture-headline nil 373(defcustom gnus-icalendar-org-capture-headline nil
374 "Target outline in `gnus-icalendar-org-capture-file' for storing captured events." 374 "Target outline in `gnus-icalendar-org-capture-file' for storing captured events."
375 :type '(repeat string) 375 :type '(repeat string))
376 :group 'gnus-icalendar-org)
377 376
378(defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org" 377(defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org"
379 "Org-mode template name." 378 "Org-mode template name."
380 :type '(string) 379 :type '(string))
381 :group 'gnus-icalendar-org)
382 380
383(defcustom gnus-icalendar-org-template-key "#" 381(defcustom gnus-icalendar-org-template-key "#"
384 "Org-mode template hotkey." 382 "Org-mode template hotkey."
385 :type '(string) 383 :type '(string))
386 :group 'gnus-icalendar-org)
387 384
388(defvar gnus-icalendar-org-enabled-p nil) 385(defvar gnus-icalendar-org-enabled-p nil)
389 386
@@ -662,7 +659,7 @@ is searched."
662 (gnus-icalendar--update-org-event event reply-status) 659 (gnus-icalendar--update-org-event event reply-status)
663 (gnus-icalendar:org-event-save event reply-status))) 660 (gnus-icalendar:org-event-save event reply-status)))
664 661
665(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status) 662(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) _reply-status)
666 (when (gnus-icalendar-find-org-event-file event) 663 (when (gnus-icalendar-find-org-event-file event)
667 (gnus-icalendar--cancel-org-event event))) 664 (gnus-icalendar--cancel-org-event event)))
668 665
@@ -685,8 +682,7 @@ is searched."
685 682
686(defcustom gnus-icalendar-reply-bufname "*CAL*" 683(defcustom gnus-icalendar-reply-bufname "*CAL*"
687 "Buffer used for building iCalendar invitation reply." 684 "Buffer used for building iCalendar invitation reply."
688 :type '(string) 685 :type '(string))
689 :group 'gnus-icalendar)
690 686
691(defcustom gnus-icalendar-additional-identities nil 687(defcustom gnus-icalendar-additional-identities nil
692 "We need to know your identity to make replies to calendar requests work. 688 "We need to know your identity to make replies to calendar requests work.
@@ -702,17 +698,13 @@ Your identity is guessed automatically from the variables
702If you need even more aliases you can define them here. It really 698If you need even more aliases you can define them here. It really
703only makes sense to define names or email addresses." 699only makes sense to define names or email addresses."
704 700
705 :type '(repeat string) 701 :type '(repeat string))
706 :group 'gnus-icalendar)
707 702
708(make-variable-buffer-local 703(defvar-local gnus-icalendar-reply-status nil)
709 (defvar gnus-icalendar-reply-status nil))
710 704
711(make-variable-buffer-local 705(defvar-local gnus-icalendar-event nil)
712 (defvar gnus-icalendar-event nil))
713 706
714(make-variable-buffer-local 707(defvar-local gnus-icalendar-handle nil)
715 (defvar gnus-icalendar-handle nil))
716 708
717(defun gnus-icalendar-identities () 709(defun gnus-icalendar-identities ()
718 "Return list of regexp-quoted names and email addresses belonging to the user. 710 "Return list of regexp-quoted names and email addresses belonging to the user.
@@ -738,7 +730,8 @@ These will be used to retrieve the RSVP information from ical events."
738 (cadr x)))) 730 (cadr x))))
739 731
740 (with-slots (organizer summary description location recur uid 732 (with-slots (organizer summary description location recur uid
741 method rsvp participation-type) event 733 method rsvp participation-type)
734 event
742 (let ((headers `(("Summary" ,summary) 735 (let ((headers `(("Summary" ,summary)
743 ("Location" ,(or location "")) 736 ("Location" ,(or location ""))
744 ("Time" ,(gnus-icalendar-event:org-timestamp event)) 737 ("Time" ,(gnus-icalendar-event:org-timestamp event))
@@ -844,7 +837,7 @@ These will be used to retrieve the RSVP information from ical events."
844 ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) 837 ("Tentative" gnus-icalendar-reply (,handle tentative ,event))
845 ("Decline" gnus-icalendar-reply (,handle declined ,event))))) 838 ("Decline" gnus-icalendar-reply (,handle declined ,event)))))
846 839
847(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) 840(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((_event gnus-icalendar-event-reply) _handle)
848 "No buttons for REPLY events." 841 "No buttons for REPLY events."
849 nil) 842 nil)
850 843
@@ -853,7 +846,7 @@ These will be used to retrieve the RSVP information from ical events."
853 (gnus-icalendar--get-org-event-reply-status event)) 846 (gnus-icalendar--get-org-event-reply-status event))
854 "Not replied yet")) 847 "Not replied yet"))
855 848
856(cl-defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) 849(cl-defmethod gnus-icalendar-event:inline-reply-status ((_event gnus-icalendar-event-reply))
857 "No reply status for REPLY events." 850 "No reply status for REPLY events."
858 nil) 851 nil)
859 852
@@ -880,7 +873,7 @@ These will be used to retrieve the RSVP information from ical events."
880 (when org-entry-exists-p 873 (when org-entry-exists-p
881 `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) 874 `("Show Org Entry" gnus-icalendar--show-org-event ,event))))))
882 875
883 876;;;###autoload
884(defun gnus-icalendar-mm-inline (handle) 877(defun gnus-icalendar-mm-inline (handle)
885 (let ((event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities)))) 878 (let ((event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities))))
886 879
@@ -892,7 +885,7 @@ These will be used to retrieve the RSVP information from ical events."
892 (buttons) 885 (buttons)
893 (when buttons 886 (when buttons
894 (mapc (lambda (x) 887 (mapc (lambda (x)
895 (apply 'gnus-icalendar-insert-button x) 888 (apply #'gnus-icalendar-insert-button x)
896 (insert " ")) 889 (insert " "))
897 buttons) 890 buttons)
898 (insert "\n\n")))) 891 (insert "\n\n"))))
@@ -973,6 +966,9 @@ These will be used to retrieve the RSVP information from ical events."
973(defvar gnus-mime-action-alist) ; gnus-art 966(defvar gnus-mime-action-alist) ; gnus-art
974 967
975(defun gnus-icalendar-setup () 968(defun gnus-icalendar-setup ()
969 ;; FIXME: Get rid of this!
970 ;; The three add-to-list are now redundant (good), but I think the rest
971 ;; is still not automatically setup.
976 (add-to-list 'mm-inlined-types "text/calendar") 972 (add-to-list 'mm-inlined-types "text/calendar")
977 (add-to-list 'mm-automatic-display "text/calendar") 973 (add-to-list 'mm-automatic-display "text/calendar")
978 (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) 974 (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity))
@@ -987,7 +983,7 @@ These will be used to retrieve the RSVP information from ical events."
987 983
988 (require 'gnus-art) 984 (require 'gnus-art)
989 (add-to-list 'gnus-mime-action-alist 985 (add-to-list 'gnus-mime-action-alist
990 (cons "save calendar event" 'gnus-icalendar-save-event) 986 (cons "save calendar event" #'gnus-icalendar-save-event)
991 t)) 987 t))
992 988
993(provide 'gnus-icalendar) 989(provide 'gnus-icalendar)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index b689b51d6a5..3f255419e7e 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -190,45 +190,45 @@ before the external MIME handler is invoked."
190 :group 'mime-display) 190 :group 'mime-display)
191 191
192(defcustom mm-inline-media-tests 192(defcustom mm-inline-media-tests
193 '(("image/p?jpeg" 193 `(("image/p?jpeg"
194 mm-inline-image 194 mm-inline-image
195 (lambda (handle) 195 ,(lambda (handle)
196 (mm-valid-and-fit-image-p 'jpeg handle))) 196 (mm-valid-and-fit-image-p 'jpeg handle)))
197 ("image/png" 197 ("image/png"
198 mm-inline-image 198 mm-inline-image
199 (lambda (handle) 199 ,(lambda (handle)
200 (mm-valid-and-fit-image-p 'png handle))) 200 (mm-valid-and-fit-image-p 'png handle)))
201 ("image/gif" 201 ("image/gif"
202 mm-inline-image 202 mm-inline-image
203 (lambda (handle) 203 ,(lambda (handle)
204 (mm-valid-and-fit-image-p 'gif handle))) 204 (mm-valid-and-fit-image-p 'gif handle)))
205 ("image/tiff" 205 ("image/tiff"
206 mm-inline-image 206 mm-inline-image
207 (lambda (handle) 207 ,(lambda (handle)
208 (mm-valid-and-fit-image-p 'tiff handle))) 208 (mm-valid-and-fit-image-p 'tiff handle)))
209 ("image/xbm" 209 ("image/xbm"
210 mm-inline-image 210 mm-inline-image
211 (lambda (handle) 211 ,(lambda (handle)
212 (mm-valid-and-fit-image-p 'xbm handle))) 212 (mm-valid-and-fit-image-p 'xbm handle)))
213 ("image/x-xbitmap" 213 ("image/x-xbitmap"
214 mm-inline-image 214 mm-inline-image
215 (lambda (handle) 215 ,(lambda (handle)
216 (mm-valid-and-fit-image-p 'xbm handle))) 216 (mm-valid-and-fit-image-p 'xbm handle)))
217 ("image/xpm" 217 ("image/xpm"
218 mm-inline-image 218 mm-inline-image
219 (lambda (handle) 219 ,(lambda (handle)
220 (mm-valid-and-fit-image-p 'xpm handle))) 220 (mm-valid-and-fit-image-p 'xpm handle)))
221 ("image/x-xpixmap" 221 ("image/x-xpixmap"
222 mm-inline-image 222 mm-inline-image
223 (lambda (handle) 223 ,(lambda (handle)
224 (mm-valid-and-fit-image-p 'xpm handle))) 224 (mm-valid-and-fit-image-p 'xpm handle)))
225 ("image/bmp" 225 ("image/bmp"
226 mm-inline-image 226 mm-inline-image
227 (lambda (handle) 227 ,(lambda (handle)
228 (mm-valid-and-fit-image-p 'bmp handle))) 228 (mm-valid-and-fit-image-p 'bmp handle)))
229 ("image/x-portable-bitmap" 229 ("image/x-portable-bitmap"
230 mm-inline-image 230 mm-inline-image
231 (lambda (handle) 231 ,(lambda (handle)
232 (mm-valid-and-fit-image-p 'pbm handle))) 232 (mm-valid-and-fit-image-p 'pbm handle)))
233 ("text/plain" mm-inline-text identity) 233 ("text/plain" mm-inline-text identity)
234 ("text/enriched" mm-inline-text identity) 234 ("text/enriched" mm-inline-text identity)
@@ -246,13 +246,14 @@ before the external MIME handler is invoked."
246 ("text/x-org" mm-display-org-inline identity) 246 ("text/x-org" mm-display-org-inline identity)
247 ("text/html" 247 ("text/html"
248 mm-inline-text-html 248 mm-inline-text-html
249 (lambda (handle) 249 ,(lambda (_handle)
250 mm-text-html-renderer)) 250 mm-text-html-renderer))
251 ("text/x-vcard" 251 ("text/x-vcard"
252 mm-inline-text-vcard 252 mm-inline-text-vcard
253 (lambda (handle) 253 ,(lambda (_handle)
254 (or (featurep 'vcard) 254 (or (featurep 'vcard)
255 (locate-library "vcard")))) 255 (locate-library "vcard"))))
256 ("text/calendar" gnus-icalendar-mm-inline identity)
256 ("message/delivery-status" mm-inline-text identity) 257 ("message/delivery-status" mm-inline-text identity)
257 ("message/rfc822" mm-inline-message identity) 258 ("message/rfc822" mm-inline-message identity)
258 ("message/partial" mm-inline-partial identity) 259 ("message/partial" mm-inline-partial identity)
@@ -261,13 +262,13 @@ before the external MIME handler is invoked."
261 ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity) 262 ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
262 ("application/zip" mm-archive-dissect-and-inline identity) 263 ("application/zip" mm-archive-dissect-and-inline identity)
263 ("audio/wav" mm-inline-audio 264 ("audio/wav" mm-inline-audio
264 (lambda (handle) 265 ,(lambda (_handle)
265 (and (or (featurep 'nas-sound) (featurep 'native-sound)) 266 (and (fboundp 'device-sound-enabled-p)
266 (device-sound-enabled-p)))) 267 (device-sound-enabled-p))))
267 ("audio/au" 268 ("audio/au"
268 mm-inline-audio 269 mm-inline-audio
269 (lambda (handle) 270 ,(lambda (_handle)
270 (and (or (featurep 'nas-sound) (featurep 'native-sound)) 271 (and (fboundp 'device-sound-enabled-p)
271 (device-sound-enabled-p)))) 272 (device-sound-enabled-p))))
272 ("application/pgp-signature" ignore identity) 273 ("application/pgp-signature" ignore identity)
273 ("application/x-pkcs7-signature" ignore identity) 274 ("application/x-pkcs7-signature" ignore identity)
@@ -279,7 +280,7 @@ before the external MIME handler is invoked."
279 ("multipart/related" ignore identity) 280 ("multipart/related" ignore identity)
280 ("image/.*" 281 ("image/.*"
281 mm-inline-image 282 mm-inline-image
282 (lambda (handle) 283 ,(lambda (handle)
283 (and (mm-valid-image-format-p 'imagemagick) 284 (and (mm-valid-image-format-p 'imagemagick)
284 (mm-with-unibyte-buffer 285 (mm-with-unibyte-buffer
285 (mm-insert-part handle) 286 (mm-insert-part handle)
@@ -331,6 +332,7 @@ a list of regexps."
331 332
332(defcustom mm-automatic-display 333(defcustom mm-automatic-display
333 '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim" 334 '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim"
335 "text/calendar"
334 "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" 336 "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
335 "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature" 337 "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature"
336 "application/emacs-lisp" "application/x-emacs-lisp" 338 "application/emacs-lisp" "application/x-emacs-lisp"