diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-notifications.el | 75 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 97 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 13 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 63 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 131 | ||||
| -rw-r--r-- | lisp/mastodon-transient.el | 213 | ||||
| -rw-r--r-- | lisp/mastodon-widget.el | 101 | ||||
| -rw-r--r-- | lisp/mastodon.el | 11 |
8 files changed, 581 insertions, 123 deletions
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index b16b5a6..f4615fb 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -62,6 +62,7 @@ (autoload 'mastodon-media--get-avatar-rendering "mastodon-media") (autoload 'mastodon-tl--image-trans-check "mastodon-tl") (autoload 'mastodon-tl--symbol "mastodon-tl") +(autoload 'mastodon-tl--display-or-uname "mastodon-tl") (defgroup mastodon-tl nil "Nofications in mastodon.el." @@ -92,7 +93,8 @@ make them unweildy." (defvar mastodon-notifications--types '("favourite" "reblog" "mention" "poll" - "follow_request" "follow" "status" "update") + "follow_request" "follow" "status" "update" + "severed_relationships" "moderation_warning") "A list of notification types according to their name on the server.") (defvar mastodon-notifications--response-alist @@ -210,6 +212,25 @@ JSON is a list of alists." for x in ids collect (mastodon-notifications--alist-by-value x 'id json))) +(defun mastodon-notifications--severance-body (group) + "Return a body for a severance notification GROUP." + ;; FIXME: actually implement this when we encounter one in the wild! + (let-alist (alist-get 'event group) + (concat .type ": " + .target_name + "\nRelationships affected: " + .relationships_count))) + +(defun mastodon-notifications--mod-warning-body (group) + "Return a body for a moderation warning notification GROUP." + (let-alist (alist-get 'moderation_warning group) + (concat .action ": " + .text + "\nStatuses: " + .status_ids + "\nfor account: " + .target_account))) + (defun mastodon-notifications--format-note (group status accounts) "Format for a GROUP notification. STATUS is the status's JSON. @@ -258,6 +279,10 @@ ACCOUNTS is data of the accounts that have reacted to the notification." (concat ":\n" (mastodon-notifications--comment-note-text body))))) + ((eq type-sym 'severed_relationships) + (mastodon-notifications--severance-body group)) + ((eq type-sym 'moderation_warning) + (mastodon-notifications--mod-warning-body group)) ((member type-sym '(favourite reblog)) (propertize (mastodon-notifications--comment-note-text body))) @@ -322,10 +347,14 @@ ACCOUNTS is the notification accounts data." 'toot-body t) ;; includes newlines etc. for folding "\n" ;; actual byline: - (mastodon-tl--byline toot author-byline nil nil - base-toot group - (if (member type '("follow" "follow_request")) - toot))) ;; account data! + (mastodon-tl--byline + toot author-byline nil nil base-toot group + (when (member type '("follow" "follow_request")) + toot) ;; account data! + ;; types listed here use base item timestamp, else we use group's + ;; latest timestamp: + (when (not (member type '("favourite" "reblog" "edit" "poll"))) + (mastodon-tl--field 'latest_page_notification_at group)))) 'item-type 'toot ;; for nav, actions, etc. 'item-id (or (alist-get 'page_max_id group) ;; newest notif (alist-get 'id toot)) ; toot id @@ -341,6 +370,7 @@ ACCOUNTS is the notification accounts data." 'toot-folded (and toot-foldable (not unfolded)) ;; grouped notifs data: 'notification-type type + 'notification-id (alist-get 'group_key group) 'notification-group group 'notification-accounts accounts ;; for pagination: @@ -385,9 +415,10 @@ When DOMAIN, force inclusion of user's domain in their handle." (propertize ;; help-echo remaining notifs authors: (format " and %s other%s" diff (if (= 1 diff) "" "s")) 'help-echo (mapconcat (lambda (a) - (alist-get 'username a)) + (propertize (alist-get 'username a) + 'face 'mastodon-display-name-face)) (cddr accounts) ;; not first two - " "))))))) + ", "))))))) (defun mastodon-notifications--render (json) "Display grouped notifications in JSON." @@ -461,18 +492,36 @@ Status notifications are created when you call (defun mastodon-notifications--clear-current () "Dismiss the notification at point." (interactive) - (let* ((id (or (mastodon-tl--property 'item-id) - (mastodon-tl--field 'id - (mastodon-tl--property 'item-json)))) - (response - (mastodon-http--post (mastodon-http--api - (format "notifications/%s/dismiss" id))))) + (let* ((id (or (or (mastodon-tl--property 'notification-id) ;; grouped + (mastodon-tl--property 'item-id) + (mastodon-tl--field + 'id + (mastodon-tl--property 'item-json))))) + (endpoint (mastodon-http--api + (format "notifications/%s/dismiss" id) + "v2")) + (response (mastodon-http--post endpoint))) (mastodon-http--triage response (lambda (_) (when mastodon-tl--buffer-spec (mastodon-tl--reload-timeline-or-profile)) (message "Notification dismissed!"))))) +(defun mastodon-notifications--get-single-notif () + "Return a single notification JSON for v2 notifs." + (interactive) + (let* ((id (mastodon-tl--property + 'notification-id)) ;; grouped, doesn't work for ungrouped! + ;; (key (format "ungrouped-%s" + ;; (mastodon-tl--property 'item-id))) + (endpoint (mastodon-http--api + (format "notifications/%s" id) + "v2")) + (response (mastodon-http--get-json endpoint))) + (mastodon-http--triage + response (lambda (_) + (message "%s" (prin1-to-string response)))))) + (defun mastodon-notifications--get-unread-count () "Return the number of unread notifications for the current account." ;; params: limit - max 1000, default 100, types[], exclude_types[], account_id diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 40f834c..b4a8d4f 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -40,6 +40,7 @@ (require 'mastodon-http) (eval-when-compile (require 'mastodon-tl)) +(require 'mastodon-widget) (autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-auth--get-account-name "mastodon-auth.el") @@ -178,8 +179,16 @@ MAX-ID is a flag to include the max_id pagination parameter." ((mastodon-tl--buffer-type-eq 'profile-following) (mastodon-profile--make-author-buffer mastodon-profile--account)))) +(defun mastodon-profile--open-statuses () + "Open a profile showing statuses." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer + mastodon-profile--account) + (user-error "Not in a mastodon profile"))) + (defun mastodon-profile--open-statuses-no-replies () - "Open a profile buffer showing statuses including replies." + "Open a profile buffer showing statuses without replies." (interactive) (if mastodon-profile--account (mastodon-profile--make-author-buffer @@ -542,6 +551,27 @@ The endpoint only holds a few preferences. For others, see "\n\n")) (goto-char (point-min))))) + +;;; PROFILE WIDGET + +(defvar mastodon-profile--view-types + '(statuses no-boosts no-replies only-media followers following tag)) + +(defvar mastodon-profile--load-funs-alist + `((statuses . mastodon-profile--open-statuses) + (no-boosts . mastodon-profile--open-statuses-no-reblogs) + (no-replies . mastodon-profile--open-statuses-no-replies) + (only-media . mastodon-profile--open-statuses-only-media) + (followers . mastodon-profile--open-followers) + (following . mastodon-profile--open-following) + (tag . mastodon-profile--open-statuses-tagged))) + +(defun mastodon-profile--view-fun-call (type) + "Call the function associated with TYPE. +Fetched from `mastodon-profile--load-funs-alist'." + (funcall + (alist-get type mastodon-profile--load-funs-alist))) + ;;; PROFILE VIEW DETAILS @@ -655,21 +685,7 @@ MAX-ID is a flag to include the max_id pagination parameter." (setq mastodon-profile--account account) (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header args nil max-id-str) - (let* ((inhibit-read-only t) - (endpoint-name - (cond ((string= endpoint-type "statuses") - (cond (no-reblogs - " TOOTS (no boosts)") - (no-replies - " TOOTS (no replies)") - (only-media - " TOOTS (media only)") - (tag - (format " TOOTS (containing #%s)" tag)) - (t - " TOOTS "))) - ((string= endpoint-type "followers") " FOLLOWERS ") - ((string= endpoint-type "following") " FOLLOWING ")))) + (let* ((inhibit-read-only t)) (insert (propertize (concat @@ -680,8 +696,7 @@ MAX-ID is a flag to include the max_id pagination parameter." (propertize .display_name 'face 'mastodon-display-name-face) ;; roles (when .roles - (concat " " - (mastodon-profile--render-roles .roles))) + (concat " " (mastodon-profile--render-roles .roles))) "\n" (propertize (concat "@" .acct) 'face 'default) (when (eq .locked t) @@ -729,26 +744,46 @@ MAX-ID is a flag to include the max_id pagination parameter." " | REQUESTED TO FOLLOW YOU") "\n\n") 'success) - ""))) ; for insert call - ;; insert endpoint - (mastodon-tl--set-face (concat " " mastodon-tl--horiz-bar "\n" - endpoint-name "\n" - " " mastodon-tl--horiz-bar "\n") - 'success)) + "")))) ; for insert call (setq mastodon-tl--update-point (point)) (mastodon-media--inline-images (point-min) (point)) + ;; widget items description + (mastodon-widget--create + "View" mastodon-profile--view-types + (or (mastodon-profile--current-view-type + endpoint-type no-reblogs no-replies only-media tag) + 'statuses) + (lambda (widget &rest _ignore) + (let ((value (widget-value widget))) + (mastodon-profile--view-fun-call value)))) + (insert "\n"))) + ;; split insert of items from insert of profile: + (with-current-buffer buffer + (let* ((inhibit-read-only t)) ;; insert pinned toots first (when (and pinned (string= endpoint-type "statuses")) (mastodon-profile--insert-statuses-pinned pinned) (setq mastodon-tl--update-point (point))) ; updates after pinned toots - (funcall update-function json)) - (goto-char (point-min)) - (message - (substitute-command-keys - ;; "\\[mastodon-profile--account-view-cycle]" ; not always bound? - "\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\ + ;; insert items + (funcall update-function json) + (goto-char (point-min)) + (message + (substitute-command-keys + ;; "\\[mastodon-profile--account-view-cycle]" ; not always bound? + "\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\ only media, followers, following. -\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag.")))))) +\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag."))))))) + +(defun mastodon-profile--current-view-type (type no-reblogs no-replies + only-media tag) + "Return the type of current profile view. +Return a member of `mastodon-profile--view-types', based on TYPE, +NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG." + (cond (no-reblogs 'no-boosts) + (no-replies 'no-replies) + (only-media 'only-media) + (tag 'tag) + (t (intern type)))) (defun mastodon-profile--format-joined-date-string (joined) "Format a human-readable Joined string from timestamp JOINED. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 25db7d8..5f1e980 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -29,6 +29,7 @@ ;;; Code: (require 'json) (require 'mastodon-tl) +(require 'mastodon-widget) (autoload 'mastodon-auth--access-token "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") @@ -193,7 +194,7 @@ is used for pagination." (following (when (or following (equal current-prefix-arg '(4))) "true")) (type (or type - (if (eq current-prefix-arg '(4)) + (if (equal current-prefix-arg '(4)) "accounts" ; if FOLLOWING, must be "accounts" (completing-read "Search type: " mastodon-search-types nil :match)))) @@ -211,7 +212,15 @@ is used for pagination." (items (alist-get (intern type) response))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-search-mode) - (mastodon-search--insert-heading type) + (mastodon-search--insert-heading "search") + (mastodon-widget--create + "Results" + '(accounts hashtags statuses) + (intern type) + (lambda (widget &rest _ignore) + (let ((value (widget-value widget))) + (mastodon-search--query query (symbol-name value))))) + (insert "\n\n") (cond ((string= type "accounts") (mastodon-search--render-response items type buffer params 'mastodon-views--insert-users-propertized-note diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1a4df7f..5eb52e3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -590,6 +590,12 @@ With a double PREFIX arg, limit results to your own instance." 'mastodon-tl--timeline nil params))) +(defun mastodon-tl--announcements () + "Display announcements from your instance." + (interactive) + (mastodon-tl--init "announcements" "announcements" + 'mastodon-tl--timeline nil nil nil nil :no-byline)) + ;;; BYLINES, etc. @@ -791,7 +797,7 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." (image-transforms-p))) (defun mastodon-tl--byline (toot author-byline &optional detailed-p - domain base-toot group account) + domain base-toot group account ts) "Generate byline for TOOT. AUTHOR-BYLINE is a function for adding the author portion of the byline that takes one variable. @@ -803,18 +809,19 @@ this just means displaying toot client. When DOMAIN, force inclusion of user's domain in their handle. BASE-TOOT is JSON for the base toot, if any. GROUP is the notification group if any. -ACCOUNT is the notification account if any." - (let* ((created-time - (if group - (mastodon-tl--field 'latest_page_notification_at group) - ;; bosts and faves in notifs view - ;; (makes timestamps be for the original toot not the boost/fave): - (or (mastodon-tl--field 'created_at - (mastodon-tl--field 'status toot)) - ;; all other toots, inc. boosts/faves in timelines: - ;; (mastodon-tl--field auto fetches from reblogs if needed): - (mastodon-tl--field 'created_at toot)))) - (parsed-time (date-to-time created-time)) +ACCOUNT is the notification account if any. +TS is a timestamp from the server, if any." + (let* ((type (alist-get 'type group)) + (created-time + (or ts ;; mentions, statuses, folls/foll-reqs + ;; bosts, faves, edits, polls in notifs view use base item + ;; timestamp: + (mastodon-tl--field 'created_at + (mastodon-tl--field 'status toot)) + ;; all other toots, inc. boosts/faves in timelines: + ;; (mastodon-tl--field auto fetches from reblogs if needed): + (mastodon-tl--field 'created_at toot))) + (parsed-time (when created-time (date-to-time created-time))) (faved (eq t (mastodon-tl--field 'favourited toot))) (boosted (eq t (mastodon-tl--field 'reblogged toot))) (bookmarked (eq t (mastodon-tl--field 'bookmarked toot))) @@ -1185,7 +1192,7 @@ Used for hitting RET on a given link." (defun mastodon-tl--do-link-action (event) "Do the action of the link at point. Used for a mouse-click EVENT on a link." - (interactive "e") + (interactive "@e") (mastodon-tl--do-link-action-at-point (posn-point (event-end event)))) @@ -1580,7 +1587,7 @@ OPTIONS is an alist." (defun mastodon-tl--click-image-or-video (event) "Click to play video with `mpv.el'. EVENT is a mouse-click arg." - (interactive "e") + (interactive "@e") (mastodon-tl--view-full-image-or-play-video (posn-point (event-end event)))) @@ -1791,7 +1798,7 @@ NO-BYLINE means just insert toot body, used for folding." #'mastodon-tl--byline-author #'mastodon-tl--byline-boost nil nil detailed-p thread domain unfolded no-byline)))) -(defun mastodon-tl--timeline (toots &optional thread domain) +(defun mastodon-tl--timeline (toots &optional thread domain no-byline) "Display each toot in TOOTS. This function removes replies if user required. THREAD means the status will be displayed in a thread view. @@ -1807,7 +1814,7 @@ When DOMAIN, force inclusion of user's domain in their handle." (cl-remove-if-not #'mastodon-tl--is-reply toots) toots)))) (mapc (lambda (toot) - (mastodon-tl--toot toot nil thread domain)) + (mastodon-tl--toot toot nil thread domain nil no-byline)) toots) ;; media: (when mastodon-tl--display-media-p @@ -2117,7 +2124,9 @@ call this function after it is set or use something else." ((string= "*masto-image*" (buffer-name)) 'mastodon-image) ((mastodon-tl--endpoint-str-= "timelines/link") - 'link-timeline)))) + 'link-timeline) + ((mastodon-tl--endpoint-str-= "announcements") + 'announcements)))) (defun mastodon-tl--buffer-type-eq (type) "Return t if current buffer type is equal to symbol TYPE." @@ -3246,7 +3255,7 @@ This location is defined by a non-nil value of (defun mastodon-tl--init (buffer-name endpoint update-function &optional headers params - hide-replies instance) + hide-replies instance no-byline) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. UPDATE-FUNCTION is used to recieve more toots. HEADERS means to also collect the response headers. Used for paginating @@ -3264,11 +3273,12 @@ a timeline from." #'mastodon-http--get-response-async #'mastodon-http--get-json-async) url params 'mastodon-tl--init* - buffer endpoint update-function headers params hide-replies instance))) + buffer endpoint update-function headers params hide-replies + instance no-byline))) (defun mastodon-tl--init* (response buffer endpoint update-function &optional headers - update-params hide-replies instance) + update-params hide-replies instance no-byline) "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by @@ -3299,7 +3309,7 @@ JSON and http headers, without it just the JSON." link-header update-params hide-replies ;; awful hack to fix multiple reloads: (alist-get "max_id" update-params nil nil #'string=)) - (mastodon-tl--do-init json update-function instance))))))) + (mastodon-tl--do-init json update-function instance no-byline))))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type params @@ -3342,14 +3352,15 @@ ENDPOINT-VERSION is a string, format Vx, e.g. V2." (mastodon-tl--do-init json update-function) buffer))) -(defun mastodon-tl--do-init (json update-fun &optional domain) +(defun mastodon-tl--do-init (json update-fun &optional domain no-byline) "Utility function for `mastodon-tl--init*' and `mastodon-tl--init-sync'. JSON is the data to call UPDATE-FUN on. When DOMAIN, force inclusion of user's domain in their handle." (remove-overlays) ; video overlays - (if domain ;; maybe our update-fun doesn't always have 3 args...: - (funcall update-fun json nil domain) - (funcall update-fun json)) + (cond (domain ;; maybe our update-fun doesn't always have 3 args...: + (funcall update-fun json nil domain)) + (no-byline (funcall update-fun json nil nil no-byline)) + (t (funcall update-fun json))) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7440fe5..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).") @@ -290,7 +297,9 @@ data about the item boosted or favourited." Includes boosts, and notifications that display toots. This macro makes the local variable ID available." (declare (debug t)) - `(if (not (eq 'toot (mastodon-tl--property 'item-type :no-move))) + `(if (or (not (eq 'toot (mastodon-tl--property 'item-type :no-move))) + (member (mastodon-tl--property 'notification-type) + '("follow" "follow_request"))) (user-error "Looks like there's no toot at point?") (mastodon-tl--with-toot-helper (lambda (id) @@ -756,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) @@ -767,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))))) @@ -867,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 @@ -892,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)) @@ -938,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 @@ -1368,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)) @@ -1399,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)) @@ -1424,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. @@ -1458,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." @@ -1477,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 @@ -1757,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" @@ -1791,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..bbfbfc9 100644 --- a/lisp/mastodon-transient.el +++ b/lisp/mastodon-transient.el @@ -25,9 +25,43 @@ ;;; 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 +(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: @@ -163,13 +197,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 +223,122 @@ 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-suffix mastodon-transient--choice-add () + "Add another poll choice if possible. +Do not add more than 9 choices. +Do not add more than the server's maximum setting." + (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 + :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-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-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") + (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))) + (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 (defclass mastodon-transient-field (tp-option-str) @@ -199,8 +348,8 @@ We always read.") (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 +368,60 @@ 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=))))) +(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))) + +(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-widget.el b/lisp/mastodon-widget.el new file mode 100644 index 0000000..a326800 --- /dev/null +++ b/lisp/mastodon-widget.el @@ -0,0 +1,101 @@ +;;; mastodon-widget.el --- Widget utilities -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2024 Marty Hiatt +;; Author: Marty Hiatt <mousebot@disroot.org> +;; Maintainer: Marty Hiatt <mousebot@disroot.org> +;; Homepage: https://codeberg.org/martianh/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; some widget utilities for mastodon.el + +;;; Code: + +(require 'cl-lib) + +(defvar mastodon-widget-keymap + (let ((map (make-sparse-keymap))) + (define-key map [down-mouse-2] 'widget-button-click) + (define-key map [down-mouse-1] 'widget-button-click) + (define-key map [touchscreen-begin] 'widget-button-click) + ;; The following definition needs to avoid using escape sequences that + ;; might get converted to ^M when building loaddefs.el + (define-key map [(control ?m)] 'widget-button-press) + map) + "Keymap containing useful binding for buffers containing widgets. +Recommended as a parent keymap for modes using widgets. +Note that such modes will need to require wid-edit.") + +(defface mastodon-widget-face + '((t :inherit font-lock-function-name-face :weight bold :underline t)) + "Face for widgets.") + +(defun mastodon-widget--return-item-widgets (list) + "Return a list of item widgets for each item, a string, in LIST." + (cl-loop for x in list + collect `(choice-item :value ,x :format "%[%v%] " + :keymap ,mastodon-widget-keymap))) + +(defun mastodon-widget--format (str &optional padding) + "Return a widget format string for STR, its name. +PADDING is an integer, for how much right-side padding to add." + (concat "%[" (propertize str + 'face 'mastodon-widget-face + 'mastodon-tab-stop t) + "%]: %v" + (make-string padding ? ))) + +(defun mastodon-widget--create (kind type value notify-fun) + "Return a widget of KIND, with TYPE elements, and default VALUE. +KIND is a string, either Listing, Sort, Items, or Inbox, and will +be used for the widget's tag. +VALUE is a string, a member of TYPE. +NOTIFY-FUN is the widget's notify function." + (let* ((val-length (length (if (symbolp value) + (symbol-name value) + value))) + (type-list (if (symbolp type) + (symbol-value type) + type)) + (longest (apply #'max + (mapcar #'length + (if (symbolp (car type-list)) + (mapcar #'symbol-name type-list) + type-list)))) + (padding (- longest val-length))) + (if (not (member value type-list)) + (user-error "%s is not a member of %s" value type-list) + (widget-create + 'menu-choice + :tag kind + :value value + :args (mastodon-widget--return-item-widgets type-list) + :help-echo (format "Select a %s kind" kind) + :format (mastodon-widget--format kind padding) + :notify notify-fun + ;; eg format of notify-fun: + ;; (lambda (widget &rest ignore) + ;; (let ((value (widget-value widget)) + ;; (tag (widget-get widget :tag))) + ;; (notify-fun value))) + :keymap mastodon-widget-keymap)))) + +(provide 'mastodon-widget) +;;; mastodon-widget.el ends here diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 89e2a87..deee0c1 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -6,7 +6,7 @@ ;; Author: Johnson Denen <johnson.denen@gmail.com> ;; Marty Hiatt <mousebot@disroot.org> ;; Maintainer: Marty Hiatt <mousebot@disroot.org> -;; Version: 1.1.1 +;; Version: 1.1.2 ;; Package-Requires: ((emacs "28.1") (request "0.3.0") (persist "0.4") (tp "0.1")) ;; Homepage: https://codeberg.org/martianh/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. |