diff options
author | H Durer <h.duerer@gmail.com> | 2018-03-30 04:59:34 +0100 |
---|---|---|
committer | Johnson Denen <johnson.denen@gmail.com> | 2018-08-10 22:20:04 -0400 |
commit | 4eaab0252c154ba4651125b7984d36a7474179ff (patch) | |
tree | f8a06b0e9fd946858f39b47042d7b111dace9082 | |
parent | 87cb71a718a5877492f958d1966d13150673e8fa (diff) |
More profile work (#193)
* Add an alternative approach to user profile opening.
This way asks the user in the minibuffer for the handle and offering completion for all user handles in the current status but allowing the user to also enter any other handle to browse whichever account they wish.
This also cleans up some compiler warnings about profile code.
* Create a new minor mode for mastodon profile pages. There we override the 'f' and 'F' keys to show following and followers respectively.
Those pages now look very similar to the regular profile page (with a header).
-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) |