(eval-and-compile
(autoload 'mm-inline-partial "mm-partial")
(autoload 'mm-inline-external-body "mm-extern")
+ (autoload 'mm-extern-cache-contents "mm-extern")
(autoload 'mm-insert-inline "mm-view"))
(defvar gnus-current-window-configuration)
"application/pkcs7-signature" "application/x-pkcs7-mime"
"application/pkcs7-mime"
;; Mutt still uses this even though it has already been withdrawn.
- "application/pgp")
+ "application/pgp\\'")
"A list of MIME types to be displayed automatically."
:type '(repeat regexp)
:group 'mime-display)
(defcustom mm-verify-option 'never
"Option of verifying signed parts.
`never', not verify; `always', always verify;
-`known', only verify known protocols. Otherwise, ask user."
+`known', only verify known protocols. Otherwise, ask user.
+
+When set to `always' or `known', you should add
+\"multipart/signed\" to `gnus-buttonized-mime-types' to see
+result of the verification."
:version "22.1"
:type '(choice (item always)
(item never)
(mailcap-parse-mailcaps)
(if (mm-handle-displayed-p handle)
(mm-remove-part handle)
- (let* ((type (mm-handle-media-type handle))
+ (let* ((ehandle (if (equal (mm-handle-media-type handle)
+ "message/external-body")
+ (progn
+ (unless (mm-handle-cache handle)
+ (mm-extern-cache-contents handle))
+ (mm-handle-cache handle))
+ handle))
+ (type (mm-handle-media-type ehandle))
(method (mailcap-mime-info type))
(filename (or (mail-content-type-get
(mm-handle-disposition handle) 'filename)
(mm-handle-type handle) 'name)
"<file>"))
(external mm-enable-external))
- (if (and (mm-inlinable-p handle)
- (mm-inlined-p handle))
+ (if (and (mm-inlinable-p ehandle)
+ (mm-inlined-p ehandle))
(progn
(forward-line 1)
(mm-display-inline handle)
(when (or method
(not no-default))
(if (and (not method)
- (equal "text" (car (split-string type))))
+ (equal "text" (car (split-string type "/"))))
(progn
(forward-line 1)
(mm-insert-inline handle (mm-get-part handle))
;;; Functions for outputting parts
;;;
-(defun mm-get-part (handle)
- "Return the contents of HANDLE as a string."
- (let ((default-enable-multibyte-characters
- (with-current-buffer (mm-handle-buffer handle)
- (mm-multibyte-p))))
- (with-temp-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-disable-multibyte)
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (mm-handle-media-type handle))
+(defmacro mm-with-part (handle &rest forms)
+ "Run FORMS in the temp buffer containing the contents of HANDLE."
+ `(let* ((handle ,handle)
+ ;; The multibyteness of the temp buffer should be turned on
+ ;; if inserting a multibyte string. Contrarily, the buffer's
+ ;; multibyteness should be off if inserting a unibyte string,
+ ;; especially if a string contains 8bit data.
+ (default-enable-multibyte-characters
+ (with-current-buffer (mm-handle-buffer handle)
+ (mm-multibyte-p))))
+ (with-temp-buffer
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-disable-multibyte)
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (mm-handle-media-type handle))
+ ,@forms)))
+(put 'mm-with-part 'lisp-indent-function 1)
+(put 'mm-with-part 'edebug-form-spec '(body))
+
+(defun mm-get-part (handle &optional no-cache)
+ "Return the contents of HANDLE as a string.
+If NO-CACHE is non-nil, cached contents of a message/external-body part
+are ignored."
+ (if (and (not no-cache)
+ (equal (mm-handle-media-type handle) "message/external-body"))
+ (progn
+ (unless (mm-handle-cache handle)
+ (mm-extern-cache-contents handle))
+ (with-current-buffer (mm-handle-buffer (mm-handle-cache handle))
+ (buffer-string)))
+ (mm-with-part handle
(buffer-string))))
-(defun mm-insert-part (handle)
- "Insert the contents of HANDLE in the current buffer."
+(defun mm-insert-part (handle &optional no-cache)
+ "Insert the contents of HANDLE in the current buffer.
+If NO-CACHE is non-nil, cached contents of a message/external-body part
+are ignored."
(save-excursion
(insert
(cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset)
(with-current-buffer (mm-handle-buffer handle)
(buffer-string)))
((mm-multibyte-p)
- (mm-string-as-multibyte (mm-get-part handle)))
+ (mm-string-as-multibyte (mm-get-part handle no-cache)))
(t
- (mm-get-part handle))))))
+ (mm-get-part handle no-cache))))))
(defun mm-file-name-delete-whitespace (file-name)
"Remove all whitespace characters from FILE-NAME."
(defun mm-save-part (handle &optional prompt)
"Write HANDLE to a file.
PROMPT overrides the default one used to ask user for a file name."
- (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
- (filename (mail-content-type-get
- (mm-handle-disposition handle) 'filename))
- file)
+ (let ((filename (or (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name)))
+ file)
(when filename
(setq filename (gnus-map-function mm-file-name-rewrite-functions
(file-name-nondirectory filename))))
(setq file
(mm-with-multibyte
- (read-file-name (or prompt "Save MIME part to: ")
- (or mm-default-directory default-directory)
- nil nil (or filename name ""))))
+ (read-file-name (or prompt "Save MIME part to: ")
+ (or mm-default-directory default-directory)
+ nil nil (or filename ""))))
(setq mm-default-directory (file-name-directory file))
(and (or (not (file-exists-p file))
(yes-or-no-p (format "File %s already exists; overwrite? "
projects / gnus / blobdiff