diff options
| -rw-r--r-- | lisp/mastodon-toot.el | 127 | ||||
| -rw-r--r-- | lisp/mastodon-transient.el | 129 | ||||
| -rw-r--r-- | lisp/mastodon.el | 9 |
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. |