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') 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') 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 f6a06454c793285e178265ab24552520198ea15a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 18 Apr 2023 18:33:21 +0200 Subject: test if any poll options go over the max, and re-run if so. FIX #436 --- lisp/mastodon-toot.el | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e7cf22c..7404f18 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -828,6 +828,7 @@ instance to edit a toot." (mastodon-http--triage response (lambda () + (setq masto-poll-toot-response response) (mastodon-toot--kill) (if scheduled (message "Toot scheduled!") @@ -1234,8 +1235,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." -- cgit v1.2.3 From e27a5d2c621be81e33a32b27d1f7cc79f82d8eb1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 18 Apr 2023 18:55:38 +0200 Subject: include CW length in max char count check. FIX #393. --- lisp/mastodon-toot.el | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7404f18..6dfd07d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -764,6 +764,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 +788,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 +820,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 @@ -1536,7 +1540,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." @@ -1554,7 +1558,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'. -- 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') 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') 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') 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 20085e6740d59232f0f22b62df6812b557ff921c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 20:31:26 +0200 Subject: report to mods binding --- lisp/mastodon.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 81a0092..9ec1d76 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -83,6 +83,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) @@ -200,6 +201,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) -- 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') 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 1715bb3f5ba468fc9d06c5835cdc9bba03de06d6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 21:47:42 +0200 Subject: allow zeroes in handle/tag regexes! --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c2c391d..4c0a274 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -217,7 +217,7 @@ send.") (concat ;; preceding bracket, space or bol [boundary doesn't work with @] "\\([(\n\t ]\\|^\\)" - "\\(?2:@[1-9a-zA-Z._-]+" ; a handle + "\\(?2:@[0-9a-zA-Z._-]+" ; a handle "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) @@ -225,7 +225,7 @@ send.") (concat ;; preceding bracket, space or bol [boundary doesn't work with #] "\\([(\n\t ]\\|^\\)" - "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag + "\\(?2:#[0-9a-zA-Z_]+\\)" ; tag "\\b")) ; boundary (defvar mastodon-toot-mode-map -- cgit v1.2.3 From f02c09e768feaf142db587c79006299205dd4818 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 21:47:42 +0200 Subject: allow zeroes in handle/tag regexes! --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6dfd07d..8aa5597 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -217,7 +217,7 @@ send.") (concat ;; preceding bracket, space or bol [boundary doesn't work with @] "\\([(\n\t ]\\|^\\)" - "\\(?2:@[1-9a-zA-Z._-]+" ; a handle + "\\(?2:@[0-9a-zA-Z._-]+" ; a handle "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) @@ -225,7 +225,7 @@ send.") (concat ;; preceding bracket, space or bol [boundary doesn't work with #] "\\([(\n\t ]\\|^\\)" - "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag + "\\(?2:#[0-9a-zA-Z_]+\\)" ; tag "\\b")) ; boundary (defvar mastodon-toot-mode-map -- cgit v1.2.3 From 28e418cbbf8bfa3b600a8bf53361b93e2b8d9f3b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 21 Apr 2023 23:01:07 +0200 Subject: add horiz bar to follow suggests/reqs --- lisp/mastodon-search.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') 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) -- cgit v1.2.3 From eacce3bf19b70b2a656e6a04b8b985f9bf56f297 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 22 Apr 2023 13:19:16 +0200 Subject: propertize urls in compose buffer. FIX #441. --- lisp/mastodon-toot.el | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8aa5597..6eb271d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -228,6 +228,13 @@ send.") "\\(?2:#[0-9a-zA-Z_]+\\)" ; tag "\\b")) ; boundary +(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 (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -1627,6 +1634,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) -- 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') 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') 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 99841bbb70d2dbccc905c53a343a705b30fd1301 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 09:29:51 +0200 Subject: fixes for display of orig in reply buffer. FIX #442. --- lisp/mastodon-toot.el | 50 ++++++++++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6eb271d..a3f337d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1072,26 +1072,27 @@ text of the toot being replied to in the compose buffer." (booster (when boosted (alist-get 'acct (alist-get 'account toot))))) - (mastodon-toot (when user - (if booster - (if (and (not (equal user booster)) - (not (member booster mentions))) - ;; different booster, user and mentions: - (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) - ;; booster is either user or in mentions: - (if (not (member user mentions)) - ;; user not already in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user already in mentions: - (mastodon-toot--mentions-to-string (copy-sequence mentions)))) - ;; ELSE no booster: - (if (not (member user mentions)) - ;; user not in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user in mentions already: - (mastodon-toot--mentions-to-string (copy-sequence mentions))))) - id - (or base-toot toot))))) + (mastodon-toot + (when user + (if booster + (if (and (not (equal user booster)) + (not (member booster mentions))) + ;; different booster, user and mentions: + (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) + ;; booster is either user or in mentions: + (if (not (member user mentions)) + ;; user not already in mentions: + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + ;; user already in mentions: + (mastodon-toot--mentions-to-string (copy-sequence mentions)))) + ;; ELSE no booster: + (if (not (member user mentions)) + ;; user not in mentions: + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + ;; user in mentions already: + (mastodon-toot--mentions-to-string (copy-sequence mentions))))) + id + (or base-toot toot))))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." @@ -1458,6 +1459,8 @@ REPLY-TEXT is the text of the toot being replied to." (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")) "") (propertize @@ -1485,7 +1488,8 @@ REPLY-JSON is the full JSON of the toot being replied to." (alist-get 'visibility reply-json))) (reply-cw (alist-get 'spoiler_text reply-json))) (when reply-to-user - (insert (format "%s " reply-to-user)) + (when (> (length reply-to-user) 0) ; self is "" unforch + (insert (format "%s " reply-to-user))) (setq mastodon-toot--reply-to-id reply-to-id) (unless (equal mastodon-toot--visibility reply-visibility) (setq mastodon-toot--visibility reply-visibility)) @@ -1669,7 +1673,9 @@ EDIT means we are editing an existing toot, not composing a new one." (buffer-exists (get-buffer buffer-name)) (buffer (or buffer-exists (get-buffer-create buffer-name))) (inhibit-read-only t) - (reply-text (alist-get 'content reply-json)) + (reply-text (alist-get 'content + (or (alist-get 'reblog reply-json) + reply-json))) (previous-window-config (list (current-window-configuration) (point-marker)))) (switch-to-buffer-other-window buffer) -- cgit v1.2.3 From 3d30ac5dc8fd2e8cb861ae2cc9165e33f83caa8a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 09:32:19 +0200 Subject: simplify views--print-instance-rules --- lisp/mastodon-views.el | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) (limited to 'lisp') 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) -- cgit v1.2.3 From d2aea126a9d5a5873a835a8ed390956c481c587c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 09:42:01 +0200 Subject: mastodon.el: update commentary and file header --- lisp/mastodon.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 9ec1d76..980e31f 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -1,4 +1,4 @@ -;;; mastodon.el --- Client for Mastodon and compatible fediverse services -*- lexical-binding: t -*- +;;; mastodon.el --- Client for fediverse services that implement the Mastodon API -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen ;; Copyright (C) 2020-2022 Marty Hiatt @@ -29,8 +29,7 @@ ;;; Commentary: -;; mastodon.el is an Emacs client for Mastodon , -;; the federated microblogging social network. It also works with Pleroma instances and other services that implement the Mastodon API. +;; mastodon.el is a client for fediverse services that implement the Mastodon API. See . ;; See the readme file at https://codeberg.org/martianh/mastodon.el for set up and usage details. ;;; Code: -- 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') 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') 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') 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 912f7609fba01baeda1601f52a68533398f5fd4d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 29 Apr 2023 12:02:34 +0200 Subject: newline after reply text in compose buffer --- lisp/mastodon-toot.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a3f337d..763c533 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1456,12 +1456,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") -- cgit v1.2.3 From 80f3193285516fbe60e34f5d732dae3b6fba8b5b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Apr 2023 11:37:53 +0200 Subject: tl--mentions not interactive --- lisp/mastodon-toot.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 763c533..bcb9c6a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -956,7 +956,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 -- cgit v1.2.3 From 1c28483501229f32700562381ed4d07b8600c72c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Apr 2023 11:51:16 +0200 Subject: handle 's after tag or mention --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bcb9c6a..2508a21 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -219,14 +219,14 @@ 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 + "\\(\\b\\|'\\)")) ; boundary or ' char (defvar mastodon-toot-url-regex ;; adapted from ffap-url-regexp -- 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') 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