diff options
| -rw-r--r-- | README.org | 12 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 19 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 100 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 5 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 139 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 36 |
6 files changed, 274 insertions, 37 deletions
@@ -1,6 +1,7 @@ #+OPTIONS: toc:nil [[https://ci.codeberg.org/api/badges/martianh/mastodon.el/status.svg]] +https://melpa.org/packages/mastodon-badge.svg * README @@ -98,7 +99,7 @@ restart Emacs and follow the steps again. =M-x mastodon= -Opens a =*mastodon-home*= buffer in the major mode and displays toots. You +Opens a =*mastodon-home*= buffer in the major mode and displays toots. If your credentials are not yet saved, you will be prompted for email and password. The app registration process will take place if your =mastodon-token-file= does not contain =:client_id= and =:client_secret=. @@ -203,6 +204,15 @@ You can download and use your instance's custom emoji | =C-c C-e= | add emoji (if =emojify= installed) | |---------+----------------------------------| +*** Other commands and account settings: + +- =mastodon-tl-view-instance-description=: View information about the instance that the author of the toot at point is on. + +- =mastodon-profile-update-display-name=: Update the display name for your account. +- =mastodon-profile-set-default-toot-visibility=: Set the default visibility for your toots. +- =mastodon-profile-account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. +- =mastodon-profile-account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. + *** Customization See =M-x customize-group RET mastodon= to view all customize options. diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 49b2375..9904232 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -168,7 +168,7 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. -PARAMS should be an alist as required `url-build-query-string'." +PARAMS should be an alist as required by `url-build-query-string'." (let ((query-string (url-build-query-string params))) (concat url "?" query-string))) @@ -204,21 +204,18 @@ PARAM is a formatted request parameter, eg 'following=true'." ;; profile update functions -(defun mastodon-http--patch-json (url) - "Make synchronous PATCH request to URL. Return JSON response." - (with-current-buffer (mastodon-http--patch url) +(defun mastodon-http--patch-json (url &optional params) + "Make synchronous PATCH request to URL. Return JSON response. +Optionally specify the PARAMS to send." + (with-current-buffer (mastodon-http--patch url params) (mastodon-http--process-json))) -;; hard coded just for bio note for now: -(defun mastodon-http--patch (base-url &optional note) +(defun mastodon-http--patch (base-url &optional params) "Make synchronous PATCH request to BASE-URL. -Optionally specify the NOTE to edit. -Pass response buffer to CALLBACK function." +Optionally specify the PARAMS to send." (mastodon-http--authorized-request "PATCH" - (let ((url (if note - (concat base-url "?note=" (url-hexify-string note)) - base-url))) + (let ((url (mastodon-http--append-query-string base-url params))) (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 516059e..00ffedd 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -34,6 +34,7 @@ ;;; Code: (require 'seq) +(require 'cl-lib) (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") @@ -207,14 +208,29 @@ JSON is the data returned by the server." 'byline t 'toot-id "0")) (mastodon-search--insert-users-propertized json :note))) - ;; (mastodon-profile--add-author-bylines json))) +;; (mastodon-profile--add-author-bylines json))) + +;;; account preferences + +(defun mastodon-profile--get-json-value (val) + "Fetch current VAL ue from account." + (let* ((url (mastodon-http--api "accounts/verify_credentials")) + (response (mastodon-http--get-json url))) + (alist-get val response))) + +(defun mastodon-profile--get-source-prefs () + "Return the \"source\" preferences from the server." + (mastodon-profile--get-json-value 'source)) + +(defun mastodon-profile--get-source-pref (pref) + "Return account PREF erence from the \"source\" section on the server." + (let ((source (mastodon-profile--get-source-prefs))) + (alist-get pref source))) (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)) + (let* ((url (mastodon-http--api "accounts/update_credentials")) (json (mastodon-http--patch-json url)) (source (alist-get 'source json)) (note (alist-get 'note source)) @@ -236,13 +252,78 @@ JSON is the data returned by the server." "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"))) + (url (mastodon-http--api "accounts/update_credentials"))) (kill-buffer-and-window) - (let ((response (mastodon-http--patch url note))) + (let ((response (mastodon-http--patch url `((note ,note))))) (mastodon-http--triage response (lambda () (message "Profile note updated!")))))) +(defun mastodon-profile--update-preference (pref val &optional source) + "Update a single acount PREF erence to setting VAL. +Both args are strings. +SOURCE means that the preference is in the 'source' part of the account json." + (let* ((url (mastodon-http--api "accounts/update_credentials")) + (pref-formatted (if source (concat "source[" pref "]") pref)) + (response (mastodon-http--patch url `((,pref-formatted ,val))))) + (mastodon-http--triage response + (lambda () + (message "Account setting %s updated to %s!" pref val))))) + +(defun mastodon-profile-account-locked-toggle () + "Toggle the locked status of your account. +Locked accounts mean follow requests have to be manually approved." + (interactive) + (mastodon-profile--toggle-account-key 'locked)) + +(defun mastodon-profile-account-discoverable-toggle () + "Toggle the discoverable status of your account. +Discoverable means the account is listed in the server directory." + (interactive) + (mastodon-profile--toggle-account-key 'discoverable)) + +(defun mastodon-profile--toggle-account-key (key) + "Toggle the boolean account setting KEY." + (let* ((val (mastodon-profile--get-json-value key)) + (prompt (format "Account setting %s is %s. Toggle?" key val))) + (if (not (equal val :json-false)) + (when (y-or-n-p prompt) + (mastodon-profile--update-preference (symbol-name key) "false")) + (when (y-or-n-p prompt) + (mastodon-profile--update-preference (symbol-name key) "true"))))) + +(defun mastodon-profile--edit-account-string (key) + "Edit the string for account setting KEY." + (let* ((val (mastodon-profile--get-json-value key)) + (new-val + (read-string (format "Edit account setting %s: " key) + val))) + (mastodon-profile--update-preference (symbol-name key) new-val))) + +(defun mastodon-profile-update-display-name () + "Update display name for your account." + (interactive) + (mastodon-profile--edit-account-string 'display_name)) + +(defun mastodon-profile-view-preferences () + "View user preferences in another window." + (interactive) + (let* ((url (mastodon-http--api "preferences")) + (response (mastodon-http--get-json url)) + (buf (get-buffer-create "*mastodon-preferences*"))) + (with-current-buffer buf + (switch-to-buffer-other-window buf) + (erase-buffer) + (special-mode) + (let ((inhibit-read-only t)) + (while response + (let ((el (pop response))) + (insert + (format "%-30s %s" + (prin1-to-string (car el)) + (prin1-to-string (cdr el))) + "\n\n")))) + (goto-char (point-min))))) + (defun mastodon-profile--relationships-get (id) "Fetch info about logged-in user's relationship to user with id ID." (let* ((their-id id) @@ -263,8 +344,9 @@ Returns a list of lists." (defun mastodon-profile--fields-insert (fields) "Format and insert field pairs (a.k.a profile metadata) in FIELDS." - (let* ((car-fields (mapcar 'car fields)) - (left-width (car (sort (mapcar 'length car-fields) '>)))) + (let* ((car-fields (mapcar #'car fields)) + (left-width (cl-reduce + #'max (mapcar #'length car-fields)))) (mapconcat (lambda (field) (mastodon-tl--render-text (concat diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 8d450e3..10e12c3 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -103,6 +103,11 @@ QUERY is the string to search." (mastodon-mode) (let ((inhibit-read-only t)) (erase-buffer) + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,(format "api/v2/search") + update-function + (lambda (toot) (message "Searched.")))) ;; user results: (insert (mastodon-tl--set-face (concat "\n ------------\n" diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 079af22..7092352 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -34,7 +34,7 @@ (require 'shr) (require 'thingatpt) ; for word-at-point (require 'time-date) -(require 'cl-lib) ; for cl-mapcar +(require 'cl-lib) (require 'mpv nil :no-error) @@ -615,7 +615,7 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." 'help-echo (format "You have %s this status." help-string))))) -(defun mastodon-tl--render-text (string toot) +(defun mastodon-tl--render-text (string &optional toot) "Return a propertized text rendering the given HTML string STRING. The contents comes from the given TOOT which is used in parsing @@ -1357,11 +1357,146 @@ RESPONSE is the JSON returned by the server." (defmacro mastodon-tl--do-if-toot (&rest body) "Execute BODY if we have a toot or user at point." + (declare (debug t)) `(if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view (not (mastodon-tl--property 'toot-json))) (message "Looks like there's no toot or user at point?") ,@body)) +(defun mastodon-tl-view-own-instance (&optional brief) + "View details of your own instance. +BRIEF means show fewer details." + (interactive) + (mastodon-tl-view-instance-description :user brief)) + +(defun mastodon-tl-view-own-instance-brief () + "View brief details of your own instance." + (interactive) + (mastodon-tl-view-instance-description :user :brief)) + +(defun mastodon-tl-view-instance-description-brief () + "View brief details of the instance the current post's author is on." + (interactive) + (mastodon-tl-view-instance-description nil :brief)) + +(defun mastodon-tl-view-instance-description (&optional user brief) + "View the details of the instance the current post's author is on. +USER means to show the instance details for the logged in user. +BRIEF means to show fewer details." + (interactive) + (mastodon-tl--do-if-toot + (let* ((toot (mastodon-tl--property 'toot-json)) + (reblog (alist-get 'reblog toot)) + (account (or (alist-get 'account reblog) + (alist-get 'account toot))) + (acct (alist-get 'acct account)) + (username (alist-get 'username account)) + (instance + (concat "https://" + (string-remove-prefix (concat username "@") + acct))) + (response (mastodon-http--get-json + (if user + (mastodon-http--api "instance") + (concat instance + "/api/v1/instance"))))) + (when response + (let ((buf (get-buffer-create "*mastodon-instance*"))) + (with-current-buffer buf + (switch-to-buffer-other-window buf) + (let ((inhibit-read-only t)) + (erase-buffer) + (special-mode) + (when brief + (setq response + (list (assoc 'uri response) + (assoc 'title response) + (assoc 'short_description response) + (assoc 'email response) + (cons 'contact_account + (list + (assoc 'username + (assoc 'contact_account response)))) + (assoc 'rules response) + (assoc 'stats response)))) + (mastodon-tl--print-json-keys response) + (goto-char (point-min))))))))) + +(defun mastodon-tl--format-key (el pad) + "Format a key of element EL, a cons, with PAD padding." + (format (concat "%-" + (number-to-string pad) + "s: ") + (prin1-to-string (car el)))) + +(defun mastodon-tl--print-json-keys (response &optional ind) + "Print the JSON keys and values in RESPONSE. +IND is the optional indentation level to print at." + (let* ((cars (mapcar + (lambda (x) (symbol-name (car x))) + response)) + (pad (1+ (cl-reduce #'max (mapcar #'length cars))))) + (while response + (let ((el (pop response))) + (cond + ;; vector of alists (fields, instance rules): + ((and (equal (type-of (cdr el)) 'vector) + (not (seq-empty-p (cdr el))) + (equal (type-of (seq-elt (cdr el) 0)) 'cons)) + (insert + (mastodon-tl--format-key el pad) + "\n\n") + (seq-do #'mastodon-tl--print-instance-rules-or-fields (cdr el)) + (insert "\n")) + ;; vector of strings (media types): + ((and (equal (type-of (cdr el)) 'vector) + (not (seq-empty-p (cdr el))) + (< 1 (seq-length (cdr el))) + (equal (type-of (seq-elt (cdr el) 0)) 'string)) + (when ind (indent-to ind)) + (insert + (mastodon-tl--format-key el pad) + "\n" + (seq-mapcat + (lambda (x) (concat x ", ")) + (cdr el) 'string) + "\n\n")) + ;; basic nesting: + ((equal (type-of (cdr el)) 'cons) + (when ind (indent-to ind)) + (insert + (mastodon-tl--format-key el pad) + "\n\n") + (mastodon-tl--print-json-keys + (cdr el) (if ind (+ ind 4) 4))) + (t + (when ind (indent-to ind)) + (insert (mastodon-tl--format-key el pad) + " " + (mastodon-tl--newline-if-long el) + (mastodon-tl--render-text + (prin1-to-string (cdr el))) + "\n"))))))) + +(defun mastodon-tl--print-instance-rules-or-fields (alist) + "Print ALIST of instance rules or contact account fields." + (let ((key (if (alist-get 'id alist) 'id 'name)) + (value (if (alist-get 'id alist) 'text 'value))) + (indent-to 4) + (insert (format "%-5s: " + (alist-get key alist)) + (mastodon-tl--newline-if-long (assoc value alist)) + (format "%s" (mastodon-tl--render-text + (alist-get value alist))) + "\n"))) + +(defun mastodon-tl--newline-if-long (el) + "Return a newline string if the cdr of EL is over 50 characters long." + (if (and (sequencep (cdr el)) + (< 50 (length (cdr el)))) + "\n" + "")) + (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. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 23abb84..7f867fe 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -71,6 +71,8 @@ (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-toot "mastodon") +(autoload 'mastodon-profile--get-source-pref "mastodon-profile") +(autoload 'mastodon-profile--update-preference "mastodon-profile") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -82,18 +84,6 @@ :prefix "mastodon-toot-" :group 'mastodon) -(defcustom mastodon-toot--default-visibility "public" - "The default visibility for new toots. - -Must be one of \"public\", \"unlisted\", \"private\" (for -followers-only), or \"direct\"." - :group 'mastodon-toot - :type '(choice - (const :tag "public" "public") - (const :tag "unlisted" "unlisted") - (const :tag "followers only" "private") - (const :tag "direct" "direct"))) - (defcustom mastodon-toot--default-media-directory "~/" "The default directory when prompting for a media file to upload." :group 'mastodon-toot @@ -137,11 +127,17 @@ This is only used if company mode is installed." (defvar-local mastodon-toot--content-nsfw nil "A flag indicating whether the toot should be marked as NSFW.") +(defvar mastodon-toot-visibility-list + '(direct private unlisted public) + "A list of the available toot visibility settings.") + (defvar-local mastodon-toot--visibility "public" "A string indicating the visibility of the toot being composed. Valid values are \"direct\", \"private\" (followers-only), -\"unlisted\", and \"public\".") +\"unlisted\", and \"public\". + +This may be set by the account setting on the server.") (defvar-local mastodon-toot--media-attachments nil "A list of the media attachments of the toot being composed.") @@ -169,6 +165,14 @@ Valid values are \"direct\", \"private\" (followers-only), map) "Keymap for `mastodon-toot'.") +(defun mastodon-toot-set-default-visibility () + "Set the default visibility for toots on the server." + (interactive) + (let ((vis (completing-read "Set default visibility to:" + mastodon-toot-visibility-list + nil t))) + (mastodon-profile--update-preference "privacy" vis :source))) + (defun mastodon-toot--get-max-toot-chars () "Fetch max_toot_chars from `mastodon-instance-url' asynchronously." (mastodon-http--get-json-async @@ -657,7 +661,7 @@ The query is matched against a tag search on the server." 'mastodon-toot--tags-company-make-candidate)) (defun mastodon-toot--make-company-backend - (command backend-name str-prefix candidates-fun annot-fun meta-fun + (command _backend-name str-prefix candidates-fun annot-fun meta-fun &optional arg &rest ignored) "Make a company backend for `mastodon-toot-mode'. @@ -1030,11 +1034,15 @@ REPLY-JSON is the full JSON of the toot being replied to." (switch-to-buffer-other-window buffer) (text-mode) (mastodon-toot-mode t) + ;; use toot visibility setting from the server: + (setq mastodon-toot--visibility + (mastodon-profile--get-source-pref 'privacy)) (unless buffer-exists (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json)) (unless mastodon-toot--max-toot-chars (mastodon-toot--get-max-toot-chars)) + ;; set up company backends: (when (require 'company nil :noerror) (when mastodon-toot--enable-completion (set (make-local-variable 'company-backends) |