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 +++++++++++++++++++++++++++++++++++---------------- 1 file changed, 45 insertions(+), 20 deletions(-) (limited to 'lisp/mastodon-toot.el') 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 -- cgit v1.2.3