diff options
Diffstat (limited to 'lisp/mastodon-profile.el')
| -rw-r--r-- | lisp/mastodon-profile.el | 143 |
1 files changed, 97 insertions, 46 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index f81441e..1200972 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -36,6 +36,7 @@ (require 'seq) (require 'cl-lib) (require 'persist) +(require 'ts) (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") @@ -69,6 +70,12 @@ (autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") +(autoload 'mastodon-tl--add-account-to-list "mastodon-tl") +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--symbol "mastodon-tl") + (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) @@ -110,7 +117,6 @@ (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 @@ -150,10 +156,11 @@ contains") ;; or handle --property failing (mastodon-tl--property 'toot-json)) -(defun mastodon-profile--make-author-buffer (account) - "Take an ACCOUNT json and insert a user account into a new buffer." +(defun mastodon-profile--make-author-buffer (account &optional no-reblogs) + "Take an ACCOUNT json and insert a user account into a new buffer. +NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for - account "statuses" #'mastodon-tl--timeline)) + account "statuses" #'mastodon-tl--timeline no-reblogs)) ;; TODO: we shd just load all views' data then switch coz this is slow af: (defun mastodon-profile--account-view-cycle () @@ -164,9 +171,17 @@ contains") (mastodon-profile--open-followers)) ((string-suffix-p "followers" endpoint) (mastodon-profile--open-following)) + ((string-suffix-p "following" endpoint) + (mastodon-profile--open-statuses-no-reblogs)) (t - (mastodon-profile--make-profile-buffer-for - mastodon-profile--account "statuses" #'mastodon-tl--timeline))))) + (mastodon-profile--make-author-buffer mastodon-profile--account))))) + +(defun mastodon-profile--open-statuses-no-reblogs () + "Open a profile buffer showing statuses without reblogs." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer mastodon-profile--account :no-reblogs) + (error "Not in a mastodon profile"))) (defun mastodon-profile--open-following () "Open a profile buffer showing the accounts that current profile follows." @@ -175,7 +190,9 @@ contains") (mastodon-profile--make-profile-buffer-for mastodon-profile--account "following" - #'mastodon-profile--add-author-bylines) + #'mastodon-profile--add-author-bylines + nil + :headers) (error "Not in a mastodon profile"))) (defun mastodon-profile--open-followers () @@ -185,7 +202,9 @@ contains") (mastodon-profile--make-profile-buffer-for mastodon-profile--account "followers" - #'mastodon-profile--add-author-bylines) + #'mastodon-profile--add-author-bylines + nil + :headers) (error "Not in a mastodon profile"))) (defun mastodon-profile--view-favourites () @@ -235,6 +254,15 @@ JSON is the data returned by the server." (mastodon-search--insert-users-propertized json :note))) ;; (mastodon-profile--add-author-bylines json))) +(defun mastodon-profile--add-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (when mastodon-profile--account + (let* ((profile mastodon-profile--account) + (id (alist-get 'id profile)) + (handle (alist-get 'acct profile))) + (mastodon-tl--add-account-to-list nil id handle)))) + ;;; ACCOUNT PREFERENCES (defun mastodon-profile--get-json-value (val) @@ -259,7 +287,8 @@ JSON is the data returned by the server." (defun mastodon-profile--update-user-profile-note () "Fetch user's profile note and display for editing." (interactive) - (let* ((url (mastodon-http--api "accounts/verify_credentials")) + (let* ((endpoint "accounts/verify_credentials") + (url (mastodon-http--api endpoint)) (json (mastodon-http--get-json url)) (source (alist-get 'source json)) (note (alist-get 'note source)) @@ -267,6 +296,9 @@ JSON is the data returned by the server." (inhibit-read-only t)) (switch-to-buffer-other-window buffer) (text-mode) + (mastodon-tl--set-buffer-spec (buffer-name buffer) + endpoint + nil) (setq-local header-line-format (propertize "Edit your profile note. C-c C-c to send, C-c C-k to cancel." @@ -469,6 +501,9 @@ This endpoint only holds a few preferences. For others, see (switch-to-buffer-other-window buf) (erase-buffer) (special-mode) + (mastodon-tl--set-buffer-spec (buffer-name buf) + "preferences" + nil) (let ((inhibit-read-only t)) (while response (let ((el (pop response))) @@ -484,11 +519,10 @@ This endpoint only holds a few preferences. For others, see (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)))) + (args `(("id[]" . ,their-id))) + (url (mastodon-http--api "accounts/relationships"))) ;; FIXME: not sure why we need to do this for relationships only! - (car (mastodon-http--get-json url)))) + (car (mastodon-http--get-json url args)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -519,8 +553,9 @@ FIELDS means provide a fields vector fetched by other means." (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))) + (args `(("pinned" . "true"))) + (url (mastodon-http--api (format "accounts/%s/statuses" id)))) + (mastodon-http--get-json url args))) (defun mastodon-profile--insert-statuses-pinned (pinned-statuses) "Insert each of the PINNED-STATUSES for a given account." @@ -530,14 +565,26 @@ FIELDS means provide a fields vector fetched by other means." (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." +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type + update-function + &optional no-reblogs headers) + "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. +NO-REBLOGS means do not display boosts in statuses. +HEADERS means also fetch link headers for pagination." (let* ((id (mastodon-profile--account-field account 'id)) + (args (when no-reblogs '(("exclude_reblogs" . "t")))) (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) + (response (if headers + (mastodon-http--get-response url args) + (mastodon-http--get-json url args))) + (json (if headers (car response) response)) + (endpoint (format "accounts/%s/%s" id endpoint-type)) + (link-header (when headers + (mastodon-tl--get-link-header-from-response + (cdr response)))) (note (mastodon-profile--account-field account 'note)) - (json (mastodon-http--get-json url)) (locked (mastodon-profile--account-field account 'locked)) (followers-count (mastodon-tl--as-string (mastodon-profile--account-field @@ -555,16 +602,17 @@ FIELDS means provide a fields vector fetched by other means." (alist-get 'followed_by relationships))) (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) - (pinned (mastodon-profile--get-statuses-pinned account))) + (pinned (mastodon-profile--get-statuses-pinned account)) + (joined (mastodon-profile--account-field account 'created_at))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) (mastodon-profile-mode) - (setq mastodon-profile--account account - mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "accounts/%s/%s" id endpoint-type) - update-function ,update-function)) + (setq mastodon-profile--account account) + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) (let* ((inhibit-read-only t) (is-statuses (string= endpoint-type "statuses")) (is-followers (string= endpoint-type "followers")) @@ -587,20 +635,25 @@ FIELDS means provide a fields vector fetched by other means." (propertize (concat "@" acct) 'face 'default) (if (equal locked t) - (if (fontp (char-displayable-p #10r9993)) - " 🔒" - " [locked]") + (concat " " (mastodon-tl--symbol 'locked)) "") "\n ------------\n" - (mastodon-tl--render-text note account) + ;; profile note: ;; account here to enable tab-stops in profile note + (mastodon-tl--render-text note account) + ;; meta fields: (if fields (concat "\n" (mastodon-tl--set-face (mastodon-profile--fields-insert fields) - 'success) - "\n") - "")) + 'success)) + "") + "\n" + ;; Joined date: + (propertize + (mastodon-profile--format-joined-date-string joined) + 'face 'success) + "\n\n") 'profile-json account) ;; insert counts (mastodon-tl--set-face @@ -635,9 +688,16 @@ FIELDS means provide a fields vector fetched by other means." (funcall update-function json))) (goto-char (point-min)))) +(defun mastodon-profile--format-joined-date-string (joined) + "Format a human-readable Joined string from timestamp JOINED." + (let ((joined-ts (ts-parse joined))) + (format "Joined %s" (concat (ts-month-name joined-ts) + " " + (number-to-string + (ts-year joined-ts)))))) + (defun mastodon-profile--get-toot-author () "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 @@ -683,17 +743,8 @@ IMG_TYPE is the JSON key from the account data." (message "Loading your profile...") (mastodon-profile--show-user (mastodon-auth--get-account-name))) -(defun mastodon-profile--view-author-profile () - "View the profile of author of present toot." - (interactive) - (let* ((toot-json (mastodon-tl--property 'toot-json)) - (acct (alist-get 'account toot-json)) - (handle (alist-get 'acct acct))) - (mastodon-profile--show-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))) @@ -724,17 +775,18 @@ Used to view a user's followers and those they're following." (defun mastodon-profile--search-account-by-handle (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)) (substring handle 1 (length handle)) handle)) + (args `(("q" . ,handle))) (matching-account (seq-remove (lambda (x) (not (string= (alist-get 'acct x) handle))) (mastodon-http--get-json - (mastodon-http--api (format "accounts/search?q=%s" handle)))))) + (mastodon-http--api "accounts/search") + args)))) (when (equal 1 (length matching-account)) (elt matching-account 0)))) @@ -745,15 +797,14 @@ If the handle does not match a search return then retun NIL." (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 (or (alist-get 'account status) ; status is a toot status)) ; status is a user listing - (mentions (or (alist-get 'mentions (alist-get 'status status)) + (mentions (or (alist-get 'mentions (alist-get 'status status)) (alist-get 'mentions status))) - (reblog (or (alist-get 'reblog (alist-get 'status status)) + (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter 'stringp |