diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-auth.el | 8 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 34 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 299 | ||||
| -rw-r--r-- | lisp/mastodon.el | 6 |
5 files changed, 337 insertions, 12 deletions
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 02799bf..263ece2 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -222,6 +222,14 @@ Handle any errors from the server." (mastodon-http--api "accounts/verify_credentials")))) +(defun mastodon-auth--get-account-id () + "Request user credentials and return an account name." + (alist-get + 'id + (mastodon-http--get-json + (mastodon-http--api + "accounts/verify_credentials")))) + (defun mastodon-auth--user-acct () "Return a mastodon user acct name." (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist)) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index a127427..d9e1d80 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -89,8 +89,11 @@ Message status and JSON error from RESPONSE if unsuccessful." (if (string-prefix-p "2" status) (funcall success) (switch-to-buffer response) - (let ((json-response (mastodon-http--process-json))) - (message "Error %s: %s" status (alist-get 'error json-response)))))) + ;; 404 returns http response not JSON: + (if (string-prefix-p "404" status) + (message "Error %s: page not found" status) + (let ((json-response (mastodon-http--process-json))) + (message "Error %s: %s" status (alist-get 'error json-response))))))) (defun mastodon-http--read-file-as-string (filename) "Read a file FILENAME as a string. Used to generate image preview." @@ -208,12 +211,31 @@ Callback to `mastodon-http--get-response-async', usually (cons (car list) (cadr list)))) head-list))) -(defun mastodon-http--delete (url) +(defun mastodon-http--delete (url &optional args) "Make DELETE request to URL." + (let ((url-request-data + (when args + (mastodon-http--build-query-string args)))) + (mastodon-http--authorized-request + "DELETE" + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) + +(defun mastodon-http--put (url &optional args headers) + "Make PUT request to URL." (mastodon-http--authorized-request - "DELETE" - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url)))) + "PUT" + (let ((url-request-data + (when args + (mastodon-http--build-query-string args))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + ;; pleroma compat: + (unless (assoc "Content-Type" headers) + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index d161544..6422716 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -162,7 +162,7 @@ QUERY is the string to search." (defun mastodon-search--insert-users-propertized (json &optional note) "Insert users list into the buffer. -JSON is the data from the server.. If NOTE is non-nil, include +JSON is the data from the server. If NOTE is non-nil, include user's profile note. This is also called by `mastodon-tl--get-follow-suggestions' and `mastodon-profile--insert-follow-requests'." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f30fc29..9481fdc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -70,6 +70,9 @@ (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") (autoload 'mastodon-http--get-response-async "mastodon-http") (autoload 'mastodon-url-lookup "mastodon") +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-http--build-query-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") @@ -175,7 +178,7 @@ We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") (defvar mastodon-tl--view-filters-keymap - (let ((map ;(make-sparse-keymap))) + (let ((map (copy-keymap mastodon-mode-map))) (define-key map (kbd "d") 'mastodon-tl--delete-filter) (define-key map (kbd "c") 'mastodon-tl--create-filter) @@ -187,7 +190,7 @@ types of mastodon links and not just shr.el-generated ones.") "Keymap for viewing filters.") (defvar mastodon-tl--follow-suggestions-map - (let ((map ;(make-sparse-keymap))) + (let ((map (copy-keymap mastodon-mode-map))) (define-key map (kbd "n") 'mastodon-tl--goto-next-item) (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) @@ -195,6 +198,30 @@ types of mastodon links and not just shr.el-generated ones.") (keymap-canonicalize map)) "Keymap for viewing follow suggestions.") +(defvar mastodon-tl--view-lists-keymap + (let ((map ;(make-sparse-keymap))) + (copy-keymap mastodon-mode-map))) + (define-key map (kbd "D") 'mastodon-tl--delete-list) + (define-key map (kbd "C") 'mastodon-tl--create-list) + (define-key map (kbd "A") 'mastodon-tl--add-account-to-list) + (define-key map (kbd "R") 'mastodon-tl--remove-account-from-list) + (define-key map (kbd "E") 'mastodon-tl--edit-list) + (define-key map (kbd "n") 'mastodon-tl--goto-next-item) + (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) + (define-key map (kbd "g") 'mastodon-tl--view-lists) + (keymap-canonicalize map)) + "Keymap for viewing lists.") + +(defvar mastodon-tl--list-name-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "<return>") 'mastodon-tl--view-timeline-list-at-point) + (define-key map (kbd "d") 'mastodon-tl--delete-list-at-point) + (define-key map (kbd "a") 'mastodon-tl--add-account-to-list-at-point) + (define-key map (kbd "r") 'mastodon-tl--remove-account-from-list-at-point) + (define-key map (kbd "e") 'mastodon-tl--edit-list-at-point) + (keymap-canonicalize map)) + "Keymap for when point is on list name.") + (defvar mastodon-tl--byline-link-keymap (when (require 'mpv nil :no-error) (let ((map (make-sparse-keymap))) @@ -1374,6 +1401,264 @@ ID is that of the toot to view." ;; else just print the lone toot: (mastodon-tl--single-toot id))))))) +;;; LISTS + +(defun mastodon-tl--get-users-lists () + "Get the list of the user's lists from the server." + (let ((url (mastodon-http--api "lists"))) + (mastodon-http--get-json url))) + +(defun mastodon-tl--get-lists-names () + "Return a list of the user's lists' names." + (let ((lists (mastodon-tl--get-users-lists))) + (mapcar (lambda (x) + (alist-get 'title x)) + lists))) + +(defun mastodon-tl--get-list-by-name (name) + "Return the list data for list with NAME." + (let* ((lists (mastodon-tl--get-users-lists))) + (cl-loop for list in lists + if (string= (alist-get 'title list) name) + return list))) + +(defun mastodon-tl--get-list-id (name) + "Return id for list with NAME." + (let ((list (mastodon-tl--get-list-by-name name))) + (alist-get 'id list))) + +(defun mastodon-tl--get-list-name (id) + "Return name of list with ID." + (let* ((url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--get-json url))) + (alist-get 'title response))) + +(defun mastodon-tl--edit-list-at-point () + "Edit list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--edit-list id))) + +(defun mastodon-tl--edit-list (&optional id) + "Prompt for a list and edit the name and replies policy. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-tl--get-lists-names))) + (name-old (if id + (word-at-point :no-properties) + (completing-read "Edit list: " + list-names))) + (id (or id (mastodon-tl--get-list-id name-old))) + (name-choice (read-string "List name: " name-old)) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) + (url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--put url + `(("title" . ,name-choice) + ("replies_policy" . ,replies-policy))))) + (mastodon-http--triage response + (lambda () + (with-current-buffer response + (let* ((json (mastodon-http--process-json)) + (name-new (alist-get 'title json))) + (message "list %s edited to %s!" name-old name-new))) + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)))))) + +(defun mastodon-tl--view-timeline-list-at-point () + "View timeline of list at point." + (interactive) + (let ((list-id (get-text-property (point) 'list-id))) + (mastodon-tl--view-list-timeline list-id))) + +(defun mastodon-tl--view-list-timeline (&optional id) + "Prompt for a list and view its timeline. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-tl--get-lists-names))) + (list-name (unless id (completing-read "View list: " list-names))) + (id (or id (mastodon-tl--get-list-id list-name))) + (endpoint (format "timelines/list/%s" id)) + (name (mastodon-tl--get-list-name id)) + (buffer-name (format "list-%s" name))) + (mastodon-tl--init buffer-name endpoint 'mastodon-tl--timeline))) + +(defun mastodon-tl--create-list () + "Create a new list. +Prompt for name and replies policy." + (interactive) + (let* ((title (read-string "New list name: ")) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) ; default + (response (mastodon-http--post (mastodon-http--api "lists") + `(("title" . ,title) + ("replies_policy" . ,replies-policy)) + nil))) + (mastodon-http--triage response + (lambda () + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)) + (message "list %s created!" title))))) + +(defun mastodon-tl--delete-list-at-point () + "Delete list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--delete-list id))) + +(defun mastodon-tl--delete-list (&optional id) + "Prompt for a list and delete it. +If ID is provided, delete that list." + (interactive) + (let* ((list-names (unless id (mastodon-tl--get-lists-names))) + (name (if id + (mastodon-tl--get-list-name id) + (completing-read "Delete list: " + list-names))) + (id (or id (mastodon-tl--get-list-id name))) + (url (mastodon-http--api (format "lists/%s" id)))) + (when (y-or-n-p (format "Delete list %s?" name)) + (let ((response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda () + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)) + (message "list %s deleted!" name))))))) + +(defun mastodon-tl--view-lists () + "Show the user's lists in a new buffer." + (interactive) + (mastodon-tl--init-sync "lists" + "lists" + 'mastodon-tl--insert-lists) + (use-local-map mastodon-tl--view-lists-keymap)) + +(defun mastodon-tl--insert-lists (_json) + "Insert the user's lists from JSON." + ;; TODO: for now we don't use the JSON, we get it ourself again + (let* ((lists-names (mastodon-tl--get-lists-names))) + (erase-buffer) + (insert (mastodon-tl--set-face + (concat "\n ------------\n" + " YOUR LISTS\n" + " ------------\n\n") + 'success) + (mastodon-tl--set-face + "[C - create a list\n D - delete a list\ +\n A/R - add/remove account from a list\ +\n E - edit a list\n n/p - go to next/prev item]\n\n" + 'font-lock-comment-face)) + (mapc (lambda (x) + (mastodon-tl--print-list-accounts x)) + lists-names) + (goto-char (point-min)))) +;; (mastodon-tl--goto-next-item))) ; causes another request! + +(defun mastodon-tl--print-list-accounts (list-name) + "Insert the accounts in list named LIST-NAME." + (let* ((id (mastodon-tl--get-list-id list-name)) + (accounts (mastodon-tl--accounts-in-list id))) + (insert + (propertize list-name + 'list t + 'list-name list-name + 'list-id id + 'keymap mastodon-tl--list-name-keymap + 'byline t ; so we nav here + 'toot-id "0" ; so we nav here + 'help-echo "RET: view list timeline, d: delete this list, \ +a: add account to this list, r: remove account from this list" + 'face '((:underline t :inherit success))) + "\n\n") + (mastodon-search--insert-users-propertized accounts))) + +(defun mastodon-tl--get-users-followings () + "Return the list of followers of the logged in account." + (let* ((id (mastodon-auth--get-account-id)) + (url (mastodon-http--api (format "accounts/%s/following" id)))) + (mastodon-http--get-json url))) + +(defun mastodon-tl--add-account-to-list-at-point () + "Prompt for account and add to list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--add-account-to-list id))) + +(defun mastodon-tl--add-account-to-list (&optional id) + "Prompt for a list and for an account, add account to list. +If ID is provided, use that list." + (interactive) + (let* ((list-name (unless id + (completing-read "Add account to list: " + (mastodon-tl--get-lists-names) nil t))) + (list-id (or id (mastodon-tl--get-list-id list-name))) + (followings (mastodon-tl--get-users-followings)) + (handles (mapcar (lambda (x) + (cons (alist-get 'acct x) + (alist-get 'id x))) + followings)) + (account (completing-read "Account to add: " + handles nil t)) + (account-id (alist-get account handles nil nil 'equal)) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (response (mastodon-http--post url + `(("account_ids[]" . ,account-id)) + nil))) + (mastodon-http--triage response + (lambda () + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)) + (message "%s added to list %s!" account list-name))))) + +(defun mastodon-tl--remove-account-from-list-at-point () + "Prompt for account and remove from list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--remove-account-from-list id))) + +(defun mastodon-tl--remove-account-from-list (&optional id) + "Prompt for a list, select an account and remove from list. +If ID is provided, use that list." + (interactive) + (let* ((list-name (if id + (word-at-point :no-properties) + (completing-read "Remove account from list: " + (mastodon-tl--get-lists-names) nil t))) + (list-id (or id (mastodon-tl--get-list-id list-name))) + (accounts (mastodon-tl--accounts-in-list list-id)) + (handles (mapcar (lambda (x) + (cons (alist-get 'acct x) + (alist-get 'id x))) + accounts)) + (account (completing-read "Account to remove: " + handles nil t)) + (account-id (alist-get account handles nil nil 'equal)) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (response (mastodon-http--delete url + `(("account_ids[]" . ,account-id))))) + (mastodon-http--triage response + (lambda () + (message "%s removed from list %s!" account list-name))))) + +(defun mastodon-tl--accounts-in-list (&optional list-id) + "Prompt for a list and return the JSON of the accounts in it. +Use LIST-ID rather than prompting if given." + (interactive) + (let* ((list-name (unless list-id + (completing-read "View accounts in list: " + (mastodon-tl--get-lists-names) nil t))) + (list-id (or list-id (mastodon-tl--get-list-id list-name))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id)))) + (mastodon-http--get-json url))) + +;;; FILTERS + (defun mastodon-tl--create-filter () "Create a filter for a word. Prompt for a context, must be a list containting at least one of \"home\", @@ -1387,7 +1672,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (if (string-empty-p word) (error "You must select at least one word for a filter") (completing-read-multiple - "Contexts to filter [TAB for options]:" + "Contexts to filter [TAB for options]: " '("home" "notifications" "public" "thread") nil ; no predicate t))) ; require-match, as context is mandatory @@ -1469,6 +1754,8 @@ JSON is what is returned by by the server." (mastodon-tl--view-filters) (message "Filter for \"%s\" deleted!" phrase))))))) +;;; FOLLOW SUGGESTIONS + (defun mastodon-tl--get-follow-suggestions () "Display a buffer of suggested accounts to follow." (interactive) @@ -1496,6 +1783,8 @@ RESPONSE is the JSON returned by the server." (message "Looks like there's no toot or user at point?") ,@body)) +;;;; INSTANCES + (defun mastodon-tl--view-own-instance (&optional brief) "View details of your own instance. BRIEF means show fewer details." @@ -1671,6 +1960,8 @@ IND is the optional indentation level to print at." "\n" ""))) +;;; FOLLOW/BLOCK/MUTE, ETC + (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. @@ -1773,7 +2064,7 @@ Can be called to toggle NOTIFY on users already being followed." (defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) "Fetch the list of accounts for ACTION from the server. -Action must be either \"unblock\" or \"mute\"." +Action must be either \"unblock\" or \"unmute\"." (let* ((endpoint (cond ((equal action "unblock") "blocks") ((equal action "unmute") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 055de21..6b56341 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -193,7 +193,11 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) (define-key map (kbd "I") #'mastodon-tl--view-filters) (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) +<<<<<<< HEAD + (define-key map (kbd "X") #'mastodon-tl--view-lists) +======= (define-key map (kbd "@") #'mastodon-notifications--get-mentions) +>>>>>>> develop (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) @@ -208,7 +212,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (defface mastodon-handle-face '((t :inherit default)) - "Face used for user display names.") + "Face used for user handles in bylines.") (defface mastodon-display-name-face '((t :inherit warning)) |