2023-01-15 16:03:25 +01:00
|
|
|
(in-package :client-events)
|
|
|
|
|
|
|
|
(defparameter *stop-events-loop* t)
|
|
|
|
|
2024-02-11 12:32:22 +01:00
|
|
|
(defparameter *events-loop-lock* (make-lock "events-loop-lock"))
|
2023-01-15 16:03:25 +01:00
|
|
|
|
2023-02-19 12:57:10 +01:00
|
|
|
(defparameter *events-loop-thread* nil)
|
|
|
|
|
2023-01-15 16:03:25 +01:00
|
|
|
(defun events-loop-running-p ()
|
2024-02-11 15:08:16 +01:00
|
|
|
(misc:with-lock-held (*events-loop-lock*)
|
2023-01-15 16:03:25 +01:00
|
|
|
(not *stop-events-loop*)))
|
|
|
|
|
|
|
|
(defun stop-events-loop ()
|
2024-02-11 15:08:16 +01:00
|
|
|
(misc:with-lock-held (*events-loop-lock*)
|
2023-02-19 12:57:10 +01:00
|
|
|
(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"))
|
2023-01-15 16:03:25 +01:00
|
|
|
|
|
|
|
(defun start-events-loop ()
|
2024-02-11 15:08:16 +01:00
|
|
|
(misc:with-lock-held (*events-loop-lock*)
|
2023-01-15 16:03:25 +01:00
|
|
|
(setf *stop-events-loop* nil))
|
2023-02-19 12:57:10 +01:00
|
|
|
(setf *events-loop-thread*
|
2024-02-11 12:32:22 +01:00
|
|
|
(make-thread (lambda ()
|
2023-02-19 15:45:22 +01:00
|
|
|
(let ((gui:*wish* gui-goodies:*gui-server*))
|
|
|
|
(loop while (events-loop-running-p) do
|
|
|
|
(ev:dispatch-program-events-or-wait)))))))
|
2023-02-19 12:57:10 +01:00
|
|
|
|
2023-02-19 16:15:10 +01:00
|
|
|
(defmacro with-enqueue-request ((method-name id &rest args) &body on-error)
|
2023-02-19 12:57:10 +01:00
|
|
|
`(ev:with-enqueued-process-and-unblock ()
|
|
|
|
(handler-case
|
|
|
|
(comm:make-request ,method-name ,id ,@args)
|
2023-02-19 16:15:10 +01:00
|
|
|
,@on-error)))
|
2023-02-19 12:57:10 +01:00
|
|
|
|
|
|
|
(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))
|