syncing to debug level.

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,18 +83,19 @@
         (l (hash-ref log-hash level 6)))
     (>= l ll)))
 
-(define (log-to* receiver log-callbacks)
+(define logger-thread #f)
-  (void
+
+(when (eq? logger-thread #f)
+  (set! logger-thread 
         (thread
-    (λ () (let loop ()
+         (λ () (let loop ((v (sync log-queue)))
-            (let* ((v (sync receiver))
+
-                   (level (vector-ref v 0))
+                 (let* ((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@@")
                      (let ((sem (hash-ref sync-sems topic #f)))
@@ -103,30 +106,57 @@
                            (begin
                              (semaphore-post sem)
                              (set! msg (format "Synchronization received on topic ~a" topic))
-                        (set! level 'info)
+                             (set! level 'debug)
                              )
                            )))
 
-              (enqueue! log-queue (list topic level dt msg))
+                   (if (null? lc)
-              (unless (null? lc)
+                       (begin
+                         (enqueue! buffer-queue (list topic level dt msg))
+                         (let loop ()
+                           (when (> (queue-length buffer-queue) max-log-queue-len)
+                             (dequeue! buffer-queue)
+                             (loop)))
+                         )
+                       (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 (let ((a (async-channel-try-get log-queue)))
+                         (if (eq? a #f)
+                             (sync log-queue)
+                             a)))
+                 )
+           )
+         #:pool 'own
+         )
+        )
+  )
+
+(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)