diff options
| author | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2023-04-30 12:18:03 +0200 | 
|---|---|---|
| committer | marty hiatt <martianhiatus [a t] riseup [d o t] net> | 2023-04-30 12:18:03 +0200 | 
| commit | a44f2363f6c74a91844b43a57e434646adc059c4 (patch) | |
| tree | 183cb309546869414b582fd7a25f9b93f578350f | |
| parent | 780dead06547b15d28cf073e787ae67d6a752c26 (diff) | |
| parent | 9613f51d57e5235de99b3e3a7ec6cb24cffdf70e (diff) | |
Merge branch 'develop'
| -rw-r--r-- | Makefile | 10 | ||||
| -rw-r--r-- | README.org | 1 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 4 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 330 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 64 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 26 | ||||
| -rw-r--r-- | lisp/mastodon.el | 2 | ||||
| -rw-r--r-- | mastodon.info | 71 | ||||
| -rw-r--r-- | mastodon.texi | 14 | ||||
| -rw-r--r-- | test/mastodon-http-tests.el | 17 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 191 | 
11 files changed, 485 insertions, 245 deletions
@@ -14,13 +14,19 @@ ORG_EVAL2 = --funcall org-texinfo-export-to-info  ## ################################################################ -.PHONY: clean +.PHONY: infoclean tests testsclean  all: $(PKG).info dir -clean: +infoclean:  	rm -f $(PKG).org $(PKG).texi $(PKG).info dir +tests: +	cask emacs -batch -load test/ert-helper.el -f ert-run-tests-batch-and-exit + +testsclean: +	rm -f stubfile.plstore~ +  ## ################################################################  # May look at this in the future @@ -140,6 +140,7 @@ not contain =:client_id= and =:client_secret=.  | =,=              | view favouriters of toot at point                                               |  | =.=              | view boosters of toot at point                                                  |  | =/=              | switch between mastodon buffers                                                 | +| =Z=              | report user/toot at point to instances moderators                               |  |----------------+---------------------------------------------------------------------------------|  |                | *Other views*                                                                     |  | =s=              | search (posts, users, tags) (NB: only posts you have interacted with)           | diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 9b3641b..8cfa3cb 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -191,7 +191,9 @@ user's profile note. This is also called by  `mastodon-tl--get-follow-suggestions' and  `mastodon-profile--insert-follow-requests'."    (mapc (lambda (acct) -          (insert (mastodon-search--propertize-user acct note))) +          (insert (concat (mastodon-search--propertize-user acct note) +                          mastodon-tl--horiz-bar +                          "\n\n")))          json))  (defun mastodon-search--propertize-user (acct &optional note) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e90be9a..b2b7d27 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1090,117 +1090,6 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add."                             (concat help-echo "\nC-RET: play " type " with mpv")))) -;;; INSERT TOOTS - -(defun mastodon-tl--content (toot) -  "Retrieve text content from TOOT. -Runs `mastodon-tl--render-text' and fetches poll or media." -  (let* ((content (mastodon-tl--field 'content toot)) -         (reblog (alist-get 'reblog toot)) -         (poll-p (if reblog -                     (alist-get 'poll reblog) -                   (alist-get 'poll toot)))) -    (concat -     (mastodon-tl--render-text content toot) -     (when poll-p -       (mastodon-tl--get-poll toot)) -     (mastodon-tl--media toot)))) - -(defun mastodon-tl--insert-status (toot body author-byline action-byline -                                        &optional id base-toot detailed-p) -  "Display the content and byline of timeline element TOOT. -BODY will form the section of the toot above the byline. -AUTHOR-BYLINE is an optional function for adding the author -portion of the byline that takes one variable. By default it is -`mastodon-tl--byline-author'. -ACTION-BYLINE is also an optional function for adding an action, -such as boosting favouriting and following to the byline. It also -takes a single function. By default it is -`mastodon-tl--byline-boosted'. -ID is that of the status if it is a notification, which is -attached as a `toot-id' property if provided. If the -status is a favourite or boost notification, BASE-TOOT is the -JSON of the toot responded to. -DETAILED-P means display more detailed info. For now -this just means displaying toot client." -  (let ((start-pos (point))) -    (insert -     (propertize -      (concat "\n" -              body -              " \n" -              (mastodon-tl--byline toot author-byline action-byline detailed-p)) -      'toot-id      (or id ; notification's own id -                        (alist-get 'id toot)) ; toot id -      'base-toot-id (mastodon-tl--toot-id -                     ;; if status is a notif, get id from base-toot -                     ;; (-tl--toot-id toot) will not work here: -                     (or base-toot -                         ;; else normal toot with reblog check: -                         toot)) -      'toot-json    toot -      'base-toot    base-toot) -     "\n") -    (when mastodon-tl--display-media-p -      (mastodon-media--inline-images start-pos (point))))) - -;; from mastodon-alt.el: -(defun mastodon-tl--toot-for-stats (&optional toot) -  "Return the TOOT on which we want to extract stats. -If no TOOT is given, the one at point is considered." -  (let* ((original-toot (or toot (get-text-property (point) 'toot-json))) -         (toot (or (alist-get 'status original-toot) -                   (when (alist-get 'type original-toot) -                     original-toot) -                   (alist-get 'reblog original-toot) -                   original-toot)) -         (type (alist-get 'type (or toot)))) -    (unless (member type '("follow" "follow_request")) -      toot))) - -(defun mastodon-tl--toot-stats (toot) -  "Return a right aligned string (using display align-to). -String is filled with TOOT statistics (boosts, favs, replies). -When the TOOT is a reblog (boost), statistics from reblogged -toots are returned. -To disable showing the stats, customize -`mastodon-tl--show-stats'." -  (when-let ((toot (mastodon-tl--toot-for-stats toot))) -    (let* ((favourites-count (alist-get 'favourites_count toot)) -           (favourited (equal 't (alist-get 'favourited toot))) -           (faves-prop (propertize (format "%s" favourites-count) -                                   'favourites-count favourites-count)) -           (boosts-count (alist-get 'reblogs_count toot)) -           (boosted (equal 't (alist-get 'reblogged toot))) -           (boosts-prop (propertize (format "%s" boosts-count) -                                    'boosts-count boosts-count)) -           (replies-count (alist-get 'replies_count toot)) -           (favourites (format "%s %s" faves-prop ;favourites-count -                               (mastodon-tl--symbol 'favourite))) -           (boosts (format "%s %s" boosts-prop ;boosts-count -                           (mastodon-tl--symbol 'boost))) -           (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) -           (status (concat -                    (propertize favourites -                                'favourited-p favourited -                                'favourites-field t -                                'face font-lock-comment-face) -                    (propertize " | " 'face font-lock-comment-face) -                    (propertize boosts -                                'boosted-p boosted -                                'boosts-field t -                                'face font-lock-comment-face) -                    (propertize " | " 'face font-lock-comment-face) -                    (propertize replies -                                'replies-field t -                                'replies-count replies-count -                                'face font-lock-comment-face))) -           (status (concat -                    (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) -                    status))) -      status))) - -  ;; POLLS  (defun mastodon-tl--get-poll (toot) @@ -1359,7 +1248,115 @@ in which case play first video or gif from current toot."        (message "no moving image here?")))) -;; INSERT TOOTS +;;; INSERT TOOTS + +(defun mastodon-tl--content (toot) +  "Retrieve text content from TOOT. +Runs `mastodon-tl--render-text' and fetches poll or media." +  (let* ((content (mastodon-tl--field 'content toot)) +         (reblog (alist-get 'reblog toot)) +         (poll-p (if reblog +                     (alist-get 'poll reblog) +                   (alist-get 'poll toot)))) +    (concat +     (mastodon-tl--render-text content toot) +     (when poll-p +       (mastodon-tl--get-poll toot)) +     (mastodon-tl--media toot)))) + +(defun mastodon-tl--insert-status (toot body author-byline action-byline +                                        &optional id base-toot detailed-p) +  "Display the content and byline of timeline element TOOT. +BODY will form the section of the toot above the byline. +AUTHOR-BYLINE is an optional function for adding the author +portion of the byline that takes one variable. By default it is +`mastodon-tl--byline-author'. +ACTION-BYLINE is also an optional function for adding an action, +such as boosting favouriting and following to the byline. It also +takes a single function. By default it is +`mastodon-tl--byline-boosted'. +ID is that of the status if it is a notification, which is +attached as a `toot-id' property if provided. If the +status is a favourite or boost notification, BASE-TOOT is the +JSON of the toot responded to. +DETAILED-P means display more detailed info. For now +this just means displaying toot client." +  (let ((start-pos (point))) +    (insert +     (propertize +      (concat "\n" +              body +              " \n" +              (mastodon-tl--byline toot author-byline action-byline detailed-p)) +      'toot-id      (or id ; notification's own id +                        (alist-get 'id toot)) ; toot id +      'base-toot-id (mastodon-tl--toot-id +                     ;; if status is a notif, get id from base-toot +                     ;; (-tl--toot-id toot) will not work here: +                     (or base-toot +                         ;; else normal toot with reblog check: +                         toot)) +      'toot-json    toot +      'base-toot    base-toot) +     "\n") +    (when mastodon-tl--display-media-p +      (mastodon-media--inline-images start-pos (point))))) + +;; from mastodon-alt.el: +(defun mastodon-tl--toot-for-stats (&optional toot) +  "Return the TOOT on which we want to extract stats. +If no TOOT is given, the one at point is considered." +  (let* ((original-toot (or toot (get-text-property (point) 'toot-json))) +         (toot (or (alist-get 'status original-toot) +                   (when (alist-get 'type original-toot) +                     original-toot) +                   (alist-get 'reblog original-toot) +                   original-toot)) +         (type (alist-get 'type (or toot)))) +    (unless (member type '("follow" "follow_request")) +      toot))) + +(defun mastodon-tl--toot-stats (toot) +  "Return a right aligned string (using display align-to). +String is filled with TOOT statistics (boosts, favs, replies). +When the TOOT is a reblog (boost), statistics from reblogged +toots are returned. +To disable showing the stats, customize +`mastodon-tl--show-stats'." +  (when-let ((toot (mastodon-tl--toot-for-stats toot))) +    (let* ((favourites-count (alist-get 'favourites_count toot)) +           (favourited (equal 't (alist-get 'favourited toot))) +           (faves-prop (propertize (format "%s" favourites-count) +                                   'favourites-count favourites-count)) +           (boosts-count (alist-get 'reblogs_count toot)) +           (boosted (equal 't (alist-get 'reblogged toot))) +           (boosts-prop (propertize (format "%s" boosts-count) +                                    'boosts-count boosts-count)) +           (replies-count (alist-get 'replies_count toot)) +           (favourites (format "%s %s" faves-prop ;favourites-count +                               (mastodon-tl--symbol 'favourite))) +           (boosts (format "%s %s" boosts-prop ;boosts-count +                           (mastodon-tl--symbol 'boost))) +           (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) +           (status (concat +                    (propertize favourites +                                'favourited-p favourited +                                'favourites-field t +                                'face font-lock-comment-face) +                    (propertize " | " 'face font-lock-comment-face) +                    (propertize boosts +                                'boosted-p boosted +                                'boosts-field t +                                'face font-lock-comment-face) +                    (propertize " | " 'face font-lock-comment-face) +                    (propertize replies +                                'replies-field t +                                'replies-count replies-count +                                'face font-lock-comment-face))) +           (status (concat +                    (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) +                    status))) +      status)))  (defun mastodon-tl--is-reply (toot)    "Check if the TOOT is a reply to another one (and not boosted)." @@ -1667,6 +1664,10 @@ webapp"          (reblog (alist-get 'reblog json)))      (if reblog (alist-get 'id reblog) id))) +(defun mastodon-tl--toot-or-base (json) +  "Return the base toot or just the toot from toot JSON." +  (or (alist-get 'reblog json) json)) +  ;;; THREADS @@ -1719,8 +1720,7 @@ view all branches of a thread."                 (mastodon-http--api (concat "statuses/" id))                 nil                 :silent)) -             (context (mastodon-http--get-json url nil :silent)) -             (marker (make-marker))) +             (context (mastodon-http--get-json url nil :silent)))          (if (equal (caar toot) 'error)              (message "Error: %s" (cdar toot))            (when (member (alist-get 'type toot) '("reblog" "favourite")) @@ -1731,7 +1731,8 @@ view all branches of a thread."                ;; if we have a thread:                (progn                  (with-current-buffer (get-buffer-create buffer) -                  (let ((inhibit-read-only t)) +                  (let ((inhibit-read-only t) +                        (marker (make-marker)))                      (switch-to-buffer buffer)                      (erase-buffer)                      (mastodon-mode) @@ -1743,10 +1744,10 @@ view all branches of a thread."                      (move-marker marker (point))                      ;; print re-fetched toot:                      (mastodon-tl--toot toot :detailed-p) -                    (mastodon-tl--timeline (alist-get 'descendants context)))) -                ;; put point at the toot: -                (goto-char (marker-position marker)) -                (mastodon-tl--goto-next-toot)) +                    (mastodon-tl--timeline (alist-get 'descendants context)) +                    ;; put point at the toot: +                    (goto-char (marker-position marker)) +                    (mastodon-tl--goto-next-toot))))              ;; else just print the lone toot:              (mastodon-tl--single-toot id))))))) @@ -2078,7 +2079,7 @@ If TAG is provided, unfollow it."  (defun mastodon-tl--list-followed-tags (&optional prefix)    "List followed tags. View timeline of tag user choses. -Prefix is sent to `mastodon-tl--get-tag-timeline', which see." +PREFIX is sent to `mastodon-tl--get-tag-timeline', which see."    (interactive "p")    (let* ((followed-tags-json (mastodon-tl--followed-tags))           (tags (mastodon-tl--map-alist 'name followed-tags-json)) @@ -2089,7 +2090,7 @@ Prefix is sent to `mastodon-tl--get-tag-timeline', which see."  (defun mastodon-tl--followed-tags-timeline (&optional prefix)    "Open a timeline of all your followed tags. -Prefix is sent to `mastodon-tl--show-tag-timeline', which see." +PREFIX is sent to `mastodon-tl--show-tag-timeline', which see."    (interactive "p")    (let* ((followed-tags-json (mastodon-tl--followed-tags))           (tags (mastodon-tl--map-alist 'name followed-tags-json))) @@ -2107,6 +2108,93 @@ The suggestions are from followed tags, but any other tags are also allowed."      (mastodon-tl--show-tag-timeline prefix selection))) +;;; REPORT TO MODERATORS + +(defun mastodon-tl--instance-rules () +  "Return the rules of the user's instance." +  (let ((url (mastodon-http--api "instance/rules"))) +    (mastodon-http--get-json url nil :silent))) + +(defun mastodon-tl--report-params (account toot) +  "Query user and return report params alist. +ACCOUNT and TOOT are the data to use." +  (let* ((account-id (mastodon-profile--account-field account 'id)) +         (comment (read-string "Add comment [optional]: ")) +         (toot-id (when (y-or-n-p "Also report status at point? ") +                    (mastodon-tl--toot-id toot))) ; base toot if poss +         (forward-p (when (y-or-n-p "Forward to remote admin? ") "true")) +         (rules (when (y-or-n-p "Cite a rule broken? ") +                  (mastodon-tl--read-rules-ids))) +         (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other")))) +    (mastodon-tl--report-build-params account-id comment toot-id +                                      forward-p cat rules))) + +(defun mastodon-tl--report-build-params +    (account-id comment toot-id forward-p cat &optional rules) +  "Build the parameters alist based on user responses. +ACCOUNT-ID, COMMENT, TOOT-ID, FORWARD-P, CAT, and RULES are all from +`mastodon-tl--report-params', which see." +  (let ((params `(("account_id" . ,account-id) +                  ,(when comment +                     `("comment" . ,comment)) +                  ,(when toot-id +                     `("status_ids[]" . ,toot-id)) +                  ,(when forward-p +                     `("forward" . ,forward-p)) +                  ,(when cat +                     `("category" . ,cat))))) +    (when rules +      (let ((alist +             (mastodon-http--build-array-params-alist "rule_ids[]" rules))) +        (mapc (lambda (x) +                (push x params)) +              alist))) +    ;; FIXME: the above approach adds nils to your params. +    (setq params (delete nil params)) +    params)) + +(defun mastodon-tl--report-to-mods () +  "Report the author of the toot at point to your instance moderators. +Optionally report the toot at point, add a comment, cite rules +that have been broken, forward the report to the remove admin, +report the account for spam." +  (interactive) +  (mastodon-tl--do-if-toot +   (when (y-or-n-p "Report author of toot at point?") +     (let* ((url (mastodon-http--api "reports")) +            (toot (mastodon-tl--toot-or-base +                   (mastodon-tl--property 'toot-json :no-move))) +            (account (alist-get 'account toot)) +            (handle (alist-get 'acct account)) +            (params (mastodon-tl--report-params account toot)) +            (response (mastodon-http--post url params))) +       ;; (setq masto-report-response response) +       (mastodon-http--triage response +                              (lambda () +                                (message "User %s reported!" handle))))))) + +(defvar crm-separator) + +(defun mastodon-tl--map-rules-alist (rules) +  "Return an alist of the text and id fields of RULES." +  (mapcar (lambda (x) +            (let-alist x +              (cons .text .id))) +          rules)) + +(defun mastodon-tl--read-rules-ids () +  "Prompt for a list of instance rules and return a list of selected ids." +  (let* ((rules (mastodon-tl--instance-rules)) +         (alist (mastodon-tl--map-rules-alist rules)) +         (crm-separator (replace-regexp-in-string "," "|" crm-separator)) +         (choices (completing-read-multiple +                   "rules [TAB for options, | to separate]: " +                   alist nil :match))) +    (mapcar (lambda (x) +              (alist-get x alist nil nil 'equal)) +            choices))) + +  ;;; UPDATING, etc.  (defun mastodon-tl--more-json (endpoint id) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 35e6eab..474337b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -219,13 +219,20 @@ send.")     "\\([(\n\t ]\\|^\\)"     "\\(?2:@[0-9a-zA-Z._-]+" ; a handle     "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ -   "\\b")) +   "\\(\\b\\|'\\)")) ; boundary or ' char  (defvar mastodon-toot-tag-regex    (concat     ;; preceding bracket, space or bol [boundary doesn't work with #]     "\\([(\n\t ]\\|^\\)"     "\\(?2:#[0-9a-zA-Z_]+\\)" ; tag +   "\\(\\b\\|'\\)")) ; boundary or ' char + +(defvar mastodon-toot-url-regex +  ;; adapted from ffap-url-regexp +  (concat +   "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix +   "[^ \n\t]*\\)" ; any old thing that's, i.e. we allow invalid/unwise chars     "\\b")) ; boundary  (defvar mastodon-toot-mode-map @@ -764,6 +771,13 @@ to `emojify-user-emojis', and the emoji data is updated."     `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))     `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))) +(defun mastodon-toot--read-cw-string () +  "Read a content warning from the minibuffer." +  (when (and (not (mastodon-toot--empty-p)) +             mastodon-toot--content-warning) +    (read-string "Warning: " +                 mastodon-toot--content-warning-from-reply-or-redraft))) +  (defun mastodon-toot--send ()    "POST contents of new-toot buffer to Mastodon instance and kill buffer.  If media items have been attached and uploaded with @@ -781,16 +795,13 @@ instance to edit a toot."                (mastodon-http--api (format "statuses/%s"                                            edit-id))              (mastodon-http--api "statuses"))) -         (spoiler (when (and (not (mastodon-toot--empty-p)) -                             mastodon-toot--content-warning) -                    (read-string "Warning: " -                                 mastodon-toot--content-warning-from-reply-or-redraft))) +         (cw (mastodon-toot--read-cw-string))           (args-no-media (append `(("status" . ,toot)                                    ("in_reply_to_id" . ,mastodon-toot--reply-to-id)                                    ("visibility" . ,mastodon-toot--visibility)                                    ("sensitive" . ,(when mastodon-toot--content-nsfw                                                      (symbol-name t))) -                                  ("spoiler_text" . ,spoiler) +                                  ("spoiler_text" . ,cw)                                    ("language" . ,mastodon-toot--language))                                  ;; Pleroma instances can't handle null-valued                                  ;; scheduled_at args, so only add if non-nil @@ -816,8 +827,8 @@ instance to edit a toot."                              (length mastodon-toot--media-attachment-ids)))))             (message "Something is wrong with your uploads. Wait for them to complete or try again."))            ((and mastodon-toot--max-toot-chars -                (> (mastodon-toot--count-toot-chars toot) mastodon-toot--max-toot-chars)) -           (message "Looks like your toot is longer than that maximum allowed length.")) +                (> (mastodon-toot--count-toot-chars toot cw) mastodon-toot--max-toot-chars)) +           (message "Looks like your toot (inc. CW) is longer than that maximum allowed length."))            ((mastodon-toot--empty-p)             (message "Empty toot. Cowardly refusing to post this."))            (t @@ -944,7 +955,6 @@ eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"."  The mentioned users look like this:  Local user (including the logged in): `username`.  Federated user: `username@host.co`." -  (interactive)    (let* ((boosted (mastodon-tl--field 'reblog status))           (mentions            (if boosted @@ -1235,8 +1245,18 @@ MAX is the maximum number set by their instance."  (defun mastodon-toot--read-poll-options (count length)    "Read a list of options for poll with COUNT options.  LENGTH is the maximum character length allowed for a poll option." -  (cl-loop for x from 1 to count -           collect (read-string (format "Poll option [%s/%s] [max %s chars]: " x count length)))) +  (let* ((choices +          (cl-loop for x from 1 to count +                   collect (read-string +                            (format "Poll option [%s/%s] [max %s chars]: " +                                    x count length)))) +         (longest (cl-reduce #'max (mapcar #'length choices)))) +    (if (> longest length) +        (progn +          (message "looks like you went over the max length. Try again.") +          (sleep-for 2) +          (mastodon-toot--read-poll-options count length)) +      choices)))  (defun mastodon-toot--read-poll-expiry ()    "Prompt for a poll expiry time." @@ -1434,12 +1454,14 @@ REPLY-TEXT is the text of the toot being replied to."        'read-only "Edit your message below."        'toot-post-header t)       (if reply-text -         (propertize (truncate-string-to-width -                      (mastodon-tl--render-text reply-text) -                      mastodon-toot-orig-in-reply-length) -                     'read-only "Edit your message below." -                     'toot-post-header t -                     'face '(variable-pitch :foreground "#7c6f64")) +         (concat +          (propertize (truncate-string-to-width +                       (mastodon-tl--render-text reply-text) +                       mastodon-toot-orig-in-reply-length) +                      'read-only "Edit your message below." +                      'toot-post-header t +                      'face '(variable-pitch :foreground "#7c6f64")) +          "\n")         "")       (propertize        (concat divider "\n") @@ -1529,7 +1551,7 @@ REPLY-JSON is the full JSON of the toot being replied to."                             (list 'invisible (not mastodon-toot--content-warning)                                   'face 'mastodon-cw-face))))) -(defun mastodon-toot--count-toot-chars (toot-string) +(defun mastodon-toot--count-toot-chars (toot-string &optional cw)    "Count the characters in TOOT-STRING.  URLs always = 23, and domain names of handles are not counted.  This is how mastodon does it." @@ -1547,7 +1569,8 @@ This is how mastodon does it."                                            "\\b")                                    nil t)        (replace-match (match-string 2))) ; replace with handle only -    (length (buffer-substring (point-min) (point-max))))) +    (+ (length cw) +       (length (buffer-substring (point-min) (point-max))))))  (defun mastodon-toot--save-toot-text (&rest _args)    "Save the current toot text in `mastodon-toot-current-toot-text'. @@ -1615,6 +1638,9 @@ Added to `after-change-functions'."                                        (cdr header-region))        (mastodon-toot--propertize-item mastodon-toot-handle-regex                                        'mastodon-display-name-face +                                      (cdr header-region)) +      (mastodon-toot--propertize-item mastodon-toot-url-regex +                                      'link                                        (cdr header-region)))))  (defun mastodon-toot--propertize-item (regex face start) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index de498f3..8064282 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -893,26 +893,20 @@ IND is the optional indentation level to print at."  (defun mastodon-views--print-instance-rules-or-fields (alist)    "Print ALIST of instance rules or contact account or emoji fields." -  (let ((key   (cond ((alist-get 'id alist) -                      'id) -                     ((alist-get 'name alist) -                      'name) -                     ((alist-get 'shortcode alist) -                      'shortcode))) -        (value (cond ((alist-get 'id alist) -                      'text) -                     ((alist-get 'value alist) -                      'value) -                     ((alist-get 'url alist) -                      'url)))) +  (let ((key (or (alist-get 'id alist) +                 (alist-get 'name alist) +                 (alist-get 'shortcode alist))) +        (value (or (alist-get 'text alist) +                   (alist-get 'value alist) +                   (alist-get 'url alist))))      (indent-to 4)      (insert       (format "%-5s: " -             (propertize (alist-get key alist) -                         'face '(:underline t))) -     (mastodon-views--newline-if-long (alist-get value alist)) +             (propertize key) +             'face '(:underline t)) +     (mastodon-views--newline-if-long value)       (format "%s" (mastodon-tl--render-text -                   (alist-get value alist))) +                   value))       "\n")))  (defun mastodon-views--newline-if-long (el) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index b384a87..980e31f 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -82,6 +82,7 @@  (autoload 'mastodon-tl--unblock-user "mastodon-tl")  (autoload 'mastodon-tl--unfollow-user "mastodon-tl")  (autoload 'mastodon-tl--unmute-user "mastodon-tl") +(autoload 'mastodon-tl--report-to-mods "mastodon-tl")  (autoload 'mastodon-tl--update "mastodon-tl")  (autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot")  (when (require 'lingva nil :no-error) @@ -199,6 +200,7 @@ Use. e.g. \"%c\" for your locale's date and time format."      (define-key map (kbd "C-S-B") #'mastodon-tl--unblock-user)      (define-key map (kbd "M") #'mastodon-tl--mute-user)      (define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user) +    (define-key map (kbd "Z") #'mastodon-tl--report-to-mods)      ;; own profile      (define-key map (kbd "O") #'mastodon-profile--my-profile)      (define-key map (kbd "U") #'mastodon-profile--update-user-profile-note) diff --git a/mastodon.info b/mastodon.info index bea876e..d1389a1 100644 --- a/mastodon.info +++ b/mastodon.info @@ -57,8 +57,8 @@ File: mastodon.info,  Node: README,  Prev: Top,  Up: Top  ********  ‘mastodon.el’ is an Emacs client for the AcitivityPub social networks -that implement the Mastodon API.  For info see -<https://joinmastodon.org/>. +that implement the Mastodon API.  For info see joinmastodon.org +(https://joinmastodon.org/).  * Menu: @@ -237,6 +237,7 @@ your ‘mastodon-token-file’ does not contain ‘:client_id’ and       ‘,’                      view favouriters of toot at point       ‘.’                      view boosters of toot at point       ‘/’                      switch between mastodon buffers +     ‘Z’                      report user/toot at point to instances moderators                                *Other views*       ‘s’                      search (posts, users, tags) (NB: only posts you have interacted with)       ‘I’, ‘c’, ‘d’            view, create, and delete filters @@ -450,7 +451,8 @@ File: mastodon.info,  Node: Alternative timeline layout,  Next: Live-updating ti  The incomparable Nicholas Rougier has written an alternative timeline  layout for ‘mastodon.el’. -   The repo is at <https://github.com/rougier/mastodon-alt>. +   The repo is at mastodon-alt +(https://github.com/rougier/mastodon-alt).  File: mastodon.info,  Node: Live-updating timelines mastodon-async-mode,  Next: Translating toots,  Prev: Alternative timeline layout,  Up: Usage @@ -458,7 +460,8 @@ File: mastodon.info,  Node: Live-updating timelines mastodon-async-mode,  Next:  1.2.7 Live-updating timelines: ‘mastodon-async-mode’  ---------------------------------------------------- -(code taken from <https://github.com/alexjgriffith/mastodon-future.el>.) +(code taken from mastodon-future +(https://github.com/alexjgriffith/mastodon-future.el).)     Works for federated, local, and home timelines and for notifications.  It’s a little touchy, one thing to avoid is trying to load a timeline @@ -479,7 +482,7 @@ File: mastodon.info,  Node: Translating toots,  Next: bookmarks and mastodonel,  You can translate toots with ‘mastodon-toot--translate-toot-text’ (‘a’  in a timeline).  At the moment this requires lingva.el  (https://codeberg.org/martianh/lingva.el), a little interface I wrote to -<https://lingva.ml>, to be installed to work. +lingva.ml (https://lingva.ml), to be installed to work.     You could easily modify the simple function to use your Emacs  translator of choice (‘libretrans.el’ , ‘google-translate’, ‘babel’, @@ -516,8 +519,8 @@ File: mastodon.info,  Node: Dependencies,  Next: Network compatibility,  Prev: U  ================  Hard dependencies (should all install with ‘mastodon.el’): -   • ‘request’ (for uploading attachments), -     <https://github.com/tkf/emacs-request> +   • ‘request’ (for uploading attachments), emacs-request +     (https://github.com/tkf/emacs-request)     • ‘persist’ for storing some settings across sessions     • ‘ts’ for poll relative expiry times @@ -608,7 +611,7 @@ File: mastodon.info,  Node: Supporting mastodonel,  Next: Contributors,  Prev: C  ============================  If you’d like to support continued development of ‘mastodon.el’, I -accept donations via paypal: https://paypal.me/martianh +accept donations via paypal: paypal.me/martianh  (https://paypal.me/martianh).  If you would prefer a different payment  method, write to me at that address and I can provide IBAN or other  details. @@ -637,32 +640,32 @@ File: mastodon.info,  Node: Contributors,  Prev: Supporting mastodonel,  Up: REA  Tag Table:  Node: Top210  Node: README911 -Node: Installation1310 -Node: MELPA1846 -Node: Emoji2214 -Node: Discover2546 -Node: Usage3098 -Node: Logging in to your instance3508 -Node: Timelines4505 -Ref: Keybindings4980 -Ref: Toot byline legend9469 -Node: Composing toots9778 -Ref: Keybindings (1)11355 -Ref: Draft toots11873 -Node: Other commands and account settings12344 -Node: Customization15502 -Node: Alternative timeline layout16288 -Node: Live-updating timelines mastodon-async-mode16665 -Node: Translating toots17501 -Node: bookmarks and mastodonel18673 -Node: Dependencies19143 -Node: Network compatibility19735 -Node: Contributing20221 -Node: Bug reports20510 -Node: Fixes and features21416 -Node: Coding style21899 -Node: Supporting mastodonel22523 -Node: Contributors23053 +Node: Installation1327 +Node: MELPA1863 +Node: Emoji2231 +Node: Discover2563 +Node: Usage3115 +Node: Logging in to your instance3525 +Node: Timelines4522 +Ref: Keybindings4997 +Ref: Toot byline legend9570 +Node: Composing toots9879 +Ref: Keybindings (1)11456 +Ref: Draft toots11974 +Node: Other commands and account settings12445 +Node: Customization15603 +Node: Alternative timeline layout16389 +Node: Live-updating timelines mastodon-async-mode16779 +Node: Translating toots17631 +Node: bookmarks and mastodonel18813 +Node: Dependencies19283 +Node: Network compatibility19889 +Node: Contributing20375 +Node: Bug reports20664 +Node: Fixes and features21570 +Node: Coding style22053 +Node: Supporting mastodonel22677 +Node: Contributors23199  End Tag Table diff --git a/mastodon.texi b/mastodon.texi index 13ae33b..122bbb1 100644 --- a/mastodon.texi +++ b/mastodon.texi @@ -70,7 +70,7 @@ Contributing  @chapter README  @samp{mastodon.el} is an Emacs client for the AcitivityPub social networks that -implement the Mastodon API@. For info see @uref{https://joinmastodon.org/}. +implement the Mastodon API@. For info see @uref{https://joinmastodon.org/, joinmastodon.org}.  @menu  * Installation:: @@ -267,6 +267,8 @@ not contain @samp{:client_id} and @samp{:client_secret}.  @tab view boosters of toot at point  @item @samp{/}  @tab switch between mastodon buffers +@item @samp{Z} +@tab report user/toot at point to instances moderators  @item   @tab @strong{Other views}  @item @samp{s} @@ -584,12 +586,12 @@ Set default reply visibility  The incomparable Nicholas Rougier has written an alternative timeline layout for @samp{mastodon.el}. -The repo is at @uref{https://github.com/rougier/mastodon-alt}. +The repo is at @uref{https://github.com/rougier/mastodon-alt, mastodon-alt}.  @node Live-updating timelines @samp{mastodon-async-mode}  @subsection Live-updating timelines: @samp{mastodon-async-mode} -(code taken from @uref{https://github.com/alexjgriffith/mastodon-future.el}.) +(code taken from @uref{https://github.com/alexjgriffith/mastodon-future.el, mastodon-future}.)  Works for federated, local, and home timelines and for notifications. It's a  little touchy, one thing to avoid is trying to load a timeline more than once @@ -604,7 +606,7 @@ view a timeline with one of the commands that begin with  @subsection Translating toots  You can translate toots with @samp{mastodon-toot--translate-toot-text} (@samp{a} in a timeline). At the moment -this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I wrote to @uref{https://lingva.ml}, to +this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I wrote to @uref{https://lingva.ml, lingva.ml}, to  be installed to work.  You could easily modify the simple function to use your Emacs translator of @@ -635,7 +637,7 @@ to your translator function as its text argument. Here's what  Hard dependencies (should all install with @samp{mastodon.el}):  @itemize  @item -@samp{request} (for uploading attachments), @uref{https://github.com/tkf/emacs-request} +@samp{request} (for uploading attachments), @uref{https://github.com/tkf/emacs-request, emacs-request}  @item  @samp{persist} for storing some settings across sessions  @item @@ -724,7 +726,7 @@ There's no need for a blank line after the first docstring line (one is added au  @section Supporting @samp{mastodon.el}  If you'd like to support continued development of @samp{mastodon.el}, I accept -donations via paypal: @uref{https://paypal.me/martianh, https://paypal.me/martianh}. If you would +donations via paypal: @uref{https://paypal.me/martianh, paypal.me/martianh}. If you would  prefer a different payment method, write to me at that address and I can  provide IBAN or other details. diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el index 57b52a4..b3a02bc 100644 --- a/test/mastodon-http-tests.el +++ b/test/mastodon-http-tests.el @@ -76,10 +76,25 @@ Strict-Transport-Security: max-age=31536000    (let ((response-buffer           (get-buffer-create "mastodon-http--triage-buffer")))      (with-current-buffer response-buffer -        (erase-buffer) +      (erase-buffer)        (insert mastodon-http--example-400))      (should (equal (mastodon-http--triage                      response-buffer                      (lambda ()                        (message "success call")))                     "Error 444: some unhappy complaint")))) + +(ert-deftest mastodon-http-params-build () +  "Should correctly format parameters from an alist." +  (let ((params '(("q" . "test") +                  ("foo" . "bar")))) +    (should (string= (mastodon-http--build-params-string params) +                     "q=test&foo=bar")))) + +(ert-deftest mastodon-http-params-array-build () +  "Should correctly format parameters from an alist." +  (let ((array '("option" "option2")) +        (param-str "poll[x][]")) +    (should (equal (mastodon-http--build-array-params-alist param-str array) +                   '(("poll[x][]" . "option") +                     ("poll[x][]" . "option2")))))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index a3ac330..e029ba7 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -4,6 +4,25 @@  (require 'cl-macs)  (require 'el-mock) +(defconst mastodon-tl--test-instance-rules +  ;; brief ones calqued off todon.nl +  '(((id . "1") +     (text . "We do not accept racism.")) +    ((id . "2") +     (text . "We do not accept homophobia.")) +    ((id . "3") +     (text . "We do not accept sexism.")) +    ((id . "4") +     (text . "We do not accept ableism.")) +    ((id . "5") +     (text . "We do not accept harassment.")) +    ((id . "6") +     (text . "We also do not accept hate speech.")) +    ((id . "7") +     (text . "We do not accept abuse of minors.")) +    ((id . "8") +     (text . "We do not accept glorification of violence.")))) +  (defconst mastodon-tl-test-base-toot    '((id . 61208)      (created_at . "2017-04-24T19:01:02.000Z") @@ -1073,53 +1092,135 @@ correct value for following, as well as notifications enabled or disabled."        (let ((response-buffer-true (current-buffer)))          (insert mastodon-tl--follow-notify-true-response)          (with-mock -          (mock (mastodon-http--post url-follow-only nil) -                => response-buffer-true) -          (should -           (equal -            (mastodon-tl--do-user-action-function url-follow-only -                                                  user-name -                                                  user-handle -                                                  "follow") -            "User some-user (@some-user@instance.url) followed!")) -          (mock (mastodon-http--post url-mute nil) -                => response-buffer-true) -          (should -           (equal -            (mastodon-tl--do-user-action-function url-mute -                                                  user-name -                                                  user-handle -                                                  "mute") -            "User some-user (@some-user@instance.url) muted!")) -          (mock (mastodon-http--post url-block nil) -                => response-buffer-true) -          (should -           (equal -            (mastodon-tl--do-user-action-function url-block -                                                  user-name -                                                  user-handle -                                                  "block") -            "User some-user (@some-user@instance.url) blocked!"))) +         (mock (mastodon-http--post url-follow-only nil) +               => response-buffer-true) +         (should +          (equal +           (mastodon-tl--do-user-action-function url-follow-only +                                                 user-name +                                                 user-handle +                                                 "follow") +           "User some-user (@some-user@instance.url) followed!")) +         (mock (mastodon-http--post url-mute nil) +               => response-buffer-true) +         (should +          (equal +           (mastodon-tl--do-user-action-function url-mute +                                                 user-name +                                                 user-handle +                                                 "mute") +           "User some-user (@some-user@instance.url) muted!")) +         (mock (mastodon-http--post url-block nil) +               => response-buffer-true) +         (should +          (equal +           (mastodon-tl--do-user-action-function url-block +                                                 user-name +                                                 user-handle +                                                 "block") +           "User some-user (@some-user@instance.url) blocked!")))          (with-mock -          (mock (mastodon-http--post url-true nil) => response-buffer-true) -          (should -           (equal -            (mastodon-tl--do-user-action-function url-true -                                                  user-name -                                                  user-handle -                                                  "follow" -                                                  "true") -            "Receiving notifications for user some-user (@some-user@instance.url)!"))))) +         (mock (mastodon-http--post url-true nil) => response-buffer-true) +         (should +          (equal +           (mastodon-tl--do-user-action-function url-true +                                                 user-name +                                                 user-handle +                                                 "follow" +                                                 "true") +           "Receiving notifications for user some-user (@some-user@instance.url)!")))))      (with-temp-buffer        (let ((response-buffer-false (current-buffer)))          (insert mastodon-tl--follow-notify-false-response)          (with-mock -          (mock (mastodon-http--post url-false nil) => response-buffer-false) -          (should -           (equal -            (mastodon-tl--do-user-action-function url-false -                                                  user-name -                                                  user-handle -                                                  "follow" -                                                  "false") -            "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) +         (mock (mastodon-http--post url-false nil) => response-buffer-false) +         (should +          (equal +           (mastodon-tl--do-user-action-function url-false +                                                 user-name +                                                 user-handle +                                                 "follow" +                                                 "false") +           "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) + +(ert-deftest mastodon-tl--report-to-mods-params-alist () +  "" +  (with-temp-buffer +    (let* ((toot mastodon-tl-test-base-toot) +           (account (alist-get 'account toot))) +      (with-mock +        ;; no longer needed after our refactor +        ;; (mock (mastodon-http--api "reports") => "https://instance.url/api/v1/reports") +        ;; (mock (mastodon-tl--toot-or-base +        ;; (mastodon-tl--property 'toot-json :no-move)) +        ;; => mastodon-tl-test-base-toot) +        (mock (read-string "Add comment [optional]: ") => "Dummy complaint") +        (stub y-or-n-p => nil) ; no to all +        (should (equal (mastodon-tl--report-params account toot) +                       '(("account_id" . 42) +                         ("comment" . "Dummy complaint") +                         ("category" . "other")))) +        (with-mock +          (stub y-or-n-p => t) ; yes to all +          (mock (mastodon-tl--read-rules-ids) => '(1 2 3)) +          (should (equal (mastodon-tl--report-params account toot) +                         '(("rule_ids[]" . 3) +                           ("rule_ids[]" . 2) +                           ("rule_ids[]" . 1) +                           ("account_id" . 42) +                           ("comment" . "Dummy complaint") +                           ("status_ids[]" . 61208) +                           ("forward" . "true"))))))))) + +(ert-deftest mastodon-tl--report-build-params () +  "" +  (should (equal +           (mastodon-tl--report-build-params 42 "Dummy complaint" +                                             61208 "true" nil '(1 2 3)) +           '(("rule_ids[]" . 3) +             ("rule_ids[]" . 2) +             ("rule_ids[]" . 1) +             ("account_id" . 42) +             ("comment" . "Dummy complaint") +             ("status_ids[]" . 61208) +             ("forward" . "true")))) +  (should (equal +           (mastodon-tl--report-build-params 42 "Dummy complaint" +                                             nil "true" nil nil) +           '(("account_id" . 42) +             ("comment" . "Dummy complaint") +             ("forward" . "true")))) +  (should (equal +           (mastodon-tl--report-build-params 42 "Dummy complaint" +                                             61208 "true" "spam" nil) +           '(("account_id" . 42) +             ("comment" . "Dummy complaint") +             ("status_ids[]" . 61208) +             ("forward" . "true") +             ("category" . "spam")))) +  (should (equal +           (mastodon-tl--report-build-params 42 "Dummy complaint" +                                             61208 "true" "other" nil) +           '(("account_id" . 42) +             ("comment" . "Dummy complaint") +             ("status_ids[]" . 61208) +             ("forward" . "true") +             ("category" . "other")))) +  (should (equal +           (mastodon-tl--report-build-params 42 "Dummy complaint" +                                             61208 nil "spam" nil) +           '(("account_id" . 42) +             ("comment" . "Dummy complaint") +             ("status_ids[]" . 61208) +             ("category" . "spam"))))) + +(ert-deftest mastodon-tl--read-rules () +  "Should return a list of string numbers based on `mastodon-tl--test-instance-rules'" +  (let ((crm-separator "[ 	]*,[ 	]*")) +    (with-mock +     (stub mastodon-tl--instance-rules => mastodon-tl--test-instance-rules) +     (stub completing-read-multiple => '("We do not accept homophobia." +                                         "We do not accept harassment." +                                         "We also do not accept hate speech.")) +     (should (equal '("2" "5" "6") +                    (mastodon-tl--read-rules-ids))))))  | 
