From 814b707198d1451bd016a51fbebcd8b32e6d44bb Mon Sep 17 00:00:00 2001
From: marty hiatt <martianhiatus@riseup.net>
Date: Tue, 5 Mar 2024 10:27:00 +0100
Subject: RET/click image to view full-sized version in emacs.

---
 lisp/mastodon-media.el | 34 ++++++++++++++++++++++++++++++++++
 lisp/mastodon-tl.el    | 31 +++++++++++++++++++++++++++++--
 2 files changed, 63 insertions(+), 2 deletions(-)

(limited to 'lisp')

diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 9dd22f4..9014add 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -177,6 +177,40 @@ with the image."
               (set-marker marker nil)))
           (kill-buffer url-buffer))))))
 
+(defun mastodon-media--process-full-sized-image-response
+    (status-plist image-options url)
+  ;; FIXME: refactor this with but not into
+  ;; `mastodon-media--process-image-response'.
+  "Callback function processing the `url-retrieve' response for URL.
+URL is a full-sized image URL attached to a timeline image.
+STATUS-PLIST is a plist of status events as per `url-retrieve'.
+IMAGE-OPTIONS are the precomputed options to apply to the image."
+  (let ((url-buffer (current-buffer))
+        (is-error-response-p (eq :error (car status-plist))))
+    (let* ((data (unless is-error-response-p
+                   (goto-char (point-min))
+                   (search-forward "\n\n")
+                   (buffer-substring (point) (point-max))))
+           (image (when data
+                    (apply #'create-image data
+                           (if (version< emacs-version "27.1")
+                               (when image-options 'imagemagick)
+                             nil) ; inbuilt scaling in 27.1
+                           t nil))))
+      (when mastodon-media--enable-image-caching
+        (unless (url-is-cached url) ;; cache if not already cached
+          (url-store-in-cache url-buffer)))
+      (with-current-buffer (get-buffer-create "*masto-image*")
+        (let ((inhibit-read-only t))
+          (erase-buffer)
+          (insert " ")
+          (when image
+            (put-text-property (point-min) (point-max)
+                               'display image)
+            (image-mode)
+            (goto-char (point-min))
+            (switch-to-buffer-other-window (current-buffer))))))))
+
 (defun mastodon-media--load-image-from-url (url media-type start region-length)
   "Take a URL and MEDIA-TYPE and load the image asynchronously.
 MEDIA-TYPE is a symbol and either `avatar' or `media-link'.
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 18aaccc..e9cb6de 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -262,7 +262,7 @@ types of mastodon links and not just shr.el-generated ones.")
     (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)
+    (define-key map [remap shr-browse-url] #'mastodon-tl--view-full-image-or-play-video) ;#'shr-browse-image)
     ;; remove shr's u binding, as it the maybe-probe-and-copy-url
     ;; is already bound to w also
     (define-key map (kbd "u") #'mastodon-tl--update)
@@ -1110,6 +1110,26 @@ SENSITIVE is a flag from the item's JSON data."
                              help-echo
                            (concat help-echo "\nC-RET: play " type " with mpv"))))
 
+(defun mastodon-tl--view-full-image ()
+  "Browse full-sized version of image at point in a separate emacs window."
+  (interactive)
+  (if (not (eq (mastodon-tl--property 'mastodon-tab-stop) 'image))
+      (user-error "No image at point?")
+    (let* ((url (mastodon-tl--property 'image-url)))
+      (if (and mastodon-media--enable-image-caching
+               (url-is-cached url))
+          ;; if image url is cached, decompress and use it
+          (with-current-buffer (url-fetch-from-cache url)
+            (set-buffer-multibyte nil)
+            (goto-char (point-min))
+            (zlib-decompress-region
+             (goto-char (search-forward "\n\n")) (point-max))
+            (mastodon-media--process-full-sized-image-response
+             nil nil url))
+        ;; else fetch and load:
+        (url-retrieve url #'mastodon-media--process-full-sized-image-response
+                      (list nil url))))))
+
 
 ;; POLLS
 
@@ -1286,12 +1306,19 @@ displayed when the duration is smaller than a minute)."
          (type (plist-get video :type)))
     (mastodon-tl--mpv-play-video-at-point url type)))
 
+(defun mastodon-tl--view-full-image-or-play-video ()
+  "View full sized version of image at point, or try to play video."
+  (interactive)
+  (if (mastodon-tl--media-video-p)
+      (mastodon-tl--mpv-play-video-at-point)
+    (mastodon-tl--view-full-image)))
+
 (defun mastodon-tl--click-image-or-video (_event)
   "Click to play video with `mpv.el'."
   (interactive "e")
   (if (mastodon-tl--media-video-p)
       (mastodon-tl--mpv-play-video-at-point)
-    (shr-browse-image)))
+    (mastodon-tl--view-full-image)))
 
 (defun mastodon-tl--media-video-p (&optional type)
   "T if mastodon-media-type prop is \"gifv\" or \"video\".
-- 
cgit v1.2.3