diff options
| -rw-r--r-- | lisp/mastodon-profile.el | 37 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 56 | ||||
| -rw-r--r-- | lisp/mastodon.el | 1 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 10 |
4 files changed, 79 insertions, 25 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 9b0e51c..9dc5a82 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -25,17 +25,11 @@ ;;; Commentary: -;; mastodon-profile.el generates stream of users toots. -;; To fix -;; 1. Render Image at top of frame [x] -;; 2. Get toot author [x] -;; 3. Load more toots [x] -;; Later -;; 1. List followers [x] -;; 2. List people they follow [x] -;; 3. Option to follow -;; 4. wheather they follow you or not -;; 5. Show only Media +;; mastodon-profile.el generates a stream of users toots. +;; To add +;; - Option to follow +;; - wheather they follow you or not +;; - Show only Media ;;; Code: @@ -81,6 +75,7 @@ " TOOTS \n" " ------------\n") 'success)) + (setq mastodon-tl-update-point (point)) (mastodon-tl--timeline json))) (mastodon-tl--goto-next-toot))) @@ -120,7 +115,6 @@ FIELD is used to identify regions under 'account" tootv)) (mastodon-media--inline-images)) - (defun mastodon-profile--get-following () "Request a list of those who the user under point follows." (interactive) @@ -155,6 +149,25 @@ STRING is an endpoint, either following or followers." ,'mastodon-profile--add-author-bylines)) (mastodon-profile--add-author-bylines tootv)))) +(defun mastodon-profile--search-account-by-handle (handle) + "Return an account based on a users HANDLE. + +If the handle does not match a search return then retun NIL." + (let* ((handle (if (string= "@" (substring handle 0 1)) + (substring handle 1 (length handle)) + handle)) + (matching-account + (remove-if-not + (lambda(x) (string= (cdr (assoc 'acct x)) handle)) + (mastodon-http--get-json + (mastodon-http--api (format "accounts/search?q=%s" handle)))))) + (when (equal 1 (length matching-account)) + (elt matching-account 0)))) + +(defun mastodon-profile--account-from-id (user-id) + "Request an account object relating to a USER-ID from Mastodon." + (mastodon-http--get-json + (mastodon-http--api (format "accounts/%s" user-id)))) (provide 'mastodon-profile) ;;; mastodon-profile.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 00dc50c..4d6d0b6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -72,6 +72,12 @@ width fonts when rendering HTML text")) (image-type-available-p 'imagemagick) "A boolean value stating whether to show avatars in timelines.") +(defvar mastodon-tl-update-point nil + "When updating a mastodon buffer this is where new toots will be inserted. + +If nil `(point-min)' is used instead.") +(make-variable-buffer-local 'mastodon-tl-update-point) + (defvar mastodon-tl--display-media-p t "A boolean value stating whether to show media in timelines.") @@ -244,9 +250,11 @@ Optionally start from POS." 'face 'mastodon-handle-face 'mouse-face 'highlight ;; TODO: Replace url browsing with native profile viewing - 'mastodon-tab-stop 'shr-url + 'mastodon-tab-stop 'user-handle + 'account (cdr (assoc 'account toot)) 'shr-url profile-url - 'keymap mastodon-tl--shr-map-replacement + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" handle) 'help-echo (concat "Browse user profile of @" handle)) ")"))) @@ -414,12 +422,15 @@ links in the text. If TOOT is nil no parsing occurs." (;; 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))) - + (let ((maybe-userid (mastodon-tl--extract-userid-toot + toot maybe-userhandle))) + (setq mastodon-tab-stop-type 'user-handle + keymap mastodon-tl--link-keymap + help-echo (concat "Browse user profile of " maybe-userhandle) + extra-properties (append + (list 'mastodon-handle maybe-userhandle) + (when maybe-userid + (list 'acccount-id maybe-userid)))))) ;; Anything else: (t ;; Leave it as a url handled by shr.el. @@ -435,6 +446,19 @@ links in the text. If TOOT is nil no parsing occurs." 'help-echo help-echo) extra-properties)))) +(defun mastodon-tl--extract-userid-toot (toot acct) + "Extract a user id for an ACCT from mentions in a TOOT." + (let* ((mentions (append (cdr (assoc 'mentions toot)) nil)) + (mention (pop mentions)) + (short-acct (substring acct 1 (length acct))) + return) + (while mention + (when (string= (cdr (assoc 'acct mention)) + short-acct) + (setq return (cdr (assoc 'id mention)))) + (setq mention (pop mentions))) + return)) + (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. @@ -520,6 +544,20 @@ LINK-TYPE is the type of link to produce." (mastodon-tl--toggle-spoiler-text position)) ((eq link-type 'hashtag) (mastodon-tl--show-tag-timeline (get-text-property position 'mastodon-tag))) + ((eq link-type 'user-handle) + (let ((account-json (get-text-property position 'account)) + (account-id (get-text-property position 'account-id))) + (cond + (account-json + (mastodon-profile--make-author-buffer + account-json)) + (account-id + (mastodon-profile--make-author-buffer + (mastodon-profile--account-from-id account-id))) + (t + (mastodon-profile--make-author-buffer + (mastodon-profile--search-account-by-handle + (get-text-property position 'mastodon-handle))))))) (t (error "unknown link type %s" link-type))))) @@ -902,7 +940,7 @@ from the start if it is nil." (json (mastodon-tl--updated-json endpoint id))) (when json (let ((inhibit-read-only t)) - (goto-char (point-min)) + (goto-char (or mastodon-tl-update-point (point-min))) (funcall update-function json))))) (defun mastodon-tl--init (buffer-name endpoint update-function) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 1b040a9..c71623c 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -50,6 +50,7 @@ (autoload 'mastodon-toot--toggle-favourite "mastodon-toot") (autoload 'mastodon-profile--get-next-author "mastodon-profile") (autoload 'mastodon-notifications--get "mastodon-notifications") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (defgroup mastodon nil "Interface with Mastodon." diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index b2f51c7..f7c6091 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -266,7 +266,9 @@ a string or a numeric." | Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) - 'shr-url)) + 'user-handle)) + (should (string= (get-text-property handle-location 'mastodon-handle byline) + "@acct42@example.space")) (should (equal (get-text-property handle-location 'help-echo byline) "Browse user profile of @acct42@example.space")))))) @@ -364,11 +366,11 @@ a string or a numeric." | 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)) + 'user-handle)) (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)) + 'user-handle)) (should (equal (get-text-property handle2-location 'help-echo byline) "Browse user profile of @acct43@example.space")))))) @@ -946,7 +948,7 @@ constant." mastodon-tl-test-base-toot))) (mention-location 11)) (should (eq (get-text-property mention-location 'mastodon-tab-stop rendered) - 'shr-url)) + 'user-handle)) (should (equal (get-text-property mention-location 'help-echo rendered) "Browse user profile of @foo@bar.example")))) |