diff options
Diffstat (limited to 'lisp/mastodon-transient.el')
| -rw-r--r-- | lisp/mastodon-transient.el | 124 |
1 files changed, 103 insertions, 21 deletions
diff --git a/lisp/mastodon-transient.el b/lisp/mastodon-transient.el index 67ea667..00d9acf 100644 --- a/lisp/mastodon-transient.el +++ b/lisp/mastodon-transient.el @@ -48,6 +48,20 @@ ;;; UTILS +(transient-define-suffix mastodon-transient--prefix-inspect () + "Inspect a transient prefix's arguments and scope." + (interactive) + :transient 'transient--do-return + (let ((args (transient-args (oref transient-current-prefix command))) + (scope (oref transient-current-prefix scope))) + (message "prefix's scope: %s \ntransient-args: %s\n last: %s" + scope args + (length + (cl-member-if + (lambda (x) + (equal (car x) 'one)) + args))))) + ;; 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: @@ -219,6 +233,37 @@ the format fields.X.keyname." (let ((instance (mastodon-instance-data))) (mastodon-toot--fetch-max-poll-option-chars instance))) +(transient-define-suffix mastodon-transient--choice-add () + "docstring" + (interactive) + :transient 'transient--do-stay + (let* ((args (transient-args (oref transient-current-prefix command))) + (choice-count (length + (cl-member-if + (lambda (x) + (equal (car x) 'one)) + args))) + (inc (1+ choice-count)) + (next (number-to-string inc)) + (next-symbol (pcase inc + (5 'five) + (6 'six) + (7 'seven) + (8 'eight) + (9 'nine)))) + (if (or (>= choice-count (mastodon-transient-max-poll-opts)) + (= choice-count 9)) + ;; FIXME when we hit '10', we get a binding clash with '1'. :/ + (message "Max choices reached") + (transient-append-suffix + 'mastodon-create-poll + '(2 -1) + `(,next "" ,next + :class mastodon-transient-poll-choice + :alist-key ,next-symbol + :transient t)))) + (transient-setup 'mastodon-create-poll)) + (transient-define-prefix mastodon-create-poll () "A transient for creating a poll." ;; FIXME: handle existing polls when editing a toot @@ -244,9 +289,11 @@ the format fields.X.keyname." ("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-s" "Add another poll choice" mastodon-transient--choice-add + :if (lambda () (< 4 (mastodon-transient-max-poll-opts)))) ("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")] + ("C-x C-k" :info "Revert all") + ("C-c C-k" "Delete all" mastodon-clear-poll)] (interactive) (if (not mastodon-active-user) (user-error "User not set") @@ -263,13 +310,32 @@ the format fields.X.keyname." "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)) + (let* ((options (cl-member-if (lambda (x) + (eq (car x) 'one)) + args)) + (opt-vals (cl-loop for x in options + collect (cdr x))) + (lengths (mapcar #'length opt-vals)) + (vals (cl-remove 'nil + (cl-loop for x in args + collect (cdr x)))) + (opts-count (length (cl-remove 'nil opt-vals)))) + ;; this way of checking gets annoying if we want to just cancel out of + ;; the poll (but to actually cancel user should C-g, not C-c C-c): + (if (or (and (< 50 (apply #'max lengths)) + (not (y-or-n-p "Options longer than server max. Proceed? "))) + (and (not (alist-get 'expiry args)) + (not (y-or-n-p "No expiry. Proceed? "))) + (and (not (< 1 opts-count)) + (not (y-or-n-p "Need more than one option. Proceed? "))) + (and (> opts-count (mastodon-transient-max-poll-opts)) + (not (y-or-n-p "More options than server max. Proceed? ")))) + (mastodon-create-poll) + ;; if we are called with no poll data, do not set: + (unless (not vals) + (setq tp-transient-settings + (tp-bools-to-strs args))) + (mastodon-toot--update-status-fields)))) ;;; CLASSES @@ -278,18 +344,6 @@ 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))) @@ -319,6 +373,34 @@ CONS is a cons of the form \"(fields.1.name . val)\"." (not (equal (cdr cons) (alist-get server-key server-elt nil nil #'string=))))) +(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) + ()) + +(cl-defmethod transient-infix-read ((obj mastodon-transient-poll-choice)) + "Reader function for OBJ, a poll expiry." + (let* ((value (transient-infix-value obj)) + (prompt (transient-prompt obj)) + (str (read-string prompt (cdr value))) + (max (mastodon-transient-max-poll-opt-chars))) + (if (not (> (length str) max)) + str + (if (not + (y-or-n-p + (format "Poll option too long for server (%s/%s chars), retry?" + (length str) max))) + str + (oset obj value str) + (transient-infix-read obj))))) + +(defclass mastodon-transient-expiry (tp-option tp-option-var) + ()) + (cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry)) "Reader function for OBJ, a poll expiry." (cdr (mastodon-toot--read-poll-expiry))) |