hans/web-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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>
This commit is contained in:
Hans Dijkema
2025-10-10 21:39:56 +02:00
parent 74bcddfcdb
commit 5811df919c
4 changed files with 56 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
private/web-racket.rkt
View File

@@ -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))

36
private/web-wire.rkt
View File

@@ -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)
;(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)))))
(set! ww-current-handle h))))))
(unless (null? args)
(ww-log-level (car args)))
ww-current-handle)

1
private/webui-wire-download.rkt
View File

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

26
private/webui-wire-ffi.rkt
View File

@@ -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)))
)
)
)