- added a configuraction directive to filter boost based on a regular expression matching the username.

src/db.lisp

@@ -752,6 +752,16 @@
                (return-from user-ignored-p t)))
         nil)))
 
+(defun boost-ignored-p (account-id)
+  "Returns non nil if this boost must be ignored"
+  (when-let ((ignore-regexps (swconf:ignore-users-boost-regexps))
+             (username (db:user-id->username account-id)))
+    (misc:dbg "ignore ~a" ignore-regexps)
+    (loop for ignore-re in ignore-regexps do
+      (when (cl-ppcre:scan ignore-re username)
+        (return-from boost-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+"

src/package.lisp

@@ -860,6 +860,7 @@
    :delete-by-id
    :account-ignored-p
    :user-ignored-p
+   :boost-ignored-p
    :acct->user
    :acct->id
    :username->id
@@ -1239,6 +1240,7 @@
    :gempub-library-directory
    :color-regexps
    :ignore-users-regexps
+   :ignore-users-boost-regexps
    :win-bg
    :win-fg
    :win-height

src/program-events.lisp

@@ -387,6 +387,7 @@
         (let ((account-id (tooter:id (tooter:account status)))
               (status-id  (tooter:id status))
               (language   (tooter:language status))
+              (rebloggedp (tooter:parent status))
               (skip-this-status nil))
           (when force-saving-of-ignored-status-p
             (db:remove-from-status-ignored status-id folder timeline-type))
@@ -395,6 +396,8 @@
                     (and language
                          (cl-ppcre:scan (swconf:config-post-allowed-language)
                                         language))
+                    (and rebloggedp
+                         (db:boost-ignored-p account-id))
                     (hooks:run-hook-until-success 'hooks:*skip-message-hook*
                                                   status
                                                   timeline-type

src/software-configuration.lisp

@@ -21,6 +21,7 @@
 ;; ENTRIES               := COMMENT*
 ;;                         (USE-FILE
 ;;                          | IGNORE-USER-RE-ASSIGN
+;;                          | IGNORE-USER-BOOST-RE-ASSIGN
 ;;                          | COLOR-RE-ASSIGN
 ;;                          | SERVER-ASSIGN
 ;;                          | USERNAME-ASSIGN
@@ -39,6 +40,7 @@
 ;;                               generic-value) ; the order in this list *is* important
 ;;                         blanks)
 ;; IGNORE-USER-RE-ASSIGN := IGNORE-USER-RE-KEY ASSIGN REGEXP
+;; IGNORE-USER-BOOST-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
@@ -267,11 +269,19 @@
 (defrule ignore-user-re-key "ignore-user-regexp"
   (:constant :ignore-user-re))
 
+(defrule ignore-user-boost-re-key "ignore-user-boost-regexp"
+  (:constant :ignore-user-boost-re))
+
 (defrule ignore-user-re-assign
     (and ignore-user-re-key blanks
          assign blanks regexp blanks)
   (:function (lambda (a) (list (first a) (fifth a)))))
 
+(defrule ignore-user-boost-re-assign
+    (and ignore-user-boost-re-key blanks
+         assign blanks regexp blanks)
+  (:function (lambda (a) (list (first a) (fifth a)))))
+
 (defrule server-key "server"
   (:constant :server))
 
@@ -428,6 +438,7 @@
          (or use-file
              color-re-assign
              ignore-user-re-assign
+             ignore-user-boost-re-assign
              server-assign
              username-assign
              open-link-helper
@@ -608,6 +619,7 @@
                    password-echo-character
                    color-re
                    ignore-user-re
+                   ignore-user-boost-re
                    post-allowed-language
                    purge-history-days-offset
                    purge-cache-days-offset)
@@ -628,6 +640,7 @@
         (cond
           ((or (eq +key-color-re+ key)
                (eq +key-ignore-user-re+ key)
+               (eq +key-ignore-user-boost-re+ key)
                (eq +key-open-link-helper+ key)
                (eq +key-post-allowed-language+ key))
            (setf (access:accesses *software-configuration* key)
@@ -947,6 +960,10 @@
   (access:accesses *software-configuration*
                    +key-ignore-user-re+))
 
+(defun ignore-users-boost-regexps ()
+  (access:accesses *software-configuration*
+                   +key-ignore-user-boost-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*

src/thread-window.lisp

@@ -836,7 +836,7 @@ db:renumber-timeline-message-index."
 
 (defun reblogged-data (reblogger-status)
   (a:when-let* ((reblogged-id     (db:row-message-reblog-id reblogger-status))
-              (reblogged-status (db:find-status-id reblogged-id)))
+                (reblogged-status (db:find-status-id reblogged-id)))
     (let ((body            (db:row-message-rendered-text reblogged-status))
           (attachments     (status-attachments->text reblogged-id)))
       (values body attachments))))