(eval-when-compile (require 'cl))
(eval-and-compile
- (autoload 'mm-inline-partial "mm-partial"))
+ (autoload 'mm-inline-partial "mm-partial")
+ (autoload 'mm-inline-external-body "mm-extern"))
(defgroup mime-display ()
"Display of MIME in mail and news articles."
("text/x-patch" mm-display-patch-inline
(lambda (handle)
(locate-library "diff-mode")))
+ ("application/emacs-lisp" mm-display-elisp-inline identity)
("text/html"
mm-inline-text
(lambda (handle)
("message/delivery-status" mm-inline-text identity)
("message/rfc822" mm-inline-message identity)
("message/partial" mm-inline-partial identity)
+ ("message/external-body" mm-inline-external-body identity)
("text/.*" mm-inline-text identity)
("audio/wav" mm-inline-audio
(lambda (handle)
(defcustom mm-inlined-types
'("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
- "message/partial"
+ "message/partial" "message/external-body" "application/emacs-lisp"
"application/pgp-signature")
"List of media types that are to be displayed inline."
:type '(repeat string)
(defcustom mm-automatic-display
'("text/plain" "text/enriched" "text/richtext" "text/html"
"text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
- "message/rfc822" "text/x-patch" "application/pgp-signature")
+ "message/rfc822" "text/x-patch" "application/pgp-signature"
+ "application/emacs-lisp")
"A list of MIME types to be displayed automatically."
:type '(repeat string)
:group 'mime-display)
;; "message/rfc822".
(defvar mm-dissect-default-type "text/plain")
+(autoload 'mml2015-verify "mml2015")
+
+(defvar mm-verify-function-alist
+ '(("application/pgp-signature" . mml2015-verify)))
+
+(defcustom mm-verify-option nil
+ "Option of verifying signed parts.
+`never', not verify; `always', always verify;
+`known', only verify known protocols. Otherwise, ask user."
+ :type '(choice (item always)
+ (item never)
+ (item :tag "only known protocols" known)
+ (item :tag "ask" nil))
+ :group 'gnus-article)
+
+(autoload 'mml2015-decrypt "mml2015")
+
+(defvar mm-decrypt-function-alist
+ '(("application/pgp-encrypted" . mml2015-decrypt)))
+
+(defcustom mm-decrypt-option nil
+ "Option of decrypting signed parts.
+`never', not decrypt; `always', always decrypt;
+`known', only decrypt known protocols. Otherwise, ask user."
+ :type '(choice (item always)
+ (item never)
+ (item :tag "only known protocols" known)
+ (item :tag "ask" nil))
+ :group 'gnus-article)
+
+(defvar mm-viewer-completion-map
+ (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ map)
+ "Keymap for input viewer with completion.")
+
+;; Should we bind other key to minibuffer-complete-word?
+(define-key mm-viewer-completion-map " " 'self-insert-command)
+
;;; The functions.
(defun mm-dissect-buffer (&optional no-strict-mime)
(save-restriction
(narrow-to-region start end)
(setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
- (nreverse parts)))
+ (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
(defun mm-copy-to-buffer ()
"Copy the contents of the current buffer to a fresh buffer."
(let ((cur (current-buffer)))
(if (eq method 'mailcap-save-binary-file)
(progn
- (set-buffer (generate-new-buffer "*mm*"))
+ (set-buffer (generate-new-buffer " *mm*"))
(setq method nil))
(mm-insert-part handle)
(let ((win (get-buffer-window cur t)))
(when win
(select-window win)))
- (switch-to-buffer (generate-new-buffer "*mm*")))
+ (switch-to-buffer (generate-new-buffer " *mm*")))
(buffer-disable-undo)
(mm-set-buffer-file-coding-system mm-binary-coding-system)
(insert-buffer-substring cur)
(progn
(call-process shell-file-name nil
(setq buffer
- (generate-new-buffer "*mm*"))
+ (generate-new-buffer " *mm*"))
nil
shell-command-switch
(mm-mailcap-command
(unwind-protect
(start-process "*display*"
(setq buffer
- (generate-new-buffer "*mm*"))
+ (generate-new-buffer " *mm*"))
shell-file-name
shell-command-switch
(mm-mailcap-command
(push "<" out)
(push (mm-quote-arg file) out)))
(mapconcat 'identity (nreverse out) "")))
-
+
(defun mm-remove-parts (handles)
"Remove the displayed MIME parts represented by HANDLES."
(if (and (listp handles)
(or filename name "")
(or mm-default-directory default-directory))))
(setq mm-default-directory (file-name-directory file))
- (when (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? "
- file)))
- (mm-save-part-to-file handle file))))
+ (and (or (not (file-exists-p file))
+ (yes-or-no-p (format "File %s already exists; overwrite? "
+ file)))
+ (progn
+ (mm-save-part-to-file handle file)
+ file))))
(defun mm-save-part-to-file (handle file)
(mm-with-unibyte-buffer
(methods
(mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
(mailcap-mime-info type 'all)))
- (method (completing-read "Viewer: " methods)))
+ (method (let ((minibuffer-local-completion-map
+ mm-viewer-completion-map))
+ (completing-read "Viewer: " methods))))
(when (string= method "")
(error "No method given"))
(if (string-match "^[^% \t]+$" method)
(defun mm-valid-and-fit-image-p (format handle)
"Say whether FORMAT can be displayed natively and HANDLE fits the window."
- (and window-system
- (mm-valid-image-format-p format)
+ (and (mm-valid-image-format-p format)
(mm-image-fit-p handle)))
+(defun mm-find-part-by-type (handles type &optional notp)
+ (let (handle)
+ (while handles
+ (if (if notp
+ (not (equal (mm-handle-media-type (car handles)) type))
+ (equal (mm-handle-media-type (car handles)) type))
+ (setq handle (car handles)
+ handles nil))
+ (setq handles (cdr handles)))
+ handle))
+
+(defun mm-find-raw-part-by-type (ctl type &optional notp)
+ (goto-char (point-min))
+ (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
+ (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
+ start
+ (end (save-excursion
+ (goto-char (point-max))
+ (if (re-search-backward close-delimiter nil t)
+ (match-beginning 0)
+ (point-max))))
+ result)
+ (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
+ (while (and (not result)
+ (re-search-forward boundary end t))
+ (goto-char (match-beginning 0))
+ (when start
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point))
+ (when (let ((ctl (ignore-errors
+ (mail-header-parse-content-type
+ (mail-fetch-field "content-type")))))
+ (if notp
+ (not (equal (car ctl) type))
+ (equal (car ctl) type)))
+ (setq result (buffer-substring (point-min) (point-max)))))))
+ (forward-line 2)
+ (setq start (point)))
+ (when (and (not result) start)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (when (let ((ctl (ignore-errors
+ (mail-header-parse-content-type
+ (mail-fetch-field "content-type")))))
+ (if notp
+ (not (equal (car ctl) type))
+ (equal (car ctl) type)))
+ (setq result (buffer-substring (point-min) (point-max)))))))
+ result))
+
+(defun mm-possibly-verify-or-decrypt (parts ctl)
+ (let ((subtype (cadr (split-string (car ctl) "/")))
+ protocol func)
+ (cond
+ ((equal subtype "signed")
+ (setq protocol (mail-content-type-get ctl 'protocol))
+ (setq func (cdr (assoc protocol mm-verify-function-alist)))
+ (if (cond
+ ((eq mm-verify-option 'never) nil)
+ ((eq mm-verify-option 'always) t)
+ ((eq mm-verify-option 'known) func)
+ (t (y-or-n-p
+ (format "Verify signed part(protocol=%s)?" protocol))))
+ (condition-case err
+ (save-excursion
+ (if func
+ (funcall func parts ctl)
+ (error (format "Unknown sign protocol(%s)" protocol))))
+ (error
+ (unless (y-or-n-p (format "%s, continue?" err))
+ (error "Verify failure."))))))
+ ((equal subtype "encrypted")
+ (setq protocol (mail-content-type-get ctl 'protocol))
+ (setq func (cdr (assoc protocol mm-decrypt-function-alist)))
+ (if (cond
+ ((eq mm-decrypt-option 'never) nil)
+ ((eq mm-decrypt-option 'always) t)
+ ((eq mm-decrypt-option 'known) func)
+ (t (y-or-n-p
+ (format "Decrypt part (protocol=%s)?" protocol))))
+ (condition-case err
+ (save-excursion
+ (if func
+ (setq parts (funcall func parts ctl))
+ (error (format "Unknown encrypt protocol(%s)" protocol))))
+ (error
+ (unless (y-or-n-p (format "%s, continue?" err))
+ (error "Decrypt failure."))))))
+ (t nil))
+ parts))
+
(provide 'mm-decode)
;;; mm-decode.el ends here