diff options
| -rw-r--r-- | lisp/mastodon-tl.el | 93 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 62 |
2 files changed, 109 insertions, 46 deletions
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8588ebd..124d635 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -129,6 +129,11 @@ nil." :group 'mastodon-tl :type '(boolean :tag "Whether to display user avatars in timelines")) +(defcustom mastodon-tl--show-stats t + "Whether to show toot stats (faves, boosts, replies counts)." + :type 'bool + :group 'mastodon-tl) + (defcustom mastodon-tl--symbols '((reply . ("💬" . "R")) (boost . ("🔁" . "B")) @@ -438,26 +443,25 @@ With arg AVATAR, include the account's avatar image." ;; we don't have a tl--buffer-spec yet: (unless (or (string-suffix-p "-followers*" (buffer-name)) (string-suffix-p "-following*" (buffer-name))) - ;; (mastodon-tl--get-endpoint))) - (mastodon-tl--format-faves-count toot))) + (mastodon-tl--format-byline-help-echo toot))) " (" (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) -(defun mastodon-tl--format-faves-count (toot) - "Format a favourites, boosts, replies count for a TOOT. -Used as a help-echo when point is at the start of a byline, i.e. -where `mastodon-tl--goto-next-toot' leaves point. Also displays a -toot's media types and optionally the binding to play moving -image media from the byline." +(defun mastodon-tl--format-byline-help-echo (toot) + "Format a help-echo for byline of TOOT. +Displays a toot's media types and optionally the binding to play +moving image media from the byline. +Used when point is at the start of a byline, i.e. where +`mastodon-tl--goto-next-toot' leaves point." (let* ((toot-to-count (or ;; simply praying this order works @@ -473,19 +477,15 @@ image media from the byline." (string= (alist-get 'type toot-to-count) "follow_request")))) (unless fol-req-p (let* ((media-types (mastodon-tl--get-media-types toot)) - (format-faves (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot-to-count) - (alist-get 'reblogs_count toot-to-count) - (alist-get 'replies_count toot-to-count))) (format-media (when media-types - (format " | media: %s" + (format "media: %s" (mapconcat #'identity media-types " ")))) (format-media-binding (when (and (or (member "video" media-types) (member "gifv" media-types)) (require 'mpv nil :no-error)) (format " | C-RET to view with mpv")))) - (format "%s" (concat format-faves format-media format-media-binding)))))) + (format "%s" (concat format-media format-media-binding)))))) (defun mastodon-tl--get-media-types (toot) "Return a list of the media attachment types of the TOOT at point." @@ -632,7 +632,9 @@ this just means displaying toot client." (mastodon-tl--relative-time-description edited-parsed) edited-parsed))) "") - (propertize "\n ------------\n" 'face 'default)) + (propertize "\n ------------" 'face 'default) + (mastodon-tl--toot-stats toot) + "\n") 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked @@ -1111,6 +1113,59 @@ this just means displaying toot client." (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) +;; from mastodon-alt.el: +(defun mastodon-tl--toot-for-stats (&optional toot) + "Return the TOOT on which we want to extract stats. +If no TOOT is given, the one at point is considered." + (let* ((original-toot (or toot (get-text-property (point) 'toot-json))) + (toot (or (alist-get 'status original-toot) + (when (alist-get 'type original-toot) + original-toot) + (alist-get 'reblog original-toot) + original-toot)) + (type (alist-get 'type (or toot)))) + (unless (member type '("follow" "follow_request")) + toot))) + +(defun mastodon-tl--toot-stats (toot) + "Return a right aligned string (using display align-to). +String is filled with TOOT statistics (boosts, favs, replies). +When the TOOT is a reblog (boost), statistics from reblogged +toots are returned. +To disable showing the stats, customize +`mastodon-tl--show-stats'." + (when mastodon-tl--show-stats + (when-let ((toot (mastodon-tl--toot-for-stats toot))) + (let* ((favourites-count (alist-get 'favourites_count toot)) + (favourited (equal 't (alist-get 'favourited toot))) + (boosts-count (alist-get 'reblogs_count toot)) + (boosted (equal 't (alist-get 'reblogged toot))) + (replies-count (alist-get 'replies_count toot)) + (favourites (format "%s %s" favourites-count (mastodon-tl--symbol 'favourite))) + (boosts (format "%s %s" boosts-count (mastodon-tl--symbol 'boost))) + (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) + (status (concat + (propertize favourites + 'favourited-p favourited + 'favourites-field t + 'favourites-count favourites-count + 'face 'font-lock-comment-face) + (propertize " | " 'face 'font-lock-comment-face) + (propertize boosts + 'boosted-p boosted + 'boosts-field t + 'boosts-count boosts-count + 'face 'font-lock-comment-face) + (propertize " | " 'face 'font-lock-comment-face) + (propertize replies + 'replies-field t + 'replies-count replies-count + 'face 'font-lock-comment-face))) + (status (concat + (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) + status))) + status)))) + ;; POLLS diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 726e21a..a284c25 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -307,15 +307,16 @@ Strict-Transport-Security: max-age=31536000 (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--toot-stats mastodon-tl-test-base-toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - (handle-location 20)) + (handle-location 20)) (should (string= (substring-no-properties - byline) - "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + byline) + "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ ")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) @@ -332,6 +333,7 @@ Strict-Transport-Security: max-age=31536000 (with-mock (stub create-image => '(image "fake data")) (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--toot-stats mastodon-tl-test-base-toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") (should (string= (substring-no-properties @@ -348,15 +350,16 @@ Strict-Transport-Security: max-age=31536000 (toot (cons '(reblogged . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (mastodon-tl--symbol 'boost) => "B") - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--symbol 'boost) => "B") + (mock (mastodon-tl--toot-stats toot) => "") + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -366,15 +369,16 @@ Strict-Transport-Security: max-age=31536000 (toot (cons '(favourited . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (mastodon-tl--symbol 'favourite) => "F") - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (mastodon-tl--symbol 'favourite) => "F") + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--toot-stats toot) => "") + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -385,6 +389,7 @@ Strict-Transport-Security: max-age=31536000 (toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock + (mock (mastodon-tl--toot-stats toot) => "") (mock (date-to-time timestamp) => '(22782 21551)) ;; FIXME this mock refuses to recognise our different args ;; (mock (mastodon-tl--symbol 'favourite) => "F") @@ -413,22 +418,23 @@ Strict-Transport-Security: max-age=31536000 (mock (date-to-time timestamp) => '(1 2)) (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) + (mock (mastodon-tl--toot-stats toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") (let ((byline (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (handle1-location 20) - (handle2-location 65)) + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (handle1-location 20) + (handle2-location 65)) (should (string= (substring-no-properties byline) - "Account 42 (@acct42@example.space) + "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ ")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) - "Browse user profile of @acct42@example.space")) + "Browse user profile of @acct42@example.space")) (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle2-location 'help-echo byline) @@ -449,6 +455,7 @@ Strict-Transport-Security: max-age=31536000 (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + (mock (mastodon-tl--toot-stats toot) => "") (should (string= (substring-no-properties (mastodon-tl--byline toot @@ -474,6 +481,7 @@ Strict-Transport-Security: max-age=31536000 ;; (mock (mastodon-tl--symbol 'favourite) => "F") ;; (mock (mastodon-tl--symbol 'boost) => "B") (mock (mastodon-tl--symbol *) => "?") + (mock (mastodon-tl--toot-stats toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") |