X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=fb32ad9e8e6003c15da4d56bbce7f63a1c250fde;hp=98d854340ee2c76fd32345015fe91b9fd5acdcb5;hb=b83561e18ceb438203812786590893bd5fc2a6cc;hpb=aab98157ce3deed625ba701eecb1856dc775d426

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 98d854340..fb32ad9e8 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,6 +1,6 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
 
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -23,10 +23,6 @@
 
 ;;; Code:
 
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
 (require 'mail-parse)
 (require 'mm-bodies)
 (eval-when-compile (require 'cl))
@@ -47,6 +43,7 @@
 (defvar gnus-current-window-configuration)
 
 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
+(add-hook 'gnus-exit-gnus-hook 'mm-temp-files-delete)
 
 (defgroup mime-display ()
   "Display of MIME in mail and news articles."
@@ -123,7 +120,6 @@
 	((executable-find "w3m") 'gnus-w3m)
 	((executable-find "links") 'links)
 	((executable-find "lynx") 'lynx)
-	((locate-library "w3") 'w3)
 	((locate-library "html2text") 'html2text)
 	(t nil))
   "Render of HTML contents.
@@ -135,13 +131,11 @@ The defined renderer types are:
 `w3m-standalone': use plain w3m;
 `links': use links;
 `lynx': use lynx;
-`w3': use Emacs/W3;
 `html2text': use html2text;
 nil    : use external viewer (default web browser)."
   :version "24.1"
   :type '(choice (const shr)
                  (const gnus-w3m)
-                 (const w3)
                  (const w3m :tag "emacs-w3m")
 		 (const w3m-standalone :tag "standalone w3m" )
 		 (const links)
@@ -152,9 +146,9 @@ nil    : use external viewer (default web browser)."
   :group 'mime-display)
 
 (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."
+  "If non-nil, Gnus will allow retrieving images in HTML that has <img> tags.
+See also the documentation for the `mm-w3m-safe-url-regexp'
+variable."
   :version "22.1"
   :type 'boolean
   :group 'mime-display)
@@ -470,6 +464,11 @@ If not set, `default-directory' will be used."
 (defvar mm-content-id-alist nil)
 (defvar mm-postponed-undisplay-list nil)
 (defvar mm-inhibit-auto-detect-attachment nil)
+(defvar mm-temp-files-to-be-deleted nil
+  "List of temporary files scheduled to be deleted.")
+(defvar mm-temp-files-cache-file (concat ".mm-temp-files-" (user-login-name))
+  "Name of a file that caches a list of temporary files to be deleted.
+The file will be saved in the directory `mm-tmp-directory'.")
 
 ;; According to RFC2046, in particular, in a digest, the default
 ;; Content-Type value for a body part is changed from "text/plain" to
@@ -532,14 +531,6 @@ result of the verification."
     map)
   "Keymap for input viewer with completion.")
 
-(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.")
-
 ;;; The functions.
 
 (defun mm-alist-to-plist (alist)
@@ -586,6 +577,46 @@ Postpone undisplaying of viewers for types in
     (message "Destroying external MIME viewers")
     (mm-destroy-parts mm-postponed-undisplay-list)))
 
+(defun mm-temp-files-delete ()
+  "Delete temporary files and those parent directories.
+Note that the deletion may fail if a program is catching hold of a file
+under Windows or Cygwin.  In that case, it schedules the deletion of
+files left at the next time."
+  (let* ((coding-system-for-read mm-universal-coding-system)
+	 (coding-system-for-write mm-universal-coding-system)
+	 (cache-file (expand-file-name mm-temp-files-cache-file
+				       mm-tmp-directory))
+	 (cache (when (file-exists-p cache-file)
+		  (mm-with-multibyte-buffer
+		    (insert-file-contents cache-file)
+		    (split-string (buffer-string) "\n" t))))
+	 fails)
+    (dolist (temp (append cache mm-temp-files-to-be-deleted))
+      (when (and (file-exists-p temp)
+		 (if (file-directory-p temp)
+		     ;; A parent directory left at the previous time.
+		     (progn
+		       (ignore-errors (delete-directory temp))
+		       (file-exists-p temp))
+		   ;; Delete a temporary file and its parent directory.
+		   (ignore-errors (delete-file temp))
+		   (or (file-exists-p temp)
+		       (progn
+			 (setq temp (file-name-directory temp))
+			 (ignore-errors (delete-directory temp))
+			 (file-exists-p temp)))))
+	(push temp fails)))
+    (if fails
+	;; Schedule the deletion of the files left at the next time.
+	(progn
+	  (write-region (concat (mapconcat 'identity (nreverse fails) "\n")
+				"\n")
+			nil cache-file nil 'silent)
+	  (set-file-modes cache-file #o600))
+      (when (file-exists-p cache-file)
+	(ignore-errors (delete-file cache-file))))
+    (setq mm-temp-files-to-be-deleted nil)))
+
 (autoload 'message-fetch-field "message")
 
 (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
@@ -616,7 +647,7 @@ MIME-Version header before proceeding."
 	  (unless from
 	    (setq from (mail-fetch-field "from")))
 	  ;; FIXME: In some circumstances, this code is running within
-	  ;; an unibyte macro.  mail-extract-address-components
+	  ;; a unibyte macro.  mail-extract-address-components
 	  ;; creates unibyte buffers. This `if', though not a perfect
 	  ;; solution, avoids most of them.
 	  (if from
@@ -626,9 +657,9 @@ MIME-Version header before proceeding."
 				 description)))))
       (if (or (not ctl)
 	      (not (string-match "/" (car ctl))))
-	  (mm-dissect-singlepart
+	    (mm-dissect-singlepart
 	   (list mm-dissect-default-type)
-	   (and cte (intern (downcase (mail-header-strip cte))))
+	     (and cte (intern (downcase (mail-header-strip cte))))
 	   no-strict-mime
 	   (and cd (mail-header-parse-content-disposition cd))
 	   description)
@@ -790,7 +821,6 @@ external if displayed external."
 	  'inline)
 	 ((and (mm-inlinable-p ehandle)
 	       (mm-inlined-p ehandle))
-	  (forward-line 1)
 	  (mm-display-inline handle)
 	  'inline)
 	 ((or method
@@ -908,10 +938,20 @@ external if displayed external."
 			    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)
+		      (set-process-sentinel
+		       (start-process "*display*" nil
+				      mm-external-terminal-program
+				      "-e" shell-file-name
+				      shell-command-switch command)
+		       `(lambda (process state)
+			  (if (eq 'exit (process-status process))
+			      (run-at-time
+			       60.0 nil
+			       (lambda ()
+				 (ignore-errors (delete-file ,file))
+				 (ignore-errors (delete-directory
+						 ,(file-name-directory
+						   file))))))))
 		    (require 'term)
 		    (require 'gnus-win)
 		    (set-buffer
@@ -925,11 +965,15 @@ external if displayed external."
 		    (set-process-sentinel
 		     (get-buffer-process buffer)
 		     `(lambda (process state)
-			(if (eq 'exit (process-status process))
-			    (gnus-configure-windows
-			     ',gnus-current-window-configuration))))
+			(when (eq 'exit (process-status process))
+			  (ignore-errors (delete-file ,file))
+			  (ignore-errors
+			    (delete-directory ,(file-name-directory file)))
+			  (gnus-configure-windows
+			   ',gnus-current-window-configuration))))
 		    (gnus-configure-windows 'display-term))
-		(mm-handle-set-external-undisplayer handle (cons file buffer)))
+		(mm-handle-set-external-undisplayer handle (cons file buffer))
+		(add-to-list 'mm-temp-files-to-be-deleted file t))
 	      (message "Displaying %s..." command))
 	    'external)
 	   (copiousoutput
@@ -975,22 +1019,14 @@ external if displayed external."
 				   (buffer buffer)
 				   (command command)
 				   (handle handle))
-		       (run-at-time
-			30.0 nil
-			(lambda ()
-			  (ignore-errors
-			    (delete-file file))
-			  (ignore-errors
-			    (delete-directory (file-name-directory file)))))
 		       (lambda (process state)
 			 (when (eq (process-status process) 'exit)
 			   (run-at-time
-			    10.0 nil
+			    60.0 nil
 			    (lambda ()
-			      (ignore-errors
-				(delete-file file))
-			      (ignore-errors
-				(delete-directory (file-name-directory file)))))
+			      (ignore-errors (delete-file file))
+			      (ignore-errors (delete-directory
+					      (file-name-directory file)))))
 			   (when (buffer-live-p outbuf)
 			     (with-current-buffer outbuf
 			       (let ((buffer-read-only nil)
@@ -1007,7 +1043,8 @@ external if displayed external."
 			     (kill-buffer buffer)))
 			 (message "Displaying %s...done" command)))))
 		(mm-handle-set-external-undisplayer
-		 handle (cons file buffer)))
+		 handle (cons file buffer))
+		(add-to-list 'mm-temp-files-to-be-deleted file t))
 	      (message "Displaying %s..." command))
 	    'external)))))))
 
@@ -1362,7 +1399,7 @@ Return t if meta tag is added or replaced."
 	(goto-char (point-min))
 	(if (re-search-forward "\
 <meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\
-text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+\\)\\)?[\"'][^>]*>" nil t)
+text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\([^\"'>]+\\)\\)?[^>]*>" nil t)
 	    (if (and (not force-charset)
 		     (match-beginning 2)
 		     (string-match "\\`html\\'" (match-string 1)))
@@ -1777,6 +1814,7 @@ If RECURSIVE, search recursively."
   ;; Require since we bind its variables.
   (require 'shr)
   (let ((article-buffer (current-buffer))
+	(shr-width fill-column)
 	(shr-content-function (lambda (id)
 				(let ((handle (mm-get-content-id id)))
 				  (when handle
@@ -1830,7 +1868,7 @@ If RECURSIVE, search recursively."
        handle
        `(lambda ()
 	  (let ((inhibit-read-only t))
-	    (delete-region ,(point-min-marker)
+	    (delete-region ,(copy-marker (point-min) t)
 			   ,(point-max-marker))))))))
 
 (defvar shr-map)