[nongnu] elpa/mastodon 0cd77c1880 37/63: Merge branch 'with-toot-item' into develop

[ELPA Syncer]

branch: elpa/mastodon
commit 0cd77c188045946278ead197dfe69a0e62b5abe2
Merge: f8ee682bb4 f43ecd6bad
Author: marty hiatt <martianhiatus@riseup.net>
Commit: marty hiatt <martianhiatus@riseup.net>

    Merge branch 'with-toot-item' into develop
---
 lisp/mastodon-toot.el | 241 +++++++++++++++++++++++++-------------------------
 1 file changed, 119 insertions(+), 122 deletions(-)

diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 0cd66dbc17..856c5bbd57 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