From 694d6777e99e155cf9be0bd02e5c5d0612d117c5 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Tue, 14 Oct 2025 12:44:45 +0200 Subject: [PATCH] Racket integration Signed-off-by: Hans Dijkema --- private/web-racket.rkt | 6 +++ private/web-wire.rkt | 55 ++++++------------------ private/webui-wire-download.rkt | 7 ++- private/webui-wire-ipc.rkt | 76 +++++++++++++++++++++++++++++++++ 4 files changed, 101 insertions(+), 43 deletions(-) create mode 100644 private/webui-wire-ipc.rkt diff --git a/private/web-racket.rkt b/private/web-racket.rkt index 00e1c43..3508154 100644 --- a/private/web-racket.rkt +++ b/private/web-racket.rkt @@ -193,15 +193,19 @@ (super-new) (begin + (displayln (format "win-id: ~a, id: ~a" (send this get-win-id) (send this get-id))) (inp-set! val (ww-get-value (send this get-win-id) (send this get-id))) + (displayln (format "got value '~a'" val)) (send this connect 'input (λ (data) (ww-debug data) (let ((js-evt (hash-ref data 'js-evt #f))) (unless (eq? js-evt #f) (when (hash-has-key? js-evt 'value) (inp-set! val (hash-ref js-evt 'value))))))) + (displayln "connected") (send (send this win) bind 'input (format "#~a" (send this get-id))) + (displayln "bind of input?") ) )) @@ -388,6 +392,7 @@ (ww-debug (format "call to bind ~a ~a ~a" event selector forced-cl)) (let ((infos (ww-bind win-id event selector))) (for-each (λ (info) + (displayln (format "info = ~a" info)) (let* ((id (car info)) (tag (cadr info)) (type (caddr info))) @@ -404,6 +409,7 @@ (define/public (bind-inputs) (bind 'change 'input ) (bind 'change 'textarea) + #t ) (define/public (bind-buttons) diff --git a/private/web-wire.rkt b/private/web-wire.rkt index 6238ce4..3e9e223 100644 --- a/private/web-wire.rkt +++ b/private/web-wire.rkt @@ -9,7 +9,8 @@ "../utils/utils.rkt" "css.rkt" "menu.rkt" - "webui-wire-ffi.rkt" + ;"webui-wire-ffi.rkt" + "webui-wire-ipc.rkt" "webui-wire-download.rkt" ) @@ -239,41 +240,13 @@ (define (ww-start . args) (when (eq? ww-current-handle #f) - (let ((existing-h (webwire-current))) - (let ((h (make-web-rkt (if (eq? existing-h #f) - (webwire-new) - existing-h) + (let* ((h (make-web-rkt (webui-ipc event-queuer process-log) #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) - (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)))))) + #f)) + (thrd (event-handler h))) + (set-web-rkt-event-thread! h thrd) + (set! ww-current-handle h))) (unless (null? args) (ww-log-level (car args))) ww-current-handle) @@ -288,7 +261,7 @@ (let ((handler (hash-ref windows-evt-handlers win-id))) (handler 'destroyed #f))) keys)) - (webwire-destroy (web-rkt-handle ww-current-handle)) + ((web-rkt-handle ww-current-handle) "exit") (set! ww-current-handle #f))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -302,7 +275,7 @@ #:transparent) (define-struct cmdr - (ok kind win r)) + (ok kind win r) #:transparent) ;;;;;;;;;;;; Command Utilities @@ -352,12 +325,10 @@ (define (ww-cmd cmd) (ww-debug (format "ww-cmd ~a" cmd)) (if (eq? cmd 'quit) - (let ((result (webwire-command (web-rkt-handle ww-current-handle) "exit"))) - (let ((r (convert-result result))) - (check-nok cmd r) - (ww-stop) - r)) - (let ((result (webwire-command (web-rkt-handle ww-current-handle) cmd))) + (begin + (ww-stop) + #t) + (let ((result ((web-rkt-handle ww-current-handle) cmd))) (let ((r (convert-result result))) (check-nok cmd r) r)))) diff --git a/private/webui-wire-download.rkt b/private/webui-wire-download.rkt index da5569d..ae316ad 100644 --- a/private/webui-wire-download.rkt +++ b/private/webui-wire-download.rkt @@ -11,8 +11,13 @@ (provide ww-current-win-release ww-download-if-needed ww-set-web-wire-location! + ww-webui-wire ) - + + + (define (ww-webui-wire) + "/home/hans/src/racket/webui-wire/build/Debug/webui-wire" + ) (define ww-current-win-release "https://github.com/hdijkema/web-wire/releases/download/0.1/web-wire-0.1-win64.zip") diff --git a/private/webui-wire-ipc.rkt b/private/webui-wire-ipc.rkt new file mode 100644 index 0000000..b2ca56b --- /dev/null +++ b/private/webui-wire-ipc.rkt @@ -0,0 +1,76 @@ +(module webui-wire-ipc racket/base + + (require "webui-wire-download.rkt") + + (provide webui-ipc) + + (define re-kind #px"^([^:]+)[:]") + + (define (read-eol port) + (read-string 1 port)) + + (define (process-stderr-reader process-stderr event-queuer log-processor) + (thread (λ () + (letrec ((reader (λ () + (let* ((str-length (read-string 8 process-stderr)) + (colon (read-string 1 process-stderr))) + (if (eof-object? colon) + (begin + (log-processor 'stderr-reader "webui-wire executable exited") + 'process-ended) + (begin + (unless (and + (string? colon) + (string=? colon ":")) + (error "Unexpected input from webui-wire standard error")) + (let* ((length (string->number str-length)) + (input (read-string length process-stderr)) + (m (regexp-match re-kind input)) + ) + (read-eol process-stderr) + (if (eq? m #f) + (log-processor 'stderr-reader + (format "Unexpected: no kind: input = ~a" input)) + (let ((kind (string->symbol (list-ref m 1))) + (line (substring input (string-length (car m)))) + ) + (if (eq? kind 'EVENT) + (event-queuer line) + (log-processor kind line)))) + ) + (reader) + ) + )) + ) + )) + (reader))) + ) + ) + + (define (webui-ipc event-queuer log-processor) + (let ((webui-wire-exe (ww-webui-wire))) + (displayln webui-wire-exe) + (call-with-values + (λ () (subprocess #f #f #f webui-wire-exe)) + (λ (pid process-stdout process-stdin process-stderr) + ;(displayln (format "~a ~a ~a ~a" pid process-stdout process-stdin process-stderr)) + (let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor))) + (λ (cmd) + (displayln cmd process-stdin) + (flush-output process-stdin) + (let* ((str-length (read-string 8 process-stdout)) + (colon (read-string 1 process-stdout))) + ;(displayln (format "len: ~a, str-length: ~a, colon: ~a" (string-length str-length) str-length colon)) + (unless (and (string? colon) + (string=? colon ":")) + (error "Unexpected input from webui-wire executable")) + (let* ((length (string->number str-length)) + (input (read-string length process-stdout)) + ) + (read-eol process-stdout) + input))))) + )) + ) + + + ) \ No newline at end of file