Internal definitions other

main.rkt

@@ -3,6 +3,7 @@
 (require (for-syntax racket/syntax)
          racket/date
          racket-sprintf
+         racket/async-channel
          data/queue
          )
 
@@ -44,7 +45,8 @@
 (set! log-level 'debug)
 
 (define max-log-queue-len 1000)
-(define log-queue (make-queue))
+(define log-queue (make-async-channel))
+(define buffer-queue (make-queue))
 
 (define (sl-set-log-level l)
   (if (or
@@ -81,17 +83,16 @@
         (l (hash-ref log-hash level 6)))
     (>= l ll)))
 
-(define (log-to* receiver log-callbacks)
+(define logger-thread
-  (void
   (thread
    (λ () (let loop ()
-            (let* ((v (sync receiver))
+           (let* ((v (sync log-queue))
                   (level (vector-ref v 0))
                   (msg (vector-ref v 1))
                   (data (vector-ref v 2))
                   (dt (car data))
                   (topic (cadr data))
-                   (lc (log-callbacks))
+                  (lc log-callbacks)
                   )
 
              (when (string=? msg "@@SYNC@@")
@@ -107,26 +108,39 @@
                        )
                      )))
 
-              (enqueue! log-queue (list topic level dt msg))
+             (if (null? lc)
-              (unless (null? lc)
+                 (enqueue! buffer-queue (list topic level dt msg))
+                 (begin
+                   (when (> (queue-length buffer-queue) 0)
                      (for-each (λ (log-entry)
                                  (when (needs-logging (cadr log-entry))
                                    (for-each (λ (e)
                                                (let ((callback (cdr e)))
                                                  (apply callback log-entry)))
+                                             lc)))
+                               (queue->list buffer-queue))
+                     (set! buffer-queue (make-queue)))
+                   (when (needs-logging level)
+                     (for-each (λ (e)
+                                 (let ((callback (cdr e)))
+                                   (callback topic level dt msg)))
                                lc))
                    )
-                          (queue->list log-queue))
-                (set! log-queue (make-queue)))
-              (when (> (queue-length log-queue) max-log-queue-len)
-                (dequeue! log-queue))
                  )
+
+             (loop))))
+   )
+  )
+
+(define (log-to* receiver log-callbacks)
+  (void
+   (thread
+    (λ () (let loop ()
+            (let* ((v (sync receiver)))
+              (async-channel-put log-queue v))
             (loop)
-            )
+            )))
-      )
+   ))
-    )
-   )
-  )
 
 (define-syntax sl-log-to
   (syntax-rules (log-callbacks)