diff options
| -rw-r--r-- | lisp/mastodon-media.el | 34 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 31 |
2 files changed, 63 insertions, 2 deletions
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\". |