Implement clickable images with shr-browse-image.

images are tab stops. click or RET runs shr-browse-image. a prefix arg
copies the URL.

images use the mastodon-tl--shr-image-map-replacement for extra functions like zoom
image, save image, rotate image, etc.

3 files changed, 26 insertions, 6 deletions

diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el
index 862eb8f..9e1cbad 100644
--- a/lisp/mastodon-discover.el
+++ b/lisp/mastodon-discover.el
@@ -50,6 +50,8 @@
                        ("c" "Toggle hidden text" mastodon-tl--toggle-spoiler-text-in-toot)
                        ("n" "Next" mastodon-tl--goto-next-toot)
                        ("p" "Prev" mastodon-tl--goto-prev-toot)
+                       ("TAB" "Next link item" mastodon-tl--next-tab-item)
+                       ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item)
                        ("t" "New toot" mastodon-toot)
                        ("r" "Reply" mastodon-toot--reply)
                        ("C" "Copy toot URL" mastodon-tl--copy-toot-url)
@@ -72,6 +74,12 @@
                        ("C-S-M" "Unmute" mastodon-tl--unmute-user)
                        ("B" "Block" mastodon-tl--block-user)
                        ("C-S-B" "Unblock" mastodon-tl--unblock-user))
+                      ("Images"
+                       ("RET/i" "Load full image in browser" 'shr-browse-image)
+                       ("r" "rotate" 'image-rotate)
+                       ("+" "zoom in" 'image-increase-size)
+                       ("-" "zoom out" 'image-decrease-size)
+                       ("u" "copy URL" 'shr-maybe-probe-and-copy-url))
                       ("Profile view"
                        ("o" "Show following" mastodon-profile--open-following)
                        ("O" "Show followers" mastodon-profile--open-followers))
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 7a11660..6837f9b 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -262,14 +262,20 @@ replacing them with the referenced image."
                                  t image-options))
      " ")))
 
-(defun mastodon-media--get-media-link-rendering (media-url)
+(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url)
   "Returns the string to be written that renders the image at MEDIA-URL."
   (concat
    (propertize "[img]"
                'media-url media-url
                'media-state 'needs-loading
                'media-type 'media-link
-               'display (create-image mastodon-media--generic-broken-image-data nil t))
+               'display (create-image mastodon-media--generic-broken-image-data nil t)
+               'mouse-face 'highlight
+               'mastodon-tab-stop 'image ; for do-link-action-at-point
+               'image-url full-remote-url ; for shr-browse-image
+               'keymap mastodon-tl--shr-image-map-replacement
+               'help-echo (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")
+               )
    " "))
 
 (provide 'mastodon-media)
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 4931913..da2e418 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -130,6 +130,9 @@ types of mastodon links and not just shr.el-generated ones.")
     ;; version that knows about more types of links.
     (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item)
     (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item)
+    ;; browse-url loads the preview only, we want browse-image
+    ;; on RET to browse full sized image URL
+    (define-key map [remap shr-browse-url] 'shr-browse-image)
     (keymap-canonicalize map))
   "The keymap to be set for shr.el generated image links.
 
@@ -551,6 +554,7 @@ LINK-TYPE is the type of link to produce."
      'help-echo help-text)))
 
 (defun mastodon-tl--do-link-action-at-point (position)
+  ;; called by RET
   (interactive "d")
   (let ((link-type (get-text-property position 'mastodon-tab-stop)))
     (cond ((eq link-type 'content-warning)
@@ -575,6 +579,7 @@ LINK-TYPE is the type of link to produce."
            (error "unknown link type %s" link-type)))))
 
 (defun mastodon-tl--do-link-action (event)
+  ;; called by mouse click
   (interactive "e")
   (mastodon-tl--do-link-action-at-point (posn-point (event-end event))))
 
@@ -603,7 +608,7 @@ message is a link which unhides/hides the main body."
          (message (concat ;"\n"
                           " ---------------\n"
                           " " (mastodon-tl--make-link
-                               (concat "CW: " string) ;"Content Warning"
+                               (concat "CW: " string)
                                                       'content-warning)
                           "\n"
                           " ---------------\n"))
@@ -620,10 +625,12 @@ message is a link which unhides/hides the main body."
          (media-string (mapconcat
                         (lambda (media-attachement)
                           (let ((preview-url
-                                 (cdr (assoc 'preview_url media-attachement))))
+                                 (cdr (assoc 'preview_url media-attachement)))
+                                (remote-url
+                                 (cdr (assoc 'remote_url media-attachement))))
                             (if mastodon-tl--display-media-p
                                 (mastodon-media--get-media-link-rendering
-                                 preview-url)
+                                 preview-url remote-url) ; 2nd arg for shr-browse-url
                               (concat "Media::" preview-url "\n"))))
                         media-attachements "")))
     (if (not (and mastodon-tl--display-media-p
@@ -631,7 +638,6 @@ message is a link which unhides/hides the main body."
         (concat "\n" media-string)
       "")))
 
-
 (defun mastodon-tl--content (toot)
   "Retrieve text content from TOOT."
   (let ((content (mastodon-tl--field 'content toot)))