From 15987cc5b2461bc6964f9932c959f5700c6d994d Mon Sep 17 00:00:00 2001
From: cage <cage-invalid@invalid>
Date: Thu, 25 Jun 2020 14:38:14 +0200
Subject: [PATCH] - added '*skip-message-hook*' (with example).

---
 etc/init.lisp           | 13 +++++++++++++
 src/hooks.lisp          |  4 ++++
 src/html-utils.lisp     |  4 ++--
 src/package.lisp        |  3 ++-
 src/program-events.lisp | 20 ++++++++++++--------
 5 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/etc/init.lisp b/etc/init.lisp
index d662362..5494f27 100644
--- a/etc/init.lisp
+++ b/etc/init.lisp
@@ -346,3 +346,16 @@
 
 (define-key "q"         #'close-open-message-link-window
   *open-message-link-keymap*)
+
+;;;; hooks
+
+;;; this hooks will skips toots with contain less than 20 words
+;;; (note: it is commented out)
+
+;; (hooks:add-hook 'hooks:*skip-message-hook*
+;;                 (lambda (toot)
+;;                   (when-let* ((text        (html-utils:html->text (tooter:content toot)
+;;                                                                   :add-link-footnotes nil))
+;;                               (trimmed     (text-utils:trim-blanks text))
+;;                               (word-counts (length (text-utils:split-words trimmed))))
+;;                     (< word-counts 10))))
diff --git a/src/hooks.lisp b/src/hooks.lisp
index ec2311b..6e5df10 100644
--- a/src/hooks.lisp
+++ b/src/hooks.lisp
@@ -81,3 +81,7 @@ non-nil.")
   "Run this  hooks before sending  the message, note that  the message
   could  be encrypted  after this  hooks  runs, the  function takes  a
   message-window as parameter")
+
+(defparameter *skip-message-hook* '()
+  "Run this  hooks to check if a message must be skipped,
+all hooks must returns nil for this message to be not skipped")
diff --git a/src/html-utils.lisp b/src/html-utils.lisp
index 7dd929f..7d20b4e 100644
--- a/src/html-utils.lisp
+++ b/src/html-utils.lisp
@@ -64,11 +64,11 @@
 (defun html->text (html &key (add-link-footnotes t))
   "Transform html to text, note that if `add-link-footnotes` is non nil footnotes that marks html link in the text are added aftere the body of the message
 
-This function uses a library that transhorm html5 text into s-expressions um the form
+This function uses a library that transform html5 text into s-expressions um the form
 
 '(name (attributes) children*)
 
-Some convenience functions are provided to works with this structures.
+Some convenience functions are provided to works with these structures.
 "
   (when html
     (let ((root       (append (list :root
diff --git a/src/package.lisp b/src/package.lisp
index 2617f10..db3701e 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1284,7 +1284,8 @@
    :*before-main-loop*
    :*before-quit*
    :*before-prepare-for-rendering-message*
-   :*before-sending-message*))
+   :*before-sending-message*
+   :*skip-message-hook*))
 
 (defpackage :keybindings
   (:use
diff --git a/src/program-events.lisp b/src/program-events.lisp
index 712347a..30f962b 100644
--- a/src/program-events.lisp
+++ b/src/program-events.lisp
@@ -322,15 +322,19 @@
         (dbg "statuses ~a" dump))
       (loop for status in statuses do
            (let ((account-id (tooter:id (tooter:account status)))
-                 (status-id  (tooter:id status)))
-             (when (and (db:user-ignored-p account-id)
-                        (not (db:status-skipped-p status-id folder timeline-type)))
+                 (status-id  (tooter:id status))
+                 (skip-this-status nil))
+             (when (or (and (db:user-ignored-p account-id)
+                            (not (db:status-skipped-p status-id folder timeline-type)))
+                       (hooks:run-hook-until-success 'hooks:*skip-message-hook* status))
                (db:add-to-status-skipped status-id folder timeline-type)
-               (incf ignored-count)))
-           (db:update-db status
-                         :timeline       timeline-type
-                         :folder         folder
-                         :skip-ignored-p t))
+               (setf skip-this-status t)
+               (incf ignored-count))
+             (when (not skip-this-status)
+               (db:update-db status
+                             :timeline       timeline-type
+                             :folder         folder
+                             :skip-ignored-p t))))
       (db:renumber-timeline-message-index timeline-type
                                           folder
                                           :account-id nil)