diff --git a/src/db.lisp b/src/db.lisp index f38e2d0..ea91c82 100644 --- a/src/db.lisp +++ b/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+" diff --git a/src/package.lisp b/src/package.lisp index b42d839..6cff073 100644 --- a/src/package.lisp +++ b/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 diff --git a/src/program-events.lisp b/src/program-events.lisp index e2ccd24..5d60357 100644 --- a/src/program-events.lisp +++ b/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 diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 1fb6027..d084f88 100644 --- a/src/software-configuration.lisp +++ b/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* diff --git a/src/thread-window.lisp b/src/thread-window.lisp index 518d731..3542498 100644 --- a/src/thread-window.lisp +++ b/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))))