branch: elpa/mastodon
commit a8baf9bbcba4a108e9e1a51552b9df1c4be06e60
Author: marty hiatt <martianhia...@disroot.org>
Commit: marty hiatt <martianhia...@disroot.org>
implement full sized image cycling. #666.
- adds mastodon-image-mode inheriting image-mode
- keymap for cycling on `.`/`>`/`<right>`
- modifies toot attachments text property order
- adds mastodon-media--attachments local variable in image buffer
- media.el: full sized image response now requires attachments arg, and
- optional prev-buf arg.
---
lisp/mastodon-media.el | 22 ++++++++----
lisp/mastodon-tl.el | 92 ++++++++++++++++++++++++++++++++++++++++++++------
2 files changed, 98 insertions(+), 16 deletions(-)
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 841d30397c..85e341c5a1 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -332,7 +332,12 @@ image-data prop so it can be toggled."
mastodon-media--sensitive-image-data nil t)
sensitive-state hidden image-data ,image))))
-(defun mastodon-media--process-full-sized-image-response (status-plist url)
+(defvar mastodon-media--attachments nil
+ "A list attachment details for full sized image view buffer.
+The first element is the URL of the image displayed, followed by plists of
details of all of a toot's attachments.")
+
+(defun mastodon-media--process-full-sized-image-response
+ (status-plist url attachments &optional prev-buf)
;; FIXME: refactor this with but not into
;; `mastodon-media--process-image-response'.
"Callback function processing the `url-retrieve' response for URL.
@@ -347,16 +352,21 @@ STATUS-PLIST is a plist of status events as per
`url-retrieve'."
;; https://codeberg.org/martianh/mastodon.el/issues/540
(let* ((handle (mm-dissect-buffer t))
(image (mm-get-image handle))
- (str (image-property image :data)))
- (with-current-buffer (get-buffer-create "*masto-image*")
+ (str (image-property image :data))
+ (buf "*masto-image*"))
+ (with-current-buffer (get-buffer-create buf)
(let ((inhibit-read-only t))
(erase-buffer)
(insert-image image str)
(special-mode) ; prevent image-mode loop bug
- (image-mode)
+ (mastodon-image-mode) ;; for our keymap
(goto-char (point-min))
- (switch-to-buffer-other-window (current-buffer))
- (image-transform-fit-both))))))
+ (image-transform-fit-both)
+ ;; set image metadata for view cycling:
+ (setq-local mastodon-media--attachments (cons url attachments))))
+ ;; switch to buf if not already viewing it:
+ (unless (equal buf prev-buf)
+ (switch-to-buffer-other-window buf)))))
(defun mastodon-media--image-or-cached (url process-fun args)
"Fetch URL from cache or fro host.
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 33913d8b66..230962e515 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -333,6 +333,14 @@ types of mastodon links and not just shr.el-generated
ones.")
"The keymap to be set for the author byline.
It is active where point is placed by `mastodon-tl-goto-next-item.'")
+(defvar mastodon-image-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map image-mode-map)
+ (define-key map (kbd ">") #'mastodon-tl-next-full-image)
+ (define-key map (kbd ".") #'mastodon-tl-next-full-image)
+ (define-key map (kbd "<right>") #'mastodon-tl-next-full-image)
+ map))
+
;;; MACROS
@@ -750,8 +758,10 @@ The result is added as an attachments property to
author-byline."
(let ((media (mastodon-tl--field 'media_attachments toot)))
(mapcar (lambda (attachment)
(let-alist attachment
- (list :url (or .remote_url .url) ; fallback for notifications
- :type .type)))
+ (list :id .id
+ :type .type
+ ;; fallback for notifications:
+ :url (or .remote_url .url))))
media)))
(defun mastodon-tl--byline-booster (toot)
@@ -1405,18 +1415,80 @@ 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 ()
+;;; FULL IMAGE VIEW
+
+(define-derived-mode mastodon-image-mode image-mode
+ "mastodon-image"
+ :group 'mastodon)
+
+;; patch `shr-browse-image' to accept url arg:
+(defun mastodon-tl-shr-browse-image (&optional image-url copy-url)
+ "Browse the image under point.
+If COPY-URL (the prefix if called interactively) is non-nil, copy
+the URL of the image to the kill buffer instead."
+ (interactive "sP")
+ (let ((url (or image-url (get-text-property (point) 'image-url))))
+ (cond
+ ((not url)
+ (message "No image under point"))
+ (copy-url
+ (with-temp-buffer
+ (insert url)
+ (copy-region-as-kill (point-min) (point-max))
+ (message "Copied %s" url)))
+ (t
+ (message "Browsing %s..." url)
+ (browse-url url)))))
+
+(defun mastodon-tl--view-image-url (url attachments)
+ "View image URL. Set ATTACHMENTS metadata in image buffer."
+ (if (not url)
+ (user-error "No url found")
+ (if (not mastodon-tl--load-full-sized-images-in-emacs)
+ (mastodon-tl-shr-browse-image url)
+ (mastodon-media--image-or-cached
+ url #'mastodon-media--process-full-sized-image-response
+ `(nil ,url ,attachments ,(buffer-name))))))
+
+(defun mastodon-tl-view-full-image-at-point ()
"Browse full-sized version of image at point in a new 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 (not mastodon-tl--load-full-sized-images-in-emacs)
- (shr-browse-image)
- (mastodon-media--image-or-cached
- url
- #'mastodon-media--process-full-sized-image-response
- `(nil ,url))))))
+ (let* ((url (mastodon-tl--property 'image-url))
+ (attachments (mastodon-tl--property 'attachments)))
+ (mastodon-tl--view-image-url url attachments))))
+
+(defun mastodon-tl-view-first-full-image ()
+ "From item byline, fetch load its first full image."
+ (interactive)
+ (let* ((attachments (mastodon-tl--property 'attachments))
+ (url (plist-get (car attachments) :url)))
+ (mastodon-tl--view-image-url url attachments)))
+
+(defun mastodon-tl--get-next-image-url ()
+ "Return the url for the next image to load.
+Cycles through values in `mastodon-media--attachments'."
+ (cl-loop for attachment in (cdr mastodon-media--attachments)
+ for url = (car mastodon-media--attachments)
+ ;; match url against our plists:
+ for current = (cl-member-if
+ (lambda (attachment)
+ (equal url (plist-get attachment :url)))
+ (cdr mastodon-media--attachments))
+ ;; fetch from next item in current or use first item if current
+ ;; has only 1 item:
+ return (plist-get (if (= 1 (length current))
+ (cadr mastodon-media--attachments)
+ (cadr current))
+ :url)))
+
+(defun mastodon-tl-next-full-image ()
+ "From full image view buffer, load the toot's next image."
+ (interactive)
+ (let* ((next-url (mastodon-tl--get-next-image-url)))
+ (mastodon-tl--view-image-url next-url
+ (cdr mastodon-media--attachments))))
(defun mastodon-tl-toggle-sensitive-image ()
"Toggle dislay of sensitive image at point."
