mirror of https://codeberg.org/cage/tinmop/
40 lines
1.5 KiB
Common Lisp
40 lines
1.5 KiB
Common Lisp
(in-package :client-events)
|
|
|
|
(defparameter *stop-events-loop* t)
|
|
|
|
(defparameter *events-loop-lock* (make-lock "events-loop-lock"))
|
|
|
|
(defparameter *events-loop-thread* nil)
|
|
|
|
(defun events-loop-running-p ()
|
|
(misc:with-lock-held (*events-loop-lock*)
|
|
(not *stop-events-loop*)))
|
|
|
|
(defun stop-events-loop ()
|
|
(misc:with-lock-held (*events-loop-lock*)
|
|
(setf *stop-events-loop* t))
|
|
#+debug-mode (misc:dbg "Stopping gui event thread")
|
|
(ev:with-enqueued-process-and-unblock ()
|
|
#+debug-mode (misc:dbg "Stopping dummy event"))
|
|
#+debug-mode (misc:dbg "Stopped gui event thread"))
|
|
|
|
(defun start-events-loop ()
|
|
(misc:with-lock-held (*events-loop-lock*)
|
|
(setf *stop-events-loop* nil))
|
|
(setf *events-loop-thread*
|
|
(make-thread (lambda ()
|
|
(let ((gui:*wish* gui-goodies:*gui-server*))
|
|
(loop while (events-loop-running-p) do
|
|
(ev:dispatch-program-events-or-wait)))))))
|
|
|
|
(defmacro with-enqueue-request ((method-name id &rest args) &body on-error)
|
|
`(ev:with-enqueued-process-and-unblock ()
|
|
(handler-case
|
|
(comm:make-request ,method-name ,id ,@args)
|
|
,@on-error)))
|
|
|
|
(defun enqueue-request-and-wait-results (method-name id priority &rest args)
|
|
(ev:push-function-and-wait-results (lambda () (apply #'comm:make-request method-name id args))
|
|
:push-event-fn #'ev:push-event-unblock
|
|
:priority priority))
|