diff options
author | Alexander Griffith <griffitaj@gmail.com> | 2018-03-17 11:59:22 -0400 |
---|---|---|
committer | Johnson Denen <johnson.denen@gmail.com> | 2018-08-10 22:20:04 -0400 |
commit | df32beb187aa7cc360324a75c802165aba016aeb (patch) | |
tree | 3f86edd1a2b5761538063a46ac48405e3f0f10e8 /lisp | |
parent | 2346da19a129b27f2dc68677522475f145adde50 (diff) |
Adjusted mastodon-tl.el to open user profiles in emacs. (#189)
* Adjusted mastodon-tl.el to open user profiles in emacs.
This also fixes an issue in user profiles where new statuses were insert at the above rather than below the user profile header.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/mastodon-profile.el | 37 | ||||
-rw-r--r-- | lisp/mastodon-tl.el | 56 | ||||
-rw-r--r-- | lisp/mastodon.el | 1 |
3 files changed, 73 insertions, 21 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." |