X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=5d7f013eaac243da396a9ab162a590116232d04f;hb=18a84c10a7e5ab2e9609ff14da3dc3a3e60b9803;hp=c44a663fc57429957bcdee405cffc07659d2ce7b;hpb=2916226ebf84e5173802bad8b4a5e821b66d1622;p=gnus

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index c44a663fc..5d7f013ea 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,5 +1,6 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -22,14 +23,6 @@
 
 ;;; Commentary:
 
-;; Jaap-Henk Hoepman (jhh@xs4all.nl):
-;;
-;; Added support for delayed destroy of external MIME viewers. All external
-;; viewers for mime types in mm-keep-viewer-alive-types will remain active
-;; after switching articles or groups, and will only be removed when exiting
-;; gnus.
-;;
-
 ;;; Code:
 
 (require 'mail-parse)
@@ -39,6 +32,7 @@
 		   (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"))
@@ -103,8 +97,80 @@
   `(list ,buffer ,type ,encoding ,undisplayer
 	 ,disposition ,description ,cache ,id))
 
+(defcustom mm-text-html-renderer
+  (cond ((locate-library "w3") 'w3)
+	((locate-library "w3m") 'w3m)
+	((executable-find "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'   : use Emacs/W3;
+`w3m'  : use emacs-w3m;
+`w3m-standalone': use w3m;
+`links': use links;
+`lynx' : use lynx;
+`html2text' : use html2text;
+nil    : use external viewer."
+  :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
+  "Function used for rendering inline HTML contents.
+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 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."
+  :type 'boolean
+  :group 'mime-display)
+
+(defcustom mm-w3m-safe-url-regexp "\\`cid:"
+  "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."
+  :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."
+  :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 "21.4"
+  :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)))
@@ -132,7 +198,7 @@
      mm-inline-image
      (lambda (handle)
        (mm-valid-and-fit-image-p 'xpm handle)))
-    ("image/x-pixmap"
+    ("image/x-xpixmap"
      mm-inline-image
      (lambda (handle)
        (mm-valid-and-fit-image-p 'xpm handle)))
@@ -151,12 +217,14 @@
      (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
+     mm-inline-text-html
      (lambda (handle)
-       (locate-library "w3")))
+       (or mm-inline-text-html-renderer
+	   mm-text-html-renderer)))
     ("text/x-vcard"
-     mm-inline-text
+     mm-inline-text-vcard
      (lambda (handle)
        (or (featurep 'vcard)
 	   (locate-library "vcard"))))
@@ -188,7 +256,7 @@
     ;; 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)
@@ -196,6 +264,7 @@
 (defcustom mm-inlined-types
   '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
     "message/partial" "message/external-body" "application/emacs-lisp"
+    "application/x-emacs-lisp"
     "application/pgp-signature" "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
     "application/pkcs7-mime")
@@ -217,7 +286,8 @@ when selecting a different article."
   '("text/plain" "text/enriched" "text/richtext" "text/html"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
     "message/rfc822" "text/x-patch" "application/pgp-signature"
-    "application/emacs-lisp" "application/x-pkcs7-signature"
+    "application/emacs-lisp" "application/x-emacs-lisp"
+    "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
     "application/pkcs7-mime")
   "A list of MIME types to be displayed automatically."
@@ -226,7 +296,9 @@ when selecting a different article."
 
 (defcustom mm-attachment-override-types '("text/x-vcard"
 					  "application/pkcs7-mime"
-					  "application/x-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)
@@ -255,9 +327,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)
@@ -267,11 +341,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',
@@ -280,10 +357,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.")
 
@@ -293,7 +370,12 @@ Each function takes a file name as input and returns a file name.")
 (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-attachment-file-modes 384
+  "Set the mode bits of saved attachments to this integer."
+  :type 'integer
   :group 'mime-display)
 
 (defcustom mm-external-terminal-program "xterm"
@@ -303,7 +385,6 @@ If not set, `default-directory' will be used."
 
 ;;; Internal variables.
 
-(defvar mm-dissection-list nil)
 (defvar mm-last-shell-command "")
 (defvar mm-content-id-alist nil)
 (defvar mm-postponed-undisplay-list nil)
@@ -330,7 +411,7 @@ 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."
   :type '(choice (item always)
 		 (item never)
 		 (item :tag "only known protocols" known)
@@ -348,7 +429,7 @@ 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."
   :type '(choice (item always)
 		 (item never)
 		 (item :tag "only known protocols" known)
@@ -404,8 +485,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)
@@ -418,13 +500,14 @@ 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)
+(defun mm-dissect-buffer (&optional no-strict-mime loose-mime)
   "Dissect the current buffer and return a list of MIME handles."
   (save-excursion
     (let (ct ctl type subtype cte cd description id result from)
       (save-restriction
 	(mail-narrow-to-head)
 	(when (or no-strict-mime
+		  loose-mime
 		  (mail-fetch-field "mime-version"))
 	  (setq ct (mail-fetch-field "content-type")
 		ctl (ignore-errors (mail-header-parse-content-type ct))
@@ -460,7 +543,8 @@ 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))
 
@@ -470,10 +554,9 @@ for types in mm-keep-viewer-alive-types."
 	     ;; 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))
-	     (add-text-properties 0 (length (car ctl))
-				  (list 'from from)
+				  (list 'buffer (mm-copy-to-buffer)
+					'from from
+					'start start)
 				  (car ctl))
 	     (cons (car ctl) (mm-dissect-multipart ctl))))
 	  (t
@@ -499,16 +582,8 @@ for types in mm-keep-viewer-alive-types."
 	    (if (equal "text/plain" (car ctl))
 		(assoc 'format ctl)
 	      t))
-    (let ((res (mm-make-handle
-		(mm-copy-to-buffer) ctl cte nil cdl description nil id)))
-      (push (car res) mm-dissection-list)
-      res)))
-
-(defun mm-remove-all-parts ()
-  "Remove all MIME handles."
-  (interactive)
-  (mapcar 'mm-remove-part mm-dissection-list)
-  (setq mm-dissection-list nil))
+    (mm-make-handle
+     (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
 
 (defun mm-dissect-multipart (ctl)
   (goto-char (point-min))
@@ -528,7 +603,9 @@ for types in mm-keep-viewer-alive-types."
 	  (save-restriction
 	    (narrow-to-region start (point))
 	    (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
-      (forward-line 2)
+      (end-of-line 2)
+      (or (looking-at boundary)
+	  (forward-line 1))
       (setq start (point)))
     (when (and start (< start end))
       (save-excursion
@@ -568,7 +645,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
@@ -583,8 +666,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."
@@ -605,7 +707,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
@@ -619,13 +722,13 @@ external if displayed external."
 		  (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 (or 
+	(let* ((dir (mm-make-temp-file
+		     (expand-file-name "emm." mm-tmp-directory) 'dir))
+	       (filename (or
 			  (mail-content-type-get
 			   (mm-handle-disposition handle) 'filename)
- 			  (mail-content-type-get
- 			   (mm-handle-type handle) 'name)))
+			  (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)
@@ -633,47 +736,45 @@ external if displayed external."
 	       (copiousoutput (assoc "copiousoutput" mime-info))
 	       file buffer)
 	  ;; We create a private sub-directory where we store our files.
-	  (make-directory dir)
 	  (set-file-modes dir 448)
 	  (if filename
-	      (setq file (expand-file-name (file-name-nondirectory filename)
-					   dir))
-	    (setq file (make-temp-name (expand-file-name "mm." dir))))
+	      (setq file (expand-file-name
+			  (gnus-map-function mm-file-name-rewrite-functions
+					     (file-name-nondirectory filename))
+			  dir))
+	    (setq file (mm-make-temp-file (expand-file-name "mm." dir))))
 	  (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))
+	    (let ((command (mm-mailcap-command
+			    method file (mm-handle-type handle))))
+	      (unwind-protect
+		  (if window-system
+		      (start-process "*display*" nil
+				     mm-external-terminal-program
+				     "-e" shell-file-name
+				     shell-command-switch command)
+		    (require 'term)
+		    (require 'gnus-win)
+		    (set-buffer
+		     (setq buffer
+			   (make-term "display"
+				      shell-file-name
+				      nil
+				      shell-command-switch command)))
+		    (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..." command))
 	    'external)
 	   (copiousoutput
 	    (with-current-buffer outbuf
@@ -700,17 +801,17 @@ external if displayed external."
 		   (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))
+	    (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)
+		(mm-handle-set-external-undisplayer
+		 handle (cons file buffer)))
+	      (message "Displaying %s..." command))
 	    'external)))))))
 
 (defun mm-mailcap-command (method file type-list)
@@ -718,7 +819,8 @@ external if displayed external."
 	(beg 0)
 	(uses-stdin t)
 	out sub total)
-    (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg)
+    (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%"
+			 method beg)
       (push (substring method beg (match-beginning 0)) out)
       (setq beg (match-end 0)
 	    total (match-string 0 method)
@@ -726,7 +828,10 @@ external if displayed external."
       (cond
        ((string= total "%%")
 	(push "%" out))
-       ((string= total "%s")
+       ((or (string= total "%s")
+	    ;; We do our own quoting.
+	    (string= total "'%s'")
+	    (string= total "\"%s\""))
 	(setq uses-stdin nil)
 	(push (mm-quote-arg
 	       (gnus-map-function mm-path-name-rewrite-functions file)) out))
@@ -791,9 +896,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)))))
@@ -897,7 +1011,7 @@ external if displayed external."
   "Return the contents of HANDLE as a string."
   (mm-with-unibyte-buffer
     (insert (with-current-buffer (mm-handle-buffer handle)
-	      (mm-with-unibyte-current-buffer-mule4
+	      (mm-with-unibyte-current-buffer
 		(buffer-string))))
     (mm-decode-content-transfer-encoding
      (mm-handle-encoding handle)
@@ -950,13 +1064,22 @@ 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-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)
   "Write HANDLE to a file."
   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
@@ -968,9 +1091,8 @@ like underscores."
 					(file-name-nondirectory filename))))
     (setq file
 	  (read-file-name "Save MIME part to: "
-			  (expand-file-name
-			   (or filename name "")
-			   (or mm-default-directory default-directory))))
+			  (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? "
@@ -983,13 +1105,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."
@@ -1104,34 +1230,37 @@ be determined."
 		      ;; Avoid testing `make-glyph' since W3 may define
 		      ;; a bogus version of it.
 		      (if (fboundp 'create-image)
-			  (create-image (buffer-string) 
+			  (create-image (buffer-string)
 					(or (mm-image-type-from-buffer)
 					    (intern type))
 					'data-p)
-			(cond
-			 ((equal type "xbm")
-			  ;; xbm images require special handling, since
-			  ;; the only way to create glyphs from these
-			  ;; (without a ton of work) is to write them
-			  ;; out to a file, and then create a file
-			  ;; specifier.
-			  (let ((file (make-temp-name
-				       (expand-file-name "emm.xbm"
-							 mm-tmp-directory))))
-			    (unwind-protect
-				(progn
-				  (write-region (point-min) (point-max) file)
-				  (make-glyph (list (cons 'x file))))
-			      (ignore-errors
-				(delete-file file)))))
-			 (t
-			  (make-glyph
-			   (vector 
-			    (or (mm-image-type-from-buffer)
-				(intern type))
-			    :data (buffer-string))))))))
+			(mm-create-image-xemacs type))))
 	    (mm-handle-set-cache handle spec))))))
 
+(defun mm-create-image-xemacs (type)
+  (cond
+   ((equal type "xbm")
+    ;; xbm images require special handling, since
+    ;; the only way to create glyphs from these
+    ;; (without a ton of work) is to write them
+    ;; out to a file, and then create a file
+    ;; specifier.
+    (let ((file (mm-make-temp-file
+		 (expand-file-name "emm.xbm"
+				   mm-tmp-directory))))
+      (unwind-protect
+	  (progn
+	    (write-region (point-min) (point-max) file)
+	    (make-glyph (list (cons 'x file))))
+	(ignore-errors
+	  (delete-file file)))))
+   (t
+    (make-glyph
+     (vector
+      (or (mm-image-type-from-buffer)
+	  (intern type))
+      :data (buffer-string))))))
+
 (defun mm-image-fit-p (handle)
   "Say whether the image in HANDLE will fit the current window."
   (let ((image (mm-get-image handle)))
@@ -1211,7 +1340,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)
@@ -1224,16 +1353,16 @@ 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)
 
 (defsubst mm-set-handle-multipart-parameter (handle parameter value)
   ;; HANDLE could be a CTL.
-  (if handle
-      (put-text-property 0 (length (car handle)) parameter value
-			 (car handle))))
+  (when handle
+    (put-text-property 0 (length (car handle)) parameter value
+		       (car handle))))
 
 (defun mm-possibly-verify-or-decrypt (parts ctl)
   (let ((type (car ctl))
@@ -1266,25 +1395,26 @@ If RECURSIVE, search recursively."
 		      protocols nil)
 	      (setq protocols (cdr protocols))))))
       (setq func (nth 1 (assoc protocol mm-verify-function-alist)))
-      (if (cond
-	   ((eq mm-verify-option 'never) nil)
-	   ((eq mm-verify-option 'always) t)
-	   ((eq mm-verify-option 'known)
-	    (and func
-		 (or (not (setq functest
-				(nth 3 (assoc protocol
-					      mm-verify-function-alist))))
-		     (funcall functest parts ctl))))
-	   (t (y-or-n-p
+      (when (cond
+	     ((eq mm-verify-option 'never) nil)
+	     ((eq mm-verify-option 'always) t)
+	     ((eq mm-verify-option 'known)
+	      (and func
+		   (or (not (setq functest
+				  (nth 3 (assoc protocol
+						mm-verify-function-alist))))
+		       (funcall functest parts ctl))))
+	     (t
+	      (y-or-n-p
 	       (format "Verify signed (%s) part? "
 		       (or (nth 2 (assoc protocol mm-verify-function-alist))
 			   (format "protocol=%s" protocol))))))
-	  (save-excursion
-	    (if func
-		(funcall func parts ctl)
-	      (mm-set-handle-multipart-parameter
-	       mm-security-handle 'gnus-details
-	       (format "Unknown sign protocol (%s)" protocol))))))
+	(save-excursion
+	  (if func
+	      (funcall func parts ctl)
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-details
+	     (format "Unknown sign protocol (%s)" protocol))))))
      ((equal subtype "encrypted")
       (unless (setq protocol
 		    (mm-handle-multipart-ctl-parameter ctl 'protocol))
@@ -1297,25 +1427,26 @@ If RECURSIVE, search recursively."
 		      parts nil)
 	      (setq parts (cdr parts))))))
       (setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
-      (if (cond
-	   ((eq mm-decrypt-option 'never) nil)
-	   ((eq mm-decrypt-option 'always) t)
-	   ((eq mm-decrypt-option 'known)
-	    (and func
-		 (or (not (setq functest
-				(nth 3 (assoc protocol
-					      mm-decrypt-function-alist))))
-		     (funcall functest parts ctl))))
-	   (t (y-or-n-p
+      (when (cond
+	     ((eq mm-decrypt-option 'never) nil)
+	     ((eq mm-decrypt-option 'always) t)
+	     ((eq mm-decrypt-option 'known)
+	      (and func
+		   (or (not (setq functest
+				  (nth 3 (assoc protocol
+						mm-decrypt-function-alist))))
+		       (funcall functest parts ctl))))
+	     (t
+	      (y-or-n-p
 	       (format "Decrypt (%s) part? "
 		       (or (nth 2 (assoc protocol mm-decrypt-function-alist))
 			   (format "protocol=%s" protocol))))))
-	  (save-excursion
-	    (if func
-		(setq parts (funcall func parts ctl))
-	      (mm-set-handle-multipart-parameter
-	       mm-security-handle 'gnus-details
-	       (format "Unknown encrypt protocol (%s)" protocol))))))
+	(save-excursion
+	  (if func
+	      (setq parts (funcall func parts ctl))
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-details
+	     (format "Unknown encrypt protocol (%s)" protocol))))))
      (t nil))
     parts))