- [TUI] removed a recursive locking.

src/program-events.lisp

@@ -23,15 +23,46 @@
 
 (define-constant +maximum-event-priority+   -2 :test #'=)
 
-(defparameter *id-lock* (make-lock))
+(defparameter *id-lock* (make-lock "id-event-lock"))
 
 (defparameter *event-id* 0)
 
 ;; used only in batch mode from the command line
 (defparameter *process-events-immediately* nil
-  "Used only in  batch mode from the command line.  Instead of pushing
-  the  event on  a priority  queue  that will  be picked  by a  thread
-  process the event immediately")
+  "Should be used  only in batch mode  from the command line  (but i have
+   broken this rule rule here and there!).
+
+  When non nil, instead of pushing  the event on a priority queue that
+  will  be  picked  (and  ran)  by  another  thread,  runs  the  event
+  immediately.  Be very careful when  binding this variable to non nil
+  value: no code when binding is true can call 'push-event'.
+
+  for example
+
+  (let ((*process-events-immediately* t))
+    (push-event (make-instance 'function-event
+                               ;;;;;                vvvvvv   !recursive locking!
+                               :payload  (lambda () (push-event (make-instance 'an-event)))
+                               :priority ,priority)))
+  will raise an error
+
+  instead:
+
+  ;;;;                                vvvvv notice the value nil
+  (let ((*process-events-immediately* nil))
+    (push-event (make-instance 'function-event
+                               :payload  (lambda () (push-event (make-instance 'an-event)))
+                               :priority ,priority)))
+
+  will not.
+
+  To clarify this is the implementation of 'push-event':
+
+  (defun push-event (event)
+  (wrapped-in-lock (*events-queue*)
+    (if *process-events-immediately*
+        (process-event event)
+        (push-element *events-queue* event))))")
 
 (defparameter *stop-event-dispatching* nil)
 
@@ -84,7 +115,8 @@
             (priority object)
             (notes object))))
 
-(defgeneric process-event (object))
+(defgeneric process-event (object)
+  (:documentation "Process a program event. NB: In the body of this method an event can not recursively push another event, this error can happens expcecially if *process-events-immediately* is bound to true."))
 
 #+debug
 (defmethod process-event :before (object)
@@ -100,11 +132,11 @@
 
 (defclass events-queue (priority-queue)
   ((lock
-    :initform (make-lock)
+    :initform (make-lock "event-queue-lock")
     :initarg  :lock
     :accessor lock)
    (blocking-lock
-    :initform (make-lock)
+    :initform (make-lock "event-blocking-queue-lock")
     :initarg  :blocking-lock
     :accessor blocking-lock)
    (condition-variable
@@ -1251,10 +1283,14 @@
               keybindings:*gemini-message-keymap*)
         (gemini-viewer:maybe-initialize-metadata window)
         (refresh-gemini-message-window links page-data ir-text nil)
-        (ui:open-gemini-toc)
-        (ui:open-gemini-message-link-window :give-focus nil :enqueue t)
-        (ui:focus-to-message-window)
-        (windows:draw window)))))
+        (let ((already-enqueued *process-events-immediately*))
+          (if already-enqueued
+              (process-event (make-instance 'gemini-toc-open))
+              (ui:open-gemini-toc))
+          (ui:open-gemini-message-link-window :give-focus nil
+                                              :enqueue (not already-enqueued))
+          (ui:focus-to-message-window)
+          (windows:draw window))))))
 
 (defclass gemini-request-event (program-event)
   ((url

src/ui-goodies.lisp

@@ -195,13 +195,17 @@
   (let ((event (make-instance 'error-message-event
                               :priority priority
                               :payload message)))
-    (push-event event)))
+    (if *process-events-immediately*
+        (process-event event)
+        (push-event event))))
 
 (defun info-message (message &optional (priority +standard-event-priority+))
   (let ((event (make-instance 'info-message-event
                               :priority priority
                               :payload  message)))
-    (push-event event)))
+    (if *process-events-immediately*
+        (process-event event)
+        (push-event event))))
 
 (defun confirm-file-overwrite-dialog-immediate (filepath)
   (let ((res (info-dialog-immediate (format nil