diff options
Diffstat (limited to 'lisp/mastodon-profile.el')
| -rw-r--r-- | lisp/mastodon-profile.el | 341 |
1 files changed, 295 insertions, 46 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 16fb1a9..05cacde 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -2,9 +2,10 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen <johnson.denen@gmail.com> -;; Version: 0.7.2 -;; Package-Requires: ((emacs "24.4")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> +;; Version: 0.10.0 +;; Package-Requires: ((emacs "27.1") (seq "1.0")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. @@ -36,24 +37,42 @@ (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") +(autoload 'mastodon-http--post "mastodon-http.el") +(autoload 'mastodon-http--triage "mastodon-http.el") +(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") +(autoload 'mastodon-http--get-json-async "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--find-property-range "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") +(autoload 'mastodon-tl--as-string "mastodon-tl.el") (autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-tl--toot "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl.el") +(autoload 'mastodon-http--patch "mastodon-http") +(autoload 'mastodon-http--patch-json "mastodon-http") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) -(defvar mastodon-profile--account nil +(defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") -(make-variable-buffer-local 'mastodon-profile--account) + +(defvar mastodon-profile-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "s") #'mastodon-profile--open-followers) + (define-key map (kbd "g") #'mastodon-profile--open-following) + (define-key map (kbd "a") #'mastodon-profile--follow-request-accept) + (define-key map (kbd "j") #'mastodon-profile--follow-request-reject) + map) + "Keymap for `mastodon-profile-mode'.") (define-minor-mode mastodon-profile-mode "Toggle mastodon profile minor mode. @@ -61,12 +80,24 @@ This minor mode is used for mastodon profile pages and adds a couple of extra keybindings." :init-value nil - ;; The mode line indicator. + ;; modeline indicator: :lighter " Profile" - ;; The key bindings - :keymap '(((kbd "F") . mastodon-profile--open-followers) - ((kbd "f") . mastodon-profile--open-following)) - :group 'mastodon) + :keymap mastodon-profile-mode-map + :group 'mastodon + :global nil) + +(defvar mastodon-profile-update-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'mastodon-profile--user-profile-send-updated) + (define-key map (kbd "C-c C-k") #'kill-buffer-and-window) + map) + "Keymap for `mastodon-profile-update-mode'.") + +(define-minor-mode mastodon-profile-update-mode + "Minor mode to update Mastodon user profile." + :group 'mastodon-profile + :keymap mastodon-profile-update-mode-map + :global nil) (defun mastodon-profile--toot-json () "Get the next toot-json." @@ -74,13 +105,12 @@ extra keybindings." (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account) - "Take a ACCOUNT and inserts a user account into a new buffer." + "Take an ACCOUNT json and insert 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." + "Open a profile buffer showing the accounts that current profile follows." (interactive) (if mastodon-profile--account (mastodon-profile--make-profile-buffer-for @@ -90,8 +120,7 @@ that current profile follows." (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." + "Open a profile buffer showing the accounts following the current profile." (interactive) (if mastodon-profile--account (mastodon-profile--make-profile-buffer-for @@ -100,14 +129,186 @@ following the current profile." #'mastodon-profile--add-author-bylines) (error "Not in a mastodon profile"))) +(defun mastodon-profile--view-favourites () + "Open a new buffer displaying the user's favourites." + (interactive) + (message "Loading your favourited toots...") + (mastodon-tl--init "favourites" + "favourites" + 'mastodon-tl--timeline)) + +(defun mastodon-profile--view-bookmarks () + "Open a new buffer displaying the user's bookmarks." + (interactive) + (message "Loading your bookmarked toots...") + (mastodon-tl--init "bookmarks" + "bookmarks" + 'mastodon-tl--timeline)) + +(defun mastodon-profile--view-follow-requests () + "Open a new buffer displaying the user's follow requests." + (interactive) + (mastodon-profile-mode) + (mastodon-tl--init "follow-requests" + "follow_requests" + 'mastodon-profile--add-author-bylines)) + +(defun mastodon-profile--follow-request-accept () + "Accept the follow request of user at point." + (interactive) + (if (mastodon-tl--find-property-range 'toot-json (point)) + (let* ((acct-json (mastodon-profile--toot-json)) + (id (alist-get 'id acct-json)) + (handle (alist-get 'acct acct-json)) + (name (alist-get 'username acct-json))) + (if id + (let ((response + (mastodon-http--post + (concat + (mastodon-http--api "follow_requests") + (format "/%s/authorize" id)) + nil nil))) + (mastodon-http--triage response + (lambda () + (message "Follow request of %s (@%s) accepted!" + name handle)))) + (message "No account result at point?"))) + (message "No follow request at point?"))) + +(defun mastodon-profile--follow-request-reject () + "Reject the follow request of user at point." + (interactive) + (if (mastodon-tl--find-property-range 'toot-json (point)) + (let* ((acct-json (mastodon-profile--toot-json)) + (id (alist-get 'id acct-json)) + (handle (alist-get 'acct acct-json)) + (name (alist-get 'username acct-json))) + (if id + (let ((response + (mastodon-http--post + (concat + (mastodon-http--api "follow_requests") + (format "/%s/reject" id)) + nil nil))) + (mastodon-http--triage response + (lambda () + (message "Follow request of %s (@%s) rejected!" + name handle)))) + (message "No account result at point?"))) + (message "No follow request at point?"))) + +(defun mastodon-profile--update-user-profile-note () + "Fetch user's profile note and display for editing." + (interactive) + (let* ((url (concat mastodon-instance-url + "/api/v1/accounts/update_credentials")) + ;; (buffer (mastodon-http--patch url)) + (json (mastodon-http--patch-json url)) + (source (alist-get 'source json)) + (note (alist-get 'note source)) + (buffer (get-buffer-create "*mastodon-update-profile*")) + (inhibit-read-only t)) + (switch-to-buffer-other-window buffer) + (mastodon-profile-update-mode t) + (insert note) + (goto-char (point-min)) + (delete-trailing-whitespace) ; remove all ^M's + (message "Edit your profile note. C-c C-c to send, C-c C-k to cancel."))) + +(defun mastodon-profile--user-profile-send-updated () + "Send PATCH request with the updated profile note." + (interactive) + (let* ((note (buffer-substring-no-properties (point-min) (point-max))) + (url (concat mastodon-instance-url + "/api/v1/accounts/update_credentials"))) + (kill-buffer-and-window) + (let ((response (mastodon-http--patch url note))) + (mastodon-http--triage response + (lambda () (message "Profile note updated!")))))) + +(defun mastodon-profile--relationships-get (id) + "Fetch info about logged-in user's relationship to user with id ID." + (let* ((their-id id) + (url (mastodon-http--api (format + "accounts/relationships?id[]=%s" + their-id)))) + (mastodon-http--get-json url))) + +(defun mastodon-profile--fields-get (account) + "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. + +Returns a list of lists." + (let ((fields (mastodon-profile--account-field account 'fields))) + (when fields + (mapcar + (lambda (el) + (list + (alist-get 'name el) + (alist-get 'value el))) + fields)))) + +(defun mastodon-profile--fields-insert (fields) + "Format and insert field pairs (a.k.a profile metadata) in FIELDS." + (let* ((car-fields (mapcar 'car fields)) + ;; (cdr-fields (mapcar 'cadr fields)) + ;; (cdr-fields-rendered + ;; (list + ;; (mapcar (lambda (x) + ;; (mastodon-tl--render-text x nil)) + ;; cdr-fields))) + (left-width (car (sort (mapcar 'length car-fields) '>)))) + ;; (right-width (car (sort (mapcar 'length cdr-fields) '>)))) + (mapconcat (lambda (field) + (mastodon-tl--render-text + (concat + (format "_ %s " (car field)) + (make-string (- (+ 1 left-width) (length (car field))) ?_) + (format " :: %s" (cadr field))) + ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_) + ;; " |") + field)) ; nil)) ; hack to make links tabstops + fields ""))) + +(defun mastodon-profile--get-statuses-pinned (account) + "Fetch the pinned toots for ACCOUNT." + (let* ((id (mastodon-profile--account-field account 'id)) + (url (mastodon-http--api (format "accounts/%s/statuses?pinned=true" id)))) + (mastodon-http--get-json url))) + +(defun mastodon-profile--insert-statuses-pinned (pinned-statuses) + "Insert each of the PINNED-STATUSES for a given account." + (mapc (lambda (pinned-status) + (insert (mastodon-tl--set-face + " :pinned: " 'success)) + (mastodon-tl--toot pinned-status)) + pinned-statuses)) + (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function) + "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." (let* ((id (mastodon-profile--account-field account 'id)) + (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) (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))) + (json (mastodon-http--get-json url)) + (locked (mastodon-profile--account-field account 'locked)) + (followers-count (mastodon-tl--as-string + (mastodon-profile--account-field + account 'followers_count))) + (following-count (mastodon-tl--as-string + (mastodon-profile--account-field + account 'following_count))) + (toots-count (mastodon-tl--as-string + (mastodon-profile--account-field + account 'statuses_count))) + (relationships (mastodon-profile--relationships-get id)) + (followed-by-you (alist-get 'following + (aref relationships 0))) + (follows-you (alist-get 'followed_by + (aref relationships 0))) + (followsp (or (equal follows-you 't) (equal followed-by-you 't))) + (fields (mastodon-profile--fields-get account)) + (pinned (mastodon-profile--get-statuses-pinned account))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) @@ -122,9 +323,9 @@ following the current profile." (is-followers (string= endpoint-type "followers")) (is-following (string= endpoint-type "following")) (endpoint-name (cond - (is-statuses " TOOTS ") - (is-followers " FOLLOWERS ") - (is-following " FOLLOWING ")))) + (is-statuses " TOOTS ") + (is-followers " FOLLOWERS ") + (is-following " FOLLOWING ")))) (insert "\n" (mastodon-profile--image-from-account account) @@ -133,10 +334,42 @@ following the current profile." account 'display_name) 'face 'mastodon-display-name-face) "\n" - (propertize acct + (propertize (concat "@" acct) 'face 'default) + (if (equal locked t) + (if (fontp (char-displayable-p #10r9993)) + " 🔒" + " [locked]") + "") "\n ------------\n" - (mastodon-tl--render-text note nil) + (mastodon-tl--render-text note account) + ;; account here to enable tab-stops in profile note + (if fields + (concat "\n" + (mastodon-tl--set-face + (mastodon-profile--fields-insert fields) + 'success) + "\n") + "") + ;; insert counts + (mastodon-tl--set-face + (concat " ------------\n" + " TOOTS: " toots-count " | " + "FOLLOWERS: " followers-count " | " + "FOLLOWING: " following-count "\n" + " ------------\n\n") + 'success) + ;; insert relationship (follows) + (if followsp + (mastodon-tl--set-face + (concat (if (equal follows-you 't) + " | FOLLOWS YOU") + (if (equal followed-by-you 't) + " | FOLLOWED BY YOU") + "\n\n") + 'success) + "") ; if no followsp we still need str-or-char-p for insert + ;; insert endpoint (mastodon-tl--set-face (concat " ------------\n" endpoint-name "\n" @@ -144,37 +377,52 @@ following the current profile." 'success)) (setq mastodon-tl--update-point (point)) (mastodon-media--inline-images (point-min) (point)) + ;; insert pinned toots first + (when (and pinned (equal endpoint-type "statuses")) + (mastodon-profile--insert-statuses-pinned pinned) + (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots (funcall update-function json))) - (mastodon-tl--goto-next-toot))) + ;;(mastodon-tl--goto-next-toot) + (goto-char (point-min)))) (defun mastodon-profile--get-toot-author () - "Opens authors profile of toot under point." + "Open profile of author of toot under point. + +If toot is a boost, opens the profile of the booster." (interactive) (mastodon-profile--make-author-buffer - (cdr (assoc 'account (mastodon-profile--toot-json))))) + (alist-get 'account (mastodon-profile--toot-json)))) (defun mastodon-profile--image-from-account (status) "Generate an image from a STATUS." - (let ((url (cdr (assoc 'avatar_static status)))) + (let ((url (alist-get 'avatar_static status))) (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." + "Query for USER-HANDLE 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: " + (completing-read "View profile of user [choose or enter any 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) + (progn + (message "Loading profile of user %s..." user-handle) + (mastodon-profile--make-author-buffer account)) (message "Cannot find a user with handle %S" user-handle)))) +(defun mastodon-profile--my-profile () + "Show the profile of the currently signed in user." + (interactive) + (message "Loading your profile...") + (mastodon-profile--show-user (mastodon-auth--get-account-name))) + (defun mastodon-profile--account-field (account field) "Return FIELD from the ACCOUNT. @@ -190,17 +438,17 @@ FIELD is used to identify regions under 'account" (propertize (mastodon-tl--byline-author `((account . ,toot))) 'byline 't - 'toot-id (cdr (assoc 'id toot)) + 'toot-id (alist-get 'id toot) 'base-toot-id (mastodon-tl--toot-id toot) 'toot-json toot)) (mastodon-media--inline-images start-pos (point)) (insert "\n" - (mastodon-tl--render-text (cdr (assoc 'note toot)) nil) + (mastodon-tl--render-text (alist-get 'note toot) nil) "\n"))) tootv))) (defun mastodon-profile--search-account-by-handle (handle) - "Return an account based on a users HANDLE. + "Return an account based on a user's HANDLE. If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) @@ -208,7 +456,8 @@ If the handle does not match a search return then retun NIL." handle)) (matching-account (seq-remove - (lambda(x) (not (string= (cdr (assoc 'acct x)) handle))) + (lambda (x) + (not (string= (alist-get 'acct x) handle))) (mastodon-http--get-json (mastodon-http--api (format "accounts/search?q=%s" handle)))))) (when (equal 1 (length matching-account)) @@ -224,35 +473,35 @@ If the handle does not match a search return then retun NIL." 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)))) + (let ((this-account (alist-get 'account status)) + (mentions (alist-get 'mentions status)) + (reblog (alist-get 'reblog status))) (seq-filter 'stringp (seq-uniq (seq-concatenate 'list - (list (cdr (assoc 'acct this-account))) + (list (alist-get 'acct this-account)) (mastodon-profile--extract-users-handles reblog) (mapcar (lambda (mention) - (cdr (assoc 'acct mention))) + (alist-get '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))))) + (let* ((this-account (alist-get 'account status)) + (reblog-account (alist-get 'account (alist-get 'reblog status))) (mention-id (seq-some (lambda (mention) (when (string= handle - (cdr (assoc 'acct mention))) - (cdr (assoc 'id mention)))) - (cdr (assoc 'mentions status))))) + (alist-get 'acct mention)) + (alist-get 'id mention))) + (alist-get 'mentions status)))) (cond ((string= handle - (cdr (assoc 'acct this-account))) + (alist-get 'acct this-account)) this-account) ((string= handle - (cdr (assoc 'acct reblog-account))) + (alist-get 'acct reblog-account)) reblog-account) (mention-id (mastodon-profile--account-from-id mention-id)) |