From: Katsumi Yamaoka <yamaoka@jpl.org>
Date: Wed, 31 Mar 2010 07:47:15 +0000 (+0000)
Subject: 2010-03-31  Katsumi Yamaoka  <yamaoka@jpl.org>
X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=commitdiff_plain;h=997124013fd18108affa53e92389f10676af7bd9

2010-03-31  Katsumi Yamaoka  <yamaoka@jpl.org>
 * gnus-art.el (gnus-article-browse-html-save-cid-content): Rename from
 gnus-article-browse-html-save-cid-image; make it work recursively for
 forwarded messages as well.
 (gnus-article-browse-html-parts): Work when prefix arg is given.
 (gnus-article-browse-html-article): Doc fix.

2010-03-30  Chong Yidong  <cyd@stupidchicken.com>
 * message.el (message-default-mail-headers):
 (message-default-headers): Carry the value mail-default-headers over
 into message-default-mail-headers, rather than message-default-headers.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 712cc97c6..b2f8b8770 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2010-03-31  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-article-browse-html-save-cid-content): Rename from
+	gnus-article-browse-html-save-cid-image; make it work recursively for
+	forwarded messages as well.
+	(gnus-article-browse-html-parts): Work when prefix arg is given.
+	(gnus-article-browse-html-article): Doc fix.
+
+2010-03-30  Chong Yidong  <cyd@stupidchicken.com>
+
+	* message.el (message-default-mail-headers):
+	(message-default-headers): Carry the value mail-default-headers over
+	into message-default-mail-headers, rather than message-default-headers.
+
 2010-03-30  Martin Stjernholm  <mast@lysator.liu.se>
 
 	* mm-decode.el (mm-add-meta-html-tag): Added option to override the
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 086eb47d7..8b9d8b69f 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -2827,41 +2827,39 @@ summary buffer."
     (setq gnus-article-browse-html-temp-list nil))
   gnus-article-browse-html-temp-list)
 
