diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-notifications.el | 151 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 125 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 9 |
3 files changed, 174 insertions, 111 deletions
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 070d23f..1b93f1b 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -201,6 +201,7 @@ Status notifications are given when (defun mastodon-notifications--format-note (note type) "Format for a NOTE of TYPE." + ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot' (let* ((id (alist-get 'id note)) (profile-note (when (equal 'follow-request type) @@ -211,77 +212,85 @@ Status notifications are given when (string-limit str mastodon-notifications--profile-note-in-foll-reqs-max-length) str)))) (status (mastodon-tl--field 'status note)) - (follower (alist-get 'username (alist-get 'account note)))) - (mastodon-tl--insert-status - ;; toot - (cond ((or (equal type 'follow) - (equal type 'follow-request)) - ;; Using reblog with an empty id will mark this as something - ;; non-boostable/non-favable. - (cons '(reblog (id . nil)) note)) - ;; reblogs/faves use 'note' to process their own json - ;; not the toot's. this ensures following etc. work on such notifs - ((or (equal type 'favourite) - (equal type 'boost)) - note) - (t - status)) - ;; body - (let ((body (mastodon-tl--clean-tabs-and-nl - (if (mastodon-tl--has-spoiler status) - (mastodon-tl--spoiler status) - (if (equal 'follow-request type) - (mastodon-tl--render-text profile-note) - (mastodon-tl--content status)))))) - (cond ((or (eq type 'follow) - (eq type 'follow-request)) - (if (equal type 'follow) - (propertize "Congratulations, you have a new follower!" - 'face 'default) - (concat - (propertize - (format "You have a follow request from... %s" - follower) - 'face 'default) - (when mastodon-notifications--profile-note-in-foll-reqs - (concat - ":\n" - (mastodon-notifications--comment-note-text body)))))) - ((or (eq type 'favourite) - (eq type 'boost)) - (mastodon-notifications--comment-note-text body)) - (t body))) - ;; author-byline - (if (or (equal type 'follow) - (equal type 'follow-request) - (equal type 'mention)) - 'mastodon-tl--byline-author - (lambda (_status &rest _args) ; unbreak stuff - (mastodon-tl--byline-author note))) - ;; action-byline - (lambda (_status) - (mastodon-notifications--byline-concat - (cond ((equal type 'boost) - "Boosted") - ((equal type 'favourite) - "Favourited") - ((equal type 'follow-request) - "Requested to follow") - ((equal type 'follow) - "Followed") - ((equal type 'mention) - "Mentioned") - ((equal type 'status) - "Posted") - ((equal type 'poll) - "Posted a poll") - ((equal type 'edit) - "Edited")))) - id - ;; base toot - (when (or (equal type 'favourite) - (equal type 'boost)) - status)))) + (follower (alist-get 'username (alist-get 'account note))) + (toot (alist-get 'status note)) + (filtered (mastodon-tl--field 'filtered toot)) + (filters (when filtered + (mastodon-tl--current-filters filtered)))) + (if (and filtered (assoc "hide" filters)) + nil + (mastodon-tl--insert-status + ;; toot + (cond ((or (equal type 'follow) + (equal type 'follow-request)) + ;; Using reblog with an empty id will mark this as something + ;; non-boostable/non-favable. + (cons '(reblog (id . nil)) note)) + ;; reblogs/faves use 'note' to process their own json + ;; not the toot's. this ensures following etc. work on such notifs + ((or (equal type 'favourite) + (equal type 'boost)) + note) + (t + status)) + ;; body + (let ((body (if-let ((match (assoc "warn" filters))) + (mastodon-tl--spoiler toot (cadr match)) + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (if (equal 'follow-request type) + (mastodon-tl--render-text profile-note) + (mastodon-tl--content status))))))) + (cond ((or (eq type 'follow) + (eq type 'follow-request)) + (if (equal type 'follow) + (propertize "Congratulations, you have a new follower!" + 'face 'default) + (concat + (propertize + (format "You have a follow request from... %s" + follower) + 'face 'default) + (when mastodon-notifications--profile-note-in-foll-reqs + (concat + ":\n" + (mastodon-notifications--comment-note-text body)))))) + ((or (eq type 'favourite) + (eq type 'boost)) + (mastodon-notifications--comment-note-text body)) + (t body))) + ;; author-byline + (if (or (equal type 'follow) + (equal type 'follow-request) + (equal type 'mention)) + 'mastodon-tl--byline-author + (lambda (_status &rest _args) ; unbreak stuff + (mastodon-tl--byline-author note))) + ;; action-byline + (lambda (_status) + (mastodon-notifications--byline-concat + (cond ((equal type 'boost) + "Boosted") + ((equal type 'favourite) + "Favourited") + ((equal type 'follow-request) + "Requested to follow") + ((equal type 'follow) + "Followed") + ((equal type 'mention) + "Mentioned") + ((equal type 'status) + "Posted") + ((equal type 'poll) + "Posted a poll") + ((equal type 'edit) + "Edited")))) + id + ;; base toot + (when (or (equal type 'favourite) + (equal type 'boost)) + status))))) (defun mastodon-notifications--by-type (note) "Filter NOTE for those listed in `mastodon-notifications--types-alist'. 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 diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 54f829d..9b40541 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -617,6 +617,9 @@ JSON is the filters data." 'byline t) ;for goto-next-filter compat "\n\n"))) +(defvar mastodon-views--filter-types + '("home" "notifications" "public" "thread" "profile")) + (defun mastodon-views--create-filter () "Create a filter for a word. Prompt for a context, must be a list containting at least one of \"home\", @@ -631,7 +634,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (user-error "You must select at least one word for a filter") (completing-read-multiple "Contexts to filter [TAB for options]: " - '("home" "notifications" "public" "thread") + mastodon-views--filter-types nil t))) (contexts-processed (if (equal nil contexts) @@ -643,9 +646,9 @@ Prompt for a context, must be a list containting at least one of \"home\", contexts-processed)))) (mastodon-http--triage response (lambda (_) - (message "Filter created for %s!" word) (when (mastodon-tl--buffer-type-eq 'filters) - (mastodon-views--view-filters)))))) + (mastodon-views--view-filters)) + (message "Filter created for %s!" word))))) (defun mastodon-views--delete-filter () "Delete filter at point." |