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

Racket integration

Browse Source 
Signed-off-by: Hans Dijkema <hans@dijkewijk.nl>
This commit is contained in:
Hans Dijkema
2025-10-14 12:44:45 +02:00
parent 5811df919c
commit 694d6777e9
4 changed files with 101 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
private/web-racket.rkt
View File

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

51
private/web-wire.rkt
View File

@@ -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)
#f))
(thrd (event-handler h)))
(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)
@@ -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)
(begin
(ww-stop)
r))
(let ((result (webwire-command (web-rkt-handle ww-current-handle) cmd)))
#t)
(let ((result ((web-rkt-handle ww-current-handle) cmd)))
(let ((r (convert-result result)))
(check-nok cmd r)
r))))

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

@@ -11,9 +11,14 @@
(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")
(define user-web-wire-location #f)

76
private/webui-wire-ipc.rkt Normal file
View File

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