X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fmm-decode.el;h=ec60b54155d630bc5bcd3c00b204ca37d3e795c4;hb=cf787e114b08d1adc92bdd50064383ffe38a80fe;hp=f347a5c62e3a8b6ea5b4739ef8e44f4de991d5ec;hpb=4e6ed4bd8e175ab78acf62b8f5e9a8af0e703992;p=gnus

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index f347a5c62..ec60b5415 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,6 +1,7 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002,
-;;        2003 Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -18,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -32,16 +33,17 @@
 		   (require 'term))
 
 (eval-and-compile
-  (autoload 'executable-find "executable")
   (autoload 'mm-inline-partial "mm-partial")
   (autoload 'mm-inline-external-body "mm-extern")
   (autoload 'mm-insert-inline "mm-view"))
 
+(defvar gnus-current-window-configuration)
+
 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
 
 (defgroup mime-display ()
   "Display of MIME in mail and news articles."
-  :link '(custom-manual "(emacs-mime)Customization")
+  :link '(custom-manual "(emacs-mime)Display Customization")
   :version "21.1"
   :group 'mail
   :group 'news
@@ -49,7 +51,7 @@
 
 (defgroup mime-security ()
   "MIME security in mail and news articles."
-  :link '(custom-manual "(emacs-mime)Customization")
+  :link '(custom-manual "(emacs-mime)Display Customization")
   :group 'mail
   :group 'news
   :group 'multimedia)
@@ -99,27 +101,31 @@
 
 (defcustom mm-text-html-renderer
   (cond ((locate-library "w3") 'w3)
-	((locate-library "w3m") 'w3m)
+	((executable-find "w3m") (if (locate-library "w3m")
+				     'w3m
+				   'w3m-standalone))
 	((executable-find "links") 'links)
 	((executable-find "lynx") 'lynx)
 	(t 'html2text))
   "Render of HTML contents.
 It is one of defined renderer types, or a rendering function.
 The defined renderer types are:
-`w3'   : using Emacs/W3;
-`w3m'  : using emacs-w3m;
-`links': using links;
-`lynx' : using lynx;
-`html2text' : using html2text;
-nil    : using external viewer."
+`w3'   : use Emacs/W3;
+`w3m'  : use emacs-w3m;
+`w3m-standalone': use w3m;
+`links': use links;
+`lynx' : use lynx;
+`html2text' : use html2text;
+nil    : use external viewer."
+  :version "22.1"
   :type '(choice (const w3)
 		 (const w3m)
+		 (const w3m-standalone)
 		 (const links)
 		 (const lynx)
 		 (const html2text)
 		 (const nil)
 		 (function))
-  :version "21.3"
   :group 'mime-display)
 
 (defvar mm-inline-text-html-renderer nil
@@ -127,31 +133,50 @@ nil    : using external viewer."
 It is suggested to customize `mm-text-html-renderer' instead.")
 
 (defcustom mm-inline-text-html-with-images nil
-  "If non-nil, Gnus will allow retrieving images in the HTML contents
-with <img> tags.  It has no effect on Emacs/w3.  See also
-the documentation for the option `mm-w3m-safe-url-regexp'."
+  "If non-nil, Gnus will allow retrieving images in HTML contents with
+the <img> tags.  It has no effect on Emacs/w3.  See also the
+documentation for the `mm-w3m-safe-url-regexp' variable."
+  :version "22.1"
   :type 'boolean
   :group 'mime-display)
 
 (defcustom mm-w3m-safe-url-regexp "\\`cid:"
-  "Regexp that matches safe url names.  Some HTML mails might have a
-trick of spammers using <img> tags.  It is likely to be intended to
-verify whether you have read the mail.  You can prevent your personal
-informations from leaking by setting this to the regexp which matches
-the safe url names.  The value of the variable `w3m-safe-url-regexp'
-will be bound with this value.  You may set this value to nil if you
-consider all the urls to be safe."
+  "Regexp matching URLs which are considered to be safe.
+Some HTML mails might contain a nasty trick used by spammers, using
+the <img> tag which is far more evil than the [Click Here!] button.
+It is most likely intended to check whether the ominous spam mail has
+reached your eyes or not, in which case the spammer knows for sure
+that your email address is valid.  It is done by embedding an
+identifier string into a URL that you might automatically retrieve
+when displaying the image.  The default value is \"\\\\`cid:\" which only
+matches parts embedded to the Multipart/Related type MIME contents and
+Gnus will never connect to the spammer's site arbitrarily.  You may
+set this variable to nil if you consider all urls to be safe."
+  :version "22.1"
   :type '(choice (regexp :tag "Regexp")
 		 (const :tag "All URLs are safe" nil))
   :group 'mime-display)
 
 (defcustom mm-inline-text-html-with-w3m-keymap t
   "If non-nil, use emacs-w3m command keys in the article buffer."
+  :version "22.1"
   :type 'boolean
   :group 'mime-display)
 
+(defcustom mm-enable-external t
+  "Indicate whether external MIME handlers should be used.
+
+If t, all defined external MIME handlers are used.  If nil, files are saved by
+`mailcap-save-binary-file'.  If it is the symbol `ask', you are prompted
+before the external MIME handler is invoked."
+  :version "22.1"
+  :type '(choice (const :tag "Always" t)
+		 (const :tag "Never" nil)
+		 (const :tag "Ask" ask))
+  :group 'mime-display)
+
 (defcustom mm-inline-media-tests
-  '(("image/jpeg"
+  '(("image/p?jpeg"
      mm-inline-image
      (lambda (handle)
        (mm-valid-and-fit-image-p 'jpeg handle)))
@@ -196,9 +221,15 @@ consider all the urls to be safe."
     ("text/richtext" mm-inline-text identity)
     ("text/x-patch" mm-display-patch-inline
      (lambda (handle)
-       (locate-library "diff-mode")))
+       ;; If the diff-mode.el package is installed, the function is
+       ;; autoloaded.  Checking (locate-library "diff-mode") would be trying
+       ;; to cater to broken installations.  OTOH checking the function
+       ;; makes it possible to install another package which provides an
+       ;; alternative implementation of diff-mode.  --Stef
+       (fboundp 'diff-mode)))
     ("application/emacs-lisp" mm-display-elisp-inline identity)
     ("application/x-emacs-lisp" mm-display-elisp-inline identity)
+    ("text/dns" mm-display-dns-inline identity)
     ("text/html"
      mm-inline-text-html
      (lambda (handle)
@@ -237,7 +268,7 @@ consider all the urls to be safe."
     ;; Default to displaying as text
     (".*" mm-inline-text mm-readable-p))
   "Alist of media types/tests saying whether types can be displayed inline."
-  :type '(repeat (list (string :tag "MIME type")
+  :type '(repeat (list (regexp :tag "MIME type")
 		       (function :tag "Display function")
 		       (function :tag "Display test")))
   :group 'mime-display)
@@ -260,13 +291,14 @@ type inline."
     "application/pdf" "application/x-dvi")
   "List of media types for which the external viewer will not be killed
 when selecting a different article."
+  :version "22.1"
   :type '(repeat string)
   :group 'mime-display)
 
 (defcustom mm-automatic-display
-  '("text/plain" "text/enriched" "text/richtext" "text/html"
+  '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
-    "message/rfc822" "text/x-patch" "application/pgp-signature"
+    "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature"
     "application/emacs-lisp" "application/x-emacs-lisp"
     "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
@@ -308,9 +340,11 @@ to:
   :group 'mime-display)
 
 (defcustom mm-tmp-directory
-  (cond ((fboundp 'temp-directory) (temp-directory))
-	((boundp 'temporary-file-directory) temporary-file-directory)
-	("/tmp/"))
+  (if (fboundp 'temp-directory)
+      (temp-directory)
+    (if (boundp 'temporary-file-directory)
+	temporary-file-directory
+      "/tmp/"))
   "Where mm will store its temporary files."
   :type 'directory
   :group 'mime-display)
@@ -320,11 +354,14 @@ to:
   :type 'boolean
   :group 'mime-display)
 
-(defvar mm-file-name-rewrite-functions nil
+(defvar mm-file-name-rewrite-functions
+  '(mm-file-name-delete-control mm-file-name-delete-gotchas)
   "*List of functions used for rewriting file names of MIME parts.
 Each function takes a file name as input and returns a file name.
 
 Ready-made functions include
+`mm-file-name-delete-control'
+`mm-file-name-delete-gotchas'
 `mm-file-name-delete-whitespace',
 `mm-file-name-trim-whitespace',
 `mm-file-name-collapse-whitespace',
@@ -333,10 +370,10 @@ Ready-made functions include
 `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.
+  "*List of functions for rewriting the full file names of MIME parts.
+This is used when viewing parts externally, and is meant for
+transforming the absolute 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.")
 
@@ -349,8 +386,15 @@ If not set, `default-directory' will be used."
   :type '(choice directory (const :tag "Default" nil))
   :group 'mime-display)
 
+(defcustom mm-attachment-file-modes 384
+  "Set the mode bits of saved attachments to this integer."
+  :version "22.1"
+  :type 'integer
+  :group 'mime-display)
+
 (defcustom mm-external-terminal-program "xterm"
   "The program to start an external terminal."
+  :version "22.1"
   :type 'string
   :group 'mime-display)
 
@@ -382,7 +426,8 @@ If not set, `default-directory' will be used."
 (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."
+  :version "22.1"
   :type '(choice (item always)
 		 (item never)
 		 (item :tag "only known protocols" known)
@@ -400,7 +445,8 @@ If not set, `default-directory' will be used."
 (defcustom mm-decrypt-option nil
   "Option of decrypting encrypted parts.
 `never', not decrypt; `always', always decrypt;
-`known', only decrypt known protocols. Otherwise, ask user."
+`known', only decrypt known protocols.  Otherwise, ask user."
+  :version "22.1"
   :type '(choice (item always)
 		 (item never)
 		 (item :tag "only known protocols" known)
@@ -410,21 +456,19 @@ If not set, `default-directory' will be used."
 (defvar mm-viewer-completion-map
   (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
     (set-keymap-parent map minibuffer-local-completion-map)
+    ;; Should we bind other key to minibuffer-complete-word?
+    (define-key map " " 'self-insert-command)
     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)
-
 (defvar mm-viewer-completion-map
   (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
     (set-keymap-parent map minibuffer-local-completion-map)
+    ;; Should we bind other key to minibuffer-complete-word?
+    (define-key map " " 'self-insert-command)
     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-alist-to-plist (alist)
@@ -456,8 +500,9 @@ The original alist is not modified.  See also `destructive-alist-to-plist'."
 	  (throw 'found t))))))
 
 (defun mm-handle-set-external-undisplayer (handle function)
-  "Set the undisplayer for this handle; postpone undisplaying of viewers
-for types in mm-keep-viewer-alive-types."
+  "Set the undisplayer for HANDLE to FUNCTION.
+Postpone undisplaying of viewers for types in
+`mm-keep-viewer-alive-types'."
   (if (mm-keep-viewer-alive-p handle)
       (let ((new-handle (copy-sequence handle)))
 	(mm-handle-set-undisplayer new-handle function)
@@ -470,10 +515,10 @@ for types in mm-keep-viewer-alive-types."
     (message "Destroying external MIME viewers")
     (mm-destroy-parts mm-postponed-undisplay-list)))
 
-(defun mm-dissect-buffer (&optional no-strict-mime loose-mime)
+(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
   "Dissect the current buffer and return a list of MIME handles."
   (save-excursion
-    (let (ct ctl type subtype cte cd description id result from)
+    (let (ct ctl type subtype cte cd description id result)
       (save-restriction
 	(mail-narrow-to-head)
 	(when (or no-strict-mime
@@ -484,23 +529,20 @@ for types in mm-keep-viewer-alive-types."
 		cte (mail-fetch-field "content-transfer-encoding")
 		cd (mail-fetch-field "content-disposition")
 		description (mail-fetch-field "content-description")
-		from (mail-fetch-field "from")
 		id (mail-fetch-field "content-id"))
+	  (unless from
+		(setq from (mail-fetch-field "from")))
 	  ;; FIXME: In some circumstances, this code is running within
 	  ;; an unibyte macro.  mail-extract-address-components
 	  ;; creates unibyte buffers. This `if', though not a perfect
 	  ;; solution, avoids most of them.
 	  (if from
 	      (setq from (cadr (mail-extract-address-components from))))))
-      (when cte
-	(setq cte (mail-header-strip cte)))
       (if (or (not ctl)
 	      (not (string-match "/" (car ctl))))
 	  (mm-dissect-singlepart
 	   (list mm-dissect-default-type)
-	   (and cte (intern (downcase (mail-header-remove-whitespace
-				       (mail-header-remove-comments
-					cte)))))
+	   (and cte (intern (downcase (mail-header-strip cte))))
 	   no-strict-mime
 	   (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
 	   description)
@@ -513,29 +555,27 @@ for types in mm-keep-viewer-alive-types."
 	  ((equal type "multipart")
 	   (let ((mm-dissect-default-type (if (equal subtype "digest")
 					      "message/rfc822"
-					    "text/plain")))
+					    "text/plain"))
+		 (start (cdr (assq 'start (cdr ctl)))))
 	     (add-text-properties 0 (length (car ctl))
 				  (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 article).  That would probably require changing
-	     ;; the mm-handle API so we simply store the multipart buffert
+	     ;; the mm-handle API so we simply store the multipart buffer
 	     ;; name as a text property of the "multipart/whatever" string.
 	     (add-text-properties 0 (length (car ctl))
-				  (list 'buffer (mm-copy-to-buffer))
+				  (list 'buffer (mm-copy-to-buffer)
+					'from from
+					'start start)
 				  (car ctl))
-	     (add-text-properties 0 (length (car ctl))
-				  (list 'from from)
-				  (car ctl))
-	     (cons (car ctl) (mm-dissect-multipart ctl))))
+	     (cons (car ctl) (mm-dissect-multipart ctl from))))
 	  (t
 	   (mm-possibly-verify-or-decrypt
 	    (mm-dissect-singlepart
 	     ctl
-	     (and cte (intern (downcase (mail-header-remove-whitespace
-					 (mail-header-remove-comments
-					  cte)))))
+	     (and cte (intern (downcase (mail-header-strip cte))))
 	     no-strict-mime
 	     (and cd (ignore-errors
 		       (mail-header-parse-content-disposition cd)))
@@ -555,7 +595,7 @@ for types in mm-keep-viewer-alive-types."
     (mm-make-handle
      (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
 
-(defun mm-dissect-multipart (ctl)
+(defun mm-dissect-multipart (ctl from)
   (goto-char (point-min))
   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
 	 (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
@@ -572,7 +612,7 @@ for types in mm-keep-viewer-alive-types."
 	(save-excursion
 	  (save-restriction
 	    (narrow-to-region start (point))
-	    (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
+	    (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
       (end-of-line 2)
       (or (looking-at boundary)
 	  (forward-line 1))
@@ -581,7 +621,7 @@ for types in mm-keep-viewer-alive-types."
       (save-excursion
 	(save-restriction
 	  (narrow-to-region start end)
-	  (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
+	  (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
     (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
 
 (defun mm-copy-to-buffer ()
@@ -592,7 +632,10 @@ for types in mm-keep-viewer-alive-types."
       (goto-char (point-min))
       (search-forward-regexp "^\n" nil t)
       (setq beg (point))
-      (set-buffer (generate-new-buffer " *mm*"))
+      (set-buffer
+       ;; Preserve the data's unibyteness (for url-insert-file-contents).
+       (let ((default-enable-multibyte-characters (mm-multibyte-p)))
+	 (generate-new-buffer " *mm*")))
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 
@@ -615,7 +658,13 @@ external if displayed external."
     (if (mm-handle-displayed-p handle)
 	(mm-remove-part handle)
       (let* ((type (mm-handle-media-type handle))
-	     (method (mailcap-mime-info type)))
+	     (method (mailcap-mime-info type))
+	     (filename (or (mail-content-type-get
+			    (mm-handle-disposition handle) 'filename)
+			   (mail-content-type-get
+			    (mm-handle-type handle) 'name)
+			   "<file>"))
+	     (external mm-enable-external))
 	(if (and (mm-inlinable-p handle)
 		 (mm-inlined-p handle))
 	    (progn
@@ -630,8 +679,27 @@ external if displayed external."
 		  (forward-line 1)
 		  (mm-insert-inline handle (mm-get-part handle))
 		  'inline)
-	      (mm-display-external
-	       handle (or method 'mailcap-save-binary-file)))))))))
+	      (if (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)
+				(y-or-n-p
+				 (concat
+				  "Display part (" type
+				  ") using external program"
+				  ;; Can non-string method ever happen?
+				  (if (stringp method)
+				      (concat
+				       " \"" (format method filename) "\"")
+				    "")
+				  "? ")))))
+		  (setq external t)
+		(setq external nil))
+	      (if external
+		  (mm-display-external
+		   handle (or method 'mailcap-save-binary-file))
+		(mm-display-external
+		 handle 'mailcap-save-binary-file)))))))))
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
@@ -652,7 +720,8 @@ external if displayed external."
 	    (mm-set-buffer-file-coding-system mm-binary-coding-system)
 	    (insert-buffer-substring cur)
 	    (goto-char (point-min))
-	    (message "Viewing with %s" method)
+	    (when method
+	      (message "Viewing with %s" method))
 	    (let ((mm (current-buffer))
 		  (non-viewer (assq 'non-viewer
 				    (mailcap-mime-info
@@ -735,8 +804,7 @@ external if displayed external."
 				   (mm-mailcap-command
 				    method file (mm-handle-type handle)))
 		     (if (buffer-live-p buffer)
-			 (save-excursion
-			   (set-buffer buffer)
+			 (with-current-buffer buffer
 			   (buffer-string))))
 		 (progn
 		   (ignore-errors (delete-file file))
@@ -748,11 +816,32 @@ external if displayed external."
 	    (let ((command (mm-mailcap-command
 			    method file (mm-handle-type handle))))
 	      (unwind-protect
-		  (start-process "*display*"
-				 (setq buffer
-				       (generate-new-buffer " *mm*"))
-				 shell-file-name
-				 shell-command-switch command)
+		  (progn
+		    (start-process "*display*"
+				   (setq buffer
+					 (generate-new-buffer " *mm*"))
+				   shell-file-name
+				   shell-command-switch command)
+		    (set-process-sentinel
+		     (get-buffer-process buffer)
+		     `(lambda (process state)
+			(when (eq 'exit (process-status process))
+			  ;; Don't use `ignore-errors'.
+			  (condition-case nil
+			      (delete-file ,file)
+			    (error))
+			  (condition-case nil
+			      (delete-directory ,(file-name-directory file))
+			    (error))
+			  (condition-case nil
+			      (kill-buffer ,buffer)
+			    (error))
+			  (condition-case nil
+			      ,(macroexpand (list 'mm-handle-set-undisplayer
+						  (list 'quote handle)
+						  nil))
+			    (error))
+			  (message "Displaying %s...done" ,command)))))
 		(mm-handle-set-external-undisplayer
 		 handle (cons file buffer)))
 	      (message "Displaying %s..." command))
@@ -777,16 +866,16 @@ external if displayed external."
 	    (string= total "'%s'")
 	    (string= total "\"%s\""))
 	(setq uses-stdin nil)
-	(push (mm-quote-arg
+	(push (shell-quote-argument
 	       (gnus-map-function mm-path-name-rewrite-functions file)) out))
        ((string= total "%t")
-	(push (mm-quote-arg (car type-list)) out))
+	(push (shell-quote-argument (car type-list)) out))
        (t
-	(push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
+	(push (shell-quote-argument (or (cdr (assq (intern sub) ctl)) "")) out))))
     (push (substring method beg (length method)) out)
     (when uses-stdin
       (push "<" out)
-      (push (mm-quote-arg
+      (push (shell-quote-argument
 	     (gnus-map-function mm-path-name-rewrite-functions file))
 	    out))
     (mapconcat 'identity (nreverse out) "")))
@@ -840,9 +929,18 @@ external if displayed external."
 	  (funcall object))
 	 ;; Externally displayed part.
 	 ((consp object)
+	  (condition-case ()
+	      (while (get-buffer-process (cdr object))
+		(interrupt-process (get-buffer-process (cdr object)))
+		(message "Waiting for external displayer to die...")
+		(sit-for 1))
+	    (quit)
+	    (error))
+	  (ignore-errors (and (cdr object) (kill-buffer (cdr object))))
+	  (message "Waiting for external displayer to die...done")
 	  (ignore-errors (delete-file (car object)))
-	  (ignore-errors (delete-directory (file-name-directory (car object))))
-	  (ignore-errors (and (cdr object) (kill-buffer (cdr object)))))
+	  (ignore-errors (delete-directory (file-name-directory
+					    (car object)))))
 	 ((bufferp object)
 	  (when (buffer-live-p object)
 	    (kill-buffer object)))))
@@ -955,27 +1053,16 @@ external if displayed external."
 
 (defun mm-insert-part (handle)
   "Insert the contents of HANDLE in the current buffer."
-  (let ((cur (current-buffer)))
-    (save-excursion
-      (if (member (mm-handle-media-supertype handle) '("text" "message"))
-	  (with-temp-buffer
-	    (insert-buffer-substring (mm-handle-buffer handle))
-	    (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))
-	  (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))))))))
+  (save-excursion
+    (insert
+     (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset)
+		'gnus-decoded)
+	    (with-current-buffer (mm-handle-buffer handle)
+	      (buffer-string)))
+	   ((mm-multibyte-p)
+	    (mm-string-as-multibyte (mm-get-part handle)))
+	   (t
+	    (mm-get-part handle))))))
 
 (defun mm-file-name-delete-whitespace (file-name)
   "Remove all whitespace characters from FILE-NAME."
@@ -999,15 +1086,25 @@ external if displayed external."
 
 (defun mm-file-name-replace-whitespace (file-name)
   "Replace whitespace characters in FILE-NAME with underscores.
-Set `mm-file-name-replace-whitespace' to any other string if you do not
-like underscores."
+Set the option `mm-file-name-replace-whitespace' to any other
+string if you do not like underscores."
   (let ((s (or mm-file-name-replace-whitespace "_")))
     (while (string-match "\\s-" file-name)
       (setq file-name (replace-match s t t file-name))))
   file-name)
 
-(defun mm-save-part (handle)
-  "Write HANDLE to a file."
+(defun mm-file-name-delete-control (filename)
+  "Delete control characters from FILENAME."
+  (gnus-replace-in-string filename "[\x00-\x1f\x7f]" ""))
+
+(defun mm-file-name-delete-gotchas (filename)
+  "Delete shell gotchas from FILENAME."
+  (setq filename (gnus-replace-in-string filename "[<>|]" ""))
+  (gnus-replace-in-string filename "^[.-]+" ""))
+
+(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))
@@ -1016,9 +1113,10 @@ like underscores."
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
 					(file-name-nondirectory filename))))
     (setq file
-	  (read-file-name "Save MIME part to: "
-			  (or mm-default-directory default-directory)
-			  nil nil (or filename name "")))
+	  (mm-with-multibyte
+	    (read-file-name (or prompt "Save MIME part to: ")
+			    (or mm-default-directory default-directory)
+			    nil nil (or filename name ""))))
     (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? "
@@ -1031,13 +1129,17 @@ like underscores."
   (mm-with-unibyte-buffer
     (mm-insert-part handle)
     (let ((coding-system-for-write 'binary)
+	  (current-file-modes (default-file-modes))
 	  ;; Don't re-compress .gz & al.  Arguably we should make
 	  ;; `file-name-handler-alist' nil, but that would chop
 	  ;; ange-ftp, which is reasonable to use here.
 	  (inhibit-file-name-operation 'write-region)
 	  (inhibit-file-name-handlers
 	   (cons 'jka-compr-handler inhibit-file-name-handlers)))
-      (write-region (point-min) (point-max) file))))
+      (set-default-file-modes mm-attachment-file-modes)
+      (unwind-protect
+	  (write-region (point-min) (point-max) file)
+	(set-default-file-modes current-file-modes)))))
 
 (defun mm-pipe-part (handle)
   "Pipe HANDLE to a process."
@@ -1262,7 +1364,7 @@ If RECURSIVE, search recursively."
 		    (if notp
 			(not (equal (car ctl) type))
 		      (equal (car ctl) type)))
-	      (setq result (buffer-substring (point-min) (point-max)))))))
+	      (setq result (buffer-string))))))
       (forward-line 1)
       (setq start (point)))
     (when (and (not result) start)
@@ -1275,7 +1377,7 @@ If RECURSIVE, search recursively."
 		  (if notp
 		      (not (equal (car ctl) type))
 		    (equal (car ctl) type)))
-	    (setq result (buffer-substring (point-min) (point-max)))))))
+	    (setq result (buffer-string))))))
     result))
 
 (defvar mm-security-handle nil)
@@ -1373,6 +1475,12 @@ If RECURSIVE, search recursively."
     parts))
 
 (defun mm-multiple-handles (handles)
+  (and (listp handles)
+       (> (length handles) 1)
+       (or (listp (car handles))
+	   (stringp (car handles)))))
+
+(defun mm-complicated-handles (handles)
   (and (listp (car handles))
        (> (length handles) 1)))
 
@@ -1396,4 +1504,5 @@ If RECURSIVE, search recursively."
 
 (provide 'mm-decode)
 
+;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b
 ;;; mm-decode.el ends here