From d5941204eac2f4502bf54d25c68686c17f3c2386 Mon Sep 17 00:00:00 2001
From: Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Date: Mon, 4 Oct 2010 19:32:31 +0200
Subject: [PATCH] Start implementing the various url and image interactive
 commands.

---
 lisp/ChangeLog |  1 +
 lisp/shr.el    | 29 +++++++++++++++++++++++++++++
 2 files changed, 30 insertions(+)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0ac2c8fb4..493f7b154 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -3,6 +3,7 @@
 	* shr.el (browse-url): Required.
 	(shr-ensure-paragraph): Don't insert a new newline after empty-ish
 	lines.
+	(shr-show-alt-text, shr-browse-image): New commands.
 
 	* gnus-sum.el (gnus-widen-article-window): New variable.
 	(gnus-summary-select-article-buffer): Use it.
diff --git a/lisp/shr.el b/lisp/shr.el
index 4b5d2fb42..c51bb461c 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -59,6 +59,15 @@ fit these criteria."
 
 (defvar shr-width 70)
 
+(defvar shr-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "a" 'shr-show-alt-text)
+    (define-key map "i" 'shr-browse-image)
+    (define-key map "I" 'shr-insert-image)
+    (define-key map "u" 'shr-copy-string)
+    (define-key map "v" 'shr-browse-url)
+    map))
+
 (defun shr-transform-dom (dom)
   (let ((result (list (pop dom))))
     (dolist (arg (pop dom))
@@ -165,9 +174,29 @@ fit these criteria."
 	(url-retrieve url 'shr-image-fetched
 		      (list (current-buffer) start (point-marker))
 		      t)))
+      (put-text-property start (point) 'keymap shr-map)
+      (put-text-property start (point) 'shr-alt alt)
+      (put-text-property start (point) 'shr-image url)
       (insert " ")
       (setq shr-state 'image))))
 
+(defun shr-show-alt-text ()
+  "Show the ALT text of the image under point."
+  (interactive)
+  (let ((text (get-text-property (point) 'shr-alt)))
+    (if (not text)
+	(message "No image under point")
+      (message "%s" text))))
+
+(defun shr-browse-image ()
+  "Browse the image under point."
+  (interactive)
+  (let ((url (get-text-property (point) 'shr-image)))
+    (if (not url)
+	(message "No image under point")
+      (message "Browsing %s..." url)
+      (browse-url url))))
+
 (defun shr-image-fetched (status buffer start end)
   (when (and (buffer-name buffer)
 	     (not (plist-get status :error)))
-- 
2.25.1