Merge branch 'develop'

1 files changed, 230 insertions, 0 deletions

diff --git a/lisp/mastodon-transient.el b/lisp/mastodon-transient.el
new file mode 100644
index 0000000..526dfa4
--- /dev/null
+++ b/lisp/mastodon-transient.el
@@ -0,0 +1,230 @@
+;;; mastodon-transient.el --- transient menus for mastodon.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  martian hiatus
+
+;; Author: martian hiatus <mousebot@disroot.org>
+;; Keywords: convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(require 'tp)
+
+;;; UTILS
+
+;; some JSON fields that are returned under the "source" field need to be
+;; sent back in the format source[key], while some others are sent kust as
+;; key:
+(defun mastodon-transient-parse-source-key (key)
+  "Parse mastodon source KEY.
+If KEY needs to be source[key], format like so, else just return
+the inner key part."
+  (let* ((split (split-string key "[][]"))
+         (array-key (cadr split)))
+    (if (or (= 1 (length split)) ;; no split
+            (member array-key '("privacy" "sensitive" "language")))
+        key
+      array-key)))
+
+(defun mastodon-transient-parse-source-keys (alist)
+  "Parse ALIST containing source[key] keys."
+  (cl-loop for a in alist
+           collect (cons (mastodon-transient-parse-source-key (car a))
+                         (cdr a))))
+
+(defun mastodon-transient-get-creds ()
+  "Fetch account data."
+  (mastodon-http--get-json
+   (mastodon-http--api "accounts/verify_credentials")
+   nil :silent))
+
+;; fields utils:
+;; to PATCH fields, we just need fields[x][name] and fields[x][value]
+
+(defun mastodon-transient--fields-alist (fields)
+  "Convert fields in FIELDS to numbered conses.
+The keys in the data are not numbered, so we convert the key into
+the format fields.X.keyname."
+  (cl-loop
+   for f in fields
+   for count from 1 to 5
+   collect
+   (cl-loop for x in f
+            collect
+            (cons (concat "fields." (number-to-string count)
+                          "." (symbol-name (car x)))
+                  (cdr x)))))
+
+(defun mastodon-transient-field-dot-to-array (key)
+  "Convert KEY from tp dot annotation to array[key] annotation."
+  (tp-dot-to-array (symbol-name key) nil "_attributes"))
+
+(defun mastodon-transient-dot-fields-to-arrays (alist)
+  "Parse fields ALIST in dot notation to array notation."
+  (cl-loop for y in alist
+           collect
+           (cons (mastodon-transient-field-dot-to-array (car y))
+                 (cdr y))))
+
+;;; TRANSIENTS
+
+;; FIXME: PATCHing source vals as JSON request body doesn't work! existing
+;; `mastodon-profile--update-preference' doesn't use it! it just uses
+;; query params! strange thing is it works for non-source params
+(transient-define-suffix mastodon-user-settings-update (&optional args)
+  "Update current user settings on the server."
+  :transient 'transient--do-exit
+  (interactive (list (transient-args 'mastodon-user-settings)))
+  (let* ((parsed (tp-parse-args-for-send args :strings))
+         (strs (mastodon-transient-parse-source-keys parsed))
+         (url (mastodon-http--api "accounts/update_credentials"))
+         (resp (mastodon-http--patch url strs))) ;; :json fails
+    (mastodon-http--triage
+     resp
+     (lambda (_)
+       (message "Settings updated!\n%s" (pp-to-string strs))))))
+
+(transient-define-prefix mastodon-user-settings ()
+  "A transient for setting current user settings."
+  :value (lambda () (tp-return-data
+                     #'mastodon-transient-get-creds))
+  [:description
+   (lambda ()
+     (format "User settings for %s" mastodon-active-user))
+   (:info
+    "Note: use the empty string (\"\") to remove a value from an option.")]
+  ;; strings
+  ["Account info"
+   ("n" "display name" "display_name" :alist-key display_name :class tp-option-str)
+   ("t" "update profile note" mastodon-update-profile-note)
+   ("f" "update profile fields" mastodon-profile-fields)]
+  ;; "choice" booleans (so we can PATCH :json-false explicitly):
+  ["Account options"
+   ("l" "locked" "locked" :alist-key locked :class tp-bool)
+   ("b" "bot" "bot" :alist-key bot :class tp-bool)
+   ("d"  "discoverable" "discoverable" :alist-key discoverable :class tp-bool)
+   ("c" "hide follower/following lists" "source.hide_collections"
+    :alist-key source.hide_collections :class tp-bool)
+   ("i" "indexable" "source.indexable" :alist-key source.indexable :class tp-bool)
+   ]
+  ["Tooting options"
+   ("p" "default privacy" "source.privacy" :alist-key source.privacy
+    :class tp-option
+    :choices (lambda () mastodon-toot-visibility-settings-list))
+   ("s" "mark sensitive" "source.sensitive" :alist-key source.sensitive :class tp-bool)
+   ("g" "default language" "source.language" :alist-key source.language :class tp-option
+    :choices (lambda () mastodon-iso-639-regional))
+   ]
+  ["Update"
+   ("C-c C-c" "Save settings" mastodon-user-settings-update)
+   ("C-c C-k" :info "Revert all changes")]
+  (interactive)
+  (if (or (not (boundp 'mastodon-active-user))
+          (not mastodon-active-user))
+      (user-error "User not set")
+    (transient-setup 'mastodon-user-settings)))
+
+(transient-define-suffix mastodon-update-profile-note ()
+  "Update current user profile note."
+  :transient 'transient--do-exit
+  (interactive)
+  (mastodon-profile--update-user-profile-note))
+
+(transient-define-suffix mastodon-profile-fields-update (args)
+  "Update current user profile fields."
+  :transient 'transient--do-return
+  (interactive (list (transient-args 'mastodon-profile-fields)))
+  (let* (;; FIXME: maybe only changed also won't work with fields, as
+         ;; perhaps what is PATCHed overwrites whatever is on the server?
+         ;; (only-changed (tp-only-changed-args alist))
+         (arrays (mastodon-transient-dot-fields-to-arrays args))
+         (endpoint "accounts/update_credentials")
+         (url (mastodon-http--api endpoint))
+         (resp (mastodon-http--patch url arrays))) ; :json)))
+    (mastodon-http--triage
+     resp (lambda (_) (message "Fields updated!")))))
+
+(defun mastodon-transient-fetch-fields ()
+  "Fetch profile fields (metadata)."
+  (tp-return-data #'mastodon-transient-get-creds nil 'fields)
+  (setq tp-server-settings
+        (mastodon-transient--fields-alist tp-server-settings)))
+
+(transient-define-prefix mastodon-profile-fields ()
+  "A transient for setting profile fields."
+  :value
+  (lambda () (mastodon-transient-fetch-fields))
+  [:description
+   "Fields"
+   ["Name"
+    ("1 n" "" "fields.1.name" :alist-key fields.1.name :class mastodon-transient-field)
+    ("2 n" "" "fields.2.name" :alist-key fields.2.name :class mastodon-transient-field)
+    ("3 n" "" "fields.3.name" :alist-key fields.3.name :class mastodon-transient-field)
+    ("4 n" "" "fields.4.name" :alist-key fields.4.name :class mastodon-transient-field)]
+   ["Value"
+    ("1 v" "" "fields.1.value" :alist-key fields.1.value :class mastodon-transient-field)
+    ("2 v" "" "fields.2.value" :alist-key fields.2.value :class mastodon-transient-field)
+    ("3 v" "" "fields.3.value" :alist-key fields.3.value :class mastodon-transient-field)
+    ("4 v" "" "fields.4.value" :alist-key fields.4.value :class mastodon-transient-field)]]
+  ["Update"
+   ("C-c C-c" "Save settings" mastodon-profile-fields-update)
+   ("C-c C-k" :info "Revert all changes")]
+  (interactive)
+  (if (not mastodon-active-user)
+      (user-error "User not set")
+    (transient-setup 'mastodon-profile-fields)))
+
+;;; CLASSES
+
+(defclass mastodon-transient-field (tp-option-str)
+  ((always-read :initarg :always-read :initform t))
+  "An infix option class for our options.
+We always read.")
+
+(cl-defmethod transient-init-value ((obj mastodon-transient-field))
+  "Initialize value of OBJ."
+  (let* ((prefix-val (oref transient--prefix value))
+         (arg (oref obj alist-key)))
+    (oset obj value
+          (tp-get-server-val obj prefix-val))))
+
+(cl-defmethod tp-get-server-val ((obj mastodon-transient-field) data)
+  "Return the server value for OBJ from DATA.
+If OBJ's key has dotted notation, drill down into the alist. Currently
+only one level of nesting is supported."
+  ;; TODO: handle nested alist keys
+  (let* ((key (oref obj alist-key))
+         (split (split-string (symbol-name key) "\\."))
+         (num (string-to-number (cadr split))))
+    (alist-get key
+               (nth (1- num) data) nil nil #'string=)))
+
+(cl-defmethod tp-arg-changed-p ((_obj mastodon-transient-field) cons)
+  "T if value of OBJ is changed from the server value.
+CONS is a cons of the form \"(fields.1.name . val)\"."
+  (let* ((key-split (split-string
+                     (symbol-to-string (car cons)) "\\."))
+         (num (1- (string-to-number (nth 1 key-split))))
+         (server-key (symbol-name (car cons)))
+         (server-elt (nth num tp-server-settings)))
+    (not (equal (cdr cons)
+                (alist-get server-key server-elt nil nil #'string=)))))
+
+(provide 'mastodon-transient)
+;;; mastodon-transient.el ends here