From 31aa5bfd07b76b99aac7f0f03de333c467f2149d Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 12 Nov 2025 20:31:39 +0100 Subject: [PATCH] More of example 1 and ensuring thread safety executing commands --- example1/example-1-dialog.html | 17 +++++++++++ example1/example.rkt | 53 ++++++++++++++++++++-------------- private/webui-wire-ipc.rkt | 27 +++++++++++------ 3 files changed, 66 insertions(+), 31 deletions(-) create mode 100644 example1/example-1-dialog.html diff --git a/example1/example-1-dialog.html b/example1/example-1-dialog.html new file mode 100644 index 0000000..a733a9f --- /dev/null +++ b/example1/example-1-dialog.html @@ -0,0 +1,17 @@ + + + + + + This is test 1 Dialog + + +

Dialog test 1

+ + + + + +
Input 1
Input 2
Input 3
+ + diff --git a/example1/example.rkt b/example1/example.rkt index 5f646e7..b07538b 100644 --- a/example1/example.rkt +++ b/example1/example.rkt @@ -40,7 +40,7 @@ )) )) -(define test-dialog% +(define example-1-dialog% (class ww-webview% (super-new [html-file dialog-html] [width 400] @@ -48,7 +48,7 @@ (define/override (html-loaded) (super html-loaded) - (ww-debug "html-loaded for test-dialog%") + (ww-debug "html-loaded for example-1-dialog%") (let* ((btn (send this element 'ok-btn))) (send btn connect 'click (λ (data) (send this close))))) @@ -73,7 +73,7 @@ (let* ((dialog-btn (send this element 'app-button)) ) (send dialog-btn connect 'click (λ (data) - (new test-dialog% [parent this]))) + (new example-1-dialog% [parent this]))) ) (ww-debug "SETTING MENU") @@ -112,29 +112,38 @@ (send this connect-menu! 'm-start (λ () (set! counter-thread - (thread (λ () - (letrec ((f (λ () - (when go-on-counter - (set! c-counter (+ c-counter 1)) - (send div-counter set-inner-html (format "Count = ~a" c-counter)) - (when (and (> c-counter 0) (<= c-counter 1)) - (send div-counter set-style! (css-style '((background white))))) - (when (and (> c-counter 100) (<= c-counter 101)) - (send div-counter set-style! (css-style '((background green) (color white))))) - (when (and (> c-counter 200) (<= c-counter 201)) - (send div-counter set-style! (string->css-style "background: yellow; font-size: 120%;"))) - (when (and (> c-counter 300) (<= c-counter 301)) - (send div-counter set-style! (string->css-style "color: white; background: orange; font-size: 130%;"))) - (when (and (> c-counter 400) (<= c-counter 401)) - (send div-counter set-style! (string->css-style "color: white; background: red; font-size: 150%; font-weight: bold;"))) - (sleep 0.01) - (f))))) - (set! go-on-counter #t) - (f))))))) + (thread + (λ () + (letrec ((f (λ () + (when go-on-counter + (set! c-counter (+ c-counter 1)) + (send div-counter set-inner-html (format "Count = ~a" c-counter)) + (when (and (> c-counter 0) (<= c-counter 1)) + (send div-counter set-style! + (css-style '((background white))))) + (when (and (> c-counter 100) (<= c-counter 101)) + (send div-counter set-style! + (css-style '((background green) (color white))))) + (when (and (> c-counter 200) (<= c-counter 201)) + (send div-counter set-style! + (css-style '((background yellow) (font-size: 120%))))) + (when (and (> c-counter 300) (<= c-counter 301)) + (send div-counter set-style! + (css-style '((color white) (background orange) (font-size 130%))))) + (when (and (> c-counter 400) (<= c-counter 401)) + (send div-counter set-style! + (css-style '((color white) (background red) (font-size 150%) (font-weight bold))))) + (sleep 0.01) + (f))))) + (set! go-on-counter #t) + (f))))))) + (send this connect-menu! 'm-stop (λ () (set! go-on-counter #f) (set! c-counter 0))) + + (send this connect-menu! 'm-prefs (λ () (new example-1-dialog% [parent this]))) ) ) diff --git a/private/webui-wire-ipc.rkt b/private/webui-wire-ipc.rkt index ea7e210..253ea28 100644 --- a/private/webui-wire-ipc.rkt +++ b/private/webui-wire-ipc.rkt @@ -15,6 +15,7 @@ #t #f))) + ;; This function only expects one character, namely \n ;; In windows disable text mode on stdout/stderr of webui-wire. (define (read-eol port) @@ -62,7 +63,8 @@ ) (define (webui-ipc event-queuer log-processor) - (let ((webui-wire-cmd (ww-get-webui-wire-command))) + (let ((webui-wire-cmd (ww-get-webui-wire-command)) + ) (call-with-values (λ () (process webui-wire-cmd)) (λ (args) @@ -72,23 +74,30 @@ (process-stderr (cadddr args)) (signal-func (car (cddddr args))) ) - (let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor))) + (let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor)) + (sem (make-semaphore 1)) + ) (λ (cmd) + (semaphore-wait sem) ; Ensure thread safety (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 ":")) + (string=? colon ":")) + (semaphore-post sem) (error "Unexpected input from webui-wire executable")) (let* ((length (string->number str-length)) (input (read-string length process-stdout)) ) - (read-eol process-stdout) - input))))) - ))) + (read-eol process-stdout) + (semaphore-post sem) + input))) + ) + ) + ) + ) + ) ) - - ) \ No newline at end of file + ) ; End of module \ No newline at end of file