(lambda (handle)
(locate-library "diff-mode")))
("application/emacs-lisp" mm-display-elisp-inline identity)
+ ("application/x-emacs-lisp" mm-display-elisp-inline identity)
("text/html"
mm-inline-text
(lambda (handle)
("application/pgp-signature" ignore identity)
("application/x-pkcs7-signature" ignore identity)
("application/pkcs7-signature" ignore identity)
+ ("application/x-pkcs7-mime" ignore identity)
+ ("application/pkcs7-mime" ignore identity)
("multipart/alternative" ignore identity)
("multipart/mixed" ignore identity)
("multipart/related" ignore identity)
'("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
"message/partial" "message/external-body" "application/emacs-lisp"
"application/pgp-signature" "application/x-pkcs7-signature"
- "application/pkcs7-signature")
+ "application/pkcs7-signature" "application/x-pkcs7-mime"
+ "application/pkcs7-mime")
"List of media types that are to be displayed inline.
See also `mm-inline-media-tests', which says how to display a media
type inline."
"text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
"message/rfc822" "text/x-patch" "application/pgp-signature"
"application/emacs-lisp" "application/x-pkcs7-signature"
- "application/pkcs7-signature")
+ "application/pkcs7-signature" "application/x-pkcs7-mime"
+ "application/pkcs7-mime")
"A list of MIME types to be displayed automatically."
:type '(repeat string)
:group 'mime-display)
-(defcustom mm-attachment-override-types '("text/x-vcard")
+(defcustom mm-attachment-override-types '("text/x-vcard"
+ "application/pkcs7-mime"
+ "application/x-pkcs7-mime"
+ "application/pkcs7-signature"
+ "application/x-pkcs7-signature")
"Types to have \"attachment\" ignored if they can be displayed inline."
:type '(repeat string)
:group 'mime-display)
`capitalize', `downcase', `upcase', and
`upcase-initials'.")
+(defvar mm-path-name-rewrite-functions nil
+ "*List of functions used for rewriting path names of MIME parts.
+This is used when viewing parts externally , and is meant for
+transforming the path name so that non-compliant programs can
+find the file where it's saved.
+
+Each function takes a file name as input and returns a file name.")
+
(defvar mm-file-name-replace-whitespace nil
"String used for replacing whitespace characters; default is `\"_\"'.")
(defcustom mm-default-directory nil
"The default directory where mm will save files.
If not set, `default-directory' will be used."
- :type 'directory
+ :type '(choice directory (const :tag "Default" nil))
:group 'mime-display)
(defcustom mm-external-terminal-program "xterm"
(mm-handle-set-undisplayer handle function)))
(defun mm-destroy-postponed-undisplay-list ()
- (message "Destroying external MIME viewers")
- (mm-destroy-parts mm-postponed-undisplay-list))
+ (when mm-postponed-undisplay-list
+ (message "Destroying external MIME viewers")
+ (mm-destroy-parts mm-postponed-undisplay-list)))
(defun mm-dissect-buffer (&optional no-strict-mime)
"Dissect the current buffer and return a list of MIME handles."
(mm-alist-to-plist (cdr ctl)) (car ctl))
;; what really needs to be done here is a way to link a
- ;; MIME handle back to it's parent MIME handle (in a multilevel
+ ;; MIME handle back to it's parent MIME handle (in a multilevel
;; MIME article). That would probably require changing
- ;; the mm-handle API so we simply store the multipart buffert
- ;; name as a text property of the "multipart/whatever" string.
+ ;; the mm-handle API so we simply store the multipart buffert
+ ;; name as a text property of the "multipart/whatever" string.
(add-text-properties 0 (length (car ctl))
(list 'buffer (mm-copy-to-buffer))
(car ctl))
(car ctl))
(cons (car ctl) (mm-dissect-multipart ctl))))
(t
- (mm-dissect-singlepart
- ctl
- (and cte (intern (downcase (mail-header-remove-whitespace
- (mail-header-remove-comments
- cte)))))
- no-strict-mime
- (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
- description id))))
+ (mm-possibly-verify-or-decrypt
+ (mm-dissect-singlepart
+ ctl
+ (and cte (intern (downcase (mail-header-remove-whitespace
+ (mail-header-remove-comments
+ cte)))))
+ no-strict-mime
+ (and cd (ignore-errors
+ (mail-header-parse-content-disposition cd)))
+ description id)
+ ctl))))
(when id
(when (string-match " *<\\(.*\\)> *" id)
(setq id (match-string 1 id)))
(mm-handle-set-undisplayer handle mm)))))
;; The function is a string to be executed.
(mm-insert-part handle)
- (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
- (filename (mail-content-type-get
- (mm-handle-disposition handle) 'filename))
+ (let* ((dir (make-temp-name
+ (expand-file-name "emm." mm-tmp-directory)))
+ (filename (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name)))
(mime-info (mailcap-mime-info
(mm-handle-media-type handle) t))
(needsterm (or (assoc "needsterm" mime-info)
(assoc "needsterminal" mime-info)))
(copiousoutput (assoc "copiousoutput" mime-info))
file buffer)
- ;; We create a private sub-directory where we store our files.
+ ;; We create a private sub-directory where we store our files.
(make-directory dir)
(set-file-modes dir 448)
(if filename
(let ((coding-system-for-write mm-binary-coding-system))
(write-region (point-min) (point-max) file nil 'nomesg))
(message "Viewing with %s" method)
- (cond (needsterm
- (unwind-protect
- (if window-system
- (start-process "*display*" nil
- mm-external-terminal-program
- "-e" shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (require 'term)
- (require 'gnus-win)
- (set-buffer
- (setq buffer
- (make-term "display"
- shell-file-name
- nil
- shell-command-switch
- (mm-mailcap-command
- method file
- (mm-handle-type handle)))))
- (term-mode)
- (term-char-mode)
- (set-process-sentinel
- (get-buffer-process buffer)
- `(lambda (process state)
- (if (eq 'exit (process-status process))
- (gnus-configure-windows
- ',gnus-current-window-configuration))))
- (gnus-configure-windows 'display-term))
- (mm-handle-set-external-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
- 'external)
- (copiousoutput
- (with-current-buffer outbuf
- (forward-line 1)
- (mm-insert-inline
- handle
- (unwind-protect
- (progn
- (call-process shell-file-name nil
- (setq buffer
- (generate-new-buffer " *mm*"))
- nil
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (if (buffer-live-p buffer)
- (save-excursion
- (set-buffer buffer)
- (buffer-string))))
- (progn
- (ignore-errors (delete-file file))
- (ignore-errors (delete-directory
- (file-name-directory file)))
- (ignore-errors (kill-buffer buffer))))))
- 'inline)
- (t
- (unwind-protect
- (start-process "*display*"
- (setq buffer
- (generate-new-buffer " *mm*"))
+ (cond
+ (needsterm
+ (unwind-protect
+ (if window-system
+ (start-process "*display*" nil
+ mm-external-terminal-program
+ "-e" shell-file-name
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))
+ (require 'term)
+ (require 'gnus-win)
+ (set-buffer
+ (setq buffer
+ (make-term "display"
shell-file-name
+ nil
shell-command-switch
(mm-mailcap-command
- method file (mm-handle-type handle)))
- (mm-handle-set-external-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
- 'external)))))))
+ method file
+ (mm-handle-type handle)))))
+ (term-mode)
+ (term-char-mode)
+ (set-process-sentinel
+ (get-buffer-process buffer)
+ `(lambda (process state)
+ (if (eq 'exit (process-status process))
+ (gnus-configure-windows
+ ',gnus-current-window-configuration))))
+ (gnus-configure-windows 'display-term))
+ (mm-handle-set-external-undisplayer handle (cons file buffer)))
+ (message "Displaying %s..." (format method file))
+ 'external)
+ (copiousoutput
+ (with-current-buffer outbuf
+ (forward-line 1)
+ (mm-insert-inline
+ handle
+ (unwind-protect
+ (progn
+ (call-process shell-file-name nil
+ (setq buffer
+ (generate-new-buffer " *mm*"))
+ nil
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))
+ (if (buffer-live-p buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (buffer-string))))
+ (progn
+ (ignore-errors (delete-file file))
+ (ignore-errors (delete-directory
+ (file-name-directory file)))
+ (ignore-errors (kill-buffer buffer))))))
+ 'inline)
+ (t
+ (unwind-protect
+ (start-process "*display*"
+ (setq buffer
+ (generate-new-buffer " *mm*"))
+ shell-file-name
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))
+ (mm-handle-set-external-undisplayer
+ handle (cons file buffer)))
+ (message "Displaying %s..." (format method file))
+ 'external)))))))
(defun mm-mailcap-command (method file type-list)
(let ((ctl (cdr type-list))
(push "%" out))
((string= total "%s")
(setq uses-stdin nil)
- (push (mm-quote-arg file) out))
+ (push (mm-quote-arg
+ (gnus-map-function mm-path-name-rewrite-functions file)) out))
((string= total "%t")
(push (mm-quote-arg (car type-list)) out))
(t
(push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
(push (substring method beg (length method)) out)
- (if uses-stdin
- (progn
- (push "<" out)
- (push (mm-quote-arg file) out)))
+ (when uses-stdin
+ (push "<" out)
+ (push (mm-quote-arg
+ (gnus-map-function mm-path-name-rewrite-functions file))
+ out))
(mapconcat 'identity (nreverse out) "")))
(defun mm-remove-parts (handles)
(if (member (mm-handle-media-supertype handle) '("text" "message"))
(with-temp-buffer
(insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (mm-handle-media-type handle))
- (let ((temp (current-buffer)))
- (set-buffer cur)
- (insert-buffer-substring temp)))
+ (prog1
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (mm-handle-media-type handle))
+ (let ((temp (current-buffer)))
+ (set-buffer cur)
+ (insert-buffer-substring temp))))
(mm-with-unibyte-buffer
(insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (mm-handle-media-type handle))
- (let ((temp (current-buffer)))
- (set-buffer cur)
- (insert-buffer-substring temp)))))))
+ (prog1
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (mm-handle-media-type handle))
+ (let ((temp (current-buffer)))
+ (set-buffer cur)
+ (insert-buffer-substring temp))))))))
(defun mm-file-name-delete-whitespace (file-name)
"Remove all whitespace characters from FILE-NAME."
(car handle))))
(defun mm-possibly-verify-or-decrypt (parts ctl)
- (let ((subtype (cadr (split-string (car ctl) "/")))
+ (let ((type (car ctl))
+ (subtype (cadr (split-string (car ctl) "/")))
(mm-security-handle ctl) ;; (car CTL) is the type.
protocol func functest)
(cond
+ ((or (equal type "application/x-pkcs7-mime")
+ (equal type "application/pkcs7-mime"))
+ (with-temp-buffer
+ (when (and (cond
+ ((eq mm-decrypt-option 'never) nil)
+ ((eq mm-decrypt-option 'always) t)
+ ((eq mm-decrypt-option 'known) t)
+ (t (y-or-n-p
+ (format "Decrypt (S/MIME) part? "))))
+ (mm-view-pkcs7 parts))
+ (setq parts (mm-dissect-buffer t)))))
((equal subtype "signed")
(unless (and (setq protocol
(mm-handle-multipart-ctl-parameter ctl 'protocol))
(defun mm-readable-p (handle)
"Say whether the content of HANDLE is readable."
- (and (< (buffer-size (mm-handle-buffer handle)) 10000)
+ (and (< (with-current-buffer (mm-handle-buffer handle)
+ (buffer-size)) 10000)
(mm-with-unibyte-buffer
(mm-insert-part handle)
(and (eq (mm-body-7-or-8) '7bit)