From 3245239eee880068d83b09177d9dc1740cc6fe2b Mon Sep 17 00:00:00 2001
From: cage <cage-invalid@invalid>
Date: Thu, 31 Dec 2020 11:36:34 +0100
Subject: [PATCH] - added a profiling macro;

- added function to stop event dispatching.
---
 src/main.lisp           |  5 +++--
 src/misc-utils.lisp     |  7 +++++++
 src/package.lisp        |  5 ++++-
 src/program-events.lisp | 24 +++++++++++++++++++++---
 src/ui-goodies.lisp     |  3 ++-
 5 files changed, 37 insertions(+), 7 deletions(-)

diff --git a/src/main.lisp b/src/main.lisp
index d552af0..1babfc1 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -56,8 +56,9 @@ etc.) happened"
             (declare (ignore w e))
             (incf-dt)
             (incf-ticks)
-            (scheduled-events:run-scheduled-events *ticks*)
-            (program-events:dispatch-program-events)
+            (when (not (program-events:stop-event-dispatching-p))
+              (scheduled-events:run-scheduled-events *ticks*)
+              (program-events:dispatch-program-events))
             (windows:calculate-all +dt+)))))
 
 (defun init-i18n ()
diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp
index afe8881..1f6688b 100644
--- a/src/misc-utils.lisp
+++ b/src/misc-utils.lisp
@@ -943,3 +943,10 @@ to the array"
                        :want-stream         t
                        :verify              :required
                        :external-format-out :utf8))
+
+;; profiling
+
+(defmacro with-profile-time (&body body)
+  `(with-output-to-string (stream)
+     (let ((*trace-output* stream))
+       (time ,@body))))
diff --git a/src/package.lisp b/src/package.lisp
index cf2ded6..e0453b8 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -227,7 +227,8 @@
    :binary-search
    :defun-w-lock
    :with-lock
-   :get-url-content))
+   :get-url-content
+   :with-profile-time))
 
 (defpackage :box
   (:use
@@ -1240,6 +1241,8 @@
    :+minimum-event-priority+
    :+maximum-event-priority+
    :*process-events-immediately*
+   :with-stop-event-dispatching
+   :stop-event-dispatching-p
    :program-event
    :event-id
    :payload
diff --git a/src/program-events.lisp b/src/program-events.lisp
index 56b4c40..71ea2f9 100644
--- a/src/program-events.lisp
+++ b/src/program-events.lisp
@@ -17,6 +17,12 @@
 
 (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 *event-id* 0)
@@ -27,11 +33,23 @@
   the  event on  a priority  queue  that will  be picked  by a  thread
   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
 ;; elements in priority queue is going to be messed up
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index 04173d7..761abe5 100644
--- a/src/ui-goodies.lisp
+++ b/src/ui-goodies.lisp
@@ -1600,7 +1600,8 @@ mot recent updated to least recent"
   (close-window-and-return-to-threads *chats-list-window*))
 
 (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 ()
   (refresh-chats)