Merge branch 'poll-transient' into develop

3 files changed, 216 insertions, 49 deletions

diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index df1a773..4e116fa 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -53,6 +53,7 @@
 (defvar mastodon-tl--enable-proportional-fonts)
 (defvar mastodon-profile-account-settings)
 (defvar mastodon-profile-acccount-preferences-data)
+(defvar tp-transient-settings)
 
 (autoload 'iso8601-parse "iso8601")
 (autoload 'mastodon-auth--user-acct "mastodon-auth")
@@ -100,6 +101,8 @@
 (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile")
 (autoload 'mastodon-views--get-own-instance "mastodon-views")
 (autoload 'mastodon-tl--image-trans-check "mastodon-tl")
+(autoload 'mastodon-instance-data "mastodon")
+(autoload 'mastodon-create-poll "mastodon-transient")
 
 ;; for mastodon-toot--translate-toot-text
 (autoload 'mastodon-tl--content "mastodon-tl")
@@ -168,6 +171,10 @@ By default fixed width fonts are used."
   :type '(boolean :tag "Enable using proportional rather than fixed \
 width fonts"))
 
+(defcustom mastodon-toot-poll-use-transient t
+  "Whether to use the transient menu to create a poll."
+  :type '(boolean))
+
 (defvar-local mastodon-toot--content-warning nil
   "The content warning of the current toot.")
 
@@ -198,8 +205,8 @@ change the setting on the server, see
 (defvar-local mastodon-toot--media-attachment-ids nil
   "A list of any media attachment ids of the toot being composed.")
 
-(defvar-local mastodon-toot-poll nil
-  "A list of poll options for the toot being composed.")
+(defvar mastodon-toot-poll nil
+  "A plist of poll options for the toot being composed.")
 
 (defvar-local mastodon-toot--language nil
   "The language of the toot being composed, in ISO 639 (two-letter).")
@@ -758,9 +765,9 @@ If toot is not empty, prompt to save text as a draft."
 Pushes `mastodon-toot-current-toot-text' to
 `mastodon-toot-draft-toots-list'."
   (interactive)
-  (unless (eq mastodon-toot-current-toot-text nil)
+  (unless (string= mastodon-toot-current-toot-text nil)
     (cl-pushnew mastodon-toot-current-toot-text
-                mastodon-toot-draft-toots-list :test 'equal)
+                mastodon-toot-draft-toots-list :test 'string=)
     (message "Draft saved!")))
 
 (defun mastodon-toot--empty-p (&optional text-only)
@@ -769,7 +776,7 @@ TEXT-ONLY means don't check for attachments or polls."
   (and (if text-only
            t
          (and (not mastodon-toot--media-attachments)
-              (not mastodon-toot-poll)))
+              (not (mastodon-toot-poll-var))))
        (string-empty-p (mastodon-tl--clean-tabs-and-nl
                         (mastodon-toot--remove-docs)))))
 
@@ -869,13 +876,22 @@ to `emojify-user-emojis', and the emoji data is updated."
 
 (defun mastodon-toot--build-poll-params ()
   "Return an alist of parameters for POSTing a poll status."
-  (append
-   (mastodon-http--build-array-params-alist
-    "poll[options][]"
-    (plist-get mastodon-toot-poll :options))
-   `(("poll[expires_in]" .  ,(plist-get mastodon-toot-poll :expiry)))
-   `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
-   `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide))))))
+  (if mastodon-toot-poll-use-transient
+      (let-alist tp-transient-settings
+        (append
+         (mastodon-http--build-array-params-alist
+          "poll[options][]"
+          (list .one .two .three .four))
+         (list (cons "poll[expires_in]" .expiry)
+               (cons "poll[multiple]" .multi)
+               (cons "poll[hide_totals]" .hide))))
+    (append
+     (mastodon-http--build-array-params-alist
+      "poll[options][]"
+      (plist-get mastodon-toot-poll :options))
+     `(("poll[expires_in]" .  ,(plist-get mastodon-toot-poll :expiry)))
+     `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
+     `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))))
 
 
 ;;; SEND TOOT FUNCTION
@@ -894,26 +910,29 @@ instance to edit a toot."
          (endpoint (mastodon-http--api (if edit-id ; we are sending an edit:
                                            (format "statuses/%s" edit-id)
                                          "statuses")))
-         (args-no-media (append `(("status" . ,toot)
-                                  ("in_reply_to_id" . ,mastodon-toot--reply-to-id)
-                                  ("visibility" . ,mastodon-toot--visibility)
-                                  ("sensitive" . ,(when mastodon-toot--content-nsfw
-                                                    (symbol-name t)))
-                                  ("spoiler_text" . ,mastodon-toot--content-warning)
-                                  ("language" . ,mastodon-toot--language))
-                                ;; Pleroma instances can't handle null-valued
-                                ;; scheduled_at args, so only add if non-nil
-                                (when scheduled `(("scheduled_at" . ,scheduled)))))
+         (args-no-media
+          (append
+           `(("status" . ,toot)
+             ("in_reply_to_id" . ,mastodon-toot--reply-to-id)
+             ("visibility" . ,mastodon-toot--visibility)
+             ("sensitive" . ,(when mastodon-toot--content-nsfw
+                               (symbol-name t)))
+             ("spoiler_text" . ,mastodon-toot--content-warning)
+             ("language" . ,mastodon-toot--language))
+           ;; Pleroma instances can't handle null-valued
+           ;; scheduled_at args, so only add if non-nil
+           (when scheduled `(("scheduled_at" . ,scheduled)))))
          (args-media (when mastodon-toot--media-attachment-ids
                        (mastodon-http--build-array-params-alist
                         "media_ids[]"
                         mastodon-toot--media-attachment-ids)))
-         (args-poll (when mastodon-toot-poll
+         (poll-var (mastodon-toot-poll-var))
+         (args-poll (when poll-var
                       (mastodon-toot--build-poll-params)))
          ;; media || polls:
          (args (if mastodon-toot--media-attachment-ids
                    (append args-media args-no-media)
-                 (if mastodon-toot-poll
+                 (if poll-var
                      (append args-no-media args-poll)
                    args-no-media)))
          (prev-window-config mastodon-toot-previous-window-config))
@@ -940,6 +959,8 @@ instance to edit a toot."
               (lambda (_)
                 ;; kill buffer:
                 (mastodon-toot--kill)
+                ;; nil our poll var:
+                (set poll-var nil)
                 (message "Toot %s!" (if scheduled "scheduled" "toot"))
                 ;; cancel scheduled toot if we were editing it:
                 (when scheduled-id
@@ -1370,6 +1391,12 @@ which is used to attach it to a toot when posting."
 
 ;;; POLL
 
+(defun mastodon-toot-poll-var ()
+  "Return the correct poll var."
+  (if mastodon-toot-poll-use-transient
+      'tp-transient-settings
+    'mastodon-toot-poll))
+
 (defun mastodon-toot--fetch-max-poll-options (instance)
   "Return the maximum number of poll options from JSON data INSTANCE."
   (mastodon-toot--fetch-poll-field 'max_options instance))
@@ -1401,7 +1428,13 @@ MAX is the maximum number set by their instance."
 (defun mastodon-toot--create-poll ()
   "Prompt for new poll options and return as a list."
   (interactive)
-  (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance")))
+  (if mastodon-toot-poll-use-transient
+      (mastodon-create-poll)
+    (mastodon-toot--read-poll)))
+
+(defun mastodon-toot--read-poll ()
+  "Read poll options."
+  (let* ((instance (mastodon-instance-data))
          (max-options (mastodon-toot--fetch-max-poll-options instance))
          (count (mastodon-toot--read-poll-options-count max-options))
          (length (mastodon-toot--fetch-max-poll-option-chars instance))
@@ -1426,12 +1459,11 @@ LENGTH is the maximum character length allowed for a poll option."
                             (format "Poll option [%s/%s] [max %s chars]: "
                                     x count length))))
          (longest (apply #'max (mapcar #'length choices))))
-    (if (> longest length)
-        (progn
-          (user-error "Looks like you went over the max length. Try again")
-          (sleep-for 2)
-          (mastodon-toot--read-poll-options count length))
-      choices)))
+    (if (not (> longest length))
+        choices
+      (user-error "Looks like you went over the max length. Try again")
+      (sleep-for 2)
+      (mastodon-toot--read-poll-options count length))))
 
 (defun mastodon-toot--read-poll-expiry ()
   "Prompt for a poll expiry time.
@@ -1460,10 +1492,11 @@ Return a cons of a human readable string, and a seconds-from-now string."
   "Remove poll from toot compose buffer.
 Sets `mastodon-toot-poll' to nil."
   (interactive)
-  (if (not mastodon-toot-poll)
-      (user-error "No poll?")
-    (setq mastodon-toot-poll nil)
-    (mastodon-toot--update-status-fields)))
+  (let ((var (mastodon-toot-poll-var)))
+    (if (not var)
+        (user-error "No poll?")
+      (set var nil)
+      (mastodon-toot--update-status-fields))))
 
 (defun mastodon-toot--server-poll-to-local (json)
   "Convert server poll data JSON to a `mastodon-toot-poll' plist."
@@ -1479,9 +1512,18 @@ Sets `mastodon-toot-poll' to nil."
                           (mastodon-tl--human-duration expiry-seconds-rel)))
            (options (mastodon-tl--map-alist 'title .options))
            (multiple (if (eq :json-false .multiple) nil t)))
-      (setq mastodon-toot-poll
-            `( :options ,options :expiry-readable ,expiry-human
-               :expiry ,expiry-str :multi ,multiple)))))
+      (if mastodon-toot-poll-use-transient
+          (setq tp-transient-settings
+                `((multi . ,multiple)
+                  (expiry . ,expiry-str)
+                  ;; (hide . ,hide)
+                  (one . ,(nth 0 options))
+                  (two . ,(nth 1 options))
+                  (three . ,(nth 2 options))
+                  (four . ,(nth 3 options))))
+        (setq mastodon-toot-poll
+              `( :options ,options :expiry-readable ,expiry-human
+                 :expiry ,expiry-str :multi ,multiple))))))
 
 
 ;;; SCHEDULE
