Racket integration

Signed-off-by: Hans Dijkema <hans@dijkewijk.nl>

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)

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 (webui-ipc event-queuer process-log)
-        (let ((h (make-web-rkt (if (eq? existing-h #f)
-                                  (webwire-new)
-                                  existing-h)
                               #f
                               #f
-                              #f)))
+                              #f))
-          (unless (eq? (webwire-status (web-rkt-handle h)) 'valid)
+             (thrd (event-handler h)))
-            (error (format "Invalid handle, cannot start. Reason: ~a"
+        (set-web-rkt-event-thread! h thrd)
-                           (webwire-status->string
+        (set! ww-current-handle h)))
-                            (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))))))
     (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")))
+        (begin
-          (let ((r (convert-result result)))
+          (ww-stop)
-            (check-nok cmd r)
+          #t)
-            (ww-stop)
+        (let ((result ((web-rkt-handle ww-current-handle) cmd)))
-            r))
-        (let ((result (webwire-command (web-rkt-handle ww-current-handle) cmd)))
           (let ((r (convert-result result)))
             (check-nok cmd r)
             r))))

private/webui-wire-download.rkt

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

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