diff options
Diffstat (limited to 'lisp')
| -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 |
5 files changed, 263 insertions, 36 deletions
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) |