From 99da98a03519d08ab0779d5b21e04760848ae87d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Oct 2024 10:14:11 +0200 Subject: transient poll: use tp-transient-settings, handle repeated poll edits also integrate with toot code: send, update display, etc. --- lisp/mastodon-toot.el | 65 +++++++++++++++++++++++++++++++-------------- lisp/mastodon-transient.el | 66 ++++++++++++++++++++++++++++------------------ 2 files changed, 86 insertions(+), 45 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index efcbc72..35124ea 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") @@ -202,7 +205,7 @@ 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 +(defvar mastodon-toot-poll nil "A plist of poll options for the toot being composed.") (defvar-local mastodon-toot--language nil @@ -760,9 +763,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) @@ -771,7 +774,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))))) @@ -871,13 +874,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 @@ -912,12 +924,13 @@ instance to edit a toot." (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)) @@ -944,6 +957,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 @@ -1374,6 +1389,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)) @@ -1469,10 +1490,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." @@ -1768,7 +1790,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" @@ -1802,9 +1825,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 fbdfcb0..4776c4b 100644 --- a/lisp/mastodon-transient.el +++ b/lisp/mastodon-transient.el @@ -25,6 +25,7 @@ ;;; Code: (require 'tp) +(require 'transient) (defvar mastodon-active-user) (defvar mastodon-toot-visibility-settings-list) @@ -43,6 +44,7 @@ (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 @@ -181,8 +183,8 @@ 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." @@ -220,8 +222,7 @@ the format fields.X.keyname." (transient-define-prefix mastodon-create-poll () "A transient for creating a poll." ;; FIXME: handle existing polls when editing a toot - ;; FIXME: handle editing poll in same toot! - ;; :value (lambda () (mastodon-transient-init-poll)) + :value (lambda () tp-transient-settings) ["Create poll" (:info (lambda () (format "Max options: %s" @@ -230,9 +231,12 @@ the format fields.X.keyname." (format "Max option length: %s" (mastodon-transient-max-poll-opt-chars))))] ["Options" - ("m" "Multiple choice?" "multi" :alist-key multi :class tp-bool) - ("h" "Hide vote count till expiry?" "hide" :alist-key hide :class tp-bool) - ("e" "Expiry" "expiry" :alist-key expiry :class mastodon-transient-expiry)] + ("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 tp-option-str) ("2" "" "2" :alist-key two :class tp-option-str) @@ -240,35 +244,31 @@ the format fields.X.keyname." ("4" "" "4" :alist-key four :class tp-option-str)] ;; TODO: display the max number of options or add options cmd ["Update" - ("C-c C-c" "Done" mastodon-create-poll-done) - ("C-c C-k" :info "Revert all")] + ("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))) - ;; (message "Done!\n%s" args) - ;; this is a mess, but we are just plugging our transient data into the - ;; existing variable, as we already have code to post that. we don't - ;; want to post the poll in our suffix, just set the variable and send - ;; the data when the toot is sent - ;; FIXME: if ;; - no options filled in ;; - no expiry ;; then offer to cancel or warn / return to transient - (let-alist args - (setq mastodon-toot-poll - `( :options ,(list .one .two .three .four) - ;; :length ,length - ;; :expiry-readable ,expiry-human - :multi ,.multi - :hide ,.hide - :expiry ,.expiry))) + (setq tp-transient-settings + (tp-bools-to-strs args)) (mastodon-toot--update-status-fields)) ;;; CLASSES @@ -303,12 +303,28 @@ CONS is a cons of the form \"(fields.1.name . val)\"." (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=))))) +(defclass mastodon-transient-poll-bool (tp-bool) + ()) + +(cl-defmethod transient-init-value ((obj mastodon-transient-poll-bool)) + "Initialize OBJ, an expiry option. +Pull value from `mastodon-tool-poll' if possible.'" + (let ((key (oref obj alist-key))) + (oset obj value + (alist-get key tp-transient-settings)))) + (defclass mastodon-transient-expiry (tp-option) - ((always-read :initarg :always-read :initform t))) + ()) + +(cl-defmethod transient-init-value ((obj mastodon-transient-expiry)) + "Initialize OBJ, an expiry option. +Pull value from `mastodon-tool-poll' if possible.'" + (oset obj value + (alist-get 'expiry tp-transient-settings))) (cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry)) "Reader function for OBJ, a poll expiry." -- cgit v1.2.3