Refactoring to webui FFI.

info.rkt

@@ -13,7 +13,7 @@
   )
 
 (define deps
-  '("racket/base" "net/http-easy" "file/unzip"))
+  '("racket/base" "net/http-easy" "file/unzip" "gregor" "html-printer"))
 
 (define build-deps
   '("racket-doc"

private/css.rkt

@@ -31,13 +31,15 @@
     (
      [style #:auto #:mutable]
      )
-    #:auto-value (make-hash))
+    #:auto-value (make-hash)
+    #:transparent)
 
   (define-struct css-stylesheet
     (
      [sheet #:auto #:mutable]
      )
-     #:auto-value (make-hashalw))
+     #:auto-value (make-hashalw)
+    #:transparent)
 
   (define st-style style-style)
   (define make-st make-style)

private/web-racket.rkt

@@ -3,7 +3,11 @@
   (require racket/gui
            "web-wire.rkt"
            "css.rkt"
+           "../utils/sprintf.rkt"
            html-printer
+           (prefix-in g: gregor)
+           (prefix-in g: gregor/time)
+           gregor-utils
            )
   
   (provide ww-element%
@@ -50,6 +54,11 @@
          (set! _std_x 50))
        )))
 
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Class representing an element in the HTML page
+  ;;   each element is identified by an id. 
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
   (define ww-element%
     (class object%
       (init-field [win-id #f] [id #f])
@@ -144,32 +153,126 @@
       )
     )
 
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Classes representing different kinds of input/textarea elements in html
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define-syntax inp-set!
+    (syntax-rules ()
+      ((_ var val)
+       (set! var val))))
+  
+
+  ;;;; Generic input
   (define ww-input%
     (class ww-element%
 
+      (define val #f)
+
       (define/public (get)
-        (ww-get-value (send this get-win-id) (send this get-id)))
+        val)
 
       (define/public (set! v)
-        (ww-set-value (send this get-win-id) (send this get-id) v))
+        (inp-set! val v)
+        (ww-set-value (send this get-win-id)
+                      (send this get-id) v))
 
       (define/override (disable)
         (super disable)
-        (ww-set-attr (send this get-win-id) (send this get-id) 'disabled ""))
+        (ww-set-attr (send this get-win-id)
+                     (send this get-id) 'disabled ""))
 
       (define/override (enable)
         (super enable)
-        (ww-del-attr (send this get-win-id) (send this get-id) 'disabled))
+        (ww-del-attr (send this get-win-id)
+                     (send this get-id) 'disabled))
+          
+      (super-new)
+
+      (begin
+        (inp-set! val (ww-get-value (send this get-win-id)
+                                    (send this get-id)))
+        (send this connect 'input (λ (data)
+                                    (inp-set! val (hash-ref data 'value))))
+        (send (send this win) bind 'input (format "#~a" (send this get-id)))
+        )
+      ))
+
+
+  ;;;; Email input
+  (define ww-input-email%
+    (class ww-input%
 
       (super-new)))
 
+  ;;;; Date input
   (define ww-input-date%
     (class ww-input%
 
       (define/override (get)
         (let ((val (super get)))
-          val))
+          (g:parse-date val "yyyy-MM-dd")))
 
+      (define/override (set! d)
+        (when (racket-date? d)
+          (set! (date->moment d)))
+        (unless (or (g:date? d) (g:moment? d) (g:datetime? d))
+          (error "set! - gregor date expected"))
+        (super set! (sprintf "%04d-%02d-%02d" (g:->year d) (g:->month d) (g:->day d)))
+        d)
+
+      (super-new)
+      ))
+
+  ;;;; Time input
+
+  (define ww-input-time%
+    (class ww-input%
+
+      (define/override (get)
+        (let ((val (super get)))
+          (with-handlers ([exn:fail?
+                           (λ (e) (g:parse-time val "HH:mm"))])
+            (g:parse-time val "HH:mm:ss"))))
+
+      (define/override (set! t)
+        (when (racket-date? t)
+          (set! (date->moment t)))
+        (unless (or (g:time? t) (g:datetime? t) (g:moment? t))
+          (error "set! - gregor time?, moment? or datetime? expected"))
+        (super set! (sprintf "%02d:%02d:%02d" (g:->hours t) (g:->minutes t) (g:->seconds t))))
+
+      (super-new)
+      ))
+
+  ;;;;; Date-time local
+  (define ww-input-datetime%
+    (class ww-input%
+
+      (define/override (get)
+        (let ((val (super get)))
+          (with-handlers ([exn:fail?
+                           (λ (e) (g:parse-moment val "yyyy-MM-dd'T'HH:mm:ss"))])
+            (g:parse-moment val "yyyy-MM-dd'T'HH:mm"))))
+
+      (define/override (set! m)
+        (when (racket-date? m)
+          (set! date->moment m))
+        (unless (or (g:datetime? m) (g:moment? m) (g:date? m) (g:time? m))
+          (error "set! - gregor time? , date?, datetime? or moment? expected"))
+        #t)
+
+      (super-new)
+      )
+    )
+
+  ;;;; Range
+  (define ww-input-range%
+    (class ww-input%
+
+      (define/override (get)
+        (let ((val (super get)))
+          val))
       (super-new)
       ))
 
@@ -199,6 +302,7 @@
         (cond
           ([eq? evt 'page-loaded] (send this html-loaded))
           ([eq? evt 'click] (handle-click (car content) (cadr content)))
+          ([eq? evt 'input] (handle-input (car content) (cadr content)))
           ([eq? evt 'change] (handle-change (car content) (cadr content)))
           ([eq? evt 'resized] (let* ((m (regexp-match re-resize content))
                                      (width* (string->number (cadr m)))
@@ -238,6 +342,11 @@
           (unless (eq? el #f)
             (send el callback 'change (hash-ref data 'value)))))
 
+      (define/public (handle-input element-id data)
+        (let ((el (hash-ref elements element-id #f)))
+          (unless (eq? el #f)
+            (send el callback 'input data))))
+
       (define/public (handle-navigate url type kind)
         (let ((method (if (eq? kind 'set-html) 'set-html-file! 'set-url)))
           (cond
@@ -256,10 +365,12 @@
            (cond
              ([eq? type 'text] ww-input%)
              ([eq? type 'date] ww-input-date%)
+             ([eq? type 'datetime-local] ww-input-datetime%)
              (else ww-input%)))
           (else ww-element%)))
 
       (define/public (bind event selector . forced-cl)
+        (ww-debug (format "call to bind ~a ~a ~a" event selector forced-cl))
         (let ((infos (ww-bind win-id event selector)))
           (for-each (λ (info)
                       (let* ((id (car info))
@@ -269,8 +380,10 @@
                         (let ((cl (if (null? forced-cl)
                                       (cl-selector tag type)
                                       (car forced-cl))))
+                          (unless (hash-has-key? elements id)
+                            (hash-set! elements id 'in-the-making)
                             (hash-set! elements id
-                                     (new cl [win-id win-id] [id id])))))
+                                       (new cl [win-id win-id] [id id]))))))
                     infos)))
 
       (define/public (bind-inputs)
@@ -283,8 +396,7 @@
         )
 
       (define/public (element id)
-        (let ((el (hash-ref elements id 'no-element-with-id-in-hash)))
+        (unless (hash-has-key? elements id)
-          (if (eq? el 'no-element-with-id-in-hash)
           (let ((info (ww-element-info win-id id)))
             (let* ((el-id (car info))
                    (tag (cadr info))
@@ -298,7 +410,8 @@
                 (hash-set! elements el-id obj)
                 ))
             (element id))
-              el)))
+          )
+        (hash-ref elements id))
 
       (define/public (get-elements selector)
         (ww-get-elements win-id selector))

private/web-wire.rkt

@@ -11,6 +11,7 @@
            json
            "../utils/utils.rkt"
            "css.rkt"
+           "webui-wire-ffi.rkt"
            )
 
   (provide ww-start
@@ -246,7 +247,7 @@
       ))
   
   (define re-kind #px"([A-Z]+)[(]([0-9]+)[)][:]")
-  (define re-event #px"([^:]+)[:]([0-9]+)([:](.*))?")
+  ;(define re-event #px"([^:]+)[:]([0-9]+)([:](.*))?")
   (define re-js-event #px"^([^:]+)([:](.*))?")
   (define re-js-result #px"([0-9]+)[:]([^:]+)[:](.*)")
   (define re-js-handle #px"([^:]+)[:]([0-9]+)[:]([0-9]+)([:](.*))?")
@@ -272,6 +273,7 @@
                  )
             handle))))
 
+  #|
   (define (ww-start)
     (ww-debug "ww-start called")
 
@@ -433,7 +435,101 @@
   (define (new-handle)
     (set! current-handle (+ current-handle 1))
     current-handle)
+  |#
 
+  (define-struct web-rkt
+    ([handle #:mutable]
+     [event-and-log-thread #:mutable]
+     [stop-thread #:mutable]
+     )
+    )
+
+  (define ww-current-handle #f)
+
+  (define log-fifo (make-queue))
+  (define log-fifo-max 100)
+
+  (define re-event #px"^([^:]+)([:]([^:]+))?")
+  
+  (define (process-event h evt)
+    (let ((m (regexp-match re-event evt)))
+      (displayln evt)
+      (let* ((e (string->symbol (string-downcase (list-ref m 1))))
+             (win-id (if (eq? (list-ref m 3) #f) #f (string->number (list-ref m 3))))
+             (win (hash-ref windows-evt-handlers win-id #f))
+             (payload (substring evt (string-length (list-ref m 0))))
+            )
+        (if (eq? win #f)
+            (displayln (format "no window to handle event ~a" evt))
+            (win e payload)))))
+
+  (define (process-log h kind msg)
+    (unless (< (queue-length log-fifo) log-fifo-max)
+      (dequeue! log-fifo)
+      (process-log h kind msg))
+    (enqueue! log-fifo (cons kind msg)))
+
+  (define (ww-display-log)
+    (for-each (λ (item)
+                   (displayln (format "~a - ~a" (car item) (cdr item))))
+              (queue->list log-fifo)))
+
+  (define (event-and-log-handler h)
+     (parameterize ([current-eventspace (current-eventspace)])
+       (let ((ww-h (web-rkt-handle h)))
+         (thread
+          (lambda ()
+            (letrec ((f (lambda ()
+                          (let* ((count (webwire-items ww-h))
+                                 (item (if (= count 0)
+                                           '(null)                ; If we know the count to be 0, we don't wait on a semaphore in the C library (will block racket).
+                                           (webwire-get ww-h)))
+                                 (info (car item)))
+                            (cond
+                              ([eq? info 'invalid-handle]
+                               'invalid-handle)
+                              ([eq? info 'null]
+                               (sleep 0.1) ; give others room to do something
+                               (f))
+                              ([eq? info 'event]
+                               (begin
+                                 (process-event h (cadr item))
+                                 (f)))
+                              ([eq? info 'log]
+                               (begin
+                                 (process-log h (caddr item) (cadddr item))
+                                 (f)))
+                              )
+                            )))
+                     )
+              (f))
+            ))
+         ))
+    )
+
+  (define (ww-start)
+    (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)
+                              #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-and-log-handler h)))
+            (set-web-rkt-event-and-log-thread! h thrd)
+            (set! ww-current-handle h)))))
+    ww-current-handle)
+
+  (define (ww-stop)
+    (unless (eq? ww-current-handle #f)
+      (webwire-destroy (web-rkt-handle ww-current-handle))
+      (set! ww-current-handle #f)))
+
+  #|
   (define (do-cmd cmd)
     (if (eq? ww-to-ww #f)
         (ww-error
@@ -443,7 +539,64 @@
           (flush-output ww-to-ww))
         )
     )
+  |#
 
+  (define-struct cmdr
+    (ok kind win r))
+
+  (define (cmdr->list r)
+    (list (cmdr-ok r) (cmdr-kind r)
+          (cmdr-win r) (cmdr-r r)))
+
+  (define (cmdr-dbg r)
+    (displayln (cmdr->list r)))
+
+
+  (define re-generic-result #px"^(OK|NOK)[:]([^:]+)([:]([0-9]+))?")
+
+  (define (convert-result result)
+    (let ((m (regexp-match re-generic-result result)))
+      (displayln result)
+      (displayln m)
+      (if m
+          (let* ((ok (string=? (list-ref m 1) "OK"))
+                 (kind (list-ref m 2))
+                 (win (if (eq? (list-ref m 4) #f)
+                          #f
+                          (string->number (list-ref m 4))))
+                 (r (substring result (string-length (list-ref m 0))))
+                 )
+            (make-cmdr ok (string->symbol kind)
+                       win
+                       (if (string-prefix? r ":")
+                           (substring r 1)
+                           r)))
+          (make-cmdr #f 'parse-error #f result))
+      )
+    )
+
+  (define (check-nok cmd r)
+    (when (eq? (cmdr-ok r) #f)
+      (process-log ww-current-handle 'CMD-NOK
+                   (format "~a - ~a" cmd (cmdr->list r)))))
+
+  
+  (define (ww-cmd 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)
+            (set! ww-quit #t)
+            r))
+        (let ((result (webwire-command (web-rkt-handle ww-current-handle) cmd)))
+          (let ((r (convert-result result)))
+            (check-nok cmd r)
+            r))))
+
+
+  (define ww-await (lambda x #t))
+  #|
 
   (define (ww-cmd cmd)
     (if (eq? cmd 'quit)
@@ -493,7 +646,9 @@
         )
     )
 
-  (define (ww-await handle cmd)
+  |#
+
+  #|(define (ww-await handle cmd)
     (hash-set! handle-semaphores handle (make-semaphore 0))
     (hash-set! handle-results handle #f)
     (let* ((r (ww-cmd cmd))
@@ -514,20 +669,21 @@
           )
       )
     )
+  |#
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; Web Wire Commands
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   ;; Stop the QtWebEngine
-  (define (ww-stop)
+ ; (define (ww-stop)
-    (ww-debug "ww-stop called")
+ ;   (ww-debug "ww-stop called")
-    (let ((win-ids (hash-keys windows-evt-handlers)))
+ ;   (let ((win-ids (hash-keys windows-evt-handlers)))
-      (for-each (λ (win-id)
+ ;     (for-each (λ (win-id)
-                  (ww-close win-id))
+ ;                 (ww-close win-id))
-                win-ids))
+ ;               win-ids))
-    (let ((r (ww-cmd 'quit)))
+ ;   (let ((r (ww-cmd 'quit)))
-      (car r)))
+ ;     (car r)))
 
   ;; Global stylesheet
   (define (ww-set-stylesheet st)
@@ -545,7 +701,7 @@
   (define (ww-get-stylesheet)
     (let ((cmd (format "get-stylesheet")))
       (let ((r (ww-cmd cmd)))
-        (displayln r)
+        (cmdr-dbg r)
         #t)))
   
   ;; Debug window
@@ -562,24 +718,19 @@
                                   (format " ~a" (car parent)))))
            (cmd (string-append "new " (format "~a" profile) parent-win-id))
            (r (ww-cmd cmd)))
-      (let ((ok (car r))
+      (let ((ok (cmdr-ok r))
-            (res (cdr r)))
+            (win-id (cmdr-win r)))
-        (if ok
+        win-id)))
-            (let* ((win-str-id (drop "new" res))
-                   (win-id (if (eq? win-str-id #f) #f (string->number win-str-id)))
-                   )
-              win-id)
-            #f))))
 
   ;; Close window
   (define (ww-close win-id)
     (let ((r (ww-cmd (format "close ~a" win-id))))
-      (car r)))
+      r))
 
   ;; Move window
   (define (ww-move win-id x y)
     (let ((r (ww-cmd (format "move ~a ~a ~a" win-id x y))))
-      (car r)))
+      r))
 
   ;; Resize window
   (define (ww-resize win-id width height)
@@ -589,7 +740,7 @@
   ;; Set title of window
   (define (ww-set-title win-id title)
     (let ((r (ww-cmd (format "set-title ~a ~a" win-id (as-string title)))))
-      (car r)))
+      r))
 
 
   ;; Set icon of window
@@ -599,7 +750,7 @@
                (cmd (format "set-icon ~a ~a"
                                     win-id (as-string (format "~a" icon-file))))
                (r (ww-cmd cmd)))
-          (car r))
+          r)
         (error "ww-set-icon - file does not exist")))
 
   ;; Set menu of window
@@ -726,70 +877,71 @@
             (car r)))))
     )
 
+  (define (new-handle)
+    #t)
 
   ;; set url
   (define (ww-set-url win-id url)
-    (let ((cmd (format "set-url ~a ~a ~a"
+    (let ((cmd (format "set-url ~a ~a"
-                       win-id (new-handle) (as-string url))))
+                       win-id (as-string url))))
       (ww-cmd cmd)))
   
 
   ;; Set html of window
   (define (ww-set-html win-id html-file)
     (if (file-exists? html-file)
-        (let ((cmd (format "set-html ~a ~a ~a"
+        (let ((cmd (format "set-html ~a ~a"
-                           win-id (new-handle)
+                           win-id 
                            (as-string (to-server-file html-file)))))
           (let ((r (ww-cmd cmd)))
-            (car r)))
+            r))
         (error "set-html: file does not exist")
         ))
 
   ;; Set inner html of an Id of the HTML in the window
   (define (ww-set-inner-html win-id element-id html-or-file)
     (if (file-exists? html-or-file)
-        (let* ((js-handle (new-handle))
+        (let* ((cmd (format "set-inner-html ~a ~a ~a"
-               (cmd (format "set-inner-html ~a ~a ~a ~a"
+                            win-id 
-                            win-id js-handle
                             (format "~a" element-id)
                             (as-string (to-server-file html-or-file))))
                )
-          (ww-await js-handle cmd))
+          (ww-cmd cmd))
-        (let* ((js-handle (new-handle))
+        (let* ((cmd (format "set-inner-html ~a ~a ~a"
-               (cmd (format "set-inner-html ~a ~a ~a ~a"
+                            win-id 
-                            win-id js-handle
                             (format "~a" element-id)
                             (as-string (format "~a" html-or-file))))
                )
-          (ww-await js-handle cmd))
+          (ww-cmd cmd))
         ))
 
   ;; Het the inner html of an id of the HTML in the window
   (define (ww-get-inner-html win-id element-id)
-    (let* ((js-handle (new-handle))
+    (let* ((cmd (format "get-inner-html ~a ~a"
-           (cmd (format "get-inner-html ~a ~a ~a"
+                        win-id (format "~a" element-id)))
-                        win-id js-handle (format "~a" element-id)))
            )
-      (ww-await js-handle cmd)))
+      (ww-cmd cmd)))
 
   ;; Set attribute of element in html
   (define (ww-set-attr win-id element-id attr val)
-    (let* ((js-handle (new-handle))
+    (let* ((cmd (format "set-attr ~a ~a ~a ~a" win-id 
-           (cmd (format "set-attr ~a ~a ~a ~a ~a" win-id js-handle
+                        (as-string element-id)
-                        (as-string element-id) (as-string attr) (as-string val))))
+                        (as-string attr) (as-string val))))
-      (displayln cmd)
       (ww-cmd cmd)))
 
   ;; Get attribute value of element in html
   (define (ww-get-attr win-id element-id attr)
-    (let* ((js-handle (new-handle))
+    (let* ((cmd (format "get-attr ~a ~a ~a" win-id 
-           (cmd (format "get-attr ~a ~a ~a ~a" win-id js-handle
                         (as-string element-id) (as-string attr))))
-      (ww-await js-handle cmd)))
+      (ww-cmd cmd)))
-
   
   ;; Get all attributes of an element with given id
   (define (mk-attrs _attrs)
+    (let* ((r (cmdr-r _attrs))
+           (rr (hash-ref 'result
+                         (with-input-from-string
+                             (string-replace r "\\\"" "\"")
+                           read-json))))
       (let* ((attrs (make-hash)))
         (for-each (λ (attr-val)
                     (hash-set! attrs
@@ -797,13 +949,12 @@
                                (cadr attr-val)))
                   _attrs)
         attrs)
-    )
+    ))
   
   (define (ww-get-attrs win-id element-id)
-    (let* ((js-handle (new-handle))
+    (let* ((cmd (format "get-attrs ~a ~a" win-id 
-           (cmd (format "get-attrs ~a ~a ~a" win-id js-handle
                         (as-string element-id))))
-      (mk-attrs (ww-await js-handle cmd))))
+      (mk-attrs (ww-cmd cmd))))
 
   ;; Get info of all elements for a selector
   (define (ww-get-elements win-id selector)
@@ -814,7 +965,7 @@
              (cons (string->symbol (car item))
                    (mk-attrs (cadr item)))
              )
-           (ww-await js-handle cmd))))
+           (ww-cmd cmd))))
 
   ;; Delete attribute of element
   (define (ww-del-attr win-id element-id attr)
@@ -847,6 +998,7 @@
     (let* ((js-handle (new-handle))
            (cmd (format "bind ~a ~a ~a ~a" win-id js-handle
                        (as-string event) (as-string selector))))
+      (ww-debug cmd)
       (map (lambda (info)
              (map string->symbol info))
              (ww-await js-handle cmd))))

private/webui-wire-ffi.rkt

@@ -0,0 +1,183 @@
+#lang racket/base
+
+(require ffi/unsafe
+         ffi/unsafe/define
+         ffi/unsafe/atomic
+         setup/dirs
+         "../utils/utils.rkt"
+         (prefix-in g: racket/gui)
+         )
+
+(provide webwire-new
+         webwire-current
+         webwire-destroy
+         webwire-command
+         webwire-items
+         webwire-get
+         webwire-status
+         webwire-status->string
+         )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Handle finalization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define webwire-will (make-will-executor))
+(void (thread (λ () (let loop () (will-execute webwire-will) (loop)))))
+
+
+(define-ffi-definer define-libwebui-wire
+  (ffi-lib "c:/devel/racket/webui-wire/build/Debug/libwebui-wire.dll"
+           #:custodian (current-custodian)))
+  ;(ffi-lib "libwebui-wire" '("3" "4" "5" #f)
+  ;         #:get-lib-dirs (lambda ()
+  ;                          (cons (build-path ".") (get-lib-search-dirs)))
+  ;         #:fail (lambda ()
+  ;                  (ffi-lib (get-lib-path "libwebui-wire.dll")))
+  ;         ))
+
+(define-cpointer-type _webui-handle #:tag 'webui-handle)
+;(define _webui-handle _pointer)
+
+(define _webui-get-result
+ (_enum '(null = 0
+          event
+          log
+          invalid-handle = 256
+          )))
+
+(define _webui-handle-status
+  (_enum '(valid = 1
+           handle-destroyed
+           handle-needs-destroying
+           null-handle
+           existing-handle-destroy-this-one
+           handle-invalid-unexpected
+           )))
+
+(define-libwebui-wire webwire-new
+  (_fun -> (handle : _webui-handle/null)
+        -> (begin
+             (unless (eq? handle #f)
+               (will-register webwire-will
+                            handle (λ (handle)
+                                     (webwire-destroy handle))))
+             handle))
+  #:c-id webwire_new)
+
+(define-libwebui-wire webwire-current
+  (_fun -> (handle : _webui-handle/null)
+        -> (begin
+             (unless (eq? handle #f)
+               (will-register webwire-will
+                            handle (λ (handle)
+                                     (webwire-destroy handle))))
+             handle))
+  #:c-id webwire_current)
+
+(define-libwebui-wire webwire-destroy
+  (_fun _webui-handle/null -> _void)
+  #:c-id webwire_destroy)
+
+(define-libwebui-wire webwire-command
+  (_fun _webui-handle/null _string/utf-8
+        -> [r : _string/utf-8]
+        -> r
+        )
+  #:c-id webwire_command)
+
+(define-libwebui-wire webwire-items
+  (_fun _webui-handle/null -> _uint)
+  #:c-id webwire_items)
+
+(define-libwebui-wire webwire-get
+  (_fun _webui-handle/null
+        [evt : (_ptr o _string/utf-8)]
+        [kind : (_ptr o _string/utf-8)]
+        [msg : (_ptr o _string/utf-8)]
+        -> [ result : _webui-get-result ]
+        -> (list result
+                 evt
+                 kind
+                 msg)
+        )
+  #:c-id webwire_get)
+
+#|
+                 (if (eq? evt #f)
+                     #f
+                     (cast evt _pointer _string/utf-8))
+                 (if (eq? kind #f)
+                     #f
+                     (string->symbol
+                      (cast kind _pointer _string/utf-8)))
+                 (if (eq? msg #f)
+                     #f
+                     (cast msg _pointer _string/utf-8))
+                 )
+|#
+
+(define-libwebui-wire webwire-status
+  (_fun _webui-handle/null -> _webui-handle-status)
+  #:c-id webwire_status
+  )
+
+(define-libwebui-wire webwire-status->string
+  (_fun _webui-handle-status
+        -> (r : _string/utf-8)
+        -> r)
+  #:c-id webwire_status_string)
+
+
+
+
+
+
+;(define (webwire-new evt-cb log-cb)
+;  (parameterize ([g:current-eventspace (g:current-eventspace)])
+;    (let ((evtcb (lambda (msg)
+;                   (g:queue-callback (lambda () (evt-cb msg)))))
+;          (logcb  (lambda (k m)
+;                    (g:queue-callback (lambda () (log-cb k m)))))
+;          )
+;      (webwire_new evtcb logcb))))
+
+(define last-evt #f)
+
+(define (evt msg)
+  (displayln msg)
+  (set! last-evt msg))
+
+(define last-log #f)
+
+(define (log k m)
+  (let ((msg (format "~a ~a" k m)))
+    (displayln msg)
+    (set! last-log msg)))
+
+(define (reader h)
+  (let ((l (webwire-get 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)
+            (displayln (format "EVENT:~a" evt)))
+          (unless (eq? kind #f)
+            (displayln (format "~a:~a" kind msg)))
+          (reader h)))
+      result)))
+  
+(define (reader-thread h)
+    (thread (lambda ()
+              (letrec ((f (lambda ()
+                            (let ((r (reader h)))
+                              (sleep 0.01);
+                              ;(displayln r)
+                              (if (eq? r 'invalid-handle)
+                                  r
+                                  (f))))))
+                (f)))))
+

utils/sprintf.rkt

@@ -0,0 +1,114 @@
+(module sprintf racket/base
+
+  (require racket/format
+           racket/string
+           )
+
+  (provide sprintf
+           sprintf*
+           )
+
+  (define re-format
+    #px"([^%]*)[%]([0-]{0,1})([1-9][0-9]*|[*]){0,1}([.]([0-9]+|[*])){0,1}(l*)([%dfsx])")
+
+  (define-syntax shift
+    (syntax-rules ()
+      ((_ args)
+       (let ((first (car args)))
+         (set! args (cdr args))
+         first))))
+
+  (define (format-part zeros adjust-width precision kind arg)
+    (if (number? arg)
+        (let* ((pad-str (if (eq? zeros #f) " "
+                            (if (string=? zeros "0")
+                                "0"
+                                " ")))
+               (adjust   (if (eq? zeros #f) 'right
+                             (if (string=? zeros "-") 'left 'right)))
+               (min-width (if (eq? adjust-width #f) 1 adjust-width))
+               (precision (if (eq? precision #f) 0
+                              (if (eq? kind 'd)
+                                  0
+                                  precision)))
+               (base (if (eq?  kind 'x) 16 10))
+               )
+          (when (eq? kind 's)
+            (error "argument is a number, but string expected"))
+          (let ((r (~r arg #:pad-string pad-str #:min-width min-width #:precision precision #:base base)))
+            (if (eq? adjust 'left)
+                (let ((r-trim (string-trim r)))
+                  (string-append r-trim
+                                 (make-string
+                                  (- (string-length r) (string-length r-trim))
+                                   #\space)))
+                r)))
+        (let* ((pad-str (if (string=? zeros "") " " zeros))
+               (min-width (if (eq? adjust-width #f) 0 adjust-width))
+               (max-width (if (eq? precision #f) +inf.0 precision))
+               (adjust (if (eq? zeros #f) 'left
+                           (if (string=? zeros "-") 'left 'right)))
+               )
+          (unless (eq? kind 's)
+            (error "argument is a string, but a number is expected"))
+          (~a arg #:pad-string pad-str #:min-width min-width #:max-width max-width #:align adjust))
+        )
+    )
+
+  (define-syntax fmt
+    (syntax-rules ()
+      ((_ a ...)
+       (format a ...))))
+  
+  (define (do-format format args)
+    (if (null? args)
+        (let ((m (regexp-match re-format format)))
+          (unless (eq? m #f)
+            (error (fmt "formatting left, but no arguments left: ~a" format)))
+          format)
+        (let ((m (regexp-match re-format format)))
+          (when (eq? m #f)
+            (error (fmt "arguments left, but no formatting left: ~a" format)))
+          (let* ((matched-length (string-length (list-ref m 0)))
+                 (prefix (list-ref m 1))
+                 (zeros (list-ref m 2))
+                 (adjust-width (list-ref m 3))
+                 (precision (list-ref m 5))
+                 (long (list-ref m 6))
+                 (kind (string->symbol (list-ref m 7)))
+                 )
+            (unless (eq? adjust-width #f)
+              (set! adjust-width (if (string=? adjust-width "*")
+                                     (let ((n (shift args)))
+                                       (when (null? args)
+                                         (error "* requires >= 2 arguments left"))
+                                       (unless (number? n)
+                                         (error "* requires a number?"))
+                                       n)
+                                     (string->number adjust-width))))
+            (unless (eq? precision #f)
+              (set! precision (if (string=? precision "*")
+                                  (let ((n (shift args)))
+                                    (when (null? args)
+                                      (error "* requires >= 2 arguments left"))
+                                    (unless (number? n)
+                                      (error "* requires a number?"))
+                                    n)
+                                  (string->number precision))))
+            (string-append prefix
+                           (if (eq? kind '%)
+                               "%"
+                               (format-part zeros adjust-width precision kind (shift args)))
+                           (do-format (substring format matched-length) args))))
+        )
+    )
+                                     
+  
+  (define (sprintf format . args)
+    (do-format format args))
+
+  (define (sprintf* format args)
+    (do-format format args))
+    
+  
+  ) ; end of module