X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/89b163db286d79b43fb5c9927fc622bbf7d2ef1a..99191b89ff64172740add88e67f163619a07830c:/lisp/gnus/mm-decode.el

diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index d0401bc9de..7274708f01 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/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-2013 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -29,8 +29,7 @@
 
 (require 'mail-parse)
 (require 'mm-bodies)
-(eval-when-compile (require 'cl)
-		   (require 'term))
+(eval-when-compile (require 'cl))
 
 (autoload 'gnus-map-function "gnus-util")
 (autoload 'gnus-replace-in-string "gnus-util")
@@ -64,6 +63,18 @@
   :group 'news
   :group 'multimedia)
 
+(defface mm-command-output
+  '((((class color)
+      (background dark))
+     (:foreground "ForestGreen"))
+    (((class color)
+      (background light))
+     (:foreground "red3"))
+    (t
+     (:italic t)))
+  "Face used for displaying output from commands."
+  :group 'mime-display)
+
 ;;; Convenience macros.
 
 (defmacro mm-handle-buffer (handle)
@@ -813,6 +824,8 @@ external if displayed external."
 
 (declare-function gnus-configure-windows "gnus-win" (setting &optional force))
 (defvar mailcap-mime-extensions)	; mailcap-mime-info autoloads
+(declare-function term-mode "term" ())
+(declare-function term-char-mode "term" ())
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
@@ -982,9 +995,12 @@ external if displayed external."
 			       (let ((buffer-read-only nil)
 				     (point (point)))
 				 (forward-line 2)
-				 (mm-insert-inline
-				  handle (with-current-buffer buffer
-					   (buffer-string)))
+				 (let ((start (point)))
+				   (mm-insert-inline
+				    handle (with-current-buffer buffer
+					     (buffer-string)))
+				   (put-text-property start (point)
+						      'face 'mm-command-output))
 				 (goto-char point))))
 			   (when (buffer-live-p buffer)
 			     (kill-buffer buffer)))
@@ -1298,14 +1314,26 @@ PROMPT overrides the default one used to ask user for a file name."
     (when filename
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
 					(file-name-nondirectory filename))))
-    (setq file
-          (read-file-name
-	   (or prompt
-	       (format "Save MIME part to (default %s): "
-		       (or filename "")))
-	   (or mm-default-directory default-directory)
-	   (expand-file-name (or filename "")
-			     (or mm-default-directory default-directory))))
+    (while
+	(progn
+	  (setq file
+		(read-file-name
+		 (or prompt
+		     (format "Save MIME part to (default %s): "
+			     (or filename "")))
+		 (or mm-default-directory default-directory)
+		 (expand-file-name (or filename "")
+				   (or mm-default-directory default-directory))))
+	  (cond ((or (not file) (equal file ""))
+		 (message "Please enter a file name")
+		 t)
+		((and (file-directory-p file)
+		      (not filename))
+		 (message "Please enter a non-directory file name")
+		 t)
+		(t nil)))
+      (sit-for 2)
+      (discard-input))
     (if (file-directory-p file)
 	(setq file (expand-file-name filename file))
       (setq file (expand-file-name
@@ -1772,7 +1800,8 @@ If RECURSIVE, search recursively."
 	 (insert (prog1
 		     (if (and charset
 			      (setq charset
-				    (mm-charset-to-coding-system charset))
+				    (mm-charset-to-coding-system charset
+								 nil t))
 			      (not (eq charset 'ascii)))
 			 (mm-decode-coding-string (buffer-string) charset)
 		       (mm-string-as-multibyte (buffer-string)))
@@ -1790,11 +1819,12 @@ If RECURSIVE, search recursively."
 	     (replace-match (char-to-string char))))
 	 ;; Remove "soft hyphens".
 	 (goto-char (point-min))
-	 (while (search-forward "­" nil t)
+	 (while (search-forward "­" nil t)
 	   (replace-match "" t t))
 	 (libxml-parse-html-region (point-min) (point-max))))
       (unless (bobp)
 	(insert "\n"))
+      (mm-convert-shr-links)
       (mm-handle-set-undisplayer
        handle
        `(lambda ()
@@ -1802,6 +1832,25 @@ If RECURSIVE, search recursively."
 	    (delete-region ,(point-min-marker)
 			   ,(point-max-marker))))))))
 
+(defvar shr-map)
+
+(autoload 'widget-convert-button "wid-edit")
+
+(defun mm-convert-shr-links ()
+  (let ((start (point-min))
+	end)
+    (while (and start
+		(< start (point-max)))
+      (when (setq start (text-property-not-all start (point-max) 'shr-url nil))
+	(setq end (next-single-property-change start 'shr-url nil (point-max)))
+	(widget-convert-button
+	 'url-link start end
+	 :help-echo (get-text-property start 'help-echo)
+	 :keymap shr-map
+	 (get-text-property start 'shr-url))
+	(put-text-property start end 'local-map nil)
+	(setq start end)))))
+
 (defun mm-handle-filename (handle)
   "Return filename of HANDLE if any."
   (or (mail-content-type-get (mm-handle-type handle)
@@ -1812,7 +1861,7 @@ If RECURSIVE, search recursively."
 (provide 'mm-decode)
 
 ;; Local Variables:
-;; coding: iso-8859-1
+;; coding: utf-8
 ;; End:
 
 ;;; mm-decode.el ends here