X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=7982b745d6600bc2e95ceea84255ab6b60fdf900;hb=873ba7b51ddfb07246cd874b7de72662308236c9;hp=891843424fd7fcd01bfeb624fa2565123587c843;hpb=0083071bc8c341265712e48a4cd128d280fbec94;p=gnus diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 891843424..7982b745d 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -29,7 +29,6 @@ (require 'mail-parse) (require 'mm-bodies) -(require 'mm-archive) (eval-when-compile (require 'cl) (require 'term)) @@ -42,6 +41,10 @@ (autoload 'mm-extern-cache-contents "mm-extern") (autoload 'mm-insert-inline "mm-view") +(autoload 'mm-archive-decoders "mm-archive") +(autoload 'mm-archive-dissect-and-inline "mm-archive") +(autoload 'mm-dissect-archive "mm-archive") + (defvar gnus-current-window-configuration) (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list) @@ -278,7 +281,8 @@ before the external MIME handler is invoked." (ignore-errors (if (fboundp 'create-image) (create-image (buffer-string) 'imagemagick 'data-p) - (mm-create-image-xemacs (mm-handle-media-subtype handle)))))) + (mm-create-image-xemacs + (mm-handle-media-subtype handle)))))) (when image (setcar (cdr handle) (list "image/imagemagick")) (mm-image-fit-p handle))))))) @@ -454,6 +458,7 @@ If not set, `default-directory' will be used." (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) (defvar mm-postponed-undisplay-list nil) +(defvar mm-inhibit-auto-detect-attachment nil) ;; According to RFC2046, in particular, in a digest, the default ;; Content-Type value for a body part is changed from "text/plain" to @@ -573,7 +578,9 @@ Postpone undisplaying of viewers for types in (autoload 'message-fetch-field "message") (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) - "Dissect the current buffer and return a list of MIME handles." + "Dissect the current buffer and return a list of MIME handles. +If NO-STRICT-MIME, don't require the message to have a +MIME-Version header before proceeding." (save-excursion (let (ct ctl type subtype cte cd description id result) (save-restriction @@ -662,7 +669,8 @@ Postpone undisplaying of viewers for types in ;; Guess what the type of application/octet-stream parts should ;; really be. (let ((filename (cdr (assq 'filename (cdr cdl))))) - (when (and (equal (car ctl) "application/octet-stream") + (when (and (not mm-inhibit-auto-detect-attachment) + (equal (car ctl) "application/octet-stream") filename (string-match "\\.\\([^.]+\\)$" filename)) (let ((new-type (mailcap-extension-to-mime (match-string 1 filename)))) @@ -671,7 +679,7 @@ Postpone undisplaying of viewers for types in (let ((handle (mm-make-handle (mm-copy-to-buffer) ctl cte nil cdl description nil id)) - (decoder (assoc (car ctl) mm-archive-decoders))) + (decoder (assoc (car ctl) (mm-archive-decoders)))) (if (and decoder ;; Do automatic decoding (cadr decoder) @@ -688,7 +696,9 @@ Postpone undisplaying of viewers for types in (goto-char (point-max)) (if (re-search-backward close-delimiter nil t) (match-beginning 0) - (point-max))))) + (point-max)))) + (mm-inhibit-auto-detect-attachment + (equal (car ctl) "multipart/encrypted"))) (setq boundary (concat (regexp-quote boundary) "[ \t]*$")) (while (and (< (point) end) (re-search-forward boundary end t)) (goto-char (match-beginning 0)) @@ -759,23 +769,29 @@ external if displayed external." (mail-content-type-get (mm-handle-type handle) 'name) "")) - (external mm-enable-external)) - (if (and (mm-inlinable-p ehandle) - (mm-inlined-p ehandle)) - (progn - (forward-line 1) - (mm-display-inline handle) - 'inline) - (when (or method - (not no-default)) - (if (and (not method) - (equal "text" (car (split-string type "/")))) - (progn - (forward-line 1) - (mm-insert-inline handle (mm-get-part handle)) - 'inline) - (setq external - (and method ;; If nil, we always use "save". + (external mm-enable-external) + (decoder (assoc (car (mm-handle-type handle)) + (mm-archive-decoders)))) + (cond + ((and decoder + (executable-find (caddr decoder))) + (mm-archive-dissect-and-inline handle) + 'inline) + ((and (mm-inlinable-p ehandle) + (mm-inlined-p ehandle)) + (forward-line 1) + (mm-display-inline handle) + 'inline) + ((or method + (not no-default)) + (if (and (not method) + (equal "text" (car (split-string type "/")))) + (progn + (forward-line 1) + (mm-insert-inline handle (mm-get-part handle)) + 'inline) + (setq external + (and method ;; If nil, we always use "save". (stringp method) ;; 'mailcap-save-binary-file (or (eq mm-enable-external t) (and (eq mm-enable-external 'ask) @@ -788,12 +804,12 @@ external if displayed external." (concat " \"" (format method filename) "\"") "") - "? ")))))) - (if external - (mm-display-external - handle (or method 'mailcap-save-binary-file)) + "? ")))))) + (if external (mm-display-external - handle 'mailcap-save-binary-file))))))))) + handle (or method 'mailcap-save-binary-file)) + (mm-display-external + handle 'mailcap-save-binary-file))))))))) (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) (defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads @@ -1756,7 +1772,8 @@ If RECURSIVE, search recursively." (insert (prog1 (if (and charset (setq charset - (mm-charset-to-coding-system charset)) + (mm-charset-to-coding-system charset + nil t)) (not (eq charset 'ascii))) (mm-decode-coding-string (buffer-string) charset) (mm-string-as-multibyte (buffer-string))) @@ -1795,4 +1812,8 @@ If RECURSIVE, search recursively." (provide 'mm-decode) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; mm-decode.el ends here