@@ -1759,7 +1801,8 @@ REPLY-REGION is a string to be injected into the buffer."
            (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag
                                                           (point-min)))
            (toot-string (buffer-substring-no-properties (cdr header-region)
-                                                        (point-max))))
+                                                        (point-max)))
+           (poll-var (mastodon-toot-poll-var)))
       (mastodon-toot--apply-fields-props
        count-region
        (format "%s/%s chars"
@@ -1793,9 +1836,11 @@ REPLY-REGION is a string to be injected into the buffer."
        'mastodon-cw-face)
       (mastodon-toot--apply-fields-props
        poll-region
-       (if mastodon-toot-poll "POLL" "")
+       (if (symbol-value poll-var)
+           "POLL"
+         "")
        'mastodon-cw-face
-       (prin1-to-string mastodon-toot-poll))
+       (prin1-to-string (symbol-value poll-var)))
       (mastodon-toot--apply-fields-props
        cw-region
        (if (and mastodon-toot--content-warning
diff --git a/lisp/mastodon-transient.el b/lisp/mastodon-transient.el
index 526dfa4..67ea667 100644
--- a/lisp/mastodon-transient.el
+++ b/lisp/mastodon-transient.el
@@ -25,6 +25,26 @@
 ;;; Code:
 
 (require 'tp)
+(require 'transient)
+
+(defvar mastodon-active-user)
+(defvar mastodon-toot-visibility-settings-list)
+(defvar mastodon-iso-639-regional)
+(defvar mastodon-toot-poll)
+
+(autoload 'mastodon-toot-visibility-settings-list "mastodon-toot")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--triage "mastodon-http")
+(autoload 'mastodon-http--patch "mastodon-http")
+(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile")
+(autoload 'mastodon-toot--fetch-max-poll-options "mastodon-toot")
+(autoload 'mastodon-toot--fetch-max-poll-option-chars "mastodon-toot")
+(autoload 'mastodon-instance-data "mastodon")
+(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
+(autoload 'mastodon-toot--read-poll-expiry "mastodon-toot")
+(autoload 'mastodon-toot--poll-expiry-options-alist "mastodon-toot")
+(autoload 'mastodon-toot--clear-poll "mastodon-toot")
 
 ;;; UTILS
 
@@ -163,13 +183,12 @@ the format fields.X.keyname."
 (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)))
+  (setq tp-transient-settings
+        (mastodon-transient--fields-alist tp-transient-settings)))
 
 (transient-define-prefix mastodon-profile-fields ()
   "A transient for setting profile fields."
-  :value
-  (lambda () (mastodon-transient-fetch-fields))
+  :value (lambda () (mastodon-transient-fetch-fields))
   [:description
    "Fields"
    ["Name"
@@ -190,6 +209,68 @@ the format fields.X.keyname."
       (user-error "User not set")
     (transient-setup 'mastodon-profile-fields)))
 
+(defun mastodon-transient-max-poll-opts ()
+  "Return max poll options of user's instance."
+  (let ((instance (mastodon-instance-data)))
+    (mastodon-toot--fetch-max-poll-options instance)))
+
+(defun mastodon-transient-max-poll-opt-chars ()
+  "Return max poll option characters of user's instance."
+  (let ((instance (mastodon-instance-data)))
+    (mastodon-toot--fetch-max-poll-option-chars instance)))
+
+(transient-define-prefix mastodon-create-poll ()
+  "A transient for creating a poll."
+  ;; FIXME: handle existing polls when editing a toot
+  :value (lambda () tp-transient-settings)
+  ["Create poll"
+   (:info (lambda ()
+            (format "Max options: %s"
+                    (mastodon-transient-max-poll-opts))))
+   (:info (lambda ()
+            (format "Max option length: %s"
+                    (mastodon-transient-max-poll-opt-chars))))]
+  ["Options"
+   ("m" "Multiple choice?" "multi" :alist-key multi
+    :class mastodon-transient-poll-bool)
+   ("h" "Hide vote count till expiry?" "hide" :alist-key hide
+    :class mastodon-transient-poll-bool)
+   ("e" "Expiry" "expiry" :alist-key expiry
+    :class mastodon-transient-expiry)]
+  ["Choices"
+   ("1" "" "1" :alist-key one :class mastodon-transient-poll-choice)
+   ("2" "" "2" :alist-key two :class mastodon-transient-poll-choice)
+   ("3" "" "3" :alist-key three :class mastodon-transient-poll-choice)
+   ("4" "" "4" :alist-key four :class mastodon-transient-poll-choice)]
+  ;; TODO: display the max number of options or add options cmd
+  ["Update"
+   ("C-c C-c" "Save and done" mastodon-create-poll-done)
+   ("C-c C-k" "Delete all" mastodon-clear-poll)
+   ("C-x C-k" :info "Revert all")]
+  (interactive)
+  (if (not mastodon-active-user)
+      (user-error "User not set")
+    (transient-setup 'mastodon-create-poll)))
+
+(transient-define-suffix mastodon-clear-poll ()
+  "Clear current poll data."
+  :transient 'transient--do-stay
+  (interactive)
+  (mastodon-toot--clear-poll)
+  (transient-reset))
+
+(transient-define-suffix mastodon-create-poll-done (args)
+  "Update current user profile fields."
+  :transient 'transient--do-exit
+  (interactive (list (transient-args 'mastodon-create-poll)))
+  ;; FIXME: if
+  ;; - no options filled in
+  ;; - no expiry
+  ;; then offer to cancel or warn / return to transient
+  (setq tp-transient-settings
+        (tp-bools-to-strs args))
+  (mastodon-toot--update-status-fields))
+
 ;;; CLASSES
 
 (defclass mastodon-transient-field (tp-option-str)
@@ -197,10 +278,22 @@ the format fields.X.keyname."
   "An infix option class for our options.
 We always read.")
 
+(defclass mastodon-transient-opt (tp-option tp-option-var)
+  (()))
+
+(defclass mastodon-transient-poll-bool (tp-bool tp-option-var)
+  ())
+
+(defclass mastodon-transient-poll-choice (tp-option-str tp-option-var)
+  ())
+
+(defclass mastodon-transient-expiry (tp-option tp-option-var)
+  ())
+
 (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)))
+  (let* ((prefix-val (oref transient--prefix value)))
+    ;; (arg (oref obj alist-key)))
     (oset obj value
           (tp-get-server-val obj prefix-val))))
 
@@ -219,12 +312,32 @@ only one level of nesting is supported."
   "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)) "\\."))
+                     (symbol-name (car cons)) "\\."))
          (num (1- (string-to-number (nth 1 key-split))))
          (server-key (symbol-name (car cons)))
-         (server-elt (nth num tp-server-settings)))
+         (server-elt (nth num tp-transient-settings)))
     (not (equal (cdr cons)
                 (alist-get server-key server-elt nil nil #'string=)))))
 
+(cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry))
+  "Reader function for OBJ, a poll expiry."
+  (cdr (mastodon-toot--read-poll-expiry)))
+
+(cl-defmethod transient-format-value ((obj mastodon-transient-expiry))
+  "Format function for OBJ, a poll expiry."
+  (let* ((cons (transient-infix-value obj))
+         (value (when cons (cdr cons))))
+    (if (not value)
+        ""
+      (let ((readable
+             (or (car
+                  (rassoc value
+                          (mastodon-toot--poll-expiry-options-alist)))
+                 (concat value " secs")))) ;; editing a poll wont match expiry list
+        (propertize readable
+                    'face (if (tp-arg-changed-p obj cons)
+                              'transient-value
+                            'transient-inactive-value))))))
+
 (provide 'mastodon-transient)
 ;;; mastodon-transient.el ends here
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 89e2a87..8560902 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -337,6 +337,15 @@ FORCE means to fetch from the server in any case and update
     ;; else just return the var:
     mastodon-profile-credential-account))
 
+(defvar mastodon-instance-data nil
+  "Instance data from the instance endpoint.")
+
+(defun mastodon-instance-data ()
+  "Return `mastodon-instnace-data' or else fetch from instance endpoint."
+  (or mastodon-instance-data
+      (setq mastodon-instance-data
+            (mastodon-http--get-json (mastodon-http--api "instance")))))
+
 ;;;###autoload
 (defun mastodon-toot (&optional user reply-to-id reply-json)
   "Update instance with new toot. Content is captured in a new buffer.