branch: elpa/mastodon
commit 5704193a0209b0238190af76078b5aab0b6417c4
Merge: 98351a7c4f 2b5b5cdd21
Author: marty hiatt <martianhia...@riseup.net>
Commit: marty hiatt <martianhia...@riseup.net>
Merge branch 'develop'
---
lisp/mastodon-media.el | 39 +++++++++++++++++++++++++
lisp/mastodon-tl.el | 78 ++++++++++++++++++++++++++++++++++++++++++++++----
lisp/mastodon.el | 7 +++--
mastodon-index.org | 3 ++
4 files changed, 119 insertions(+), 8 deletions(-)
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 9dd22f46d3..ff406339b8 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -177,6 +177,45 @@ 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
+ (add-text-properties (point-min) (point-max)
+ `( display ,image
+ keymap ,(if (boundp 'shr-image-map)
+ shr-image-map
+ shr-map)
+ image-url ,url
+ shr-url ,url))
+ (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 856325e8a5..4034ebf063 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -36,6 +36,7 @@
(require 'cl-lib)
(require 'mastodon-iso)
(require 'mpv nil :no-error)
+(require 'url-cache)
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-notifications-get "mastodon")
@@ -86,6 +87,7 @@
(autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ;
for search pagination
(autoload 'mastodon-http--get-response "mastodon-http")
(autoload 'mastodon-search--insert-heading "mastodon-search")
+(autoload 'mastodon-media--process-full-sized-image-response "mastodon-media")
(defvar mastodon-toot--visibility)
(defvar mastodon-toot-mode)
@@ -96,6 +98,8 @@
(defvar mastodon-instance-url)
(defvar mastodon-toot-timestamp-format)
(defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this
+(defvar mastodon-media--enable-image-caching)
+
(defvar mastodon-mode-map)
@@ -118,6 +122,11 @@ By default fixed width fonts are used."
:type '(boolean :tag "Enable using proportional rather than fixed \
width fonts when rendering HTML text"))
+(defcustom mastodon-tl--no-fill-on-render nil
+ "Non-nil to disable filling by shr.el while rendering toot body.
+Use this if your setup isn't compatible with shr's window width filling."
+ :type '(boolean))
+
(defcustom mastodon-tl--display-media-p t
"A boolean value stating whether to show media in timelines."
:type 'boolean)
@@ -195,6 +204,14 @@ re-load mastodon.el, or restart Emacs."
"A list of up to four tags for use with
`mastodon-tl--followed-tags-timeline'."
:type '(repeat string))
+(defcustom mastodon-tl--load-full-sized-images-in-emacs t
+ "Whether to load full-sized images inside Emacs.
+Full-sized images are loaded when you hit return on or click on
+an image in a timeline.
+If nil, mastodon.el will instead call `shr-browse-image', which
+respects the user's `browse-url' settings."
+ :type '(boolean))
+
;;; VARIABLES
@@ -262,7 +279,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)
@@ -389,12 +406,14 @@ Optionally start from POS."
(funcall refresh)
(error "No more items")))))
-(defun mastodon-tl--goto-next-item ()
+(defun mastodon-tl--goto-next-item (&optional no-refresh)
"Jump to next item.
-Load more items it no next item."
+Load more items it no next item.
+NO-REFRESH means do no not try to load more items if no next item
+found."
(interactive)
(mastodon-tl--goto-item-pos 'next-single-property-change
- 'mastodon-tl--more))
+ (unless no-refresh 'mastodon-tl--more)))
(defun mastodon-tl--goto-prev-item ()
"Jump to previous item.
@@ -763,7 +782,9 @@ links in the text. If TOOT is nil no parsing occurs."
(insert string)
(let ((shr-use-fonts mastodon-tl--enable-proportional-fonts)
(shr-width (when mastodon-tl--enable-proportional-fonts
- (- (window-width) 3))))
+ (if mastodon-tl--no-fill-on-render
+ 0
+ (- (window-width) 3)))))
(shr-render-region (point-min) (point-max)))
;; Make all links a tab stop recognized by our own logic, make things
point
;; to our own logic (e.g. hashtags), and update keymaps where needed:
@@ -989,6 +1010,22 @@ content should be hidden."
(t
(mastodon-tl--toggle-spoiler-text (car spoiler-range))))))
+(defun mastodon-tl--toggle-spoiler-in-thread ()
+ "Toggler content warning for all posts in current thread."
+ (interactive)
+ (let ((thread-p (eq (mastodon-tl--buffer-property 'update-function)
+ 'mastodon-tl--thread)))
+ (if (not thread-p)
+ (user-error "Not in a thread")
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (equal "No more items" ; improve this hack test!
+ (mastodon-tl--goto-next-item :no-refresh)))
+ (let* ((json (mastodon-tl--property 'item-json :no-move))
+ (cw (alist-get 'spoiler_text json)))
+ (when (not (equal "" cw))
+ (mastodon-tl--toggle-spoiler-text-in-toot))))))))
+
(defun mastodon-tl--clean-tabs-and-nl (string)
"Remove tabs and newlines from STRING."
(replace-regexp-in-string "[\t\n ]*\\'" "" string))
@@ -1096,6 +1133,28 @@ 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 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)
+ (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
@@ -1272,12 +1331,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\".
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 4928bf1d26..46674500b0 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -455,6 +455,10 @@ Calls `mastodon-tl--get-buffer-type', which see."
(mastodon-tl--get-buffer-type))))))
(switch-to-buffer choice)))
+(defun mastodon--url-at-point ()
+ "`thing-at-point' provider function."
+ (get-text-property (point) 'shr-url))
+
(defun mastodon-mode-hook-fun ()
"Function to add to `mastodon-mode-hook'."
(when (require 'emojify nil :noerror)
@@ -467,8 +471,7 @@ Calls `mastodon-tl--get-buffer-type', which see."
;; make `thing-at-point' functions work:
(setq-local thing-at-point-provider-alist
(append thing-at-point-provider-alist
- '((url . eww--url-at-point)))))
-
+ '((url . mastodon--url-at-point)))))
;;;###autoload
(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
diff --git a/mastodon-index.org b/mastodon-index.org
index 35fa77ad3a..0c18aa047d 100644
--- a/mastodon-index.org
+++ b/mastodon-index.org
@@ -135,6 +135,7 @@
| | mastodon-tl--single-toot | View
toot at point in separate buffer. |
| | mastodon-tl--some-followed-tags-timeline |
Prompt for some tags, and open a timeline for them. |
| RET, T | mastodon-tl--thread | Open
thread buffer for toot at point or with ID. |
+| | mastodon-tl--toggle-spoiler-in-thread |
Toggler content warning for all posts in current thread. |
| c | mastodon-tl--toggle-spoiler-text-in-toot |
Toggle the visibility of the spoiler text in the current toot. |
| C-S-b | mastodon-tl--unblock-user | Query
for USER-HANDLE from list of blocked users and unblock that user. |
| | mastodon-tl--unfollow-tag |
Prompt for a followed tag, and unfollow it. |
@@ -142,6 +143,8 @@
| | mastodon-tl--unmute-thread | Mute
the thread displayed in the current buffer. |
| S-RET | mastodon-tl--unmute-user | Query
for USER-HANDLE from list of muted users and unmute that user. |
| u, g | mastodon-tl--update |
Update timeline with new toots. |
+| | mastodon-tl--view-full-image |
Browse full-sized version of image at point in a separate emacs window. |
+| | mastodon-tl--view-full-image-or-play-video | View
full sized version of image at point, or try to play video. |
| | mastodon-tl--view-whole-thread | From
a thread view, view entire thread. |
| t | mastodon-toot |
Update instance with new toot. Content is captured in a new buffer. |
| C-c C-a | mastodon-toot--attach-media |
Prompt for an attachment FILE with DESCRIPTION. |
