mirror of https://codeberg.org/cage/tinmop/
- [GUI] scheduled deletion of old history entries;
- [GUI] removed scheduler's notifications.
This commit is contained in:
parent
63c35ac408
commit
22f598e485
|
@ -1389,7 +1389,7 @@
|
|||
|
||||
(defun print-info-message (message &key
|
||||
(color (gui-goodies:parse-color "black"))
|
||||
(bold nil))
|
||||
(bold t))
|
||||
(let ((info-widget (info-text gui-goodies:*main-frame*)))
|
||||
(setf (gui:text info-widget) message)
|
||||
(let ((color-tag (gui:tag-create info-widget
|
||||
|
|
|
@ -21,28 +21,40 @@
|
|||
|
||||
(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)
|
||||
(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)))))))
|
||||
(a:with-gensyms (event-fn)
|
||||
(let ((fn-name (misc:format-fn-symbol t "~a" name)))
|
||||
`(defun ,fn-name (&key (start-on-boot nil))
|
||||
(labels ((,event-fn ()
|
||||
(ev:with-enqueued-process-and-unblock
|
||||
(program-events:+minimum-event-priority+)
|
||||
,@body
|
||||
(,fn-name))))
|
||||
(when start-on-boot
|
||||
(funcall (function ,event-fn)))
|
||||
(gui:after ,frequency (function ,event-fn)))))))
|
||||
|
||||
(define-scheduled-procedure (refresh-gemlog-subscriptions
|
||||
+refresh-gemlog-subscriptions-frequency+)
|
||||
(client-main-window:print-info-message (_ "Gemlogs subscriptions updating in progress…"))
|
||||
(comm:make-request :gemini-gemlog-refresh-all-subscriptions 1)
|
||||
(nodgui.tklib.notify:notify-window (_ "Gemlogs subscriptions updated")))
|
||||
(client-main-window:print-info-message (_ "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")))
|
||||
(client-main-window:print-info-message (_ "Old gemlog posts deleted")))
|
||||
|
||||
(define-scheduled-procedure (purge-history +purge-history-frequency+)
|
||||
(comm:make-request :purge-history 1)
|
||||
(client-main-window:print-info-message (_ "Old history entries removed")))
|
||||
|
||||
(defun start ()
|
||||
(refresh-gemlog-subscriptions)
|
||||
(purge-gemlogs))
|
||||
(refresh-gemlog-subscriptions :start-on-boot t)
|
||||
(purge-gemlogs)
|
||||
(purge-history))
|
||||
|
|
|
@ -31,12 +31,12 @@
|
|||
(db-utils:close-db)
|
||||
(stop-server))
|
||||
|
||||
(defun purge-history ()
|
||||
(db:purge-history)
|
||||
t)
|
||||
|
||||
(defmacro prepare-rpc (&body body)
|
||||
`(let ((rpc:*function-db* '()))
|
||||
(gen-rpc "add"
|
||||
'+
|
||||
"a" 0
|
||||
"b" 1)
|
||||
(gen-rpc "complete-net-address"
|
||||
'complete-net-address
|
||||
"hint" 0)
|
||||
|
@ -138,4 +138,5 @@
|
|||
"url" 0)
|
||||
(gen-rpc "iri-to-parent-path" 'iri-to-parent-path "iri" 0)
|
||||
(gen-rpc "quit-program" 'quit-program)
|
||||
(gen-rpc "purge-history" 'purge-history)
|
||||
,@body))
|
||||
|
|
|
@ -3646,6 +3646,7 @@
|
|||
:set-bookmark-button-true
|
||||
:set-bookmark-button-false
|
||||
:clear-gemtext
|
||||
:print-info-message
|
||||
:make-internal-iri
|
||||
:internal-iri-bookmark
|
||||
:show-bookmarks-page))
|
||||
|
|
Loading…
Reference in New Issue