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 #'=)
|
(define-constant +maximum-event-priority+ -2 :test #'=)
|
||||||
|
|
||||||
(defparameter *id-lock* (make-lock))
|
(defparameter *id-lock* (make-lock "id-event-lock"))
|
||||||
|
|
||||||
(defparameter *event-id* 0)
|
(defparameter *event-id* 0)
|
||||||
|
|
||||||
;; used only in batch mode from the command line
|
;; used only in batch mode from the command line
|
||||||
(defparameter *process-events-immediately* nil
|
(defparameter *process-events-immediately* nil
|
||||||
"Used only in batch mode from the command line. Instead of pushing
|
"Should be used only in batch mode from the command line (but i have
|
||||||
the event on a priority queue that will be picked by a thread
|
broken this rule rule here and there!).
|
||||||
process the event immediately")
|
|
||||||
|
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)
|
(defparameter *stop-event-dispatching* nil)
|
||||||
|
|
||||||
|
@ -84,7 +115,8 @@
|
||||||
(priority object)
|
(priority object)
|
||||||
(notes 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
|
#+debug
|
||||||
(defmethod process-event :before (object)
|
(defmethod process-event :before (object)
|
||||||
|
@ -100,11 +132,11 @@
|
||||||
|
|
||||||
(defclass events-queue (priority-queue)
|
(defclass events-queue (priority-queue)
|
||||||
((lock
|
((lock
|
||||||
:initform (make-lock)
|
:initform (make-lock "event-queue-lock")
|
||||||
:initarg :lock
|
:initarg :lock
|
||||||
:accessor lock)
|
:accessor lock)
|
||||||
(blocking-lock
|
(blocking-lock
|
||||||
:initform (make-lock)
|
:initform (make-lock "event-blocking-queue-lock")
|
||||||
:initarg :blocking-lock
|
:initarg :blocking-lock
|
||||||
:accessor blocking-lock)
|
:accessor blocking-lock)
|
||||||
(condition-variable
|
(condition-variable
|
||||||
|
@ -1251,10 +1283,14 @@
|
||||||
keybindings:*gemini-message-keymap*)
|
keybindings:*gemini-message-keymap*)
|
||||||
(gemini-viewer:maybe-initialize-metadata window)
|
(gemini-viewer:maybe-initialize-metadata window)
|
||||||
(refresh-gemini-message-window links page-data ir-text nil)
|
(refresh-gemini-message-window links page-data ir-text nil)
|
||||||
(ui:open-gemini-toc)
|
(let ((already-enqueued *process-events-immediately*))
|
||||||
(ui:open-gemini-message-link-window :give-focus nil :enqueue t)
|
(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)
|
(ui:focus-to-message-window)
|
||||||
(windows:draw window)))))
|
(windows:draw window))))))
|
||||||
|
|
||||||
(defclass gemini-request-event (program-event)
|
(defclass gemini-request-event (program-event)
|
||||||
((url
|
((url
|
||||||
|
|
|
@ -195,13 +195,17 @@
|
||||||
(let ((event (make-instance 'error-message-event
|
(let ((event (make-instance 'error-message-event
|
||||||
:priority priority
|
:priority priority
|
||||||
:payload message)))
|
:payload message)))
|
||||||
(push-event event)))
|
(if *process-events-immediately*
|
||||||
|
(process-event event)
|
||||||
|
(push-event event))))
|
||||||
|
|
||||||
(defun info-message (message &optional (priority +standard-event-priority+))
|
(defun info-message (message &optional (priority +standard-event-priority+))
|
||||||
(let ((event (make-instance 'info-message-event
|
(let ((event (make-instance 'info-message-event
|
||||||
:priority priority
|
:priority priority
|
||||||
:payload message)))
|
:payload message)))
|
||||||
(push-event event)))
|
(if *process-events-immediately*
|
||||||
|
(process-event event)
|
||||||
|
(push-event event))))
|
||||||
|
|
||||||
(defun confirm-file-overwrite-dialog-immediate (filepath)
|
(defun confirm-file-overwrite-dialog-immediate (filepath)
|
||||||
(let ((res (info-dialog-immediate (format nil
|
(let ((res (info-dialog-immediate (format nil
|
||||||
|
|
Loading…
Reference in New Issue