From aa635a3a389b184e54fc26270bc6037632ad596c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 5 Apr 2023 21:56:06 +0200 Subject: start on reporting to admins --- lisp/mastodon-tl.el | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 794b198..aa016cf 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1665,6 +1665,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 @@ -2093,6 +2097,67 @@ Prefix is sent to `mastodon-tl--show-tag-timeline', which see." (tags (mastodon-tl--map-alist 'name followed-tags-json))) (mastodon-tl--show-tag-timeline prefix tags))) +(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-to-mods () + "" + (interactive) + (when (y-or-n-p (format "report author of toot at point?")) + (let* ((url (mastodon-http--api "reports")) + (toot (mastodon-tl--toot-or-base + (mastodon-tl--property 'toot-json))) + (account (alist-get 'account toot)) + (handle (alist-get 'acct account)) + (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"))) + (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)) + (message "%s" (prin1-to-string params)) + (let ((response ;; (mastodon-http--post-async url params))) + ;; (mastodon-http--triage response + ;; (lambda (response) + ;; (message "User %s reported!" handle))) + ;; ))) + )))))) + +(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 (mapcar (lambda (x) + (cons (alist-get 'text x) + (alist-get 'id x))) + rules)) + (crm-separator (string-replace "," "|" crm-default-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. -- cgit v1.2.3 From 597d3a1f6e62df80f67fcb378342d2e2fdfeb96a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 15 Apr 2023 20:38:04 +0200 Subject: docstring + actual request for report-to-mods --- lisp/mastodon-tl.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aa016cf..3ebcec1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2103,7 +2103,8 @@ Prefix is sent to `mastodon-tl--show-tag-timeline', which see." (mastodon-http--get-json url nil :silent))) (defun mastodon-tl--report-to-mods () - "" + "Report the author of the toot at point to your instance moderators. +Optionally report the toot at point, optionally add a comment, optionally cite rules that have been broken, optionally forward the report to the remove admin, optionally report the account for spam." (interactive) (when (y-or-n-p (format "report author of toot at point?")) (let* ((url (mastodon-http--api "reports")) @@ -2136,13 +2137,11 @@ Prefix is sent to `mastodon-tl--show-tag-timeline', which see." alist))) ;; FIXME: the above approach adds nils to your params. (setq params (delete nil params)) - (message "%s" (prin1-to-string params)) - (let ((response ;; (mastodon-http--post-async url params))) - ;; (mastodon-http--triage response - ;; (lambda (response) - ;; (message "User %s reported!" handle))) - ;; ))) - )))))) + ;; (message "%s" (prin1-to-string params)) + (let ((response (mastodon-http--post-async url params))) + (mastodon-http--triage response + (lambda (response) + (message "User %s reported!" handle))))))) (defun mastodon-tl--read-rules-ids () "Prompt for a list of instance rules and return a list of selected ids." -- cgit v1.2.3 From d8149443fafae6131a52443a0c5e333bf114aab2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 10:06:03 +0200 Subject: refactor and basic test for report to mods --- lisp/mastodon-tl.el | 79 ++++++++++++++++-------------- test/mastodon-tl-tests.el | 122 +++++++++++++++++++++++++++++----------------- 2 files changed, 120 insertions(+), 81 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3ebcec1..0355a27 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2102,46 +2102,53 @@ Prefix is sent to `mastodon-tl--show-tag-timeline', which see." (let ((url (mastodon-http--api "instance/rules"))) (mastodon-http--get-json url nil :silent))) +(defun mastodon-tl--report-params () + "Query user and return report params alist." + (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)) + (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"))) + (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, optionally add a comment, optionally cite rules that have been broken, optionally forward the report to the remove admin, optionally report the account for spam." +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) - (when (y-or-n-p (format "report author of toot at point?")) + (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))) - (account (alist-get 'account toot)) - (handle (alist-get 'acct account)) - (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"))) - (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)) - ;; (message "%s" (prin1-to-string params)) - (let ((response (mastodon-http--post-async url params))) - (mastodon-http--triage response - (lambda (response) - (message "User %s reported!" handle))))))) + (params (mastodon-tl--report-params)) + (response (mastodon-http--post-async url params))) + (mastodon-http--triage response + (lambda (response) + (message "User %s reported!" handle)))))) (defun mastodon-tl--read-rules-ids () "Prompt for a list of instance rules and return a list of selected ids." diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index a3ac330..f1b4735 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1073,53 +1073,85 @@ 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)) + (with-mock + (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_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)) + ;; (mock (y-or-n-p "Also report status at point? ") => t) + ;; (mock (y-or-n-p "Forward to remote admin? ") => nil) + ;; (mock (y-or-n-p "Cite a rule broken? ") => nil) + ;; (mock (y-or-n-p "Spam? ") => nil) + (should (equal (mastodon-tl--report-params) + '(("rule_ids[]" . 3) + ("rule_ids[]" . 2) + ("rule_ids[]" . 1) + ("account_id" . 42) + ("comment" . "Dummy complaint") + ("status_ids[]" . 61208) + ("forward" . "true"))))))))) -- cgit v1.2.3 From 96fc842db36d138b3d6cbd8d109c61fb6aa2cf6f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 11:11:13 +0200 Subject: refactor tl--report-build-params and a hack test for it --- lisp/mastodon-tl.el | 28 ++++++++++++++++++---------- test/mastodon-tl-tests.el | 42 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+), 10 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0355a27..91cc989 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2116,16 +2116,24 @@ Prefix is sent to `mastodon-tl--show-tag-timeline', which see." (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"))) - (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))))) + (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, TOOD-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))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index f1b4735..5dd6a04 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1155,3 +1155,45 @@ correct value for following, as well as notifications enabled or disabled." ("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"))))) -- cgit v1.2.3 From 1a3efb03ba10692c897f7f20426d2f926adeef9e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 14:27:46 +0200 Subject: clean up reports based on real-world test, flycheck, etc. --- lisp/mastodon-tl.el | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 91cc989..1fa0d09 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2080,7 +2080,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)) @@ -2091,7 +2091,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))) @@ -2102,14 +2102,10 @@ Prefix is sent to `mastodon-tl--show-tag-timeline', which see." (let ((url (mastodon-http--api "instance/rules"))) (mastodon-http--get-json url nil :silent))) -(defun mastodon-tl--report-params () - "Query user and return report params alist." - (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)) - (account-id (mastodon-profile--account-field account 'id)) +(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 @@ -2123,7 +2119,7 @@ Prefix is sent to `mastodon-tl--show-tag-timeline', which see." (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, TOOD-ID, FORWARD-P, CAT, and RULES are all from +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 @@ -2152,12 +2148,19 @@ report the account for spam." (interactive) (when (y-or-n-p "Report author of toot at point?") (let* ((url (mastodon-http--api "reports")) - (params (mastodon-tl--report-params)) - (response (mastodon-http--post-async url params))) + (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 (response) + (lambda () (message "User %s reported!" handle)))))) +(defvar crm-separator) + (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)) @@ -2165,7 +2168,7 @@ report the account for spam." (cons (alist-get 'text x) (alist-get 'id x))) rules)) - (crm-separator (string-replace "," "|" crm-default-separator)) + (crm-separator (replace-regexp-in-string "," "|" crm-separator)) (choices (completing-read-multiple "rules [TAB for options, | to separate]: " alist nil :match))) -- cgit v1.2.3 From 1e671d8258c7d56b1ea07fc083c587b439b97b20 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 20:33:39 +0200 Subject: wrap report to mods in do-if-toot --- lisp/mastodon-tl.el | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1fa0d09..7b26ecd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2146,18 +2146,19 @@ 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) - (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)))))) + (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) -- cgit v1.2.3 From d5fa6bbb03318490e0ad041d09331871e2877efb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 24 Apr 2023 18:33:40 +0200 Subject: heading for report to mods --- lisp/mastodon-tl.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b4d90a2..c10c9ec 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2110,6 +2110,9 @@ The suggestions are from followed tags, but any other tags are also allowed." tags))) (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"))) -- cgit v1.2.3 From 71420a495cb1647df67d124dd9a6fe45449612da Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 24 Apr 2023 23:41:47 +0200 Subject: refactor and let-alist for tl--map-rules-alist --- lisp/mastodon-tl.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index c10c9ec..5175370 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2178,13 +2178,16 @@ report the account for spam." (defvar crm-separator) +(defun mastodon-tl--map-rules-alist (rules) + (mapcar (lambda (x) + (let-alist x + `(,.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 (mapcar (lambda (x) - (cons (alist-get 'text x) - (alist-get 'id x))) - 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]: " -- cgit v1.2.3 From c9b7327e411893855ef5564de8a1cdcd3fff102a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 28 Apr 2023 15:01:30 +0200 Subject: fix thread marker to leave point on right toot. --- lisp/mastodon-tl.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5175370..7b2fcac 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1723,8 +1723,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")) @@ -1735,7 +1734,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) @@ -1747,10 +1747,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))))))) -- cgit v1.2.3 From d841c2522ea63e5a2e02811b20506185072740ca Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 28 Apr 2023 15:27:10 +0200 Subject: combine two 'insert toots' groups in -tl.el --- lisp/mastodon-tl.el | 221 ++++++++++++++++++++++++++-------------------------- 1 file changed, 109 insertions(+), 112 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7b2fcac..92ca02a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1089,117 +1089,6 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." help-echo (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 @@ -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)." -- cgit v1.2.3 From bec7a01c1fe63fdb9ca45602ec71315514b4572d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 28 Apr 2023 17:06:53 +0200 Subject: no quasi-quotes for let-alist dots --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 92ca02a..a567544 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2176,9 +2176,10 @@ report the account for spam." (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 - `(,.text . ,.id))) + (cons .text .id))) rules)) (defun mastodon-tl--read-rules-ids () -- cgit v1.2.3 From b67ce61e9a847ee1c19990c1359c66d3a285dff9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Apr 2023 12:14:51 +0200 Subject: readme and tiny cleanups --- README.org | 1 + lisp/mastodon-tl.el | 2 +- lisp/mastodon-toot.el | 1 - 3 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') 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-tl.el b/lisp/mastodon-tl.el index a567544..b2b7d27 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1745,7 +1745,7 @@ view all branches of a thread." ;; print re-fetched toot: (mastodon-tl--toot toot :detailed-p) (mastodon-tl--timeline (alist-get 'descendants context)) - ;; put point at the toot: + ;; put point at the toot: (goto-char (marker-position marker)) (mastodon-tl--goto-next-toot)))) ;; else just print the lone toot: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 2508a21..474337b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -839,7 +839,6 @@ instance to edit a toot." (mastodon-http--triage response (lambda () - (setq masto-poll-toot-response response) (mastodon-toot--kill) (if scheduled (message "Toot scheduled!") -- cgit v1.2.3