From: Katsumi Yamaoka <yamaoka@jpl.org>
Date: Tue, 31 Aug 2010 13:28:02 +0000 (+0000)
Subject: Clarify the code a bit by renaming the variable with the url to `url'; Support cid... 
X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~48^2~180
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ad1421332b1bf192e0f59367c86e3a128c4b7329;p=emacs.git

Clarify the code a bit by renaming the variable with the url to `url'; Support cid: URLs/images; by Lars Magne Ingebrigtsen <larsi@gnus.org>.
---

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ec4427bb836..03d96b6f36f 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -10,6 +10,9 @@
 2010-08-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* gnus-html.el: require mm-url.
+	(gnus-html-wash-tags): Clarify the code a bit by renaming the variable
+	with the url to `url'.
+	(gnus-html-wash-tags): Support cid: URLs/images.
 
 2010-08-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index efa74146a91..6b7d6a624a6 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -276,7 +276,7 @@
 
 (defun gnus-put-image (glyph &optional string category)
   (let ((point (point)))
-    (insert-image glyph (or string " "))
+    (insert-image glyph (or string "*"))
     (put-text-property point (point) 'gnus-image-category category)
     (unless string
       (put-text-property (1- (point)) (point)
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 77cc5dc18d8..542d1401a80 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -72,7 +72,7 @@
       (gnus-html-wash-tags))))
 
 (defun gnus-html-wash-tags ()
-  (let (tag parameters string start end images)
+  (let (tag parameters string start end images url)
     (mm-url-decode-entities)
     (goto-char (point-min))
     (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t)
@@ -89,31 +89,46 @@
        ;; Fetch and insert a picture.
        ((equal tag "img_alt")
 	(when (string-match "src=\"\\([^\"]+\\)" parameters)
-	  (setq parameters (match-string 1 parameters))
+	  (setq url (match-string 1 parameters))
 	  (when (or (null mm-w3m-safe-url-regexp)
-		    (string-match mm-w3m-safe-url-regexp parameters))
-	    (let ((file (gnus-html-image-id parameters)))
-	      (if (file-exists-p file)
-		  ;; It's already cached, so just insert it.
-		  (when (gnus-html-put-image file (point))
-		    ;; Delete the ALT text.
-		    (delete-region start end))
-		;; We don't have it, so schedule it for fetching
-		;; asynchronously.
-		(push (list parameters
-			    (set-marker (make-marker) start)
-			    (point-marker))
-		      images))))))
+		    (string-match mm-w3m-safe-url-regexp url))
+	    (if (string-match "^cid:\\(.*\\)" url)
+		;; URLs with cid: have their content stashed in other
+		;; parts of the MIME structure, so just insert them
+		;; immediately.
+		(let ((handle (mm-get-content-id
+			       (setq url (match-string 1 url))))
+		      image)
+		  (when handle
+		    (mm-with-part handle
+		      (setq image (gnus-create-image (buffer-string)
+						     nil t))))
+		  (when image
+		    (delete-region start end)
+		    (gnus-put-image image)))
+	      ;; Normal, external URL.
+	      (let ((file (gnus-html-image-id url)))
+		(if (file-exists-p file)
+		    ;; It's already cached, so just insert it.
+		    (when (gnus-html-put-image file (point))
+		      ;; Delete the ALT text.
+		      (delete-region start end))
+		  ;; We don't have it, so schedule it for fetching
+		  ;; asynchronously.
+		  (push (list url
+			      (set-marker (make-marker) start)
+			      (point-marker))
+			images)))))))
        ;; Add a link.
        ((equal tag "a")
 	(when (string-match "href=\"\\([^\"]+\\)" parameters)
-	  (setq parameters (match-string 1 parameters))
+	  (setq url (match-string 1 parameters))
 	  (gnus-article-add-button start end
-				   'browse-url parameters
-				   parameters)
+				   'browse-url url
+				   url)
 	  (let ((overlay (gnus-make-overlay start end)))
 	    (gnus-overlay-put overlay 'evaporate t)
-	    (gnus-overlay-put overlay 'gnus-button-url parameters)
+	    (gnus-overlay-put overlay 'gnus-button-url url)
 	    (when gnus-article-mouse-face
 	      (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))))
        ;; Whatever.  Just ignore the tag.