diff options
author | marty hiatt <martianhiatus@riseup.net> | 2024-07-30 09:33:03 +0200 |
---|---|---|
committer | marty hiatt <martianhiatus@riseup.net> | 2024-07-30 09:33:03 +0200 |
commit | 0cd77c188045946278ead197dfe69a0e62b5abe2 (patch) | |
tree | de7ff2f74336a0d61d0d2f9387a881e80f105e56 /lisp/mastodon-toot.el | |
parent | f8ee682bb403b5488294e69c464149626221f7c7 (diff) | |
parent | f43ecd6bad329bd16b76d1b6962ef4b3715f362c (diff) |
Merge branch 'with-toot-item' into develop
Diffstat (limited to 'lisp/mastodon-toot.el')
-rw-r--r-- | lisp/mastodon-toot.el | 241 |
1 files changed, 119 insertions, 122 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0cd66db..856c5bb 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -259,15 +259,36 @@ send.") "\\>")) ; boundary end +;;; UTILS + +(defun mastodon-toot--base-toot-or-item-json () + "Return the JSON data of either base-toot or item-json property. +The former is for boost or favourite notifications, returning +data about the item boosted or favourited." + (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs + (mastodon-tl--property 'item-json))) + + ;;; MACRO (defmacro mastodon-toot--with-toot-item (&rest body) "Execute BODY if we have a toot object at point. -Includes boosts, and notifications that display toots." +Includes boosts, and notifications that display toots. +This macro makes the local variable ID available." (declare (debug t)) `(if (not (equal 'toot (mastodon-tl--property 'item-type :no-move))) - (message "Looks like there's no toot at point?") - ,@body)) + (user-error "Looks like there's no toot at point?") + (mastodon-tl--with-toot-helper + (lambda (id) + ,@body)))) + +(defun mastodon-tl--with-toot-helper (body-fun) + "Helper function for `mastodon-tl--with-toot-item'. +Extract any common variables needed, such as base-item-id +property, and call BODY-FUN on them." + (let ((id (mastodon-tl--property 'base-item-id))) + (funcall body-fun id))) + ;;; MODE MAP @@ -335,7 +356,7 @@ JSON is added to the string as its item-json." (beginning-of-line) ;; The marker is not part of the byline (if (search-forward (format "(%s) " marker) eol t) (replace-match "") - (message "Oops: could not find marker '(%s)'" marker))) + (user-error "Oops: could not find marker '(%s)'" marker))) (unless remove (goto-char bol) (insert @@ -364,20 +385,17 @@ boosting, or bookmarking toots." (response (mastodon-http--post url))) (mastodon-http--triage response callback))) -(defun mastodon-toot--toggle-boost-or-favourite (type) +(defun mastodon-toot--toggle-boost-or-favourite (action) "Toggle boost or favourite of toot at `point'. -TYPE is a symbol, either `favourite' or `boost.'" +ACTION is a symbol, either `favourite' or `boost.'" (mastodon-toot--with-toot-item (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) (user-error (format "Can't do action on %s notifications." n-type)) - (let* ((boost-p (equal type 'boost)) - ;; (has-id (mastodon-tl--property 'base-item-id)) - (byline-region ;(when has-id + (let* ((boost-p (equal action 'boost)) + (byline-region (mastodon-tl--find-property-range 'byline (point))) - (id (when byline-region - (mastodon-tl--as-string (mastodon-tl--property 'base-item-id)))) (boosted (when byline-region (get-text-property (car byline-region) 'boosted-p))) (faved (when byline-region @@ -389,44 +407,35 @@ TYPE is a symbol, either `favourite' or `boost.'" (action-string (if boost-p "boost" "favourite")) (remove (if boost-p (when boosted t) (when faved t))) (item-json (mastodon-tl--property 'item-json)) - (toot-type (alist-get 'type item-json)) (visibility (mastodon-tl--field 'visibility item-json))) - (if byline-region - (if (and (or (equal visibility "direct") - (equal visibility "private")) - boost-p) - (message "You cant boost posts with visibility: %s" visibility) - (cond ;; actually there's nothing wrong with faving/boosting own toots! - ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'item-json)) - ;;(error "You can't %s your own toots" action-string)) - ;; & nothing wrong with faving/boosting own toots from notifs: - ;; this boosts/faves the base toot, not the notif status - ((and (equal "reblog" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (user-error "You can't %s boosts" action-string)) - ((and (equal "favourite" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (user-error "You can't %s favourites" action-string)) - ((and (equal "private" visibility) - (equal type 'boost)) - (user-error "You can't boost private toots")) - (t - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--update-stats-on-action type remove) - (mastodon-toot--action-success (if boost-p - (mastodon-tl--symbol 'boost) - (mastodon-tl--symbol 'favourite)) - byline-region remove item-json)) - (message (format "%s #%s" (if boost-p msg action) id))))))) - (message (format "Nothing to %s here?!?" action-string)))))))) + (if (not byline-region) + (user-error "Nothing to %s here?!?" action-string) + (if (and (or (equal visibility "direct") + (equal visibility "private")) + boost-p) + (user-error "You cant boost posts with visibility: %s" + visibility) + ;; there's nothing wrong with faving/boosting own toots + ;; & nothing wrong with faving/boosting own toots from notifs, + ;; it boosts/faves the base toot, not the notif status + (if (and (equal "private" visibility) + (eq action 'boost)) + (user-error "You can't boost private toots") + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) + (mastodon-toot--update-stats-on-action action remove) + (mastodon-toot--action-success (if boost-p + (mastodon-tl--symbol 'boost) + (mastodon-tl--symbol 'favourite)) + byline-region remove)) + (message "%s #%s" (if boost-p msg action) id))))))))))) (defun mastodon-toot--inc-or-dec (count subtract) "If SUBTRACT, decrement COUNT, else increment." @@ -474,16 +483,15 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) - (user-error (format "Can't do action on %s notifications." n-type)) - (let* ((id (mastodon-tl--property 'base-item-id)) - (bookmarked-p - (mastodon-tl--property - 'bookmarked-p - (if (mastodon-tl--property 'byline :no-move) - ;; no move if not in byline, the idea being if in body, we do - ;; move forward to byline to toggle correctly. - ;; alternatively we could bookmarked-p whole posts. - :no-move))) + (user-error (format "Can't bookmark %s notifications." n-type)) + (let* ((bookmarked-p (mastodon-tl--property + 'bookmarked-p + (if (mastodon-tl--property 'byline :no-move) + ;; no move if not in byline, the idea being + ;; if in body, we do move forward to byline + ;; to toggle correctly. alternatively we + ;; could bookmarked-p whole posts. + :no-move))) (byline-region (when id (mastodon-tl--find-property-range 'byline (point)))) (action (if bookmarked-p "unbookmark" "bookmark")) @@ -492,18 +500,18 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "Bookmark removed!" "Toot bookmarked!")) (remove (when bookmarked-p t))) - (if byline-region - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (list 'bookmarked-p (not bookmarked-p)))) - (mastodon-toot--action-success bookmark-str - byline-region remove) - (message (format "%s #%s" message id)))) - (message (format "Nothing to %s here?!?" action)))))))) + (if (not byline-region) + (user-error "Nothing to %s here?!?" action) + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p)))) + (mastodon-toot--action-success bookmark-str + byline-region remove) + (message "%s #%s" message id))))))))) (defun mastodon-toot--list-toot-boosters () "List the boosters of toot at point." @@ -519,22 +527,20 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." (mastodon-toot--with-toot-item - (let* ((base-toot (mastodon-tl--property 'base-item-id)) - (endpoint (if favourite "favourited_by" "reblogged_by")) - (url (mastodon-http--api (format "statuses/%s/%s" base-toot endpoint))) + (let* ((endpoint (if favourite "favourited_by" "reblogged_by")) + (url (mastodon-http--api (format "statuses/%s/%s" id endpoint))) (params '(("limit" . "80"))) (json (mastodon-http--get-json url params))) (if (eq (caar json) 'error) - (user-error "%s (Status does not exist or is private)" (alist-get 'error json)) + (user-error "%s (Status does not exist or is private)" + (alist-get 'error json)) (let ((handles (mastodon-tl--map-alist 'acct json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) (user-error "Looks like this toot has no %s" type-string) (let ((choice (completing-read (format "%s (enter to view profile): " type-string) - handles - nil - t))) + handles nil t))) (mastodon-profile--show-user choice)))))))) (defun mastodon-toot--copy-toot-url () @@ -581,10 +587,10 @@ Uses `lingva.el'." (when mastodon-tl--enable-proportional-fonts t)) (void-function - (message "Looks like you need to install lingva.el. Error: %s" - (error-message-string x)))) - (message "No toot to translate?")) - (message "No mastodon buffer?"))) + (user-error "Looks like you need to install lingva.el. Error: %s" + (error-message-string x)))) + (user-error "No toot to translate?")) + (user-error "No mastodon buffer?"))) (defun mastodon-toot--own-toot-p (toot) "Check if TOOT is user's own, for deleting, editing, or pinning it." @@ -605,7 +611,7 @@ Uses `lingva.el'." (msg (if pinned-p "unpinned" "pinned")) (msg-y-or-n (if pinned-p "Unpin" "Pin"))) (if (not pinnable-p) - (message "You can only pin your own toots.") + (user-error "You can only pin your own toots.") (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) (mastodon-toot--action action (lambda (_) @@ -635,7 +641,7 @@ NO-REDRAFT means delete toot only." (reply-id (alist-get 'in_reply_to_id toot)) (pos (point))) (if (not (mastodon-toot--own-toot-p toot)) - (message "You can only delete (and redraft) your own toots.") + (user-error "You can only delete (and redraft) your own toots.") (when (y-or-n-p (if no-redraft (format "Delete this toot? ") (format "Delete and redraft this toot? "))) @@ -781,7 +787,7 @@ To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (custom-emoji (mastodon-http--get-json url)) (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) (if (not (file-directory-p emojify-emojis-dir)) - (message "Looks like you need to set up emojify first.") + (user-error "Looks like you need to set up emojify first.") (unless (file-directory-p mastodon-custom-emoji-dir) (make-directory mastodon-custom-emoji-dir nil)) ; no add parent (mapc (lambda (x) @@ -907,13 +913,13 @@ instance to edit a toot." (or (not args-media) (not (= (length mastodon-toot--media-attachments) (length mastodon-toot--media-attachment-ids))))) - (message "Something is wrong with your uploads. Wait for them to complete or try again.")) + (user-error "Something is wrong with your uploads. Wait for them to complete or try again.")) ((and mastodon-toot--max-toot-chars (> (mastodon-toot--count-toot-chars toot mastodon-toot--content-warning) mastodon-toot--max-toot-chars)) - (message "Looks like your toot (inc. CW) is longer than that maximum allowed length.")) + (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length.")) ((mastodon-toot--empty-p) - (message "Empty toot. Cowardly refusing to post this.")) + (user-error "Empty toot. Cowardly refusing to post this.")) (t (let ((response (if edit-id ; we are sending an edit: (mastodon-http--put endpoint args) @@ -923,9 +929,7 @@ instance to edit a toot." (lambda (_) ;; kill buffer: (mastodon-toot--kill) - (if scheduled - (message "Toot scheduled!") - (message "Toot toot!")) + (message "Toot %s!" (if scheduled "scheduled" "toot")) ;; cancel scheduled toot if we were editing it: (when scheduled-id (mastodon-views--cancel-scheduled-toot @@ -951,27 +955,22 @@ instance to edit a toot." "Edit the user's toot at point." (interactive) (mastodon-toot--with-toot-item - (let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs - (mastodon-tl--property 'item-json)))) - (if (not (mastodon-toot--own-toot-p toot)) - (message "You can only edit your own toots.") - (let* ((id (mastodon-tl--as-string (mastodon-tl--item-id toot))) - (source (mastodon-toot--get-toot-source id)) - (content (alist-get 'text source)) - (source-cw (alist-get 'spoiler_text source)) - (toot-visibility (alist-get 'visibility toot)) - (toot-language (alist-get 'language toot)) - (reply-id (alist-get 'in_reply_to_id toot)) - (media (alist-get 'media_attachments toot)) - (poll (alist-get 'poll toot))) - (when (y-or-n-p "Edit this toot? ") - (mastodon-toot--compose-buffer nil reply-id nil content :edit) - (goto-char (point-max)) - ;; adopt reply-to-id, visibility, CW, language, and media: - (mastodon-toot--set-toot-properties reply-id toot-visibility - source-cw toot-language nil - nil media poll) - (setq mastodon-toot--edit-item-id id))))))) + (mastodon-tl--with-toot-item + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only edit your own toots.") + (let* ((source (mastodon-toot--get-toot-source id)) + (content (alist-get 'text source)) + (source-cw (alist-get 'spoiler_text source))) + (let-alist toot + (when (y-or-n-p "Edit this toot? ") + (mastodon-toot--compose-buffer nil .in_reply_to_id nil + content :edit) + (goto-char (point-max)) + ;; adopt reply-to-id, visibility, CW, language, and media: + (mastodon-toot--set-toot-properties .in_reply_to_id .visibility + source-cw .language nil nil + .media_attachments .poll) + (setq mastodon-toot--edit-item-id id)))))))) (defun mastodon-toot--get-toot-source (id) "Fetch the source JSON of toot with ID." @@ -1180,14 +1179,12 @@ prefixed by >." (let* ((quote (when (region-active-p) (buffer-substring (region-beginning) (region-end)))) - (toot (mastodon-tl--property 'item-json)) ;; no-move arg for base toot: don't try next toot - (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling - (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) + (toot (mastodon-toot--base-toot-or-item-json)) (account (mastodon-tl--field 'account toot)) (user (alist-get 'acct account)) - (mentions (mastodon-toot--mentions (or base-toot toot))) - (boosted (mastodon-tl--field 'reblog (or base-toot toot))) + (mentions (mastodon-toot--mentions toot)) + (boosted (mastodon-tl--field 'reblog toot)) (booster (when boosted (alist-get 'acct (alist-get 'account toot))))) @@ -1211,7 +1208,7 @@ prefixed by >." ;; user in mentions already: (mastodon-toot--mentions-to-string (copy-sequence mentions))))) id - (or base-toot toot) + toot quote)))) @@ -1236,7 +1233,7 @@ prefixed by >." "Change the current visibility to the next valid value." (interactive) (if (mastodon-tl--buffer-type-eq 'edit-toot) - (message "You can't change visibility when editing toots.") + (user-error "You can't change visibility when editing toots.") (setq mastodon-toot--visibility (cond ((string= mastodon-toot--visibility "public") "unlisted") @@ -1280,7 +1277,7 @@ File is actually attached to the toot upon posting." ;; Only a max. of 4 attachments are allowed, so pop the oldest one. (pop mastodon-toot--media-attachments)) (if (file-directory-p file) - (message "Looks like you chose a directory not a file.") + (user-error "Looks like you chose a directory not a file.") (setq mastodon-toot--media-attachments (nconc mastodon-toot--media-attachments `(((:contents . ,(mastodon-http--read-file-as-string file)) @@ -1419,7 +1416,7 @@ LENGTH is the maximum character length allowed for a poll option." (longest (apply #'max (mapcar #'length choices)))) (if (> longest length) (progn - (message "looks like you went over the max length. Try again.") + (user-error "looks like you went over the max length. Try again.") (sleep-for 2) (mastodon-toot--read-poll-options count length)) choices))) @@ -1487,10 +1484,10 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;; https://codeberg.org/martianh/mastodon.el/issues/285 (interactive) (cond ((mastodon-tl--buffer-type-eq 'edit-toot) - (message "You can't schedule toots you're editing.")) + (user-error "You can't schedule toots you're editing.")) ((not (or (mastodon-tl--buffer-type-eq 'new-toot) (mastodon-tl--buffer-type-eq 'scheduled-statuses))) - (message "You can only schedule toots from the compose buffer or scheduled toots view.")) + (user-error "You can only schedule toots from the compose buffer or scheduled toots view.")) (t (let* ((id (when reschedule (mastodon-tl--property 'id :no-move))) (ts (when reschedule |