Trying to fix problems with gtk event processing, but it interferes

with the DrRacket WxWidgets base, which is also Gtk. So this will
never work reliable.

We're going back to inter process communication instead of integrating
on library/FFI/thread level.


Signed-off-by: Hans Dijkema <hans@dijkewijk.nl>

private/web-racket.rkt

@@ -9,6 +9,7 @@
            (prefix-in g: gregor)
            (prefix-in g: gregor/time)
            gregor-utils
+           net/sendurl
            )
   
   (provide ww-element%
@@ -286,7 +287,7 @@
     (class object%
       
       (init-field [profile 'default-profile]
-                  [use-browser #t]
+                  [use-browser #f]
                   [parent-id #f]
                   [parent #f]
                   [title "Racket HTML Window"]
@@ -454,7 +455,9 @@
 
       (define/public (set-html-file! file)
         (set! html-file file)
-        (set! html-handle (ww-set-html win-id html-file)))
+        (set! html-handle (ww-set-html win-id html-file))
+        (ww-debug (format "html file set to ~a" html-file))
+        )
 
       (define/public (set-url url)
         (send-url url))

private/web-wire.rkt

@@ -15,7 +15,6 @@
 
   (provide ww-start
            ww-stop
-           ww-set-web-wire-location!
 
            ww-set-debug
            ww-debug
@@ -170,6 +169,7 @@
     ([handle #:mutable]
      [event-thread #:mutable]
      [stop-thread #:mutable]
+     [reader-thread #:mutable]
      )
     )
 
@@ -188,7 +188,7 @@
     (semaphore-post evt-sem))
 
   (define (process-event h evt*)
-    (let* ((evt (bytes->string/utf-8 evt*))
+    (let* ((evt evt*) ;(bytes->string/utf-8 evt*))
            (m (regexp-match re-event evt)))
       (ww-debug evt)
       (let* ((e (string->symbol (string-downcase (list-ref m 1))))
@@ -202,6 +202,7 @@
         (if (eq? evt-handler #f)
             (ww-error (format "no event handler to handle event ~a" evt))
             (queue-callback (lambda () (evt-handler e payload))))
+;            (evt-handler e payload))
         )
       )
     )
@@ -225,8 +226,8 @@
             (dequeue! log-fifo)
             (ensure-fifo))
           (queue-length log-fifo)))
-    (let ((kind (bytes->string/utf-8 kind*))
+    (let ((kind kind*) ;(bytes->string/utf-8 kind*))
-          (msg (bytes->string/utf-8 msg*)))
+          (msg msg*)) ;(bytes->string/utf-8 msg*)))
       (enqueue! log-fifo (cons kind msg))
       (ensure-fifo)))
 
@@ -243,17 +244,36 @@
                                   (webwire-new)
                                   existing-h)
                               #f
+                              #f
                               #f)))
           (unless (eq? (webwire-status (web-rkt-handle h)) 'valid)
             (error (format "Invalid handle, cannot start. Reason: ~a"
                            (webwire-status->string
                             (webwire-status (web-rkt-handle h))))))
           (let ((thrd (event-handler h)))
-            (webwire-handlers! (web-rkt-handle h)
+            ;(webwire-handlers! (web-rkt-handle h)
-                               event-queuer
+            ;                   event-queuer
-                               process-log)
+            ;                   process-log)
-            (set-web-rkt-event-thread! h thrd)
+            (let ((reader-thread (thread (λ ()
-            (set! ww-current-handle h)))))
+                                           (let loop ()
+                                             (begin
+                                               (sleep 0.01)
+                                               (let ((l (webwire-get (web-rkt-handle h))))
+                                                 (let ((result (car l)))
+                                                   (unless (or (eq? result 'null) (eq? result 'invalid-handle))
+                                                     (let* ((evt (cadr l))
+                                                            (kind (caddr l))
+                                                            (msg (cadddr l)))
+                                                       (unless (eq? evt #f)
+                                                         (event-queuer evt))
+                                                       (unless (eq? kind #f)
+                                                         (process-log kind msg))))))
+                                               (loop)))
+                )
+              )))
+              (set-web-rkt-reader-thread! h reader-thread)
+              (set-web-rkt-event-thread! h thrd)
+              (set! ww-current-handle h))))))
     (unless (null? args)
       (ww-log-level (car args)))
     ww-current-handle)

private/webui-wire-download.rkt

@@ -10,6 +10,7 @@
   
   (provide ww-current-win-release
            ww-download-if-needed
+           ww-set-web-wire-location!
            )
            
 

private/webui-wire-ffi.rkt

@@ -29,11 +29,16 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define webwire-will (make-will-executor))
-(void (thread (λ () (let loop () (will-execute webwire-will) (loop)))))
+;(void (thread (λ ()
+;                (let loop ()
+;                  (begin
+;                    (sleep 0.1)
+;                    (will-execute webwire-will) (loop))))))
 
 
 (define-ffi-definer define-libwebui-wire
-  (ffi-lib "c:/devel/racket/webui-wire/build/Debug/libwebui-wire.dll"
+  (ffi-lib ;"c:/devel/racket/webui-wire/build/Debug/libwebui-wire.dll"
+           "/home/hans/src/racket/webui-wire/build/Debug/liblibwebui-wire.so"
            #:custodian (current-custodian)))
   ;(ffi-lib "libwebui-wire" '("3" "4" "5" #f)
   ;         #:get-lib-dirs (lambda ()
@@ -143,9 +148,9 @@
         -> r)
   #:c-id webwire_status_string)
 
-
+(define-libwebui-wire webwire-process-gui
-
+  (_fun _webui-handle/null -> _void)
-
+  #:c-id webwire_process_gui)
 
 
 ;(define (webwire-new evt-cb log-cb)
@@ -257,3 +262,14 @@
 ;                      (g:queue-callback (lambda () (h-log kind msg))))))
 
 
+; Make sure GUI Events are processed (e.g. for linux - gtk main loop)
+(void (thread (λ ()
+                (let loop ()
+                  (begin
+                    (sleep 0.05)
+                    (webwire-process-gui #f)
+                    ;(displayln 'process-gui-ok)
+                    (loop)))
+                )
+              )
+      )