From 5811df919cab3b07aa3969757d607cab0d26b6ff Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Fri, 10 Oct 2025 21:39:56 +0200 Subject: [PATCH] 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 --- private/web-racket.rkt | 7 ++++-- private/web-wire.rkt | 38 +++++++++++++++++++++++++-------- private/webui-wire-download.rkt | 1 + private/webui-wire-ffi.rkt | 26 +++++++++++++++++----- 4 files changed, 56 insertions(+), 16 deletions(-) diff --git a/private/web-racket.rkt b/private/web-racket.rkt index 800dfdf..00e1c43 100644 --- a/private/web-racket.rkt +++ b/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)) diff --git a/private/web-wire.rkt b/private/web-wire.rkt index 0cc0aa2..6238ce4 100644 --- a/private/web-wire.rkt +++ b/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*)) - (msg (bytes->string/utf-8 msg*))) + (let ((kind kind*) ;(bytes->string/utf-8 kind*)) + (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) - event-queuer - process-log) - (set-web-rkt-event-thread! h thrd) - (set! ww-current-handle h))))) + ;(webwire-handlers! (web-rkt-handle h) + ; event-queuer + ; process-log) + (let ((reader-thread (thread (λ () + (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) diff --git a/private/webui-wire-download.rkt b/private/webui-wire-download.rkt index 04c7b6d..da5569d 100644 --- a/private/webui-wire-download.rkt +++ b/private/webui-wire-download.rkt @@ -10,6 +10,7 @@ (provide ww-current-win-release ww-download-if-needed + ww-set-web-wire-location! ) diff --git a/private/webui-wire-ffi.rkt b/private/webui-wire-ffi.rkt index 8cb5b26..6c08b8e 100644 --- a/private/webui-wire-ffi.rkt +++ b/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))) + ) + ) + )