Merge branch 'filters-apply' into develop

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."