aboutsummaryrefslogtreecommitdiff
path: root/lisp/mastodon-tl.el
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus@riseup.net>2024-08-15 10:36:45 +0200
committermarty hiatt <martianhiatus@riseup.net>2024-08-15 10:36:45 +0200
commitd5999c7d467982845d53def10368810544dc2fa8 (patch)
tree146211d3accfa48a15e1f365d87e3aeaa3ff35fb /lisp/mastodon-tl.el
parenta8c93def01a7d0d1b09b61d743fef99987fbce3f (diff)
parent3bd81ee203d880ca83e3ec22172c0a2508c4d78e (diff)
Merge branch 'filters-apply' into develop
Diffstat (limited to 'lisp/mastodon-tl.el')
-rw-r--r--lisp/mastodon-tl.el125
1 files changed, 88 insertions, 37 deletions
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 944e662..0d5d8a9 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -1105,12 +1105,13 @@ content should be hidden."
(when (not (equal "" cw))
(mastodon-tl--toggle-spoiler-text-in-toot))))))))
-(defun mastodon-tl--spoiler (toot)
+(defun mastodon-tl--spoiler (toot &optional filter)
"Render TOOT with spoiler message.
This assumes TOOT is a toot with a spoiler message.
The main body gets hidden and only the spoiler text and the
content warning message are displayed. The content warning
-message is a link which unhides/hides the main body."
+message is a link which unhides/hides the main body.
+FILTER is a string to use as a filter warning spoiler instead."
(let* ((spoiler (mastodon-tl--field 'spoiler_text toot))
(string (mastodon-tl--set-face
(mastodon-tl--clean-tabs-and-nl
@@ -1118,7 +1119,9 @@ message is a link which unhides/hides the main body."
'default))
(message (concat " " mastodon-tl--horiz-bar "\n "
(mastodon-tl--make-link
- (concat "CW: " string)
+ (if filter
+ (concat "Filtered: " filter)
+ (concat "CW: " string))
'content-warning)
"\n "
mastodon-tl--horiz-bar "\n"))
@@ -1127,20 +1130,22 @@ message is a link which unhides/hides the main body."
cw
(propertize (mastodon-tl--content toot)
'invisible
- (let ((cust mastodon-tl--expand-content-warnings))
- (cond ((eq t cust)
- nil)
- ((eq nil cust)
- t)
- ((eq 'server cust)
- (unless (eq t
- ;; If something goes wrong reading prefs,
- ;; just return nil so CWs show by default.
- (condition-case nil
- (mastodon-profile--get-preferences-pref
- 'reading:expand:spoilers)
- (error nil)))
- t))))
+ (if filter
+ t
+ (let ((cust mastodon-tl--expand-content-warnings))
+ (cond ((eq t cust)
+ nil)
+ ((eq nil cust)
+ t)
+ ((eq 'server cust)
+ (unless (eq t
+ ;; If something goes wrong reading prefs,
+ ;; just return nil so CWs show by default.
+ (condition-case nil
+ (mastodon-profile--get-preferences-pref
+ 'reading:expand:spoilers)
+ (error nil)))
+ t)))))
'mastodon-content-warning-body t))))
@@ -1576,6 +1581,42 @@ Used as a predicate in `mastodon-tl--timeline'."
(and (mastodon-tl--field 'in_reply_to_id toot)
(eq :json-false (mastodon-tl--field 'reblogged toot))))
+(defun mastodon-tl--filters-alist (filters)
+ "Parse filter data for FILTERS.
+For each filter, return a list of action (warn or hide), filter
+title, and context."
+ (cl-loop for x in filters ;; includes non filter elts!
+ for f = (alist-get 'filter x)
+ collect (list (alist-get 'filter_action f)
+ (alist-get 'title f)
+ (alist-get 'context f))))
+
+(defun mastodon-tl--filter-by-context (context filters)
+ "Remove FILTERS that don't apply to the current CONTEXT."
+ (cl-remove-if-not
+ (lambda (x)
+ (member context (nth 2 x)))
+ filters))
+
+(defun mastodon-tl--filters-context ()
+ "Return a string of the current buffer's filter context.
+Returns a member of `mastodon-views--filter-types'."
+ (let ((buf (mastodon-tl--get-buffer-type)))
+ (cond ((or (eq buf 'local) (eq buf 'federated))
+ "public")
+ ((mastodon-tl--profile-buffer-p)
+ "profile")
+ (t ;; thread, notifs, home:
+ (symbol-name buf)))))
+
+(defun mastodon-tl--current-filters (filters)
+ "Return the filters from FILTERS data that apply in the current context.
+For each filter, return a list of action (warn or hide), filter
+title, and context."
+ (let ((context (mastodon-tl--filters-context))
+ (filters-no-context (mastodon-tl--filters-alist filters)))
+ (mastodon-tl--filter-by-context context filters-no-context)))
+
(defun mastodon-tl--toot (toot &optional detailed-p thread domain
unfolded no-byline)
"Format TOOT and insert it into the buffer.
@@ -1585,32 +1626,42 @@ THREAD means the status will be displayed in a thread view.
When DOMAIN, force inclusion of user's domain in their handle.
UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
NO-BYLINE means just insert toot body, used for folding."
- (mastodon-tl--insert-status
- toot
- (mastodon-tl--clean-tabs-and-nl
- (if (mastodon-tl--has-spoiler toot)
- (mastodon-tl--spoiler toot)
- (mastodon-tl--content toot)))
- 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted
- nil nil detailed-p thread domain unfolded no-byline))
+ (let* ((filtered (mastodon-tl--field 'filtered toot))
+ (filters (when filtered
+ (mastodon-tl--current-filters filtered)))
+ (spoiler-or-content (if-let ((match (assoc "warn" filters)))
+ (mastodon-tl--spoiler toot (cadr match))
+ (if (mastodon-tl--has-spoiler toot)
+ (mastodon-tl--spoiler toot)
+ (mastodon-tl--content toot)))))
+ ;; If any filters are "hide", then we hide,
+ ;; even though item may also have a "warn" filter:
+ (if (and filtered (assoc "hide" filters))
+ nil ;; no insert
+ (mastodon-tl--insert-status
+ toot
+ (mastodon-tl--clean-tabs-and-nl spoiler-or-content)
+ 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted
+ nil nil detailed-p thread domain unfolded no-byline))))
(defun mastodon-tl--timeline (toots &optional thread domain)
"Display each toot in TOOTS.
This function removes replies if user required.
THREAD means the status will be displayed in a thread view.
When DOMAIN, force inclusion of user's domain in their handle."
- (mapc (lambda (toot)
- (mastodon-tl--toot toot nil thread domain))
- ;; hack to *not* filter replies on profiles:
- (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses)
- toots
- (if (or ; we were called via --more*:
- (mastodon-tl--buffer-property 'hide-replies nil :no-error)
- ;; loading a tl with a prefix arg:
- (mastodon-tl--hide-replies-p current-prefix-arg))
- (cl-remove-if-not #'mastodon-tl--is-reply toots)
- toots)))
- (goto-char (point-min)))
+ (let ((toots ;; hack to *not* filter replies on profiles:
+ (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses)
+ toots
+ (if (or ; we were called via --more*:
+ (mastodon-tl--buffer-property 'hide-replies nil :no-error)
+ ;; loading a tl with a prefix arg:
+ (mastodon-tl--hide-replies-p current-prefix-arg))
+ (cl-remove-if-not #'mastodon-tl--is-reply toots)
+ toots))))
+ (mapc (lambda (toot)
+ (mastodon-tl--toot toot nil thread domain))
+ toots)
+ (goto-char (point-min))))
;;; FOLDING