mirror of https://codeberg.org/cage/tinmop/
- added a profiling macro;
- added function to stop event dispatching.
This commit is contained in:
parent
0890841f2c
commit
3245239eee
|
@ -56,8 +56,9 @@ etc.) happened"
|
||||||
(declare (ignore w e))
|
(declare (ignore w e))
|
||||||
(incf-dt)
|
(incf-dt)
|
||||||
(incf-ticks)
|
(incf-ticks)
|
||||||
(scheduled-events:run-scheduled-events *ticks*)
|
(when (not (program-events:stop-event-dispatching-p))
|
||||||
(program-events:dispatch-program-events)
|
(scheduled-events:run-scheduled-events *ticks*)
|
||||||
|
(program-events:dispatch-program-events))
|
||||||
(windows:calculate-all +dt+)))))
|
(windows:calculate-all +dt+)))))
|
||||||
|
|
||||||
(defun init-i18n ()
|
(defun init-i18n ()
|
||||||
|
|
|
@ -943,3 +943,10 @@ to the array"
|
||||||
:want-stream t
|
:want-stream t
|
||||||
:verify :required
|
:verify :required
|
||||||
:external-format-out :utf8))
|
:external-format-out :utf8))
|
||||||
|
|
||||||
|
;; profiling
|
||||||
|
|
||||||
|
(defmacro with-profile-time (&body body)
|
||||||
|
`(with-output-to-string (stream)
|
||||||
|
(let ((*trace-output* stream))
|
||||||
|
(time ,@body))))
|
||||||
|
|
|
@ -227,7 +227,8 @@
|
||||||
:binary-search
|
:binary-search
|
||||||
:defun-w-lock
|
:defun-w-lock
|
||||||
:with-lock
|
:with-lock
|
||||||
:get-url-content))
|
:get-url-content
|
||||||
|
:with-profile-time))
|
||||||
|
|
||||||
(defpackage :box
|
(defpackage :box
|
||||||
(:use
|
(:use
|
||||||
|
@ -1240,6 +1241,8 @@
|
||||||
:+minimum-event-priority+
|
:+minimum-event-priority+
|
||||||
:+maximum-event-priority+
|
:+maximum-event-priority+
|
||||||
:*process-events-immediately*
|
:*process-events-immediately*
|
||||||
|
:with-stop-event-dispatching
|
||||||
|
:stop-event-dispatching-p
|
||||||
:program-event
|
:program-event
|
||||||
:event-id
|
:event-id
|
||||||
:payload
|
:payload
|
||||||
|
|
|
@ -17,6 +17,12 @@
|
||||||
|
|
||||||
(in-package :program-events)
|
(in-package :program-events)
|
||||||
|
|
||||||
|
(define-constant +standard-event-priority+ 10 :test #'=)
|
||||||
|
|
||||||
|
(define-constant +minimum-event-priority+ -1 :test #'=)
|
||||||
|
|
||||||
|
(define-constant +maximum-event-priority+ -2 :test #'=)
|
||||||
|
|
||||||
(defparameter *id-lock* (bt:make-recursive-lock))
|
(defparameter *id-lock* (bt:make-recursive-lock))
|
||||||
|
|
||||||
(defparameter *event-id* 0)
|
(defparameter *event-id* 0)
|
||||||
|
@ -27,11 +33,23 @@
|
||||||
the event on a priority queue that will be picked by a thread
|
the event on a priority queue that will be picked by a thread
|
||||||
process the event immediately")
|
process the event immediately")
|
||||||
|
|
||||||
(define-constant +standard-event-priority+ 10 :test #'=)
|
(defparameter *stop-event-dispatching* nil)
|
||||||
|
|
||||||
(define-constant +minimum-event-priority+ -1 :test #'=)
|
(defun stop-event-dispatching ()
|
||||||
|
(setf *stop-event-dispatching* t))
|
||||||
|
|
||||||
(define-constant +maximum-event-priority+ -2 :test #'=)
|
(defun start-event-dispatching ()
|
||||||
|
(setf *stop-event-dispatching* nil))
|
||||||
|
|
||||||
|
(defun stop-event-dispatching-p ()
|
||||||
|
*stop-event-dispatching*)
|
||||||
|
|
||||||
|
(defmacro with-stop-event-dispatching (&body body)
|
||||||
|
`(unwind-protect
|
||||||
|
(progn
|
||||||
|
(stop-event-dispatching)
|
||||||
|
,@body)
|
||||||
|
(start-event-dispatching)))
|
||||||
|
|
||||||
;; keep this function stricly monotonic otherwise the order of
|
;; keep this function stricly monotonic otherwise the order of
|
||||||
;; elements in priority queue is going to be messed up
|
;; elements in priority queue is going to be messed up
|
||||||
|
|
|
@ -1600,7 +1600,8 @@ mot recent updated to least recent"
|
||||||
(close-window-and-return-to-threads *chats-list-window*))
|
(close-window-and-return-to-threads *chats-list-window*))
|
||||||
|
|
||||||
(defun update-all-chats-messages ()
|
(defun update-all-chats-messages ()
|
||||||
(program-events:push-event (make-instance 'program-events:update-all-chat-messages-event)))
|
(program-events:push-event (make-instance 'program-events:update-all-chat-messages-event
|
||||||
|
:priority +minimum-event-priority+)))
|
||||||
|
|
||||||
(defun update-all-chats-data ()
|
(defun update-all-chats-data ()
|
||||||
(refresh-chats)
|
(refresh-chats)
|
||||||
|
|
Loading…
Reference in New Issue