diff options
author | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2023-04-30 12:18:03 +0200 |
---|---|---|
committer | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2023-04-30 12:18:03 +0200 |
commit | a44f2363f6c74a91844b43a57e434646adc059c4 (patch) | |
tree | 183cb309546869414b582fd7a25f9b93f578350f | |
parent | 780dead06547b15d28cf073e787ae67d6a752c26 (diff) | |
parent | 9613f51d57e5235de99b3e3a7ec6cb24cffdf70e (diff) |
Merge branch 'develop'
-rw-r--r-- | Makefile | 10 | ||||
-rw-r--r-- | README.org | 1 | ||||
-rw-r--r-- | lisp/mastodon-search.el | 4 | ||||
-rw-r--r-- | lisp/mastodon-tl.el | 330 | ||||
-rw-r--r-- | lisp/mastodon-toot.el | 64 | ||||
-rw-r--r-- | lisp/mastodon-views.el | 26 | ||||
-rw-r--r-- | lisp/mastodon.el | 2 | ||||
-rw-r--r-- | mastodon.info | 71 | ||||
-rw-r--r-- | mastodon.texi | 14 | ||||
-rw-r--r-- | test/mastodon-http-tests.el | 17 | ||||
-rw-r--r-- | test/mastodon-tl-tests.el | 191 |
11 files changed, 485 insertions, 245 deletions
@@ -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 @@ -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)))))) |