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

Refactoring to webui FFI.

Browse Source
This commit is contained in:
Hans Dijkema
2025-09-05 11:49:40 +02:00
parent 74295f7d7e
commit 12e9d3ad94
7 changed files with 644 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
private/css.rkt
View File

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

159
private/web-racket.rkt
View File

@@ -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))))
(hash-set! elements id
(new cl [win-id win-id] [id id])))))
(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]))))))
infos)))
(define/public (bind-inputs)
@@ -283,22 +396,22 @@
)
(define/public (element id)
(let ((el (hash-ref elements id 'no-element-with-id-in-hash)))
(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))
(type (caddr info))
(exist (cadddr info))
)
(unless exist
(ww-debug (format "Element ~a does not exist!" id)))
(let* ((cl (cl-selector tag type))
(obj (new cl [win-id win-id] [id id])))
(hash-set! elements el-id obj)
))
(element id))
el)))
(unless (hash-has-key? elements id)
(let ((info (ww-element-info win-id id)))
(let* ((el-id (car info))
(tag (cadr info))
(type (caddr info))
(exist (cadddr info))
)
(unless exist
(ww-debug (format "Element ~a does not exist!" id)))
(let* ((cl (cl-selector tag type))
(obj (new cl [win-id win-id] [id id])))
(hash-set! elements el-id obj)
))
(element id))
)
(hash-ref elements id))
(define/public (get-elements selector)
(ww-get-elements win-id selector))

260
private/web-wire.rkt
View File

@@ -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)
(ww-debug "ww-stop called")
(let ((win-ids (hash-keys windows-evt-handlers)))
(for-each (λ (win-id)
(ww-close win-id))
win-ids))
(let ((r (ww-cmd 'quit)))
(car r)))
; (define (ww-stop)
; (ww-debug "ww-stop called")
; (let ((win-ids (hash-keys windows-evt-handlers)))
; (for-each (λ (win-id)
; (ww-close win-id))
; win-ids))
; (let ((r (ww-cmd 'quit)))
; (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))
(res (cdr r)))
(if ok
(let* ((win-str-id (drop "new" res))
(win-id (if (eq? win-str-id #f) #f (string->number win-str-id)))
)
win-id)
#f))))
(let ((ok (cmdr-ok r))
(win-id (cmdr-win r)))
win-id)))
;; 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"
win-id (new-handle) (as-string url))))
(let ((cmd (format "set-url ~a ~a"
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"
win-id (new-handle)
(let ((cmd (format "set-html ~a ~a"
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))
(cmd (format "set-inner-html ~a ~a ~a ~a"
win-id js-handle
(let* ((cmd (format "set-inner-html ~a ~a ~a"
win-id
(format "~a" element-id)
(as-string (to-server-file html-or-file))))
)
(ww-await js-handle cmd))
(let* ((js-handle (new-handle))
(cmd (format "set-inner-html ~a ~a ~a ~a"
win-id js-handle
(ww-cmd cmd))
(let* ((cmd (format "set-inner-html ~a ~a ~a"
win-id
(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))
(cmd (format "get-inner-html ~a ~a ~a"
win-id js-handle (format "~a" element-id)))
(let* ((cmd (format "get-inner-html ~a ~a"
win-id (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))
(cmd (format "set-attr ~a ~a ~a ~a ~a" win-id js-handle
(as-string element-id) (as-string attr) (as-string val))))
(displayln cmd)
(let* ((cmd (format "set-attr ~a ~a ~a ~a" win-id
(as-string element-id)
(as-string attr) (as-string val))))
(ww-cmd cmd)))
;; Get attribute value of element in html
(define (ww-get-attr win-id element-id attr)
(let* ((js-handle (new-handle))
(cmd (format "get-attr ~a ~a ~a ~a" win-id js-handle
(let* ((cmd (format "get-attr ~a ~a ~a" win-id
(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))
(cmd (format "get-attrs ~a ~a ~a" win-id js-handle
(let* ((cmd (format "get-attrs ~a ~a" win-id
(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))))

183
private/webui-wire-ffi.rkt Normal file
View File

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