branch: elpa/mastodon
commit 35a26600afca9bcf6fd033a2a7199a4df048c655
Author: marty hiatt <martianhia...@riseup.net>
Commit: marty hiatt <martianhia...@riseup.net>
reimplement folding via insert body only.
adds a toot-body prop to body only
adds toot-foldable and toot-folded props to whole toot (so can check it at
byline)
shouldn't add any wrong newlines
adds no-byline flag to insert-status
---
lisp/mastodon-tl.el | 188 ++++++++++++++++++++++++++++------------------------
1 file changed, 101 insertions(+), 87 deletions(-)
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 797b355efb..99d6eac7a6 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -1506,7 +1506,8 @@ 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 unfolded)
+ &optional id base-toot detailed-p
+ thread domain unfolded no-byline)
"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,32 +1524,46 @@ JSON of the toot responded to.
DETAILED-P means display more detailed info. For now
this just means displaying toot client.
THREAD means the status will be displayed in a thread view.
-When DOMAIN, force inclusion of user's domain in their handle."
+When DOMAIN, force inclusion of user's domain in their handle.
+UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
+NO-BYLINE means just insert toot body, used for folding."
(let* ((start-pos (point))
(reply-to-id (alist-get 'in_reply_to_id toot))
(after-reply-status-p
(when (and thread reply-to-id)
(mastodon-tl--after-reply-status reply-to-id)))
- (type (alist-get 'type toot)))
- ;; body:
+ (type (alist-get 'type toot))
+ (toot-foldable
+ (and mastodon-tl--fold-toots-at-length
+ (length> body mastodon-tl--fold-toots-at-length))))
(insert
(propertize
(concat
- "\n"
- (if (and after-reply-status-p thread)
- (concat (mastodon-tl--symbol 'replied)
- "\n")
- "")
- (let ((bar (mastodon-tl--symbol 'reply-bar))
- (body (mastodon-tl--fold-body-maybe body unfolded)))
+ (propertize
+ (concat
+ "\n"
+ ;; relpy symbol (broken):
(if (and after-reply-status-p thread)
- (propertize body
- 'line-prefix bar
- 'wrap-prefix bar)
- body))
- " \n"
+ (concat (mastodon-tl--symbol 'replied)
+ "\n")
+ "")
+ ;; actual body:
+ (let ((bar (mastodon-tl--symbol 'reply-bar))
+ (body (if (and toot-foldable (not unfolded))
+ (mastodon-tl--fold-body body)
+ body)))
+ (if (and after-reply-status-p thread)
+ (propertize body
+ 'line-prefix bar
+ 'wrap-prefix bar)
+ body)))
+ 'toot-body t) ;; includes newlines etc. for folding
;; byline:
- (mastodon-tl--byline toot author-byline action-byline detailed-p
domain))
+ "\n"
+ (if no-byline
+ ""
+ (mastodon-tl--byline toot author-byline action-byline
+ detailed-p domain)))
'item-type 'toot
'item-id (or id ; notification's own id
(alist-get 'id toot)) ; toot id
@@ -1560,90 +1575,86 @@ When DOMAIN, force inclusion of user's domain in their
handle."
'item-json toot
'base-toot base-toot
'cursor-face 'mastodon-cursor-highlight-face
- 'notification-type type)
- "\n")
+ 'notification-type type
+ 'toot-foldable toot-foldable
+ 'toot-folded (and toot-foldable (not unfolded)))
+ (if no-byline "" "\n"))
(when mastodon-tl--display-media-p
(mastodon-media--inline-images start-pos (point)))))
-(defun mastodon-tl--fold-body-maybe (body &optional unfolded)
+(defun mastodon-tl--fold-body (body)
"Fold toot BODY if it is very long.
Folding decided by `mastodon-tl--fold-toots-at-length'."
- (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)
- nil :no-newline))
- (display (concat (substring body 0
- mastodon-tl--fold-toots-at-length)
- heading)))
- (propertize display
- 'read-more body))))
+ (let* ((heading (mastodon-search--format-heading
+ (mastodon-tl--make-link "READ MORE" 'read-more)
+ nil :no-newline))
+ (display (concat (substring body 0
+ mastodon-tl--fold-toots-at-length)
+ heading)))
+ (propertize display
+ 'read-more body)))
(defun mastodon-tl--unfold-post (&optional fold)
- "Unfold the toot at point if it is folded (read-more)."
+ "Unfold the toot at point if it is folded (read-more).
+FOLD means to fold it instead"
(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)))
- ;; FIXME: handle any point of the item body and byline
- ;; ie if we are inbetween, try moving up or down (and check again?)
- (if (and (not fold)
- (not read-more-p))
- (user-error "No folded item at point?")
+ (let ((at-byline (mastodon-tl--property 'byline :no-move)))
+ (if (save-excursion
+ (when (not at-byline)
+ (mastodon-tl--goto-next-item))
+ (not (mastodon-tl--property 'toot-foldable :no-move)))
+ (user-error "No foldable item at point?")
(let* ((inhibit-read-only t)
- (range (mastodon-tl--find-property-range 'item-json (point)))
- ;; FIXME: we need to reload toot data if we want
- ;; fave/boost/bookmark stats to display correctly. ie if we do
- ;; an action then (un)fold, stats/(*)/etc display incorrectly.
-
- ;; another option may be to check favourited-p/boosted-p prop,
- ;; and then call toot--action-success again with the relevant
- ;; symbol (to insert it after re-display)? as per
- ;; `mastodon-toot--toggle-boost-or-favourite' callback?
-
- ;; or, is it simpler to just not replace the byline? to do that,
- ;; we need to call `mastodont-tl--insert-status' without
- ;; inserting a byline, so that props are all correct...
- (toot (mastodon-tl--property 'item-json)))
- ;; `replace-region-contents' is much too slow, our hack from fedi.el
- ;; is much simpler and much faster:
- (let ((beg (car range))
- (end (cdr range))
- (last-point (point)))
- (save-excursion
- (goto-char beg)
- (delete-region beg end)
- (delete-char 1) ;; prevent newlines accumulating
- (mastodon-tl--toot toot nil nil nil
- (when (not fold) :unfolded)))
- (cond ((or byline
- (and fold
- ;; if point was in area now folded:
- (> last-point
- (+ beg mastodon-tl--fold-toots-at-length))))
- (mastodon-tl--goto-next-item))
- (t
- (goto-char last-point)
- (beginning-of-line))))))))
+ (body-range (mastodon-tl--find-property-range 'toot-body
+ (point) :backward))
+ (toot (mastodon-tl--property 'item-json :no-move))
+ ;; `replace-region-contents' is much too slow, our hack from
+ ;; fedi.el is much simpler and much faster:
+ (beg (car body-range))
+ (end (cdr body-range))
+ (last-point (point))
+ (point-after-fold (> last-point
+ (+ beg mastodon-tl--fold-toots-at-length))))
+ ;; save-excursion here useless actually:
+
+ ;; FIXME: because point goes to top of item, the screen gets scrolled
+ ;; by insertion
+ (goto-char beg)
+ (delete-region beg end)
+ (delete-char 1) ;; prevent newlines accumulating
+ ;; insert toot body:
+ (mastodon-tl--toot toot nil nil nil
+ (not fold) ;; (if fold :folded :unfolded)
+ :no-byline)
+ ;; set toot-folded prop on entire toot (not just body):
+ (let ((toot-range ;; post fold action range:
+ (mastodon-tl--find-property-range 'item-json
+ (point) :backward)))
+ (add-text-properties (car toot-range)
+ (cdr toot-range)
+ `(toot-folded ,fold)))
+ ;; try to leave point somewhere sane:
+ (cond ((or at-byline
+ (and fold
+ point-after-fold)) ;; point was in area now folded
+ (ignore-errors (forward-line -1)) ;; in case we are btw
+ (mastodon-tl--goto-next-item)) ;; goto byline
+ (t
+ (goto-char last-point)
+ (when point-after-fold ;; point was in READ MORE heading:
+ (beginning-of-line))))
+ (message (format "%s" (if fold "Fold" "Unfold")))))))
(defun mastodon-tl--fold-post ()
"Fold post at point, if it is too long."
(interactive)
- (mastodon-tl--unfold-post :fold))
+ (mastodon-tl--unfold-post t))
(defun mastodon-tl--fold-post-toggle ()
"Toggle the folding status of the toot at point."
(interactive)
- (let* ((byline-p (mastodon-tl--property 'byline))
- (read-more-p (save-excursion
- (when byline-p
- (previous-line)
- (beginning-of-line))
- (mastodon-tl--property 'read-more))))
- (mastodon-tl--unfold-post (if (not read-more-p) :fold))))
+ (let* ((folded (mastodon-tl--property 'toot-folded :no-move)))
+ (mastodon-tl--unfold-post (not folded))))
;; from mastodon-alt.el:
(defun mastodon-tl--toot-for-stats (&optional toot)
@@ -1705,19 +1716,22 @@ 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 unfolded)
+(defun mastodon-tl--toot (toot &optional detailed-p thread domain
+ unfolded no-byline)
"Format TOOT and insert it into the buffer.
DETAILED-P means display more detailed info. For now
this just means displaying toot client.
THREAD means the status will be displayed in a thread view.
-When DOMAIN, force inclusion of user's domain in their handle."
+When DOMAIN, force inclusion of user's domain in their handle.
+UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
+NO-BYLINE means just insert toot body, used for folding."
(mastodon-tl--insert-status
toot
(mastodon-tl--clean-tabs-and-nl (if (mastodon-tl--has-spoiler toot)
(mastodon-tl--spoiler toot)
(mastodon-tl--content toot)))
'mastodon-tl--byline-author 'mastodon-tl--byline-boosted
- nil nil detailed-p thread domain unfolded))
+ nil nil detailed-p thread domain unfolded no-byline))
(defun mastodon-tl--timeline (toots &optional thread domain)
"Display each toot in TOOTS.
