# HG changeset patch
# User Katsumi Yamaoka <yamaoka@jpl.org>
# Date 1283990392 0
# Node ID a46aad43ce5a6c907f3e0dbd9a45879062d45ba9
# Parent  07962d48d84820689f8481dbfafcf61cd9626a38
gnus-html.el: Allow showing the ALT text of images and to browse the images themselves.

diff -r 07962d48d848 -r a46aad43ce5a lisp/gnus/ChangeLog
--- a/lisp/gnus/ChangeLog	Wed Sep 08 23:51:10 2010 +0000
+++ b/lisp/gnus/ChangeLog	Wed Sep 08 23:59:52 2010 +0000
@@ -1,5 +1,10 @@
 2010-09-08  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* gnus-html.el (gnus-html-show-alt-text): New command.
+	(gnus-html-browse-image): Ditto.
+	(gnus-html-wash-tags): Add the data to allow showing the ALT text and
+	to browse the image directly.
+
 	* gnus-async.el (gnus-async-article-callback): Call
 	`gnus-html-prefetch-images' unconditionally.
 
diff -r 07962d48d848 -r a46aad43ce5a lisp/gnus/gnus-html.el
--- a/lisp/gnus/gnus-html.el	Wed Sep 08 23:51:10 2010 +0000
+++ b/lisp/gnus/gnus-html.el	Wed Sep 08 23:59:52 2010 +0000
@@ -72,6 +72,12 @@
     (define-key map "i" 'gnus-html-insert-image)
     map))
 
+(defvar gnus-html-displayed-image-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "a" 'gnus-html-show-alt-text)
+    (define-key map "i" 'gnus-html-browse-image)
+    map))
+
 ;;;###autoload
 (defun gnus-article-html (&optional handle)
   (let ((article-buffer (current-buffer)))
@@ -176,11 +182,14 @@
 		     start end
 		     'gnus-image spec)))
 	      (let ((file (gnus-html-image-id url))
-		    width height)
+		    width height alt-text)
 		(when (string-match "height=\"?\\([0-9]+\\)" parameters)
 		  (setq height (string-to-number (match-string 1 parameters))))
 		(when (string-match "width=\"?\\([0-9]+\\)" parameters)
 		  (setq width (string-to-number (match-string 1 parameters))))
+		(when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
+				    parameters)
+		  (setq alt-text (match-string 2 parameters)))
 		;; Don't fetch images that are really small.  They're
 		;; probably tracking pictures.
 		(when (and (or (null height)
@@ -190,9 +199,9 @@
 		  (if (file-exists-p file)
 		      ;; It's already cached, so just insert it.
 		      (let ((string (buffer-substring start end)))
-			;; Delete the ALT text.
+			;; Delete the IMG text.
 			(delete-region start end)
-			(gnus-html-put-image file (point) string))
+			(gnus-html-put-image file (point) string url alt-text))
 		    ;; We don't have it, so schedule it for fetching
 		    ;; asynchronously.
 		    (push (list url
@@ -237,6 +246,16 @@
   (gnus-html-schedule-image-fetching
    (current-buffer) (list (get-text-property (point) 'gnus-image))))
 
+(defun gnus-html-show-alt-text ()
+  "Show the ALT text of the image under point."
+  (interactive)
+  (message "%s" (get-text-property (point) 'gnus-alt-text)))
+
+(defun gnus-html-browse-image ()
+  "Browse the image under point."
+  (interactive)
+  (browse-url (get-text-property (point) 'gnus-image)))
+
 (defun gnus-html-schedule-image-fetching (buffer images)
   (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
                 buffer images)
@@ -276,7 +295,7 @@
       (when images
 	(gnus-html-schedule-image-fetching buffer images)))))
 
-(defun gnus-html-put-image (file point string)
+(defun gnus-html-put-image (file point string &optional url alt-text)
   (when (gnus-graphic-display-p)
     (let* ((image (ignore-errors
 		   (gnus-create-image file)))
@@ -301,11 +320,17 @@
 			       'gif)
 			   (= (car size) 30)
 			   (= (cdr size) 30))))
-	    (progn
+	    (let ((start (point)))
 	      (setq image (gnus-html-rescale-image image file size))
 	      (gnus-put-image image
 			      (gnus-string-or string "*")
 			      'external)
+	      (let ((overlay (gnus-make-overlay start (point))))
+		(gnus-overlay-put overlay 'local-map
+				  gnus-html-displayed-image-map)
+		(gnus-put-text-property start (point) 'gnus-alt-text alt-text)
+		(when url
+		  (gnus-put-text-property start (point) 'gnus-image url)))
 	      (gnus-add-image 'external image)
 	      t)
 	  (insert string)
@@ -360,7 +385,7 @@
 	  (delete-file (nth 2 file)))))))
 
 (defun gnus-html-image-url-blocked-p (url blocked-images)
-"Find out if URL is blocked by BLOCKED-IMAGES."
+  "Find out if URL is blocked by BLOCKED-IMAGES."
   (let ((ret (and blocked-images
                   (string-match blocked-images url))))
     (if ret