diff --git a/example1/example-1.html b/example1/example-1.html new file mode 100644 index 0000000..63afb71 --- /dev/null +++ b/example1/example-1.html @@ -0,0 +1,67 @@ + + + + + + This is Example 1 + + + + +

This is Example 1

+

screen coöords

+

Opening a link to some website

+

+

+

+

Opening a second page

+
+ + +
+

And some other buttons

+
+ + +
+

Menu responses

+ + + + + + + + + + + + + + +
counter = 0
OpenClose
CopyCutPaste
+

Some inputs

+
+

This is replacable text

+
+ +
+ + +
+

Some pictures

+
+ +
+
+ +
+ + diff --git a/example1/example.rkt b/example1/example.rkt index 91a0462..142a1bb 100644 --- a/example1/example.rkt +++ b/example1/example.rkt @@ -1,15 +1,133 @@ #lang racket/gui +(require "../main.rkt" + racket/runtime-path + racket/gui + ) - (define m (menu (menu-item 'm-file "File" - #:submenu - (menu (menu-item 'm-open "Open File") - (menu-item 'm-close "Close File") - (menu-item 'm-quit "Quit" #:separator #t))) - (menu-item 'm-edit "Edit" - #:submenu - (menu (menu-item 'm-copy "Copy") - (menu-item 'm-cut "Cut") - (menu-item 'm-paste "Paste") - (menu-item 'm-prefs "Preferences" #:separator #t) - )))) \ No newline at end of file +(provide + (all-from-out racket/gui) + example-1-window% + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Example 1 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-runtime-path html-start "example-1.html") +(define-runtime-path dialog-html "example-1-dialog.html") + +(displayln html-start) +(displayln dialog-html) + + +(define test-menu (menu (menu-item 'm-file "File" + #:submenu + (menu (menu-item 'm-open "Open File") + (menu-item 'm-close "Close File") + (menu-item 'm-quit "Quit" #:separator #t))) + (menu-item 'm-edit "Edit" + #:submenu + (menu (menu-item 'm-copy "Copy") + (menu-item 'm-cut "Cut") + (menu-item 'm-paste "Paste") + (menu-item 'm-prefs "Preferences" #:separator #t) + )) + (menu-item 'm-auto "Processes" + #:submenu + (menu (menu-item 'm-start "Start counter") + (menu-item 'm-stop "Stop counter") + )) + )) + +(define test-dialog% + (class ww-webview% + (super-new [html-file dialog-html] + [width 400] + [height 300]) + + (define/override (html-loaded) + (super html-loaded) + (ww-debug "html-loaded for test-dialog%") + (let* ((btn (send this element 'ok-btn))) + (send btn connect 'click (λ (data) + (send this close))))) + )) + +(define-syntax inc + (syntax-rules () + ((_ var) + (λ () + (set! var (+ var 1)) + var)))) + +(define example-1-window% + (class ww-webview% + (super-new [html-file (begin (displayln html-start) html-start)]) + + (define/override (html-loaded) + (ww-debug "HTML LOADED") + (super html-loaded) + + (ww-debug "CONNECTING BUTTONS") + (let* ((dialog-btn (send this element 'app-button)) + ) + (send dialog-btn connect 'click (λ (data) + (new test-dialog% [parent this]))) + ) + + (ww-debug "SETTING MENU") + (let* ((div-open (send this element 'div-open)) + (c-open 0) + (div-close (send this element 'div-close)) + (c-close 0) + (div-copy (send this element 'div-copy)) + (c-copy 0) + (div-cut (send this element 'div-cut)) + (c-cut 0) + (div-paste (send this element 'div-paste)) + (c-paste 0) + (div-counter (send this element 'div-counter)) + (go-on-counter #f) + (c-counter 0) + (counter-thread #f) + ) + (send this set-menu! test-menu) + (send this connect-menu! 'm-quit (λ () (send this close))) + (let ((make-menu-executor (λ (item elem string count) + (send this connect-menu! item + (λ () + (send elem set-inner-html (format "~a ~a" string (count))))))) + ) + (make-menu-executor 'm-open div-open "Open file" (inc c-open)) + (make-menu-executor 'm-close div-close "Close file" (inc c-close)) + (make-menu-executor 'm-copy div-copy "Edit Copy" (inc c-copy)) + (make-menu-executor 'm-cut div-cut "Edit Cut" (inc c-cut)) + (make-menu-executor 'm-paste div-paste "Edit Paste" (inc c-paste)) + + (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)) + (sleep 0.01) + (f))))) + (set! go-on-counter #t) + (f))))))) + (send this connect-menu! 'm-stop + (λ () + (set! go-on-counter #f))) + + ) + ) + ) + + (begin + (displayln html-start) + ) + ) + ) + diff --git a/main.rkt b/main.rkt index b35f995..c466c16 100644 --- a/main.rkt +++ b/main.rkt @@ -1,4 +1,11 @@ #lang racket/base -(require "private/web-wire.rkt") -(provide (all-from-out "private/web-wire.rkt")) +(require "private/web-racket.rkt" + "private/web-racket-version.rkt" + ) + +(provide + (all-from-out "private/web-racket.rkt") + (all-from-out "private/web-racket-version.rkt") + ) + diff --git a/private/web-racket-version.rkt b/private/web-racket-version.rkt index ac19b9c..f9c0daa 100644 --- a/private/web-racket-version.rkt +++ b/private/web-racket-version.rkt @@ -6,10 +6,10 @@ ww-version-major ww-version-minor ww-version-patch - ww-ffi-version - ww-ffi-version-major - ww-ffi-version-minor - ww-ffi-version-patch + ww-wire-version + ww-wire-version-major + ww-wire-version-minor + ww-wire-version-patch ) @@ -36,10 +36,10 @@ ;; Web Wire FFI Version ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (define ww-ffi-version-major 0) - (define ww-ffi-version-minor 2) - (define ww-ffi-version-patch 1) + (define ww-wire-version-major 0) + (define ww-wire-version-minor 2) + (define ww-wire-version-patch 8) - (define ww-ffi-version (mk-version ww-ffi-version-major ww-ffi-version-minor ww-ffi-version-patch)) + (define ww-wire-version (mk-version ww-wire-version-major ww-wire-version-minor ww-wire-version-patch)) ) \ No newline at end of file diff --git a/private/web-racket.rkt b/private/web-racket.rkt index 9efe16f..78928ff 100644 --- a/private/web-racket.rkt +++ b/private/web-racket.rkt @@ -5,16 +5,18 @@ "css.rkt" "menu.rkt" "../utils/sprintf.rkt" + "webui-wire-download.rkt" html-printer (prefix-in g: gregor) (prefix-in g: gregor/time) gregor-utils net/sendurl + racket/path ) (provide ww-element% ww-input% - ww-window% + ww-webview% ww-start ww-stop @@ -23,6 +25,11 @@ ww-error (all-from-out "css.rkt") + (all-from-out "menu.rkt") + + ww-set-custom-webui-wire-command! + ww-display-log + ww-tail-log ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -232,7 +239,6 @@ )) ;;;; Time input - (define ww-input-time% (class ww-input% @@ -283,7 +289,12 @@ (super-new) )) - (define ww-window% + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Classes representing WebView Windows. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define ww-webview% (class object% (init-field [profile 'default-profile] @@ -455,11 +466,19 @@ (ww-set-icon win-id icn)) (define/public (set-html-file! file) - (ww-debug (format "set-html-file! ~a" file)) - (set! html-file file) - (set! html-handle (ww-set-html win-id html-file)) - (ww-debug (format "html file set to ~a" html-file)) - ) + (let* ((full-path (if (string? file) + (string->path file) + file)) + (folder (path-only full-path)) + (the-file (file-name-from-path full-path)) + ) + (ww-debug (format "set-html-file! ~a, ~a" folder the-file)) + (set! html-file file) + (when folder + (ww-cwd folder)) + (set! html-handle (ww-set-html win-id the-file)) + (ww-debug (format "html file set to ~a" the-file)) + )) (define/public (set-url url) (send-url url)) @@ -578,8 +597,19 @@ (hash-set! windows-evt-handlers (ww-win-id win-id) event-handler) (hash-set! windows (ww-win-id win-id) this) - (ww-move win-id x y) (ww-resize win-id width height) + + (when parent + (let* ((parent-width (send parent get-width)) + (parent-height (send parent get-height)) + (parent-x (send parent get-x)) + (parent-y (send parent get-y)) + ) + (set! x (+ parent-x (/ (- parent-width width) 2))) + (set! y (+ parent-y (/ (- parent-height height) 2))) + ) + ) + (ww-move win-id x y) (send this set-title! title) @@ -601,57 +631,6 @@ (define (get-global-stylesheet) (ww-get-stylesheet)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Testing stuff - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (define test-menu (menu (menu-item 'm-file "File" - #:submenu - (menu (menu-item 'm-open "Open File") - (menu-item 'm-close "Close File") - (menu-item 'm-quit "Quit" #:separator #t))) - (menu-item 'm-edit "Edit" - #:submenu - (menu (menu-item 'm-copy "Copy") - (menu-item 'm-cut "Cut") - (menu-item 'm-paste "Paste") - (menu-item 'm-prefs "Preferences" #:separator #t) - )))) - - (define test-dialog% - (class ww-window% - (super-new [html-file "../../web-wire/test/dialog.html"] - [width 400] - [height 300]) - - (define/override (html-loaded) - (super html-loaded) - (ww-debug "html-loaded for test-dialog%") - (let* ((btn (send this element 'ok-btn))) - (send btn connect 'click (λ (data) - (send this close))))) - )) - - (define test-window% - (class ww-window% - (super-new [html-file "../../web-wire/test/test1.html"]) - - (define/override (html-loaded) - (ww-debug "HTML LOADED") - (super html-loaded) - (let* ((btn (send this element 'app-button))) - (send btn connect 'click (λ (data) - (new test-dialog% [parent this])))) - (ww-debug "SETTING MENU") - (send this set-menu! test-menu) - (send this connect-menu! 'm-quit (λ () (send this close))) - ) - - (begin - ) - ) - ) - + + ); end of module \ No newline at end of file diff --git a/private/web-wire.rkt b/private/web-wire.rkt index cc7af3a..864c872 100644 --- a/private/web-wire.rkt +++ b/private/web-wire.rkt @@ -26,6 +26,8 @@ ww-cmd ww-cmd-nok? + ww-cwd + ww-protocol ww-log-level ww-set-stylesheet @@ -104,11 +106,20 @@ (string-replace s* "\\\"" "\""))) (define (to-server-file html-file) - (let* ((path (build-path html-file)) - (complete-p (path->complete-path path)) - (a-file (format "~a" complete-p)) - (the-file (string-replace a-file "\\" "/"))) - the-file)) + (let ((to-file (λ (p) (string-replace (format "~a" p) "\\" "/"))) + (file-path (build-path (format "~a" html-file)))) + (if (absolute-path? file-path) + (to-file file-path) + (let* ((cwd (ww-cwd)) + (full-file (build-path cwd (format "~a" html-file)))) + (if (file-exists? full-file) + (to-file html-file) + (to-file (path->complete-path (build-path html-file))) + ) + ) + ) + ) + ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; web-wire handling (interaction with the library) @@ -217,6 +228,8 @@ ) ) ) + + (define evt-hdlr 0) (define (event-handler h) (parameterize ([current-eventspace (current-eventspace)]) @@ -225,10 +238,17 @@ (letrec ((f (lambda () (semaphore-wait evt-sem) (queue-callback - (lambda () (process-event h (dequeue! evt-fifo)))) + (lambda () + (letrec ((queue-loop (λ () + (when (> (queue-length evt-fifo) 0) + (process-event h (dequeue! evt-fifo)) + (queue-loop))))) + (queue-loop)))) (f)))) - (f)))))) - + (f))) + ) + ) + ) (define (ensure-fifo) (if (> (queue-length log-fifo) log-fifo-max) @@ -314,6 +334,9 @@ (define (ww-start* type args) (when (eq? ww-current-handle #f) + (set! evt-sem (make-semaphore)) + (set! evt-fifo (make-queue)) + (set! log-fifo (make-queue)) (let ((h (make-web-rkt (if (eq? type 'ipc) (webui-ipc event-queuer-ipc process-log-ipc) (error "ffi integration not implemented")) @@ -451,7 +474,15 @@ r))) (define (html-file-exists? f) - (file-exists? f)) + (if (file-exists? f) + #t + (let* ((cwd (ww-cwd)) + (full-file (build-path cwd f))) + (ww-debug (format "file-exists? '~a'" full-file)) + (file-exists? full-file) + ) + ) + ) (define (html-or-file? v) (if (file-exists? v) @@ -515,15 +546,15 @@ ((eq? type 'ww-win) (make-ww-win (string->number str))) ((eq? type 'void) 'void) ((eq? type 'css-style) (string->css-style str)) - ((eq? type 'path) (string->path str)) + ((eq? type 'path) (string->path (substring (substring str 0 (- (string-length str) 1)) 1))) (else str))) (define (check-cmd-type v vname type typename) (let ((is-type (type v))) (unless is-type (error - (format "Expected ~a of type ~a" - vname typename))) + (format "Expected ~a of type ~a, got '~a'" + vname typename v))) #t)) (define (convert-arg-to-cmd v vname type) @@ -793,6 +824,7 @@ ;; Set inner html of an Id of the HTML in the window (def-cmd ww-set-inner-html set-inner-html ((win-id ww-win?) + (element-id symbol-or-string?) (html-of-file html-or-file?)) () -> void) diff --git a/private/webui-wire-download.rkt b/private/webui-wire-download.rkt index 2cb1577..034e99c 100644 --- a/private/webui-wire-download.rkt +++ b/private/webui-wire-download.rkt @@ -5,112 +5,151 @@ net/url file/unzip racket/file + "web-racket-version.rkt" + racket/system ) + (provide ww-set-custom-webui-wire-command! + ww-get-webui-wire-command + ) - (provide ww-current-win-release - ww-download-if-needed - ww-set-web-wire-location! - ww-webui-wire + + (define (ww-get-webui-wire-command) + (unless (webui-wire-exists?) + (error "webui-wire needs to be installed in order to use web-racket")) + (get-webui-wire-cmd)) + + (define user-webui-wire-command #f) + + (define (ww-set-custom-webui-wire-command! cmd) + (set! user-webui-wire-command cmd) + user-webui-wire-command) + + (define (get-webui-wire-cmd) + (if (eq? user-webui-wire-command #f) + (let ((os (system-type 'os*))) + (if (eq? os 'linux) + "flatpak run nl.dijkewijk.webui-wire" + (format "~a" + (build-path (webui-wire-dir) (if (eq? os 'windows) + "webui-wire.exe" + "webui-wire"))))) + user-webui-wire-command)) + + (define (webui-wire-dir) + (let* ((cache-dir (find-system-path 'cache-dir)) + (ww-dir (build-path cache-dir "webui-wire")) ) + (unless (directory-exists? ww-dir) + (make-directory ww-dir)) + ww-dir)) - ;(define (current-release os) + (define (flatpak-ok? str) + (let* ((re #px"([0-9]+)[.]([0-9]+)[.]([0-9]+)$") + (m (regexp-match re str)) + (v (if (eq? m #f) + 0 + (let ((l (map string->number (cdr m)))) + (+ (* (car l) 10000) (* (cadr l) 100) (caddr l)))))) + (>= 11000))) - (define (ww-webui-wire) - (list "C:/devel/racket/webui-wire/build/Release/webui-wire.exe") - ;(list "/home/hans/src/racket/webui-wire/build/Release/webui-wire") - ;(list "/usr/bin/flatpak" "run" "nl.dijkewijk.webui-wire") - ;(list "/Users/hans/src/webui-wire/build/Release/webui-wire") + + (define (webui-wire-exists?) + (let ((os (system-type 'os*))) + (if (eq? os 'linux) + (webui-wire-exists-linux?) + (error "Currently not implemented for other systems than Linux") + ) + ) ) - (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) - (define (ww-set-web-wire-location! path-or-dir) - (set! user-web-wire-location (build-path path-or-dir)) - user-web-wire-location) + (define (webui-wire-exists-linux?) + (let ((flatpak (call-with-values (lambda () (process "flatpak --version")) + (lambda (args) + (let ((out (car args))) + (read-line out)))))) + (unless (string? flatpak) + (error "Please install flatpak to use web-racket")) + (unless (flatpak-ok? flatpak) + (error (format "Not the right flatpak version installed: ~a" flatpak))) + (let ((webui-wire (call-with-values (lambda () (process "flatpak list --user | grep webui-wire")) + (lambda (args) + (let ((out (car args))) + (read-line out)))))) + (if (string? webui-wire) + (let ((webui-wire-version (call-with-values (lambda () (process "flatpak run nl.dijkewijk.webui-wire --version")) + (lambda (args) + (let ((out (car args)) + (in (cadr args))) + (displayln "exit" in) + (flush-output in) + (read-line out)))))) + (if (string=? webui-wire-version ww-wire-version) + #t + (begin + (system "flatpak uninstall --user --noninteractive --assumeyes nl.dijkewijk.webui-wire") + (download-webui-wire-linux))) + ) + (download-webui-wire-linux))) + ) + ) - (define (os) - (format "~a-~a" (system-type) (system-type 'word))) - (define (web-wire-exe) - (if (eq? (system-type) 'windows) - "web-wire.exe" - "web-wire")) + (define (download-webui-wire-linux) + (let* ((download-link (current-webui-wire-link)) + (filepath (do-download download-link "webui-wire.flatpak"))) + (system (format "flatpak install --user --assumeyes --noninteractive \"~a\"" filepath)) + #t + ) + ) - (define (web-wire-dir) - (if (eq? user-web-wire-location #f) - (let* ((cache-dir (find-system-path 'cache-dir)) - (os-dir (build-path cache-dir (os))) - (web-wire-prg (build-path os-dir (web-wire-exe))) - ) - (unless (file-exists? web-wire-prg) - (error "Web wire executable not found: '~a'" web-wire-prg)) - os-dir) - (let ((web-wire-prg (build-path user-web-wire-location (web-wire-exe)))) - (unless (file-exists? web-wire-prg) - (error "Web wire executable not found: '~a'" web-wire-prg)) - user-web-wire-location) - )) - - (define (web-wire-prg) - (build-path (web-wire-dir) (web-wire-exe))) - - (define (do-download-and-extract release version os-dir) - (let* ((url (string->url release)) + (define (do-download link filename) + (let* ((url (string->url link)) (port-in (get-pure-port url #:redirections 10)) - (release-file (build-path os-dir "release.zip")) - (port-out (open-output-file release-file #:exists 'replace)) + (filepath (build-path (webui-wire-dir) filename)) + (port-out (open-output-file filepath #:exists 'replace)) ) - (letrec ((f (lambda (count next-c len) - (let ((bytes (read-bytes 16384 port-in))) - (if (eof-object? bytes) - count - (let ((read-len (bytes-length bytes))) - (when (> read-len 0) - (set! count (+ count read-len)) - (when (> count next-c) - (display (format "~a..." count)) - (set! next-c (+ count len))) - (write-bytes bytes port-out) - ) - (f count next-c len))))) - )) - (display "Downloading web-wire...") - (let ((count (f 0 0 10000000))) + (letrec ((downloader-func (λ (count next-c len) + (let ((bytes (read-bytes 16384 port-in))) + (if (eof-object? bytes) + count + (let ((read-len (bytes-length bytes))) + (when (> read-len 0) + (set! count (+ count read-len)) + (when (> count next-c) + (display (format "~a..." count)) + (set! next-c (+ count len))) + (write-bytes bytes port-out) + ) + (downloader-func count next-c len))))) + )) + (display (format "Downloading webui-wire (~a)..." link)) + (let ((count (downloader-func 0 0 10000))) (displayln (format "~a downloaded" count))) (close-input-port port-in) (close-output-port port-out) - (display "Unzipping...") - (unzip release-file - (make-filesystem-entry-reader #:dest os-dir - #:strip-count 1 - #:exists 'replace) - ) - (display "removing zip file...") - (delete-file release-file) - (displayln "done") - ))) + filepath))) - (define (ww-download-if-needed release) - (let* ((os-dir (web-wire-dir)) - (re #px"web[-]wire[-]([0-9.]+)[-]") + (define (current-webui-wire-link) + (let* ((os (system-type 'os*)) + (arch (system-type 'arch)) ) - (unless (directory-exists? os-dir) - (make-directory* os-dir)) - (let ((m (regexp-match re release))) - (unless (eq? m #f) - (let* ((version-file (build-path os-dir "version")) - (version (cadr m)) - (has-version #f)) - (when (file-exists? version-file) - (let ((file-version (file->value version-file))) - (when (string=? file-version version) - (set! has-version #t)))) - (unless has-version - (do-download-and-extract release version os-dir) - (write-to-file version version-file) - )) - )))) + (when (eq? os #f) + (error "Operating system not automatically supported by webui-wire, you can compile it yourself and use 'ww-set-custom-webui-wire-command!'")) + (let ((os-str (symbol->string os)) + (arch-str (symbol->string arch)) + (ext (if (eq? os 'linux) + ".flatpak" + (if (eq? os 'win64) + ".exe" + "")))) + (string-append "https://github.com/hdijkema/webui-wire/releases/download/v" + ww-wire-version "/webui-wire-v" ww-wire-version + "-" os-str "-" arch-str ext) + ) + ) + ) + + ) diff --git a/private/webui-wire-ipc.rkt b/private/webui-wire-ipc.rkt index 166a6fc..ea7e210 100644 --- a/private/webui-wire-ipc.rkt +++ b/private/webui-wire-ipc.rkt @@ -2,6 +2,7 @@ (require "webui-wire-download.rkt" racket/string + racket/system ) (provide webui-ipc) @@ -61,28 +62,32 @@ ) (define (webui-ipc event-queuer log-processor) - (let* ((webui-wire-exe (ww-webui-wire)) - (proc-args (append (list #f #f #f) webui-wire-exe)) - ) + (let ((webui-wire-cmd (ww-get-webui-wire-command))) (call-with-values - (λ () (apply subprocess proc-args)) - (λ (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) + (λ () (process webui-wire-cmd)) + (λ (args) + (let ((process-stdout (car args)) + (process-stdin (cadr args)) + (pid (caddr args)) + (process-stderr (cadddr args)) + (signal-func (car (cddddr args))) + ) + (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)) - ) + (error "Unexpected input from webui-wire executable")) + (let* ((length (string->number str-length)) + (input (read-string length process-stdout)) + ) (read-eol process-stdout) - input))))) - )) + input))))) + ))) )