X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=891843424fd7fcd01bfeb624fa2565123587c843;hb=afbf528d6fb2fdb90f56a50212e46178b869a28b;hp=3b3695b4ca3e9e4cceb69f3f39408746a01e835d;hpb=4739da68738c1b99b0e7a58c9943539e824e2042;p=gnus

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 3b3695b4c..891843424 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-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -249,6 +249,8 @@ before the external MIME handler is invoked."
     ("message/partial" mm-inline-partial identity)
     ("message/external-body" mm-inline-external-body identity)
     ("text/.*" mm-inline-text identity)
+    ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
+    ("application/zip" mm-archive-dissect-and-inline identity)
     ("audio/wav" mm-inline-audio
      (lambda (handle)
        (and (or (featurep 'nas-sound) (featurep 'native-sound))
@@ -298,6 +300,9 @@ before the external MIME handler is invoked."
     "application/pgp-signature" "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
     "application/pkcs7-mime"
+    "application/x-gtar-compressed"
+    "application/x-tar"
+    "application/zip"
     ;; Mutt still uses this even though it has already been withdrawn.
     "application/pgp")
   "List of media types that are to be displayed inline.
@@ -654,12 +659,23 @@ Postpone undisplaying of viewers for types in
 	    (if (equal "text/plain" (car ctl))
 		(assoc 'format ctl)
 	      t))
+    ;; 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")
+		 filename
+		 (string-match "\\.\\([^.]+\\)$" filename))
+	(let ((new-type (mailcap-extension-to-mime (match-string 1 filename))))
+	  (when new-type
+	    (setcar ctl new-type)))))
     (let ((handle
 	   (mm-make-handle
 	    (mm-copy-to-buffer) ctl cte nil cdl description nil id))
 	  (decoder (assoc (car ctl) mm-archive-decoders)))
       (if (and decoder
-	       (executable-find (cadr decoder)))
+	       ;; Do automatic decoding
+	       (cadr decoder)
+	       (executable-find (caddr decoder)))
 	  (mm-dissect-archive handle)
 	handle))))
 
@@ -925,46 +941,38 @@ external if displayed external."
 				   shell-command-switch command)
 		    (set-process-sentinel
 		     (get-buffer-process buffer)
-		     (lexical-let ;; Don't use `let'.
-			 ;; Function used to remove temp file and directory.
-			 ((fn `(lambda nil
-				 ;; Don't use `ignore-errors'.
-				 (condition-case nil
-				     (delete-file ,file)
-				   (error))
-				 (condition-case nil
-				     (delete-directory
-				      ,(file-name-directory file))
-				   (error))))
-			  ;; Form uses to kill the process buffer and
-			  ;; remove the undisplayer.
-			  (fm `(progn
-				 (kill-buffer ,buffer)
-				 ,(macroexpand
-				   (list 'mm-handle-set-undisplayer
-					 (list 'quote handle)
-					 nil))))
-			  ;; Message to be issued when the process exits.
-			  (done (format "Displaying %s...done" command))
-			  ;; In particular, the timer object (which is
-			  ;; a vector in Emacs but is a list in XEmacs)
-			  ;; requires that it is lexically scoped.
-			  (timer (run-at-time 30.0 nil 'ignore)))
-		       (if (featurep 'xemacs)
-			   (lambda (process state)
-			     (when (eq 'exit (process-status process))
-			       (if (memq timer itimer-list)
-				   (set-itimer-function timer fn)
-				 (funcall fn))
-			       (ignore-errors (eval fm))
-			       (message "%s" done)))
-			 (lambda (process state)
-			   (when (eq 'exit (process-status process))
-			     (if (memq timer timer-list)
-				 (timer-set-function timer fn)
-			       (funcall fn))
-			     (ignore-errors (eval fm))
-			     (message "%s" done)))))))
+		     (lexical-let ((outbuf outbuf)
+				   (file file)
+				   (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)
+			   (condition-case nil
+			       (delete-file file)
+			     (error))
+			   (condition-case nil
+			       (delete-directory (file-name-directory file))
+			     (error))
+			   (when (buffer-live-p outbuf)
+			     (with-current-buffer outbuf
+			       (let ((buffer-read-only nil)
+				     (point (point)))
+				 (forward-line 2)
+				 (mm-insert-inline
+				  handle (with-current-buffer buffer
+					   (buffer-string)))
+				 (goto-char point))))
+			   (when (buffer-live-p buffer)
+			     (kill-buffer buffer)))
+			 (message "Displaying %s...done" command)))))
 		(mm-handle-set-external-undisplayer
 		 handle (cons file buffer)))
 	      (message "Displaying %s..." command))
@@ -1500,7 +1508,7 @@ be determined."
   (let ((image (mm-get-image handle)))
     (or (not image)
 	(if (featurep 'xemacs)
-	    ;; XEmacs' glyphs can actually tell us about their width, so
+	    ;; XEmacs's glyphs can actually tell us about their width, so
 	    ;; let's be nice and smart about them.
 	    (or mm-inline-large-images
 		(and (<= (glyph-width image) (window-pixel-width))
@@ -1764,6 +1772,10 @@ If RECURSIVE, search recursively."
 				    (string-to-number (match-string 2)))
 				  mm-extra-numeric-entities)))
 	     (replace-match (char-to-string char))))
+	 ;; Remove "soft hyphens".
+	 (goto-char (point-min))
+	 (while (search-forward "­" nil t)
+	   (replace-match "" t t))
 	 (libxml-parse-html-region (point-min) (point-max))))
       (unless (bobp)
 	(insert "\n"))