diff options
| author | Stefan Monnier | 2019-03-29 08:46:29 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-03-29 08:46:29 -0400 |
| commit | fc2da0db49fad772f4497a9dc1ffb5722fc6cc1e (patch) | |
| tree | 9f91845b5027c99045d6c437043e77d523381045 | |
| parent | 14e9a428c5e555c590629b4eeec7e754d7e7ae77 (diff) | |
| download | emacs-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.el | 58 | ||||
| -rw-r--r-- | lisp/gnus/mm-decode.el | 38 |
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 | |||
| 702 | If you need even more aliases you can define them here. It really | 698 | If you need even more aliases you can define them here. It really |
| 703 | only makes sense to define names or email addresses." | 699 | only 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" |