diff options
-rw-r--r-- | README.org | 63 | ||||
-rw-r--r-- | lisp/mastodon-profile.el | 216 | ||||
-rw-r--r-- | lisp/mastodon-tl.el | 11 | ||||
-rw-r--r-- | lisp/mastodon.el | 8 |
4 files changed, 196 insertions, 102 deletions
@@ -77,37 +77,38 @@ Opens a =*mastodon-home*= buffer in the major mode so you can see toots. You wil **** Keybindings -|--------------------------+-----------------------------------------------------------------------------------| -| Key | Action | -|--------------------------+-----------------------------------------------------------------------------------| -| | /In-buffer navigation/ | -| =<space>= | Scroll up (i.e. move down to older items) | -| =<delete>= | Scroll down (i.e. move up to newer items) | -| =<= | Move to beginning of buffer | -| =>= | Move to end of buffer | -| =j= | Go to next item (toot, notification) | -| =k= | Go to previous item (toot, notification) | -| =<tab>= / =h= | Go to the next interesting thing that has an action | -| =<S-tab>= / =l= | Go to the previous interesting thing that has an action | -| | /In-buffer actions/ | -| =?= | Open context menu (if =discover= is available) | -| =c= | Toggle the visibility of sensitive text (if there is text with a content warning) | -| =b= | Boost toot under =point= | -| =f= | Favourite toot under =point= | -| =r= | Reply to toot under =point= | -| =<return>= / =<mouse-2>= | Perform action for the thing under point (or under mouse for =<mouse-2>=) if any | -| =n= | Compose a new toot | -| | /Switching to other buffers and quitting/ | -| =N= | Open buffer with notifications | -| =F= | Open federated timeline | -| =H= | Open home timeline | -| =L= | Open local timeline | -| =U= | Open User Profile | -| =t= | Open thread buffer for toot under =point= | -| =T= | Prompt for tag and open its timeline | -| =q= | Quit mastodon buffer, leave window open | -| =Q= | Quit mastodon buffer and kill window | -|--------------------------+-----------------------------------------------------------------------------------| +|--------------------------+--------------------------------------------------------------------------------------| +| Key | Action | +|--------------------------+--------------------------------------------------------------------------------------| +| | /In-buffer navigation/ | +| =<space>= | Scroll up (i.e. move down to older items) | +| =<delete>= | Scroll down (i.e. move up to newer items) | +| =<= | Move to beginning of buffer | +| =>= | Move to end of buffer | +| =j= | Go to next item (toot, notification) | +| =k= | Go to previous item (toot, notification) | +| =<tab>= / =h= | Go to the next interesting thing that has an action | +| =<S-tab>= / =l= | Go to the previous interesting thing that has an action | +| | /In-buffer actions/ | +| =?= | Open context menu (if =discover= is available) | +| =c= | Toggle the visibility of sensitive text (if there is text with a content warning) | +| =b= | Boost toot under =point= | +| =f= | Favourite toot under =point= | +| =r= | Reply to toot under =point= | +| =<return>= / =<mouse-2>= | Perform action for the thing under point (or under mouse for =<mouse-2>=) if any | +| =n= | Compose a new toot | +| | /Switching to other buffers and quitting/ | +| =N= | Open buffer with notifications | +| =F= | Open federated timeline | +| =H= | Open home timeline | +| =L= | Open local timeline | +| =U= | Open User Profile | +| =P= | Open any users profile (free text entry with autocompletion of users in that status) | +| =t= | Open thread buffer for toot under =point= | +| =T= | Prompt for tag and open its timeline | +| =q= | Quit mastodon buffer, leave window open | +| =Q= | Quit mastodon buffer and kill window | +|--------------------------+--------------------------------------------------------------------------------------| **** Legend diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index fca1bd8..e130c22 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -32,6 +32,40 @@ ;; - Show only Media ;;; Code: +(require 'seq) + +(autoload 'mastodon-http--api "mastodon-http.el") +(autoload 'mastodon-http--get-json "mastodon-http.el") +(autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el") +(autoload 'mastodon-media--inline-images "mastodon-media.el") +(autoload 'mastodon-mode "mastodon.el") +(autoload 'mastodon-tl--byline-author "mastodon-tl.el") +(autoload 'mastodon-tl--goto-next-toot "mastodon-tl.el") +(autoload 'mastodon-tl--property "mastodon-tl.el") +(autoload 'mastodon-tl--render-text "mastodon-tl.el") +(autoload 'mastodon-tl--set-face "mastodon-tl.el") +(autoload 'mastodon-tl--timeline "mastodon-tl.el") + +(defvar mastodon-instance-url) +(defvar mastodon-tl--buffer-spec) +(defvar mastodon-tl--update-point) + +(defvar mastodon-profile--account nil + "The data for the account being described in the current profile buffer.") +(make-variable-buffer-local 'mastodon-profile--account) + +(define-minor-mode mastodon-profile-mode + "Toggle mastodon profile minor mode. + +This minor mode is used for mastodon profile pages and adds a couple of +extra keybindings." + :init-value nil + ;; The mode line indicator. + :lighter " Profile" + ;; The key bindings + :keymap '(((kbd "F") . mastodon-profile--open-followers) + ((kbd "f") . mastodon-profile--open-following)) + :group 'mastodon) (defun mastodon-profile--toot-json () "Get the next toot-json." @@ -40,24 +74,56 @@ (defun mastodon-profile--make-author-buffer (account) "Take a ACCOUNT and inserts a user account into a new buffer." + (mastodon-profile--make-profile-buffer-for + account "statuses" #'mastodon-tl--timeline)) + +(defun mastodon-profile--open-following () + "Open a profile buffer for the current profile showing the accounts +that current profile follows." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-profile-buffer-for + mastodon-profile--account + "following" + #'mastodon-profile--add-author-bylines) + (error "Not in a mastodon profile"))) + +(defun mastodon-profile--open-followers () + "Open a profile buffer for the current profile showing the accounts +following the current profile." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-profile-buffer-for + mastodon-profile--account + "followers" + #'mastodon-profile--add-author-bylines) + (error "Not in a mastodon profile"))) + +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function) (let* ((id (mastodon-profile--account-field account 'id)) - (acct (mastodon-profile--account-field account 'acct)) - (url (mastodon-http--api - (concat "accounts/" - (format "%s" id) - "/statuses" ))) - (buffer (concat "*mastodon-" acct "*")) + (acct (mastodon-profile--account-field account 'acct)) + (url (mastodon-http--api (format "accounts/%s/%s" + id endpoint-type))) + (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) (note (mastodon-profile--account-field account 'note)) (json (mastodon-http--get-json url))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) - (setq mastodon-tl--buffer-spec + (mastodon-profile-mode) + (setq mastodon-profile--account account + mastodon-tl--buffer-spec `(buffer-name ,buffer - endpoint ,(format "accounts/%s/statuses" id) - update-function - ,'mastodon-tl--timeline json)) - (let ((inhibit-read-only t)) + endpoint ,(format "accounts/%s/%s" id endpoint-type) + update-function ,update-function)) + (let* ((inhibit-read-only t) + (is-statuses (string= endpoint-type "statuses")) + (is-followers (string= endpoint-type "followers")) + (is-following (string= endpoint-type "following")) + (endpoint-name (cond + (is-statuses " TOOTS ") + (is-followers " FOLLOWERS ") + (is-following " FOLLOWING ")))) (insert "\n" (mastodon-profile--image-from-account account) @@ -72,12 +138,12 @@ (mastodon-tl--render-text note nil) (mastodon-tl--set-face (concat " ------------\n" - " TOOTS \n" + endpoint-name "\n" " ------------\n") 'success)) - (setq mastodon-tl-update-point (point)) + (setq mastodon-tl--update-point (point)) (mastodon-media--inline-images (point-min) (point)) - (mastodon-tl--timeline json))) + (funcall update-function json))) (mastodon-tl--goto-next-toot))) (defun mastodon-profile--get-toot-author () @@ -92,73 +158,55 @@ (unless (equal url "/avatars/original/missing.png") (mastodon-media--get-media-link-rendering url)))) +(defun mastodon-profile--show-user (user-handle) + "Query user for user id from current status and show that user's profile." + (interactive + (list + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read "User handle: " + user-handles + nil ; predicate + 'confirm)))) + (let ((account (mastodon-profile--lookup-account-in-status + user-handle (mastodon-profile--toot-json)))) + (if account + (mastodon-profile--make-author-buffer account) + (message "Cannot find a user with handle %S" user-handle)))) + (defun mastodon-profile--account-field (account field) "Return FIELD from the ACCOUNT. FIELD is used to identify regions under 'account" (cdr (assoc field account))) -(defun mastodon-profile--get-next-authour-id () - "Get the author id of the next toot." - (interactive) - (get-authour-id (toot-proporties))) - (defun mastodon-profile--add-author-bylines (tootv) "Convert TOOTV into a author-bylines and insert." (let ((inhibit-read-only t)) - (mapc (lambda(toot) - (insert (propertize - (mastodon-tl--byline-author - (list (append (list 'account) toot))) - 'byline 't - 'toot-id (cdr (assoc 'id toot)) 'toot-json toot) - "\n")) + (mapc (lambda (toot) + (let ((start-pos (point))) + (insert "\n" + (propertize + (mastodon-tl--byline-author `((account . ,toot))) + 'byline 't + 'toot-id (cdr (assoc 'id toot)) + 'toot-json toot)) + (mastodon-media--inline-images start-pos (point)) + (insert "\n" + (mastodon-tl--render-text (cdr (assoc 'note toot)) nil) + "\n"))) tootv))) -(defun mastodon-profile--get-following () - "Request a list of those who the user under point follows." - (interactive) - (mastodon-profile--make-follow-buffer "following")) - -(defun mastodon-profile--followers () - "Request a list of those following the user under point." - (interactive) - (mastodon-profile--make-follow-buffer "followers")) - -(defun mastodon-profile--make-follow-buffer (string) - "Make a buffer contining followers or following of user under point. - -STRING is an endpoint, either following or followers." - (let* ((account - (cdr (assoc 'account (mastodon-profile--toot-json)))) - (id (mastodon-profile--account-field - account 'id)) - (acct (mastodon-profile--account-field - account 'acct)) - (buffer (format "*%s-%s*" string acct)) - (tootv (mastodon-http--get-json - (mastodon-http--api (format "accounts/%s/%s" - id string))))) - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "accounts/%s/%s" id string) - update-function - ,'mastodon-profile--add-author-bylines)) - (mastodon-profile--add-author-bylines tootv)))) - -(defun mastodon-profile--search-account-by-handle (handle) +(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." +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)) + (seq-remove + (lambda(x) (not (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)) @@ -169,5 +217,45 @@ If the handle does not match a search return then retun NIL." (mastodon-http--get-json (mastodon-http--api (format "accounts/%s" user-id)))) +(defun mastodon-profile--extract-users-handles (status) + "Return all user handles found in STATUS. + +These include the author, author of reblogged entries and any user mentioned." + (when status + (let ((this-account (cdr (assoc 'account status))) + (mentions (cdr (assoc 'mentions status))) + (reblog (cdr (assoc 'reblog status)))) + (seq-filter + 'stringp + (seq-uniq + (seq-concatenate + 'list + (list (cdr (assoc 'acct this-account))) + (mastodon-profile--extract-users-handles reblog) + (mapcar (lambda (mention) + (cdr (assoc 'acct mention))) + mentions))))))) + +(defun mastodon-profile--lookup-account-in-status (handle status) + "Return account for HANDLE using hints in STATUS if possible." + (let* ((this-account (cdr (assoc 'account status))) + (reblog-account (cdr (assoc 'account (cdr (assoc 'reblog status))))) + (mention-id (seq-some + (lambda (mention) + (when (string= handle + (cdr (assoc 'acct mention))) + (cdr (assoc 'id mention)))) + (cdr (assoc 'mentions status))))) + (cond ((string= handle + (cdr (assoc 'acct this-account))) + this-account) + ((string= handle + (cdr (assoc 'acct reblog-account))) + reblog-account) + (mention-id + (mastodon-profile--account-from-id mention-id)) + (t + (mastodon-profile--search-account-by-handle handle))))) + (provide 'mastodon-profile) ;;; mastodon-profile.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5411d42..61a0f1e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -39,6 +39,9 @@ (autoload 'mastodon-media--get-media-link-rendering "mastodon-media") (autoload 'mastodon-media--inline-images "mastodon-media") (autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-profile--account-from-id "mastodon.el-profile.el") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile.el") +(autoload 'mastodon-profile--search-account-by-handle "mastodon.el-profile.el") (defvar mastodon-instance-url) (defvar mastodon-toot-timestamp-format) (defvar shr-use-fonts) ;; need to declare it since Emacs24 didn't have this @@ -72,11 +75,11 @@ 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 +(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) +(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.") @@ -251,7 +254,7 @@ Optionally start from POS." 'mouse-face 'highlight ;; TODO: Replace url browsing with native profile viewing 'mastodon-tab-stop 'user-handle - 'account (cdr (assoc 'account toot)) + 'account account 'shr-url profile-url 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) @@ -941,7 +944,7 @@ from the start if it is nil." (json (mastodon-tl--updated-json endpoint id))) (when json (let ((inhibit-read-only t)) - (goto-char (or mastodon-tl-update-point (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 c71623c..d608887 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -44,13 +44,14 @@ (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-notifications--get "mastodon-notifications") +(autoload 'mastodon-profile--get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") (autoload 'mastodon-toot--compose-buffer "mastodon-toot") (autoload 'mastodon-toot--reply "mastodon-toot") (autoload 'mastodon-toot--toggle-boost "mastodon-toot") (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." @@ -85,6 +86,7 @@ Use. e.g. \"%c\" for your locale's date and time format." ;; Navigating to other buffers: (define-key map (kbd "N") #'mastodon-notifications--get) (define-key map (kbd "U") #'mastodon-profile--get-toot-author) + (define-key map (kbd "P") #'mastodon-profile--show-user) (define-key map (kbd "F") #'mastodon-tl--get-federated-timeline) (define-key map (kbd "H") #'mastodon-tl--get-home-timeline) (define-key map (kbd "L") #'mastodon-tl--get-local-timeline) |