From 4eaab0252c154ba4651125b7984d36a7474179ff Mon Sep 17 00:00:00 2001 From: H Durer Date: Fri, 30 Mar 2018 04:59:34 +0100 Subject: 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). --- lisp/mastodon-profile.el | 216 +++++++++++++++++++++++++++++++++-------------- 1 file changed, 152 insertions(+), 64 deletions(-) (limited to 'lisp/mastodon-profile.el') 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 -- cgit v1.2.3