Merge branch 'stats-byline' into develop. FIX #414

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")