# HG changeset patch # User Miles Bader # Date 1146793986 0 # Node ID 1b78f3a87f16585d3c8e1087b11cab3d9f2560d8 # Parent 64d64506f4b155fcc90c35fde5034cb5384bc0d8 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 99-100) - Merge from emacs--devo--0 - Update from CVS diff -r 64d64506f4b1 -r 1b78f3a87f16 lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Thu May 04 21:58:34 2006 +0000 +++ b/lisp/gnus/ChangeLog Fri May 05 01:53:06 2006 +0000 @@ -1,3 +1,24 @@ +2006-05-04 Stefan Monnier + + * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment. + (mm-copy-to-buffer): Use with-current-buffer. + (mm-display-part): Simplify. + (mm-inlinable-p): Add optional arg `type'. + + * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED + argument. + (gnus-mime-view-part-externally, gnus-mime-view-part-internally): + Try harder to show the attachment internally or externally using + gnus-mime-view-part-as-type. + +2006-05-04 Reiner Steib + + * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch + `filename' from Content-Disposition if Content-Type doesn't + provide `name'. + (gnus-mime-view-part-as-type): Set default instead of + initial-input. + 2006-04-28 Katsumi Yamaoka * mm-uu.el (mm-uu-pgp-encrypted-extract-1): Assume buffer is made diff -r 64d64506f4b1 -r 1b78f3a87f16 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Thu May 04 21:58:34 2006 +0000 +++ b/lisp/gnus/gnus-art.el Fri May 05 01:53:06 2006 +0000 @@ -4317,21 +4317,29 @@ (defun gnus-mime-view-part-as-type-internal () (gnus-article-check-buffer) - (let* ((name (mail-content-type-get - (mm-handle-type (get-text-property (point) 'gnus-data)) - 'name)) + (let* ((handle (get-text-property (point) 'gnus-data)) + (name (or + ;; Content-Type: foo/bar; name=... + (mail-content-type-get (mm-handle-type handle) 'name) + ;; Content-Disposition: attachment; filename=... + (cdr (assq 'filename (cdr (mm-handle-disposition handle)))))) (def-type (and name (mm-default-file-encoding name)))) (and def-type (cons def-type 0)))) -(defun gnus-mime-view-part-as-type (&optional mime-type) - "Choose a MIME media type, and view the part as such." +(defun gnus-mime-view-part-as-type (&optional mime-type pred) + "Choose a MIME media type, and view the part as such. +If non-nil, PRED is a predicate to use during completion to limit the +available media-types." (interactive) (unless mime-type - (setq mime-type (completing-read - "View as MIME type: " - (mapcar #'list (mailcap-mime-types)) - nil nil - (gnus-mime-view-part-as-type-internal)))) + (setq mime-type + (let ((default (gnus-mime-view-part-as-type-internal))) + (completing-read + (format "View as MIME type (default %s): " + (car default)) + (mapcar #'list (mailcap-mime-types)) + pred nil nil nil + (car default))))) (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) (when handle @@ -4511,12 +4519,18 @@ (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) - (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (mm-display-part handle))))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) + (type (mm-handle-media-type handle)) + (method (mailcap-mime-info type)) + (mm-enable-external t)) + (if (not (stringp method)) + (gnus-mime-view-part-as-type + nil (lambda (type) (stringp (mailcap-mime-info type)))) + (when handle + (if (mm-handle-undisplayer handle) + (mm-remove-part handle) + (mm-display-part handle)))))) (defun gnus-mime-view-part-internally (&optional handle) "View the MIME part under point with an internal viewer. @@ -4528,13 +4542,16 @@ (mm-inline-large-images t) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets)) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) (inhibit-read-only t)) - (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (mm-display-part handle))))) + (if (not (mm-inlinable-p handle)) + (gnus-mime-view-part-as-type + nil (lambda (type) (mm-inlinable-p handle type))) + (when handle + (if (mm-handle-undisplayer handle) + (mm-remove-part handle) + (mm-display-part handle)))))) (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at \(point\)." diff -r 64d64506f4b1 -r 1b78f3a87f16 lisp/gnus/mm-decode.el --- a/lisp/gnus/mm-decode.el Thu May 04 21:58:34 2006 +0000 +++ b/lisp/gnus/mm-decode.el Fri May 05 01:53:06 2006 +0000 @@ -562,7 +562,7 @@ description) (setq type (split-string (car ctl) "/")) (setq subtype (cadr type) - type (pop type)) + type (car type)) (setq result (cond @@ -641,16 +641,15 @@ (defun mm-copy-to-buffer () "Copy the contents of the current buffer to a fresh buffer." - (save-excursion (let ((obuf (current-buffer)) beg) (goto-char (point-min)) (search-forward-regexp "^\n" nil t) (setq beg (point)) - (set-buffer + (with-current-buffer ;; Preserve the data's unibyteness (for url-insert-file-contents). (let ((default-enable-multibyte-characters (mm-multibyte-p))) - (generate-new-buffer " *mm*"))) + (generate-new-buffer " *mm*")) (insert-buffer-substring obuf beg) (current-buffer)))) @@ -701,7 +700,8 @@ (forward-line 1) (mm-insert-inline handle (mm-get-part handle)) 'inline) - (if (and method ;; If nil, we always use "save". + (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) @@ -714,9 +714,7 @@ (concat " \"" (format method filename) "\"") "") - "? "))))) - (setq external t) - (setq external nil)) + "? ")))))) (if external (mm-display-external handle (or method 'mailcap-save-binary-file)) @@ -1019,10 +1017,12 @@ methods nil))) result)) -(defun mm-inlinable-p (handle) - "Say whether HANDLE can be displayed inline." +(defun mm-inlinable-p (handle &optional type) + "Say whether HANDLE can be displayed inline. +TYPE is the mime-type of the object; it defaults to the one given +in HANDLE." + (unless type (setq type (mm-handle-media-type handle))) (let ((alist mm-inline-media-tests) - (type (mm-handle-media-type handle)) test) (while alist (when (string-match (caar alist) type)