From 63c35ac40848b872a5ddbfa91f4033d9723e6098 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Wed, 12 Jul 2023 16:27:24 +0200
Subject: [PATCH] - [GUI] added a scheduler.

---
 src/gui/client/main-window.lisp              |  3 +-
 src/gui/client/scheduler.lisp                | 48 ++++++++++++++++++++
 src/gui/server/public-api-gemini-gemlog.lisp |  4 ++
 src/gui/server/public-api.lisp               |  1 +
 src/package.lisp                             | 15 ++++++
 tinmop.asd                                   |  1 +
 6 files changed, 71 insertions(+), 1 deletion(-)
 create mode 100644 src/gui/client/scheduler.lisp

diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp
index 604f4a5..cbccef3 100644
--- a/src/gui/client/main-window.lisp
+++ b/src/gui/client/main-window.lisp
@@ -1565,4 +1565,5 @@
       (gui:wait-complete-redraw)
       (when (string-not-empty-p starting-iri)
         (set-address-bar-text main-frame starting-iri)
-        (open-iri starting-iri main-frame nil)))))
+        (open-iri starting-iri main-frame nil))
+      (client-scheduler:start))))
diff --git a/src/gui/client/scheduler.lisp b/src/gui/client/scheduler.lisp
new file mode 100644
index 0000000..80ef93b
--- /dev/null
+++ b/src/gui/client/scheduler.lisp
@@ -0,0 +1,48 @@
+;; tinmop: an humble gemini and pleroma client
+;; Copyright © cage
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.
+;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
+
+(in-package :client-scheduler)
+
+(a:define-constant +refresh-gemlog-subscriptions-frequency+ 1200000 :test #'=)
+
+(a:define-constant +purge-gemlog-entries-frequency+         1800000 :test #'=)
+
+(defun triggedp (ticks frequency)
+  (= (rem ticks frequency)
+     0))
+
+(defmacro define-scheduled-procedure ((name frequency) &body body)
+  (let ((fn-name (misc:format-fn-symbol t "~a" name)))
+  `(defun ,fn-name ()
+     (gui:after ,frequency
+                (lambda ()
+                  (ev:with-enqueued-process-and-unblock ()
+                    ,@body
+                    (,fn-name)))))))
+
+(define-scheduled-procedure (refresh-gemlog-subscriptions
+                             +refresh-gemlog-subscriptions-frequency+)
+  (comm:make-request :gemini-gemlog-refresh-all-subscriptions 1)
+  (nodgui.tklib.notify:notify-window (_ "Gemlogs subscriptions updated")))
+
+(define-scheduled-procedure (purge-gemlogs +purge-gemlog-entries-frequency+)
+  (comm:make-request :gemini-purge-gemlog-entries 1)
+  (nodgui.tklib.notify:notify-window (_ "Old gemlog posts deleted")))
+
+(defun start ()
+  (refresh-gemlog-subscriptions)
+  (purge-gemlogs))
diff --git a/src/gui/server/public-api-gemini-gemlog.lisp b/src/gui/server/public-api-gemini-gemlog.lisp
index 26f537e..1dd0781 100644
--- a/src/gui/server/public-api-gemini-gemlog.lisp
+++ b/src/gui/server/public-api-gemini-gemlog.lisp
@@ -67,3 +67,7 @@
                      (usocket:host-or-ip e)))
             (error (e)
               (error e))))))
+
+(defun gemini-purge-gemlog-entries ()
+  (db:purge-seen-gemlog-entries)
+  t)
diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp
index 13b648c..1ececcd 100644
--- a/src/gui/server/public-api.lisp
+++ b/src/gui/server/public-api.lisp
@@ -130,6 +130,7 @@
               "iri" 0
               "title" 1
               "subtitle" 2)
+     (gen-rpc "gemini-purge-gemlog-entries" 'gemini-purge-gemlog-entries)
      (gen-rpc "titan-save-token" 'titan-save-token
               "url" 0
               "token" 1)
diff --git a/src/package.lisp b/src/package.lisp
index 520d448..c552d1c 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -3602,6 +3602,21 @@
   (:export
    :init-window))
 
+(defpackage :client-scheduler
+  (:use :cl
+        :config
+        :constants
+        :misc
+        :text-utils)
+  (:local-nicknames (:comm      :json-rpc-communication)
+                    (:re        :cl-ppcre)
+                    (:a         :alexandria)
+                    (:ev        :program-events)
+                    (:gui       :nodgui)
+                    (:gui-utils :nodgui.utils))
+  (:export
+   :start))
+
 (defpackage :client-main-window
   (:use
    :cl
diff --git a/tinmop.asd b/tinmop.asd
index 007ae84..6338e4f 100644
--- a/tinmop.asd
+++ b/tinmop.asd
@@ -178,6 +178,7 @@
                              (:file "menu-command")
                              (:file "internal-paths")
                              (:file "search-frame")
+                             (:file "scheduler")
                              (:file "main-window")))
                (:file "main")
                (:module tests