Merge branch 'develop'

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)