- [GUI] added a scheduler.

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))))

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))

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)

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)

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

tinmop.asd

@@ -178,6 +178,7 @@
                              (:file "menu-command")
                              (:file "internal-paths")
                              (:file "search-frame")
+                             (:file "scheduler")
                              (:file "main-window")))
                (:file "main")
                (:module tests