- added a configuration directive to filter out unwanted hashtags.

src/db.lisp

@@ -761,6 +761,14 @@
         (return-from boost-ignored-p t)))
     nil))
 
+(defun tags-ignored-p (tags)
+  "Returns non nil if theh tags of a status must be filtered out"
+  (when-let ((ignore-regexps (swconf:ignore-tag-regexps)))
+    (loop for ignore-re in ignore-regexps do
+      (when (cl-ppcre:scan ignore-re tags)
+        (return-from tags-ignored-p t)))
+    nil))
+
 (defun acct->user (acct)
   "Convert `acct' (acct is synonyym  for username in mastodon account)
 to the corresponding row in table +table-account+"
@@ -1216,6 +1224,13 @@ than (swconf:config-purge-history-days-offset) days in the past"
                              (:and (:= :day  actual-day)
                                    (:= :tag  tag)))))))))
 
+(defun concat-tags (status)
+  (with-accessors ((tags tooter:tags)) status
+    (if tags
+        (join-with-strings (mapcar #'client:tag-name tags)
+                           +tag-separator+)
+        "")))
+
 (defmethod update-db ((object tooter:status)
                       &key
                         (timeline +local-timeline+)
@@ -1252,8 +1267,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
            (tag-names          (if tags
                                    (mapcar #'client:tag-name tags)
                                    ""))
-           (actual-tags        (join-with-strings tag-names
-                                                  +tag-separator+))
+           (actual-tags        (concat-tags object))
            (actual-language    (prepare-for-db language))
            ;; use string-downcase as a workaround because tooter return an upcased keyword
            (actual-visibility  (string-downcase (prepare-for-db visibility)))

src/package.lisp

@@ -861,6 +861,7 @@
    :account-ignored-p
    :user-ignored-p
    :boost-ignored-p
+   :tags-ignored-p
    :acct->user
    :acct->id
    :username->id
@@ -1241,6 +1242,7 @@
    :color-regexps
    :ignore-users-regexps
    :ignore-users-boost-regexps
+   :ignore-tag-regexps
    :win-bg
    :win-fg
    :win-height

src/program-events.lisp

@@ -388,6 +388,7 @@
               (status-id  (tooter:id status))
               (language   (tooter:language status))
               (rebloggedp (tooter:parent status))
+              (tags       (db::concat-tags status))
               (skip-this-status nil))
           (when force-saving-of-ignored-status-p
             (db:remove-from-status-ignored status-id folder timeline-type))
@@ -398,6 +399,8 @@
                                         language))
                     (and rebloggedp
                          (db:boost-ignored-p account-id))
+                    (and (text-utils:string-not-empty-p tags)
+                         (db:tags-ignored-p tags))
                     (hooks:run-hook-until-success 'hooks:*skip-message-hook*
                                                   status
                                                   timeline-type

src/software-configuration.lisp

@@ -22,6 +22,7 @@
 ;;                               (USE-FILE
 ;;                                | IGNORE-USER-RE-ASSIGN
 ;;                                | IGNORE-USER-BOOST-RE-ASSIGN
+;;                                | IGNORE-TAG-RE-ASSIGN
 ;;                                | COLOR-RE-ASSIGN
 ;;                                | SERVER-ASSIGN
 ;;                                | USERNAME-ASSIGN
@@ -41,6 +42,7 @@
 ;;                                 blanks)
 ;; IGNORE-USER-RE-ASSIGN       := IGNORE-USER-RE-KEY ASSIGN REGEXP
 ;; IGNORE-USER-BOOST-RE-ASSIGN := IGNORE-USER-RE-KEY ASSIGN REGEXP
+;; IGNORE-TAG-RE-ASSIGN        := IGNORE-USER-RE-KEY ASSIGN REGEXP
 ;; COLOR-RE-ASSIGN             := COLOR-RE-KEY ASSIGN REGEXP FG-COLOR (? ATTRIBUTE-VALUE)
 ;; USE-FILE                    := (AND USE BLANKS FILEPATH BLANKS)
 ;; POST-ALLOWED-LANGUAGE       := "post-allowed-language" BLANKS ASSIGN REGEXP
@@ -272,6 +274,9 @@
 (defrule ignore-user-boost-re-key "ignore-user-boost-regexp"
   (:constant :ignore-user-boost-re))
 
+(defrule ignore-tag-re-assign "ignore-tag-regexp"
+  (:constant :ignore-tag-re))
+
 (defrule ignore-user-re-assign
     (and ignore-user-re-key blanks
          assign blanks regexp blanks)
@@ -439,6 +444,7 @@
              color-re-assign
              ignore-user-re-assign
              ignore-user-boost-re-assign
+             ignore-tag-re-assign
              server-assign
              username-assign
              open-link-helper
@@ -622,6 +628,7 @@
                    color-re
                    ignore-user-re
                    ignore-user-boost-re
+                   ignore-tag-re
                    post-allowed-language
                    purge-history-days-offset
                    purge-cache-days-offset
@@ -644,6 +651,7 @@
           ((or (eq +key-color-re+ key)
                (eq +key-ignore-user-re+ key)
                (eq +key-ignore-user-boost-re+ key)
+               (eq +key-ignore-tag-re+ key)
                (eq +key-open-link-helper+ key)
                (eq +key-post-allowed-language+ key))
            (setf (access:accesses *software-configuration* key)
@@ -967,6 +975,10 @@
   (access:accesses *software-configuration*
                    +key-ignore-user-boost-re+))
 
+(defun ignore-tag-regexps ()
+  (access:accesses *software-configuration*
+                   +key-ignore-tag-re+))
+
 (defmacro gen-win-key-access (fn-suffix key)
   `(defun ,(misc:format-fn-symbol t "win-~a" fn-suffix) (win-key)
      (access:accesses *software-configuration*