mirror of https://codeberg.org/cage/tinmop/
- [TUI] removed a recursive locking.
This commit is contained in:
parent
8f4eed668d
commit
8fd5bcc603
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue