;; tinmop: a multiprotocol 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 #'=) (a:define-constant +purge-history-frequency+ 1800000 :test #'=) (defun triggedp (ticks frequency) (= (rem ticks frequency) 0)) (defmacro define-scheduled-procedure ((name frequency) &body body) (a:with-gensyms (event-fn process-fn) (let ((fn-name (misc:format-fn-symbol t "~a" name))) `(defun ,fn-name (&key (start-on-boot nil) (set-busy nil) (set-busy-on-boot nil)) (macrolet ((enqueue (&body local-body) `(ev:with-enqueued-process-and-unblock (program-events:+minimum-event-priority+) ,@local-body))) (labels ((,process-fn () (progn ,@body (,fn-name))) (,event-fn () (enqueue (if set-busy (gui-goodies:with-busy* (gui-goodies:*main-frame*) (,process-fn)) (,process-fn))))) (when start-on-boot (if set-busy-on-boot (enqueue (gui-goodies:with-busy* (gui-goodies:*main-frame*) (,process-fn))) (enqueue (,event-fn)))) (gui:after ,frequency (function ,event-fn)))))))) (defun notify (message) (when gui-goodies:*main-frame* (client-main-window:print-info-message message))) (define-scheduled-procedure (refresh-gemlog-subscriptions +refresh-gemlog-subscriptions-frequency+) (notify (_ "Gemlogs subscriptions updating in progress…")) (comm:make-request :gemini-gemlog-refresh-all-subscriptions 1) (notify (_ "Gemlogs subscriptions updated"))) (define-scheduled-procedure (purge-gemlogs +purge-gemlog-entries-frequency+) (comm:make-request :gemini-purge-gemlog-entries 1) (notify (_ "Old gemlog posts deleted"))) (define-scheduled-procedure (purge-history +purge-history-frequency+) (comm:make-request :purge-history 1) (notify (_ "Old history entries removed"))) (defun start () (refresh-gemlog-subscriptions :start-on-boot (swconf:gemini-update-gemlog-at-start-p) :set-busy-on-boot t) (purge-gemlogs) (purge-history))