diff options
| -rw-r--r-- | lisp/mastodon-tl.el | 44 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 75 |
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")))) |