- [GUI] added client events loop.

src/box.lisp

@@ -32,7 +32,7 @@
   (typep thing 'box))
 
 (defun box (thing)
-  "Put `thing' in a box, if thing is aalready a box return `thing'."
+  "Put `thing' in a box, if thing is a already a box return `thing'."
   (if (boxp thing)
       thing
       (make-instance 'box :contents thing)))

src/package.lisp

@@ -1598,6 +1598,11 @@
    :remove-event
    :remove-event-if
    :find-event
+   :function-event
+   :with-enqueued-process
+   :event-on-own-thread
+   :blocking-caller-event
+   :push-function-and-wait-results
    :ask-user-input-string-event
    :user-input-string-event
    :notify-user-event
@@ -1698,8 +1703,6 @@
    :send-to-pipe-event
    :print-mentions-event
    :delete-all-notifications-event
-   :function-event
-   :with-enqueued-process
    :dispatch-program-events))
 
 (defpackage :api-pleroma
@@ -3230,6 +3233,21 @@
    :gemini-preformatted-fg
    :gemini-toc-padding-char))
 
+(defpackage :client-events
+  (:use
+   :cl
+   :config
+   :constants
+   :text-utils
+   :misc-utils)
+  (:local-nicknames (:re :cl-ppcre)
+                    (:a  :alexandria)
+                    (:ev :program-events))
+  (:export
+   :events-loop-running-p
+   :stop-events-loop
+   :start-events-loop))
+
 (defpackage :main
   (:use
    :cl

src/program-events.lisp

@@ -180,6 +180,20 @@
   (wrapped-in-lock (*events-queue*)
     (map-elements *events-queue* fn)))
 
+;;;; generic events
+
+(defclass function-event (program-event) ())
+
+(defmethod process-event ((object function-event))
+  (with-accessors ((payload payload)) object
+    (assert (functionp payload))
+    (funcall payload)))
+
+(defmacro with-enqueued-process ((&optional (priority +standard-event-priority+)) &body body)
+  `(push-event (make-instance 'function-event
+                              :payload  (lambda () ,@body)
+                              :priority ,priority)))
+
 (defclass event-on-own-thread (program-event)
   ((lock
     :initform (bt:make-recursive-lock)
@@ -190,9 +204,38 @@
     :initarg  :condition-variable
     :accessor condition-variable))
   (:documentation  "This  is  the  parent  of  all  events  that  are
-   generated  in athread  that  is  not the  main  thread, contains  a
+   generated  in a thread  that  is  not the  main  thread, contains  a
    condition variable and associated lock"))
 
+(defclass blocking-caller-event (event-on-own-thread function-event)
+  ((results
+    :initform (make-instance 'box:box)
+    :initarg  :results
+    :accessor results)))
+
+(defmethod process-event ((object blocking-caller-event))
+  (with-accessors ((lock               lock)
+                   (condition-variable condition-variable)
+                   (callback           payload)
+                   (results            results)) object
+    (setf (box:unbox results) (funcall callback))
+    (with-lock (lock)
+      (bt:condition-notify condition-variable))))
+
+(defun push-function-and-wait-results (fn)
+  (let* ((event              (make-instance 'blocking-caller-event :payload fn))
+         (lock               (lock event))
+         (condition-variable (condition-variable event)))
+    (push-event event)
+    (with-lock (lock)
+      (loop
+        while (null (box:unbox (results event)))
+        do
+           (bt:condition-wait condition-variable lock)))
+    (box:unbox (results event))))
+
+;;;;
+
 (defclass ask-user-input-string-event (event-on-own-thread)
    ((prompt
     :initform +default-command-prompt+
@@ -1714,20 +1757,6 @@
           (windows:draw message-window))
         (ui:info-message (_ "No mentions")))))
 
-;;;; general usage
-
-(defclass function-event (program-event) ())
-
-(defmethod process-event ((object function-event))
-  (with-accessors ((payload payload)) object
-    (assert (functionp payload))
-    (funcall payload)))
-
-(defmacro with-enqueued-process ((&optional (priority +standard-event-priority+)) &body body)
-  `(push-event (make-instance 'function-event
-                              :payload  (lambda () ,@body)
-                              :priority ,priority)))
-
 (defclass delete-all-notifications-event (program-event) ())
 
 (defmethod process-event ((object delete-all-notifications-event))

src/tests/program-events-tests.lisp

@@ -73,3 +73,26 @@
   (setf specials:*command-window* (make-instance 'dummy-window))
   (assert-true
       (string= "foo" (dunbox (simulated-string-input)))))
+
+(defun callback ()
+  "callback called!")
+
+(defun callback-example ()
+  (flet ((callback () "callback called!"))
+    (client-events:start-events-loop)
+    (let ((res nil))
+      (bt:make-thread (lambda ()
+                        (sleep 1)
+                        (setf res (push-function-and-wait-results #'callback))))
+      (map 'nil
+           (lambda (a)
+             (sleep 1)
+             (push-event (make-instance 'function-event
+                                        :payload (lambda () (format t "~a~%" a)))))
+           (loop for i from 0 to 10 collect i))
+      (sleep 20)
+      (client-events:stop-events-loop)
+      res)))
+
+(deftest test-callback (program-events-suite)
+  (assert-equality #'string= "callback called!" (callback-example)))

tinmop.asd

@@ -156,7 +156,8 @@
                              (:file "json-rpc-communication")))
                (:module gui-client
                 :pathname    "gui/client"
-                :components ((:file "client-configuration")))
+                :components ((:file "client-configuration")
+                             (:file "program-events")))
                (:file "main")
                (:module tests
                 :components ((:file "package")