Make users handles tabstops (#188) Closes #166

* User ids in the body are tab stops.

* Make user handles in byline also links to profile.

2 files changed, 101 insertions, 18 deletions

diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 6711351..4790589 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -231,6 +231,7 @@ Optionally start from POS."
   (let* ((account (cdr (assoc 'account toot)))
          (handle (cdr (assoc 'acct account)))
          (name (cdr (assoc 'display_name account)))
+         (profile-url (cdr (assoc 'url account)))
          (avatar-url (cdr (assoc 'avatar account))))
     ;; TODO: Once we have a view for a user (e.g. their posts
     ;; timeline) make this a tab-stop and attach an action
@@ -238,10 +239,16 @@ Optionally start from POS."
      (when (and mastodon-tl--show-avatars-p mastodon-tl--display-media-p)
        (mastodon-media--get-avatar-rendering avatar-url))
      (propertize name 'face 'mastodon-display-name-face)
-     (propertize (concat " (@"
-                         handle
-                         ")")
-                 'face 'mastodon-handle-face))))
+     " ("
+     (propertize (concat "@" handle)
+                 'face 'mastodon-handle-face
+                 'mouse-face 'highlight
+		 ;; TODO: Replace url browsing with native profile viewing
+		 'mastodon-tab-stop 'shr-url
+		 'shr-url profile-url
+		 'keymap mastodon-tl--shr-map-replacement
+		 'help-echo (concat "Browse user profile of @" handle))
+     ")")))
 
 (defun mastodon-tl--byline-boosted (toot)
   "Add byline for boosted data from TOOT."
@@ -328,7 +335,7 @@ TIME-STAMP is assumed to be in the past."
 (defun mastodon-tl--byline (toot author-byline action-byline)
   "Generate byline for TOOT.
 
-AUTHOR-BYLINE is function for adding the author portion of 
+AUTHOR-BYLINE is function for adding the author portion of
 the byline that takes one variable.
 ACTION-BYLINE is a function for adding an action, such as boosting
 favouriting and following to the byline. It also takes a single function. By default
@@ -394,14 +401,24 @@ links in the text."
                                         (url-host toot-url))
                               mastodon-instance-url))
          (maybe-hashtag (mastodon-tl--extract-hashtag-from-url
-                         url toot-instance-url)))
-    ;; TODO: Recognize user handles
+                         url toot-instance-url))
+         (maybe-userhandle (mastodon-tl--extract-userhandle-from-url
+                            url (buffer-substring-no-properties start end))))
     (cond (;; Hashtags:
            maybe-hashtag
            (setq mastodon-tab-stop-type 'hashtag
                  keymap mastodon-tl--link-keymap
                  help-echo (concat "Browse tag #" maybe-hashtag)
                  extra-properties (list 'mastodon-tag maybe-hashtag)))
+
+          (;; User handles:
+           maybe-userhandle
+           ;; Until we have native profile page viewing we leave these as HTML
+           ;; links.
+           (setq mastodon-tab-stop-type 'shr-url
+                 keymap mastodon-tl--shr-map-replacement
+                 help-echo (concat "Browse user profile of " maybe-userhandle)))
+
           ;; Anything else:
           (t
            ;; Leave it as a url handled by shr.el.
@@ -417,6 +434,17 @@ links in the text."
                                 'help-echo help-echo)
                           extra-properties))))
 
+(defun mastodon-tl--extract-userhandle-from-url (url buffer-text)
+  "Returns the user hande the URL points to or nil if it is not a profile link.
+
+BUFFER-TEXT is the text covered by the link with URL, for a user profile
+this should be of the form <at-sign><user id>, e.g. \"@Gargon\"."
+  (let ((parsed-url (url-generic-parse-url url)))
+    (when (and (string= "@" (substring buffer-text 0 1))
+               (string= (downcase buffer-text)
+                        (downcase (substring (url-filename parsed-url) 1))))
+      (concat buffer-text "@" (url-host parsed-url)))))
+
 (defun mastodon-tl--extract-hashtag-from-url (url instance-url)
   "Returns the hashtag that URL points to or nil if URL is not a tag link.
 
@@ -563,7 +591,7 @@ message is a link which unhides/hides the main body."
   "Display the content and byline of a timeline element.
 
 BODY will form the section of the toot above the byline.
-AUTHOR-BYLINE is an optional function for adding the author portion of 
+AUTHOR-BYLINE is an optional function for adding the author portion of
 the byline that takes one variable. By default it is `mastodon-tl--byline-author'
 ACTION-BYLINE is also an optional function for adding an action, such as boosting
 favouriting and following to the byline. It also takes a single function. By default
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index 1a10614..b2f51c7 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -256,13 +256,19 @@ a string or a numeric."
       (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 mastodon-tl-test-base-toot
+      (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot
                                              'mastodon-tl--byline-author
                                              'mastodon-tl--byline-boosted))
-                       "
+	    (handle-location 20))
+	(should (string= (substring-no-properties
+			  byline)
+			 "
  | Account 42 (@acct42@example.space) 2999-99-99 00:11:22
-  ------------")))))
+  ------------"))
+	(should (eq (get-text-property handle-location 'mastodon-tab-stop byline)
+                'shr-url))
+	(should (equal (get-text-property handle-location 'help-echo byline)
+                   "Browse user profile of @acct42@example.space"))))))
 
 (ert-deftest mastodon-tl--byline-regular-with-avatar ()
   "Should format the regular toot correctly."
@@ -348,13 +354,23 @@ a string or a numeric."
       (mock (date-to-time original-timestamp) => '(3 4))
       (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time")
 
-      (should (string= (substring-no-properties
-                        (mastodon-tl--byline toot
-                                             'mastodon-tl--byline-author
-                                             'mastodon-tl--byline-boosted))
-                      "
+      (let ((byline (mastodon-tl--byline toot
+					 '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) Boosted Account 43 (@acct43@example.space) original time
-  ------------")))))
+  ------------"))
+	(should (eq (get-text-property handle1-location 'mastodon-tab-stop byline)
+                'shr-url))
+	(should (equal (get-text-property handle1-location 'help-echo byline)
+		       "Browse user profile of @acct42@example.space"))
+	(should (eq (get-text-property handle2-location 'mastodon-tab-stop byline)
+                'shr-url))
+	(should (equal (get-text-property handle2-location 'help-echo byline)
+                   "Browse user profile of @acct43@example.space"))))))
 
 (ert-deftest mastodon-tl--byline-reblogged-with-avatars ()
   "Should format the reblogged toot correctly."
@@ -910,3 +926,42 @@ constant."
   (should (null (mastodon-tl--extract-hashtag-from-url
 		  "https://example.org/@userid"
 		  "https://example.org"))))
+
+(ert-deftest mastodon-tl--userhandles ()
+  "Should recognise iserhandles in a toot and add the required properties to it."
+  ;; Travis's Emacs doesn't have libxml so we fake things by inputting
+  ;; propertized text and stubbing shr-render-region
+  (let* ((fake-input-text
+          (concat "mention: "
+                  (propertize
+                   "@foo"
+                   'shr-url "https://bar.example/@foo"
+                   'keymap shr-map
+                   'help-echo "https://bar.example/@foo")
+                  " some text after"))
+         (rendered (with-mock
+                    (stub shr-render-region => nil)
+                    (mastodon-tl--render-text
+                     fake-input-text
+                     mastodon-tl-test-base-toot)))
+         (mention-location 11))
+    (should (eq (get-text-property mention-location 'mastodon-tab-stop rendered)
+                'shr-url))
+    (should (equal (get-text-property mention-location 'help-echo rendered)
+                   "Browse user profile of @foo@bar.example"))))
+
+(ert-deftest mastodon-tl--extract-userhandle-from-url-correct-case ()
+  (should (equal (mastodon-tl--extract-userhandle-from-url
+                  "https://example.org/@someuser"
+                  "@SomeUser")
+                 "@SomeUser@example.org")))
+
+(ert-deftest mastodon-tl--extract-userhandle-from-url-missing-at-in-text ()
+  (should (null (mastodon-tl--extract-userhandle-from-url
+                 "https://example.org/@someuser"
+                 "SomeUser"))))
+
+(ert-deftest mastodon-tl--extract-userhandle-from-url-query-in-url ()
+  (should (null (mastodon-tl--extract-userhandle-from-url
+                 "https://example.org/@someuser?shouldnot=behere"
+                 "SomeUser"))))