Start implementing the various url and image interactive commands.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0ac2c8f..493f7b1 100644 (file)
--- 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 4b5d2fb..c51bb46 100644 (file)
--- 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)))