aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile10
-rw-r--r--README.org1
-rw-r--r--lisp/mastodon-search.el4
-rw-r--r--lisp/mastodon-tl.el330
-rw-r--r--lisp/mastodon-toot.el64
-rw-r--r--lisp/mastodon-views.el26
-rw-r--r--lisp/mastodon.el2
-rw-r--r--mastodon.info71
-rw-r--r--mastodon.texi14
-rw-r--r--test/mastodon-http-tests.el17
-rw-r--r--test/mastodon-tl-tests.el191
11 files changed, 485 insertions, 245 deletions
diff --git a/Makefile b/Makefile
index d41aa35..19ed681 100644
--- a/Makefile
+++ b/Makefile
@@ -14,13 +14,19 @@ ORG_EVAL2 = --funcall org-texinfo-export-to-info
## ################################################################
-.PHONY: clean
+.PHONY: infoclean tests testsclean
all: $(PKG).info dir
-clean:
+infoclean:
rm -f $(PKG).org $(PKG).texi $(PKG).info dir
+tests:
+ cask emacs -batch -load test/ert-helper.el -f ert-run-tests-batch-and-exit
+
+testsclean:
+ rm -f stubfile.plstore~
+
## ################################################################
# May look at this in the future
diff --git a/README.org b/README.org
index dccfa5f..ffed894 100644
--- a/README.org
+++ b/README.org
@@ -140,6 +140,7 @@ not contain =:client_id= and =:client_secret=.
| =,= | view favouriters of toot at point |
| =.= | view boosters of toot at point |
| =/= | switch between mastodon buffers |
+| =Z= | report user/toot at point to instances moderators |
|----------------+---------------------------------------------------------------------------------|
| | *Other views* |
| =s= | search (posts, users, tags) (NB: only posts you have interacted with) |
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 9b3641b..8cfa3cb 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -191,7 +191,9 @@ user's profile note. This is also called by
`mastodon-tl--get-follow-suggestions' and
`mastodon-profile--insert-follow-requests'."
(mapc (lambda (acct)
- (insert (mastodon-search--propertize-user acct note)))
+ (insert (concat (mastodon-search--propertize-user acct note)
+ mastodon-tl--horiz-bar
+ "\n\n")))
json))
(defun mastodon-search--propertize-user (acct &optional note)
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index e90be9a..b2b7d27 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -1090,117 +1090,6 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add."
(concat help-echo "\nC-RET: play " type " with mpv"))))
-;;; INSERT TOOTS
-
-(defun mastodon-tl--content (toot)
- "Retrieve text content from TOOT.
-Runs `mastodon-tl--render-text' and fetches poll or media."
- (let* ((content (mastodon-tl--field 'content toot))
- (reblog (alist-get 'reblog toot))
- (poll-p (if reblog
- (alist-get 'poll reblog)
- (alist-get 'poll toot))))
- (concat
- (mastodon-tl--render-text content toot)
- (when poll-p
- (mastodon-tl--get-poll toot))
- (mastodon-tl--media toot))))
-
-(defun mastodon-tl--insert-status (toot body author-byline action-byline
- &optional id base-toot detailed-p)
- "Display the content and byline of timeline element TOOT.
-BODY will form the section of the toot above the byline.
-AUTHOR-BYLINE is an optional function for adding the author
-portion of the byline that takes one variable. By default it is
-`mastodon-tl--byline-author'.
-ACTION-BYLINE is also an optional function for adding an action,
-such as boosting favouriting and following to the byline. It also
-takes a single function. By default it is
-`mastodon-tl--byline-boosted'.
-ID is that of the status if it is a notification, which is
-attached as a `toot-id' property if provided. If the
-status is a favourite or boost notification, BASE-TOOT is the
-JSON of the toot responded to.
-DETAILED-P means display more detailed info. For now
-this just means displaying toot client."
- (let ((start-pos (point)))
- (insert
- (propertize
- (concat "\n"
- body
- " \n"
- (mastodon-tl--byline toot author-byline action-byline detailed-p))
- 'toot-id (or id ; notification's own id
- (alist-get 'id toot)) ; toot id
- 'base-toot-id (mastodon-tl--toot-id
- ;; if status is a notif, get id from base-toot
- ;; (-tl--toot-id toot) will not work here:
- (or base-toot
- ;; else normal toot with reblog check:
- toot))
- 'toot-json toot
- 'base-toot base-toot)
- "\n")
- (when mastodon-tl--display-media-p
- (mastodon-media--inline-images start-pos (point)))))
-
-;; from mastodon-alt.el:
-(defun mastodon-tl--toot-for-stats (&optional toot)
- "Return the TOOT on which we want to extract stats.
-If no TOOT is given, the one at point is considered."
- (let* ((original-toot (or toot (get-text-property (point) 'toot-json)))
- (toot (or (alist-get 'status original-toot)
- (when (alist-get 'type original-toot)
- original-toot)
- (alist-get 'reblog original-toot)
- original-toot))
- (type (alist-get 'type (or toot))))
- (unless (member type '("follow" "follow_request"))
- toot)))
-
-(defun mastodon-tl--toot-stats (toot)
- "Return a right aligned string (using display align-to).
-String is filled with TOOT statistics (boosts, favs, replies).
-When the TOOT is a reblog (boost), statistics from reblogged
-toots are returned.
-To disable showing the stats, customize
-`mastodon-tl--show-stats'."
- (when-let ((toot (mastodon-tl--toot-for-stats toot)))
- (let* ((favourites-count (alist-get 'favourites_count toot))
- (favourited (equal 't (alist-get 'favourited toot)))
- (faves-prop (propertize (format "%s" favourites-count)
- 'favourites-count favourites-count))
- (boosts-count (alist-get 'reblogs_count toot))
- (boosted (equal 't (alist-get 'reblogged toot)))
- (boosts-prop (propertize (format "%s" boosts-count)
- 'boosts-count boosts-count))
- (replies-count (alist-get 'replies_count toot))
- (favourites (format "%s %s" faves-prop ;favourites-count
- (mastodon-tl--symbol 'favourite)))
- (boosts (format "%s %s" boosts-prop ;boosts-count
- (mastodon-tl--symbol 'boost)))
- (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply)))
- (status (concat
- (propertize favourites
- 'favourited-p favourited
- 'favourites-field t
- 'face font-lock-comment-face)
- (propertize " | " 'face font-lock-comment-face)
- (propertize boosts
- 'boosted-p boosted
- 'boosts-field t
- 'face font-lock-comment-face)
- (propertize " | " 'face font-lock-comment-face)
- (propertize replies
- 'replies-field t
- 'replies-count replies-count
- 'face font-lock-comment-face)))
- (status (concat
- (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7))))
- status)))
- status)))
-
-
;; POLLS
(defun mastodon-tl--get-poll (toot)
@@ -1359,7 +1248,115 @@ in which case play first video or gif from current toot."
(message "no moving image here?"))))
-;; INSERT TOOTS
+;;; INSERT TOOTS
+
+(defun mastodon-tl--content (toot)
+ "Retrieve text content from TOOT.
+Runs `mastodon-tl--render-text' and fetches poll or media."
+ (let* ((content (mastodon-tl--field 'content toot))
+ (reblog (alist-get 'reblog toot))
+ (poll-p (if reblog
+ (alist-get 'poll reblog)
+ (alist-get 'poll toot))))
+ (concat
+ (mastodon-tl--render-text content toot)
+ (when poll-p
+ (mastodon-tl--get-poll toot))
+ (mastodon-tl--media toot))))
+
+(defun mastodon-tl--insert-status (toot body author-byline action-byline
+ &optional id base-toot detailed-p)
+ "Display the content and byline of timeline element TOOT.
+BODY will form the section of the toot above the byline.
+AUTHOR-BYLINE is an optional function for adding the author
+portion of the byline that takes one variable. By default it is
+`mastodon-tl--byline-author'.
+ACTION-BYLINE is also an optional function for adding an action,
+such as boosting favouriting and following to the byline. It also
+takes a single function. By default it is
+`mastodon-tl--byline-boosted'.
+ID is that of the status if it is a notification, which is
+attached as a `toot-id' property if provided. If the
+status is a favourite or boost notification, BASE-TOOT is the
+JSON of the toot responded to.
+DETAILED-P means display more detailed info. For now
+this just means displaying toot client."
+ (let ((start-pos (point)))
+ (insert
+ (propertize
+ (concat "\n"
+ body
+ " \n"
+ (mastodon-tl--byline toot author-byline action-byline detailed-p))
+ 'toot-id (or id ; notification's own id
+ (alist-get 'id toot)) ; toot id
+ 'base-toot-id (mastodon-tl--toot-id
+ ;; if status is a notif, get id from base-toot
+ ;; (-tl--toot-id toot) will not work here:
+ (or base-toot
+ ;; else normal toot with reblog check:
+ toot))
+ 'toot-json toot
+ 'base-toot base-toot)
+ "\n")
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images start-pos (point)))))
+
+;; from mastodon-alt.el:
+(defun mastodon-tl--toot-for-stats (&optional toot)
+ "Return the TOOT on which we want to extract stats.
+If no TOOT is given, the one at point is considered."
+ (let* ((original-toot (or toot (get-text-property (point) 'toot-json)))
+ (toot (or (alist-get 'status original-toot)
+ (when (alist-get 'type original-toot)
+ original-toot)
+ (alist-get 'reblog original-toot)
+ original-toot))
+ (type (alist-get 'type (or toot))))
+ (unless (member type '("follow" "follow_request"))
+ toot)))
+
+(defun mastodon-tl--toot-stats (toot)
+ "Return a right aligned string (using display align-to).
+String is filled with TOOT statistics (boosts, favs, replies).
+When the TOOT is a reblog (boost), statistics from reblogged
+toots are returned.
+To disable showing the stats, customize
+`mastodon-tl--show-stats'."
+ (when-let ((toot (mastodon-tl--toot-for-stats toot)))
+ (let* ((favourites-count (alist-get 'favourites_count toot))
+ (favourited (equal 't (alist-get 'favourited toot)))
+ (faves-prop (propertize (format "%s" favourites-count)
+ 'favourites-count favourites-count))
+ (boosts-count (alist-get 'reblogs_count toot))
+ (boosted (equal 't (alist-get 'reblogged toot)))
+ (boosts-prop (propertize (format "%s" boosts-count)
+ 'boosts-count boosts-count))
+ (replies-count (alist-get 'replies_count toot))
+ (favourites (format "%s %s" faves-prop ;favourites-count
+ (mastodon-tl--symbol 'favourite)))
+ (boosts (format "%s %s" boosts-prop ;boosts-count
+ (mastodon-tl--symbol 'boost)))
+ (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply)))
+ (status (concat
+ (propertize favourites
+ 'favourited-p favourited
+ 'favourites-field t
+ 'face font-lock-comment-face)
+ (propertize " | " 'face font-lock-comment-face)
+ (propertize boosts
+ 'boosted-p boosted
+ 'boosts-field t
+ 'face font-lock-comment-face)
+ (propertize " | " 'face font-lock-comment-face)
+ (propertize replies
+ 'replies-field t
+ 'replies-count replies-count
+ 'face font-lock-comment-face)))
+ (status (concat
+ (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7))))
+ status)))
+ status)))
(defun mastodon-tl--is-reply (toot)
"Check if the TOOT is a reply to another one (and not boosted)."
@@ -1667,6 +1664,10 @@ webapp"
(reblog (alist-get 'reblog json)))
(if reblog (alist-get 'id reblog) id)))
+(defun mastodon-tl--toot-or-base (json)
+ "Return the base toot or just the toot from toot JSON."
+ (or (alist-get 'reblog json) json))
+
;;; THREADS
@@ -1719,8 +1720,7 @@ view all branches of a thread."
(mastodon-http--api (concat "statuses/" id))
nil
:silent))
- (context (mastodon-http--get-json url nil :silent))
- (marker (make-marker)))
+ (context (mastodon-http--get-json url nil :silent)))
(if (equal (caar toot) 'error)
(message "Error: %s" (cdar toot))
(when (member (alist-get 'type toot) '("reblog" "favourite"))
@@ -1731,7 +1731,8 @@ view all branches of a thread."
;; if we have a thread:
(progn
(with-current-buffer (get-buffer-create buffer)
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (marker (make-marker)))
(switch-to-buffer buffer)
(erase-buffer)
(mastodon-mode)
@@ -1743,10 +1744,10 @@ view all branches of a thread."
(move-marker marker (point))
;; print re-fetched toot:
(mastodon-tl--toot toot :detailed-p)
- (mastodon-tl--timeline (alist-get 'descendants context))))
- ;; put point at the toot:
- (goto-char (marker-position marker))
- (mastodon-tl--goto-next-toot))
+ (mastodon-tl--timeline (alist-get 'descendants context))
+ ;; put point at the toot:
+ (goto-char (marker-position marker))
+ (mastodon-tl--goto-next-toot))))
;; else just print the lone toot:
(mastodon-tl--single-toot id)))))))
@@ -2078,7 +2079,7 @@ If TAG is provided, unfollow it."
(defun mastodon-tl--list-followed-tags (&optional prefix)
"List followed tags. View timeline of tag user choses.
-Prefix is sent to `mastodon-tl--get-tag-timeline', which see."
+PREFIX is sent to `mastodon-tl--get-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (mastodon-tl--map-alist 'name followed-tags-json))
@@ -2089,7 +2090,7 @@ Prefix is sent to `mastodon-tl--get-tag-timeline', which see."
(defun mastodon-tl--followed-tags-timeline (&optional prefix)
"Open a timeline of all your followed tags.
-Prefix is sent to `mastodon-tl--show-tag-timeline', which see."
+PREFIX is sent to `mastodon-tl--show-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (mastodon-tl--map-alist 'name followed-tags-json)))
@@ -2107,6 +2108,93 @@ The suggestions are from followed tags, but any other tags are also allowed."
(mastodon-tl--show-tag-timeline prefix selection)))
+;;; REPORT TO MODERATORS
+
+(defun mastodon-tl--instance-rules ()
+ "Return the rules of the user's instance."
+ (let ((url (mastodon-http--api "instance/rules")))
+ (mastodon-http--get-json url nil :silent)))
+
+(defun mastodon-tl--report-params (account toot)
+ "Query user and return report params alist.
+ACCOUNT and TOOT are the data to use."
+ (let* ((account-id (mastodon-profile--account-field account 'id))
+ (comment (read-string "Add comment [optional]: "))
+ (toot-id (when (y-or-n-p "Also report status at point? ")
+ (mastodon-tl--toot-id toot))) ; base toot if poss
+ (forward-p (when (y-or-n-p "Forward to remote admin? ") "true"))
+ (rules (when (y-or-n-p "Cite a rule broken? ")
+ (mastodon-tl--read-rules-ids)))
+ (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other"))))
+ (mastodon-tl--report-build-params account-id comment toot-id
+ forward-p cat rules)))
+
+(defun mastodon-tl--report-build-params
+ (account-id comment toot-id forward-p cat &optional rules)
+ "Build the parameters alist based on user responses.
+ACCOUNT-ID, COMMENT, TOOT-ID, FORWARD-P, CAT, and RULES are all from
+`mastodon-tl--report-params', which see."
+ (let ((params `(("account_id" . ,account-id)
+ ,(when comment
+ `("comment" . ,comment))
+ ,(when toot-id
+ `("status_ids[]" . ,toot-id))
+ ,(when forward-p
+ `("forward" . ,forward-p))
+ ,(when cat
+ `("category" . ,cat)))))
+ (when rules
+ (let ((alist
+ (mastodon-http--build-array-params-alist "rule_ids[]" rules)))
+ (mapc (lambda (x)
+ (push x params))
+ alist)))
+ ;; FIXME: the above approach adds nils to your params.
+ (setq params (delete nil params))
+ params))
+
+(defun mastodon-tl--report-to-mods ()
+ "Report the author of the toot at point to your instance moderators.
+Optionally report the toot at point, add a comment, cite rules
+that have been broken, forward the report to the remove admin,
+report the account for spam."
+ (interactive)
+ (mastodon-tl--do-if-toot
+ (when (y-or-n-p "Report author of toot at point?")
+ (let* ((url (mastodon-http--api "reports"))
+ (toot (mastodon-tl--toot-or-base
+ (mastodon-tl--property 'toot-json :no-move)))
+ (account (alist-get 'account toot))
+ (handle (alist-get 'acct account))
+ (params (mastodon-tl--report-params account toot))
+ (response (mastodon-http--post url params)))
+ ;; (setq masto-report-response response)
+ (mastodon-http--triage response
+ (lambda ()
+ (message "User %s reported!" handle)))))))
+
+(defvar crm-separator)
+
+(defun mastodon-tl--map-rules-alist (rules)
+ "Return an alist of the text and id fields of RULES."
+ (mapcar (lambda (x)
+ (let-alist x
+ (cons .text .id)))
+ rules))
+
+(defun mastodon-tl--read-rules-ids ()
+ "Prompt for a list of instance rules and return a list of selected ids."
+ (let* ((rules (mastodon-tl--instance-rules))
+ (alist (mastodon-tl--map-rules-alist rules))
+ (crm-separator (replace-regexp-in-string "," "|" crm-separator))
+ (choices (completing-read-multiple
+ "rules [TAB for options, | to separate]: "
+ alist nil :match)))
+ (mapcar (lambda (x)
+ (alist-get x alist nil nil 'equal))
+ choices)))
+
+
;;; UPDATING, etc.
(defun mastodon-tl--more-json (endpoint id)
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 35e6eab..474337b 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -219,13 +219,20 @@ send.")
"\\([(\n\t ]\\|^\\)"
"\\(?2:@[0-9a-zA-Z._-]+" ; a handle
"\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @
- "\\b"))
+ "\\(\\b\\|'\\)")) ; boundary or ' char
(defvar mastodon-toot-tag-regex
(concat
;; preceding bracket, space or bol [boundary doesn't work with #]
"\\([(\n\t ]\\|^\\)"
"\\(?2:#[0-9a-zA-Z_]+\\)" ; tag
+ "\\(\\b\\|'\\)")) ; boundary or ' char
+
+(defvar mastodon-toot-url-regex
+ ;; adapted from ffap-url-regexp
+ (concat
+ "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix
+ "[^ \n\t]*\\)" ; any old thing that's, i.e. we allow invalid/unwise chars
"\\b")) ; boundary
(defvar mastodon-toot-mode-map
@@ -764,6 +771,13 @@ to `emojify-user-emojis', and the emoji data is updated."
`(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
`(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide))))))
+(defun mastodon-toot--read-cw-string ()
+ "Read a content warning from the minibuffer."
+ (when (and (not (mastodon-toot--empty-p))
+ mastodon-toot--content-warning)
+ (read-string "Warning: "
+ mastodon-toot--content-warning-from-reply-or-redraft)))
+
(defun mastodon-toot--send ()
"POST contents of new-toot buffer to Mastodon instance and kill buffer.
If media items have been attached and uploaded with
@@ -781,16 +795,13 @@ instance to edit a toot."
(mastodon-http--api (format "statuses/%s"
edit-id))
(mastodon-http--api "statuses")))
- (spoiler (when (and (not (mastodon-toot--empty-p))
- mastodon-toot--content-warning)
- (read-string "Warning: "
- mastodon-toot--content-warning-from-reply-or-redraft)))
+ (cw (mastodon-toot--read-cw-string))
(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" . ,spoiler)
+ ("spoiler_text" . ,cw)
("language" . ,mastodon-toot--language))
;; Pleroma instances can't handle null-valued
;; scheduled_at args, so only add if non-nil
@@ -816,8 +827,8 @@ instance to edit a toot."
(length mastodon-toot--media-attachment-ids)))))
(message "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--max-toot-chars))
- (message "Looks like your toot is longer than that maximum allowed length."))
+ (> (mastodon-toot--count-toot-chars toot cw) mastodon-toot--max-toot-chars))
+ (message "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."))
(t
@@ -944,7 +955,6 @@ eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"."
The mentioned users look like this:
Local user (including the logged in): `username`.
Federated user: `username@host.co`."
- (interactive)
(let* ((boosted (mastodon-tl--field 'reblog status))
(mentions
(if boosted
@@ -1235,8 +1245,18 @@ MAX is the maximum number set by their instance."
(defun mastodon-toot--read-poll-options (count length)
"Read a list of options for poll with COUNT options.
LENGTH is the maximum character length allowed for a poll option."
- (cl-loop for x from 1 to count
- collect (read-string (format "Poll option [%s/%s] [max %s chars]: " x count length))))
+ (let* ((choices
+ (cl-loop for x from 1 to count
+ collect (read-string
+ (format "Poll option [%s/%s] [max %s chars]: "
+ x count length))))
+ (longest (cl-reduce #'max (mapcar #'length choices))))
+ (if (> longest length)
+ (progn
+ (message "looks like you went over the max length. Try again.")
+ (sleep-for 2)
+ (mastodon-toot--read-poll-options count length))
+ choices)))
(defun mastodon-toot--read-poll-expiry ()
"Prompt for a poll expiry time."
@@ -1434,12 +1454,14 @@ REPLY-TEXT is the text of the toot being replied to."
'read-only "Edit your message below."
'toot-post-header t)
(if reply-text
- (propertize (truncate-string-to-width
- (mastodon-tl--render-text reply-text)
- mastodon-toot-orig-in-reply-length)
- 'read-only "Edit your message below."
- 'toot-post-header t
- 'face '(variable-pitch :foreground "#7c6f64"))
+ (concat
+ (propertize (truncate-string-to-width
+ (mastodon-tl--render-text reply-text)
+ mastodon-toot-orig-in-reply-length)
+ 'read-only "Edit your message below."
+ 'toot-post-header t
+ 'face '(variable-pitch :foreground "#7c6f64"))
+ "\n")
"")
(propertize
(concat divider "\n")
@@ -1529,7 +1551,7 @@ REPLY-JSON is the full JSON of the toot being replied to."
(list 'invisible (not mastodon-toot--content-warning)
'face 'mastodon-cw-face)))))
-(defun mastodon-toot--count-toot-chars (toot-string)
+(defun mastodon-toot--count-toot-chars (toot-string &optional cw)
"Count the characters in TOOT-STRING.
URLs always = 23, and domain names of handles are not counted.
This is how mastodon does it."
@@ -1547,7 +1569,8 @@ This is how mastodon does it."
"\\b")
nil t)
(replace-match (match-string 2))) ; replace with handle only
- (length (buffer-substring (point-min) (point-max)))))
+ (+ (length cw)
+ (length (buffer-substring (point-min) (point-max))))))
(defun mastodon-toot--save-toot-text (&rest _args)
"Save the current toot text in `mastodon-toot-current-toot-text'.
@@ -1615,6 +1638,9 @@ Added to `after-change-functions'."
(cdr header-region))
(mastodon-toot--propertize-item mastodon-toot-handle-regex
'mastodon-display-name-face
+ (cdr header-region))
+ (mastodon-toot--propertize-item mastodon-toot-url-regex
+ 'link
(cdr header-region)))))
(defun mastodon-toot--propertize-item (regex face start)
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
index de498f3..8064282 100644
--- a/lisp/mastodon-views.el
+++ b/lisp/mastodon-views.el
@@ -893,26 +893,20 @@ IND is the optional indentation level to print at."
(defun mastodon-views--print-instance-rules-or-fields (alist)
"Print ALIST of instance rules or contact account or emoji fields."
- (let ((key (cond ((alist-get 'id alist)
- 'id)
- ((alist-get 'name alist)
- 'name)
- ((alist-get 'shortcode alist)
- 'shortcode)))
- (value (cond ((alist-get 'id alist)
- 'text)
- ((alist-get 'value alist)
- 'value)
- ((alist-get 'url alist)
- 'url))))
+ (let ((key (or (alist-get 'id alist)
+ (alist-get 'name alist)
+ (alist-get 'shortcode alist)))
+ (value (or (alist-get 'text alist)
+ (alist-get 'value alist)
+ (alist-get 'url alist))))
(indent-to 4)
(insert
(format "%-5s: "
- (propertize (alist-get key alist)
- 'face '(:underline t)))
- (mastodon-views--newline-if-long (alist-get value alist))
+ (propertize key)
+ 'face '(:underline t))
+ (mastodon-views--newline-if-long value)
(format "%s" (mastodon-tl--render-text
- (alist-get value alist)))
+ value))
"\n")))
(defun mastodon-views--newline-if-long (el)
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index b384a87..980e31f 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -82,6 +82,7 @@
(autoload 'mastodon-tl--unblock-user "mastodon-tl")
(autoload 'mastodon-tl--unfollow-user "mastodon-tl")
(autoload 'mastodon-tl--unmute-user "mastodon-tl")
+(autoload 'mastodon-tl--report-to-mods "mastodon-tl")
(autoload 'mastodon-tl--update "mastodon-tl")
(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot")
(when (require 'lingva nil :no-error)
@@ -199,6 +200,7 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "C-S-B") #'mastodon-tl--unblock-user)
(define-key map (kbd "M") #'mastodon-tl--mute-user)
(define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user)
+ (define-key map (kbd "Z") #'mastodon-tl--report-to-mods)
;; own profile
(define-key map (kbd "O") #'mastodon-profile--my-profile)
(define-key map (kbd "U") #'mastodon-profile--update-user-profile-note)
diff --git a/mastodon.info b/mastodon.info
index bea876e..d1389a1 100644
--- a/mastodon.info
+++ b/mastodon.info
@@ -57,8 +57,8 @@ File: mastodon.info, Node: README, Prev: Top, Up: Top
********
‘mastodon.el’ is an Emacs client for the AcitivityPub social networks
-that implement the Mastodon API. For info see
-<https://joinmastodon.org/>.
+that implement the Mastodon API. For info see joinmastodon.org
+(https://joinmastodon.org/).
* Menu:
@@ -237,6 +237,7 @@ your ‘mastodon-token-file’ does not contain ‘:client_id’ and
‘,’ view favouriters of toot at point
‘.’ view boosters of toot at point
‘/’ switch between mastodon buffers
+ ‘Z’ report user/toot at point to instances moderators
*Other views*
‘s’ search (posts, users, tags) (NB: only posts you have interacted with)
‘I’, ‘c’, ‘d’ view, create, and delete filters
@@ -450,7 +451,8 @@ File: mastodon.info, Node: Alternative timeline layout, Next: Live-updating ti
The incomparable Nicholas Rougier has written an alternative timeline
layout for ‘mastodon.el’.
- The repo is at <https://github.com/rougier/mastodon-alt>.
+ The repo is at mastodon-alt
+(https://github.com/rougier/mastodon-alt).

File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Alternative timeline layout, Up: Usage
@@ -458,7 +460,8 @@ File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next:
1.2.7 Live-updating timelines: ‘mastodon-async-mode’
----------------------------------------------------
-(code taken from <https://github.com/alexjgriffith/mastodon-future.el>.)
+(code taken from mastodon-future
+(https://github.com/alexjgriffith/mastodon-future.el).)
Works for federated, local, and home timelines and for notifications.
It’s a little touchy, one thing to avoid is trying to load a timeline
@@ -479,7 +482,7 @@ File: mastodon.info, Node: Translating toots, Next: bookmarks and mastodonel,
You can translate toots with ‘mastodon-toot--translate-toot-text’ (‘a’
in a timeline). At the moment this requires lingva.el
(https://codeberg.org/martianh/lingva.el), a little interface I wrote to
-<https://lingva.ml>, to be installed to work.
+lingva.ml (https://lingva.ml), to be installed to work.
You could easily modify the simple function to use your Emacs
translator of choice (‘libretrans.el’ , ‘google-translate’, ‘babel’,
@@ -516,8 +519,8 @@ File: mastodon.info, Node: Dependencies, Next: Network compatibility, Prev: U
================
Hard dependencies (should all install with ‘mastodon.el’):
- • ‘request’ (for uploading attachments),
- <https://github.com/tkf/emacs-request>
+ • ‘request’ (for uploading attachments), emacs-request
+ (https://github.com/tkf/emacs-request)
• ‘persist’ for storing some settings across sessions
• ‘ts’ for poll relative expiry times
@@ -608,7 +611,7 @@ File: mastodon.info, Node: Supporting mastodonel, Next: Contributors, Prev: C
============================
If you’d like to support continued development of ‘mastodon.el’, I
-accept donations via paypal: https://paypal.me/martianh
+accept donations via paypal: paypal.me/martianh
(https://paypal.me/martianh). If you would prefer a different payment
method, write to me at that address and I can provide IBAN or other
details.
@@ -637,32 +640,32 @@ File: mastodon.info, Node: Contributors, Prev: Supporting mastodonel, Up: REA
Tag Table:
Node: Top210
Node: README911
-Node: Installation1310
-Node: MELPA1846
-Node: Emoji2214
-Node: Discover2546
-Node: Usage3098
-Node: Logging in to your instance3508
-Node: Timelines4505
-Ref: Keybindings4980
-Ref: Toot byline legend9469
-Node: Composing toots9778
-Ref: Keybindings (1)11355
-Ref: Draft toots11873
-Node: Other commands and account settings12344
-Node: Customization15502
-Node: Alternative timeline layout16288
-Node: Live-updating timelines mastodon-async-mode16665
-Node: Translating toots17501
-Node: bookmarks and mastodonel18673
-Node: Dependencies19143
-Node: Network compatibility19735
-Node: Contributing20221
-Node: Bug reports20510
-Node: Fixes and features21416
-Node: Coding style21899
-Node: Supporting mastodonel22523
-Node: Contributors23053
+Node: Installation1327
+Node: MELPA1863
+Node: Emoji2231
+Node: Discover2563
+Node: Usage3115
+Node: Logging in to your instance3525
+Node: Timelines4522
+Ref: Keybindings4997
+Ref: Toot byline legend9570
+Node: Composing toots9879
+Ref: Keybindings (1)11456
+Ref: Draft toots11974
+Node: Other commands and account settings12445
+Node: Customization15603
+Node: Alternative timeline layout16389
+Node: Live-updating timelines mastodon-async-mode16779
+Node: Translating toots17631
+Node: bookmarks and mastodonel18813
+Node: Dependencies19283
+Node: Network compatibility19889
+Node: Contributing20375
+Node: Bug reports20664
+Node: Fixes and features21570
+Node: Coding style22053
+Node: Supporting mastodonel22677
+Node: Contributors23199

End Tag Table
diff --git a/mastodon.texi b/mastodon.texi
index 13ae33b..122bbb1 100644
--- a/mastodon.texi
+++ b/mastodon.texi
@@ -70,7 +70,7 @@ Contributing
@chapter README
@samp{mastodon.el} is an Emacs client for the AcitivityPub social networks that
-implement the Mastodon API@. For info see @uref{https://joinmastodon.org/}.
+implement the Mastodon API@. For info see @uref{https://joinmastodon.org/, joinmastodon.org}.
@menu
* Installation::
@@ -267,6 +267,8 @@ not contain @samp{:client_id} and @samp{:client_secret}.
@tab view boosters of toot at point
@item @samp{/}
@tab switch between mastodon buffers
+@item @samp{Z}
+@tab report user/toot at point to instances moderators
@item
@tab @strong{Other views}
@item @samp{s}
@@ -584,12 +586,12 @@ Set default reply visibility
The incomparable Nicholas Rougier has written an alternative timeline layout for @samp{mastodon.el}.
-The repo is at @uref{https://github.com/rougier/mastodon-alt}.
+The repo is at @uref{https://github.com/rougier/mastodon-alt, mastodon-alt}.
@node Live-updating timelines @samp{mastodon-async-mode}
@subsection Live-updating timelines: @samp{mastodon-async-mode}
-(code taken from @uref{https://github.com/alexjgriffith/mastodon-future.el}.)
+(code taken from @uref{https://github.com/alexjgriffith/mastodon-future.el, mastodon-future}.)
Works for federated, local, and home timelines and for notifications. It's a
little touchy, one thing to avoid is trying to load a timeline more than once
@@ -604,7 +606,7 @@ view a timeline with one of the commands that begin with
@subsection Translating toots
You can translate toots with @samp{mastodon-toot--translate-toot-text} (@samp{a} in a timeline). At the moment
-this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I wrote to @uref{https://lingva.ml}, to
+this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I wrote to @uref{https://lingva.ml, lingva.ml}, to
be installed to work.
You could easily modify the simple function to use your Emacs translator of
@@ -635,7 +637,7 @@ to your translator function as its text argument. Here's what
Hard dependencies (should all install with @samp{mastodon.el}):
@itemize
@item
-@samp{request} (for uploading attachments), @uref{https://github.com/tkf/emacs-request}
+@samp{request} (for uploading attachments), @uref{https://github.com/tkf/emacs-request, emacs-request}
@item
@samp{persist} for storing some settings across sessions
@item
@@ -724,7 +726,7 @@ There's no need for a blank line after the first docstring line (one is added au
@section Supporting @samp{mastodon.el}
If you'd like to support continued development of @samp{mastodon.el}, I accept
-donations via paypal: @uref{https://paypal.me/martianh, https://paypal.me/martianh}. If you would
+donations via paypal: @uref{https://paypal.me/martianh, paypal.me/martianh}. If you would
prefer a different payment method, write to me at that address and I can
provide IBAN or other details.
diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el
index 57b52a4..b3a02bc 100644
--- a/test/mastodon-http-tests.el
+++ b/test/mastodon-http-tests.el
@@ -76,10 +76,25 @@ Strict-Transport-Security: max-age=31536000
(let ((response-buffer
(get-buffer-create "mastodon-http--triage-buffer")))
(with-current-buffer response-buffer
- (erase-buffer)
+ (erase-buffer)
(insert mastodon-http--example-400))
(should (equal (mastodon-http--triage
response-buffer
(lambda ()
(message "success call")))
"Error 444: some unhappy complaint"))))
+
+(ert-deftest mastodon-http-params-build ()
+ "Should correctly format parameters from an alist."
+ (let ((params '(("q" . "test")
+ ("foo" . "bar"))))
+ (should (string= (mastodon-http--build-params-string params)
+ "q=test&foo=bar"))))
+
+(ert-deftest mastodon-http-params-array-build ()
+ "Should correctly format parameters from an alist."
+ (let ((array '("option" "option2"))
+ (param-str "poll[x][]"))
+ (should (equal (mastodon-http--build-array-params-alist param-str array)
+ '(("poll[x][]" . "option")
+ ("poll[x][]" . "option2"))))))
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index a3ac330..e029ba7 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -4,6 +4,25 @@
(require 'cl-macs)
(require 'el-mock)
+(defconst mastodon-tl--test-instance-rules
+ ;; brief ones calqued off todon.nl
+ '(((id . "1")
+ (text . "We do not accept racism."))
+ ((id . "2")
+ (text . "We do not accept homophobia."))
+ ((id . "3")
+ (text . "We do not accept sexism."))
+ ((id . "4")
+ (text . "We do not accept ableism."))
+ ((id . "5")
+ (text . "We do not accept harassment."))
+ ((id . "6")
+ (text . "We also do not accept hate speech."))
+ ((id . "7")
+ (text . "We do not accept abuse of minors."))
+ ((id . "8")
+ (text . "We do not accept glorification of violence."))))
+
(defconst mastodon-tl-test-base-toot
'((id . 61208)
(created_at . "2017-04-24T19:01:02.000Z")
@@ -1073,53 +1092,135 @@ correct value for following, as well as notifications enabled or disabled."
(let ((response-buffer-true (current-buffer)))
(insert mastodon-tl--follow-notify-true-response)
(with-mock
- (mock (mastodon-http--post url-follow-only nil)
- => response-buffer-true)
- (should
- (equal
- (mastodon-tl--do-user-action-function url-follow-only
- user-name
- user-handle
- "follow")
- "User some-user (@some-user@instance.url) followed!"))
- (mock (mastodon-http--post url-mute nil)
- => response-buffer-true)
- (should
- (equal
- (mastodon-tl--do-user-action-function url-mute
- user-name
- user-handle
- "mute")
- "User some-user (@some-user@instance.url) muted!"))
- (mock (mastodon-http--post url-block nil)
- => response-buffer-true)
- (should
- (equal
- (mastodon-tl--do-user-action-function url-block
- user-name
- user-handle
- "block")
- "User some-user (@some-user@instance.url) blocked!")))
+ (mock (mastodon-http--post url-follow-only nil)
+ => response-buffer-true)
+ (should
+ (equal
+ (mastodon-tl--do-user-action-function url-follow-only
+ user-name
+ user-handle
+ "follow")
+ "User some-user (@some-user@instance.url) followed!"))
+ (mock (mastodon-http--post url-mute nil)
+ => response-buffer-true)
+ (should
+ (equal
+ (mastodon-tl--do-user-action-function url-mute
+ user-name
+ user-handle
+ "mute")
+ "User some-user (@some-user@instance.url) muted!"))
+ (mock (mastodon-http--post url-block nil)
+ => response-buffer-true)
+ (should
+ (equal
+ (mastodon-tl--do-user-action-function url-block
+ user-name
+ user-handle
+ "block")
+ "User some-user (@some-user@instance.url) blocked!")))
(with-mock
- (mock (mastodon-http--post url-true nil) => response-buffer-true)
- (should
- (equal
- (mastodon-tl--do-user-action-function url-true
- user-name
- user-handle
- "follow"
- "true")
- "Receiving notifications for user some-user (@some-user@instance.url)!")))))
+ (mock (mastodon-http--post url-true nil) => response-buffer-true)
+ (should
+ (equal
+ (mastodon-tl--do-user-action-function url-true
+ user-name
+ user-handle
+ "follow"
+ "true")
+ "Receiving notifications for user some-user (@some-user@instance.url)!")))))
(with-temp-buffer
(let ((response-buffer-false (current-buffer)))
(insert mastodon-tl--follow-notify-false-response)
(with-mock
- (mock (mastodon-http--post url-false nil) => response-buffer-false)
- (should
- (equal
- (mastodon-tl--do-user-action-function url-false
- user-name
- user-handle
- "follow"
- "false")
- "Not receiving notifications for user some-user (@some-user@instance.url)!")))))))
+ (mock (mastodon-http--post url-false nil) => response-buffer-false)
+ (should
+ (equal
+ (mastodon-tl--do-user-action-function url-false
+ user-name
+ user-handle
+ "follow"
+ "false")
+ "Not receiving notifications for user some-user (@some-user@instance.url)!")))))))
+
+(ert-deftest mastodon-tl--report-to-mods-params-alist ()
+ ""
+ (with-temp-buffer
+ (let* ((toot mastodon-tl-test-base-toot)
+ (account (alist-get 'account toot)))
+ (with-mock
+ ;; no longer needed after our refactor
+ ;; (mock (mastodon-http--api "reports") => "https://instance.url/api/v1/reports")
+ ;; (mock (mastodon-tl--toot-or-base
+ ;; (mastodon-tl--property 'toot-json :no-move))
+ ;; => mastodon-tl-test-base-toot)
+ (mock (read-string "Add comment [optional]: ") => "Dummy complaint")
+ (stub y-or-n-p => nil) ; no to all
+ (should (equal (mastodon-tl--report-params account toot)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("category" . "other"))))
+ (with-mock
+ (stub y-or-n-p => t) ; yes to all
+ (mock (mastodon-tl--read-rules-ids) => '(1 2 3))
+ (should (equal (mastodon-tl--report-params account toot)
+ '(("rule_ids[]" . 3)
+ ("rule_ids[]" . 2)
+ ("rule_ids[]" . 1)
+ ("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true")))))))))
+
+(ert-deftest mastodon-tl--report-build-params ()
+ ""
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 "true" nil '(1 2 3))
+ '(("rule_ids[]" . 3)
+ ("rule_ids[]" . 2)
+ ("rule_ids[]" . 1)
+ ("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ nil "true" nil nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("forward" . "true"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 "true" "spam" nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true")
+ ("category" . "spam"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 "true" "other" nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true")
+ ("category" . "other"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 nil "spam" nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("category" . "spam")))))
+
+(ert-deftest mastodon-tl--read-rules ()
+ "Should return a list of string numbers based on `mastodon-tl--test-instance-rules'"
+ (let ((crm-separator "[ ]*,[ ]*"))
+ (with-mock
+ (stub mastodon-tl--instance-rules => mastodon-tl--test-instance-rules)
+ (stub completing-read-multiple => '("We do not accept homophobia."
+ "We do not accept harassment."
+ "We also do not accept hate speech."))
+ (should (equal '("2" "5" "6")
+ (mastodon-tl--read-rules-ids))))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 20:15:01 +0000