diff options
Diffstat (limited to 'lisp/mastodon-tl.el')
| -rw-r--r-- | lisp/mastodon-tl.el | 163 |
1 files changed, 111 insertions, 52 deletions
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2574a0f..17f7ae5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -89,6 +89,8 @@ (autoload 'mastodon-search--insert-heading "mastodon-search") (autoload 'mastodon-media--process-full-sized-image-response "mastodon-media") (autoload 'mastodon-search--trending-statuses "mastodon-search") +(autoload 'mastodon-search--format-heading "mastodon-search") +(autoload 'mastodon-toot--with-toot-item "mastodon-toot") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) @@ -219,6 +221,13 @@ respects the user's `browse-url' settings." See `mastodon-tl--get-remote-local-timeline' for view remote local domains." :type '(repeat string)) + +(defcustom mastodon-tl--fold-toots-at-length 1200 + "Length, in characters, to fold a toot at. +Longer toots will be folded and the remainder replaced by a +\"read more\" button. If the value is nil, don't fold at all." + :type '(integer)) + ;;; VARIABLES @@ -239,9 +248,8 @@ If nil `(point-min)' is used instead.") "The timer that, when set will scan the buffer to update the timestamps.") (defvar mastodon-tl--horiz-bar - (if (char-displayable-p ?―) - (make-string 12 ?―) - (make-string 12 ?-))) + (make-string 12 + (if (char-displayable-p ?―) ?― ?-))) ;;; KEYMAPS @@ -396,14 +404,18 @@ Optionally start from POS." (current-buffer)))) (if npos (if (not - ;; (get-text-property npos 'item-id) ; toots, users, not tags (get-text-property npos 'item-type)) ; generic + ;; FIXME let's make refresh &optional and only call refresh/recur + ;; if non-nil: (mastodon-tl--goto-item-pos find-pos refresh npos) (goto-char npos) ;; force display of help-echo on moving to a toot byline: (mastodon-tl--message-help-echo)) - ;; FIXME: this doesn't work, as the funcall doesn't return if we - ;; run into an endless refresh loop + ;; FIXME: doesn't work, the funcall doesn't return if in an endless + ;; refresh loop. + ;; either let-bind `max-lisp-eval-depth' and try to error handle when it + ;; errors, or else set up a counter, and error when it gets to high + ;; (like >2 would already be too much) (condition-case nil (funcall refresh) (error "No more items"))))) @@ -976,6 +988,8 @@ the toot)." LINK-TYPE is the type of link to produce." (let ((help-text (cond ((eq link-type 'content-warning) "Toggle hidden text") + ((eq link-type 'read-more) + "Toggle full post") (t (error "Unknown link type %s" link-type))))) (propertize string @@ -1017,6 +1031,8 @@ Used for hitting RET on a given link." "Search for account returned nothing. Perform URL lookup?") (mastodon-url-lookup (get-text-property position 'shr-url)) (message "Unable to find account.")))))))) + ((eq link-type 'read-more) + (mastodon-tl--unfold-post)) (t (error "Unknown link type %s" link-type))))) @@ -1357,7 +1373,7 @@ displayed when the duration is smaller than a minute)." cell)) options-alist))) (if (null poll) - (message "No poll here.") + (user-error "No poll here") (list ;; var "option" = just the cdr, a cons of option number and desc (cdr (assoc (completing-read "Poll option to vote for: " @@ -1369,7 +1385,7 @@ displayed when the duration is smaller than a minute)." "If there is a poll at point, prompt user for OPTION to vote on it." (interactive (mastodon-tl--read-poll-option)) (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'item-json))) - (message "No poll here.") + (user-error "No poll here") (let* ((toot (mastodon-tl--property 'item-json)) (poll (mastodon-tl--field 'poll toot)) (poll-id (alist-get 'id poll)) @@ -1490,7 +1506,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (string= reply-to-id prev-id))) (defun mastodon-tl--insert-status (toot body author-byline action-byline - &optional id base-toot detailed-p thread domain) + &optional id base-toot detailed-p thread domain unfolded) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. AUTHOR-BYLINE is an optional function for adding the author @@ -1523,12 +1539,13 @@ When DOMAIN, force inclusion of user's domain in their handle." (concat (mastodon-tl--symbol 'replied) "\n") "") - (if (and after-reply-status-p thread) - (let ((bar (mastodon-tl--symbol 'reply-bar))) + (let ((bar (mastodon-tl--symbol 'reply-bar)) + (body (mastodon-tl--fold-body-maybe body unfolded))) + (if (and after-reply-status-p thread) (propertize body 'line-prefix bar - 'wrap-prefix bar)) - body) + 'wrap-prefix bar) + body)) " \n" ;; byline: (mastodon-tl--byline toot author-byline action-byline detailed-p domain)) @@ -1548,6 +1565,47 @@ When DOMAIN, force inclusion of user's domain in their handle." (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) +(defun mastodon-tl--fold-body-maybe (body &optional unfolded) + "Fold toot BODY if it is very long." + (if (or unfolded + (eq nil mastodon-tl--fold-toots-at-length) + (length< body mastodon-tl--fold-toots-at-length)) + body + (let* ((heading (mastodon-search--format-heading + (mastodon-tl--make-link + "READ MORE" + 'read-more))) + (display (concat (substring body 0 + mastodon-tl--fold-toots-at-length) + heading))) + (propertize display + 'read-more body)))) + +(defun mastodon-tl--unfold-post () + "Unfold the toot at point if it is folded (read-more)." + (interactive) + ;; if at byline, must search backwards: + (let* ((byline (mastodon-tl--property 'byline :no-move)) + (read-more-p (mastodon-tl--find-property-range + 'read-more (point) byline))) + (if (not read-more-p) + (user-error "No folded item at point?") + (let* ((inhibit-read-only t) + (range (mastodon-tl--find-property-range + 'item-json (point))) + (toot (mastodon-tl--property 'item-json))) + ;; `replace-region-contents' is much to slow, our hack from fedi.el + ;; is much simpler and much faster + (let ((beg (car range)) + (end (cdr range))) + (save-excursion + (goto-char beg) + (delete-region beg end) + (mastodon-tl--toot toot nil nil nil :unfolded)) + ;; move point to line where text formerly ended: + (goto-char end) + (beginning-of-line)))))) + ;; from mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) "Return the TOOT on which we want to extract stats. @@ -1608,7 +1666,7 @@ To disable showing the stats, customize (and (null (mastodon-tl--field 'in_reply_to_id toot)) (not (mastodon-tl--field 'rebloged toot)))) -(defun mastodon-tl--toot (toot &optional detailed-p thread domain) +(defun mastodon-tl--toot (toot &optional detailed-p thread domain unfolded) "Format TOOT and insert it into the buffer. DETAILED-P means display more detailed info. For now this just means displaying toot client. @@ -1620,7 +1678,7 @@ When DOMAIN, force inclusion of user's domain in their handle." (mastodon-tl--spoiler toot) (mastodon-tl--content toot))) 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted - nil nil detailed-p thread domain)) + nil nil detailed-p thread domain unfolded)) (defun mastodon-tl--timeline (toots &optional thread domain) "Display each toot in TOOTS. @@ -1953,7 +2011,7 @@ ID is that of the toot to view." #'mastodon-tl--update-toot) (mastodon-tl--toot toot :detailed-p) (goto-char (point-min)) - (mastodon-tl--goto-next-item))))) + (mastodon-tl--goto-next-item :no-refresh))))) (defun mastodon-tl--update-toot (json) "Call `mastodon-tl--single-toot' on id found in JSON." @@ -1975,42 +2033,43 @@ view all branches of a thread." (defun mastodon-tl--thread (&optional id) "Open thread buffer for toot at point or with ID." (interactive) - (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move))) - (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move)))) - (if (or (string= type "follow_request") - (string= type "follow")) ; no can thread these - (user-error "No thread") - (let* ((endpoint (format "statuses/%s/context" id)) - (url (mastodon-http--api endpoint)) - (buffer (format "*mastodon-thread-%s*" id)) - (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: - (mastodon-http--api (concat "statuses/" id)) - nil :silent)) - (context (mastodon-http--get-json url nil :silent))) - (if (equal (caar toot) 'error) - (user-error "Error: %s" (cdar toot)) - (when (member (alist-get 'type toot) '("reblog" "favourite")) - (setq toot (alist-get 'status toot))) - (if (> (+ (length (alist-get 'ancestors context)) - (length (alist-get 'descendants context))) - 0) - ;; if we have a thread: - (with-mastodon-buffer buffer #'mastodon-mode nil - (let ((marker (make-marker))) - (mastodon-tl--set-buffer-spec buffer endpoint - #'mastodon-tl--thread) - (mastodon-tl--timeline (alist-get 'ancestors context) :thread) - (goto-char (point-max)) - (move-marker marker (point)) - ;; print re-fetched toot: - (mastodon-tl--toot toot :detailed-p :thread) - (mastodon-tl--timeline (alist-get 'descendants context) - :thread) - ;; put point at the toot: - (goto-char (marker-position marker)) - (mastodon-tl--goto-next-item))) - ;; else just print the lone toot: - (mastodon-tl--single-toot id))))))) + (mastodon-toot--with-toot-item + (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move)))) + (if (or (string= type "follow_request") + (string= type "follow")) ; no can thread these + (user-error "No thread") + (let* ((endpoint (format "statuses/%s/context" id)) + (url (mastodon-http--api endpoint)) + (buffer (format "*mastodon-thread-%s*" id)) + (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: + (mastodon-http--api (concat "statuses/" id)) + nil :silent)) + (context (mastodon-http--get-json url nil :silent))) + (if (equal (caar toot) 'error) + (user-error "Error: %s" (cdar toot)) + (when (member (alist-get 'type toot) '("reblog" "favourite")) + (setq toot (alist-get 'status toot))) + (if (> (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))) + 0) + ;; if we have a thread: + (with-mastodon-buffer buffer #'mastodon-mode nil + (let ((marker (make-marker))) + (mastodon-tl--set-buffer-spec buffer endpoint + #'mastodon-tl--thread) + (mastodon-tl--timeline (alist-get 'ancestors context) :thread) + (goto-char (point-max)) + (move-marker marker (point)) + ;; print re-fetched toot: + (mastodon-tl--toot toot :detailed-p :thread) + (mastodon-tl--timeline (alist-get 'descendants context) + :thread) + ;; put point at the toot: + (goto-char (marker-position marker)) + (mastodon-tl--goto-next-item))) + ;; else just print the lone toot: + (mastodon-tl--single-toot id)))))))) (defun mastodon-tl--mute-thread () "Mute the thread displayed in the current buffer. |