-(defun gnus-article-browse-html-save-cid-image (cid dir)
-  "Save CID contents to a file in DIR.  Return file name."
+(defun gnus-article-browse-html-save-cid-content (cid handles directory)
+  "Find CID content in HANDLES and save it in a file in DIRECTORY.
+Return file name."
   (save-match-data
-    (gnus-with-article-buffer
-      (let (cid-handle cid-tmp-file cid-type)
-	(mapc
-	 (lambda (handle)
-	   (when (and (listp handle)
-		      (stringp (car (last handle)))
-		      (string= (format "<%s>" cid)
-			       (car (last handle))))
-	     (setq cid-handle handle)
-	     (setq cid-tmp-file
-		   (expand-file-name
-		    (or (mail-content-type-get
-			 (mm-handle-disposition handle) 'filename)
-			(mail-content-type-get
-			 (setq cid-type (mm-handle-type handle)) 'name)
-			(concat (make-temp-name "cid")
-				(or (car (rassoc (car cid-type)
-						 mailcap-mime-extensions))
-				    "")))
-		    dir))))
-	 gnus-article-mime-handles)
-	(when (and cid-handle cid-tmp-file)
-	  (mm-save-part-to-file cid-handle
-				cid-tmp-file)
-	  (concat "file://" cid-tmp-file))))))
+    (let (file type)
+      (catch 'found
+	(dolist (handle handles)
+	  (cond
+	   ((not (listp handle)))
+	   ((equal (mm-handle-media-supertype handle) "multipart")
+	    (when (setq file (gnus-article-browse-html-save-cid-content
+			      cid handle directory))
+	      (throw 'found file)))
+	   ((equal (concat "<" cid ">") (mm-handle-id handle))
+	    (setq file
+		  (expand-file-name
+		   (or (mail-content-type-get
+			(mm-handle-disposition handle) 'filename)
+		       (mail-content-type-get
+			(setq type (mm-handle-type handle)) 'name)
+		       (concat
+			(make-temp-name "cid")
+			(car (rassoc (car type) mailcap-mime-extensions))))
+		   directory))
+	    (mm-save-part-to-file handle file)
+	    (throw 'found file))))))))
 
 (defun gnus-article-browse-html-parts (list &optional header)
   "View all \"text/html\" parts from LIST.
 Recurse into multiparts.  The optional HEADER that should be a decoded
 message header will be added to the bodies of the \"text/html\" parts."
   ;; Internal function used by `gnus-article-browse-html-article'.
-  (let (type file charset tmp-file showed)
+  (let (type file charset content cid-dir tmp-file showed)
     ;; Find and show the html-parts.
     (dolist (handle list)
       ;; If HTML, show it:
@@ -2884,17 +2882,42 @@ message header will be added to the bodies of the \"text/html\" parts."
 			(setq handle (mm-handle-cache handle)
 			      type (mm-handle-type handle))
 			(equal (car type) "text/html"))))
-	     (when (or (setq charset (mail-content-type-get type 'charset))
-		       header
-		       (not file))
+	     (setq charset (mail-content-type-get type 'charset)
+		   content (mm-get-part handle))
+	     (with-temp-buffer
+	       (if (eq charset 'gnus-decoded)
+		   (mm-enable-multibyte)
+		 (mm-disable-multibyte))
+	       (insert content)
+	       ;; resolve cid contents
+	       (let ((case-fold-search t)
+		     cid-file)
+		 (goto-char (point-min))
+		 (while (re-search-forward "\
+<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
+					   nil t)
+		   (unless cid-dir
+		     (setq cid-dir (make-temp-file "cid" t))
+		     (add-to-list 'gnus-article-browse-html-temp-list cid-dir))
+		   (setq file nil
+			 content nil)
+		   (when (setq cid-file
+			       (gnus-article-browse-html-save-cid-content
+				(match-string 2)
+				(with-current-buffer gnus-article-buffer
+				  gnus-article-mime-handles)
+				cid-dir))
+		     (replace-match (concat "file://" cid-file)
+				    nil nil nil 1))))
+	       (unless content (setq content (buffer-string))))
+	     (when (or charset header (not file))
 	       (setq tmp-file (mm-make-temp-file
 			       ;; Do we need to care for 8.3 filenames?
 			       "mm-" nil ".html")))
 	     ;; Add a meta html tag to specify charset and a header.
 	     (cond
 	      (header
-	       (let (title eheader body hcharset coding force-charset
-			   cid-image-dir)
+	       (let (title eheader body hcharset coding force-charset)
 		 (with-temp-buffer
 		   (mm-enable-multibyte)
 		   (setq case-fold-search t)
@@ -2917,8 +2940,7 @@ message header will be added to the bodies of the \"text/html\" parts."
 							      charset)
 			     title (when title
 				     (mm-encode-coding-string title charset))
-			     body (mm-encode-coding-string (mm-get-part handle)
-							   charset)
+			     body (mm-encode-coding-string content charset)
 			     force-charset t)
 		     (setq hcharset (mm-find-mime-charset-region (point-min)
 								 (point-max)))
@@ -2940,7 +2962,7 @@ message header will be added to the bodies of the \"text/html\" parts."
 					 title (when title
 						 (mm-encode-coding-string
 						  title coding))
-					 body (mm-get-part handle))
+					 body content)
 				 (setq charset 'utf-8
 				       eheader (mm-encode-coding-string
 						(buffer-string) charset)
@@ -2949,7 +2971,7 @@ message header will be added to the bodies of the \"text/html\" parts."
 						title charset))
 				       body (mm-encode-coding-string
 					     (mm-decode-coding-string
-					      (mm-get-part handle) body)
+					      content body)
 					     charset)
 				       force-charset t)))
 			   (setq charset hcharset
@@ -2958,9 +2980,9 @@ message header will be added to the bodies of the \"text/html\" parts."
 				 title (when title
 					 (mm-encode-coding-string
 					  title coding))
-				 body (mm-get-part handle)))
+				 body content))
 		       (setq eheader (mm-string-as-unibyte (buffer-string))
-			     body (mm-get-part handle))))
+			     body content)))
 		   (erase-buffer)
 		   (mm-disable-multibyte)
 		   (insert body)
@@ -2977,27 +2999,14 @@ message header will be added to the bodies of the \"text/html\" parts."
 		       (re-search-forward
 			"</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t))
 		   (insert eheader)
-		   ;; resolve cid images
-		   (while (re-search-forward
-			   "<img src=\"\\(cid:\\([^\"]+\\)\\)\""
-			   nil t)
-		     (unless cid-image-dir
-		       (setq cid-image-dir (make-temp-file "cid" t))
-		       (add-to-list 'gnus-article-browse-html-temp-list
-				    cid-image-dir))
-		     (replace-match
-		      (gnus-article-browse-html-save-cid-image
-		       (match-string 2) cid-image-dir)
-		      nil nil nil 1))
 		   (mm-write-region (point-min) (point-max)
 				    tmp-file nil nil nil 'binary t))))
 	      (charset
 	       (mm-with-unibyte-buffer
 		 (insert (if (eq charset 'gnus-decoded)
-			     (mm-encode-coding-string
-			      (mm-get-part handle)
-			      (setq charset 'utf-8))
-			   (mm-get-part handle)))
+			     (mm-encode-coding-string content
+						      (setq charset 'utf-8))
+			   content))
 		 (if (or (mm-add-meta-html-tag handle charset)
 			 (not file))
 		     (mm-write-region (point-min) (point-max)
@@ -3044,17 +3053,23 @@ message header will be added to the bodies of the \"text/html\" parts."
 
 (defun gnus-article-browse-html-article (&optional arg)
   "View \"text/html\" parts of the current article with a WWW browser.
+Inline images embedded in a message using the cid scheme, as they are
+generally considered to be safe, will be processed properly.
 The message header is added to the beginning of every html part unless
 the prefix argument ARG is given.
 
-Warning: Spammers use links to images in HTML articles to verify
-whether you have read the message.  As
+Warning: Spammers use links to images (using the http scheme) in HTML
+articles to verify whether you have read the message.  As
 `gnus-article-browse-html-article' passes the HTML content to the
 browser without eliminating these \"web bugs\" you should only
 use it for mails from trusted senders.
 
 If you always want to display HTML parts in the browser, set
-`mm-text-html-renderer' to nil."
+`mm-text-html-renderer' to nil.
+
+This command creates temporary files to pass HTML contents including
+images if any to the browser, and deletes them when exiting the group
+\(if you want)."
   ;; Cf. `mm-w3m-safe-url-regexp'
   (interactive "P")
   (if arg
diff --git a/lisp/message.el b/lisp/message.el
index 9262878e3..018646df7 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1153,16 +1153,18 @@ these lines."
   ;; Ease the transition from mail-mode to message-mode.  See bugs#4431, 5555.
   (concat (if (and (boundp 'mail-default-reply-to)
 		   (stringp mail-default-reply-to))
-	      (format "Reply-to: %s\n" mail-default-reply-to)
-	    "")
+	      (format "Reply-to: %s\n" mail-default-reply-to))
 	  (if (and (boundp 'mail-self-blind)
 		   mail-self-blind)
-	      (format "BCC: %s\n" user-mail-address)
-	    "")
+	      (format "BCC: %s\n" user-mail-address))
 	  (if (and (boundp 'mail-archive-file-name)
 		   (stringp mail-archive-file-name))
-	      (format "FCC: %s\n" mail-archive-file-name)
-	    ""))
+	      (format "FCC: %s\n" mail-archive-file-name))
+	  ;; Use the value of `mail-default-headers' if available.
+	  ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is
+	  ;; unavailable unless sendmail.el is loaded.
+	  (if (boundp 'mail-default-headers)
+	      mail-default-headers))
   "*A string of header lines to be inserted in outgoing mails."
   :version "23.2"
   :group 'message-headers