ok

private/css.rkt

@@ -0,0 +1,207 @@
+(module css racket/base
+
+  (require racket/string)
+
+  (provide css-style
+           css-style->list
+
+           set-css!
+           get-css
+           clear-css!
+           css-keys
+
+           css-style?
+
+           string->css-style
+           css-style->string
+
+           stylesheet
+           stylesheet?
+           
+           stylesheet-set!
+           stylesheet-get
+           stylesheet-clear!
+           stylesheet-keys
+
+           stylesheet->string
+           string->stylesheet
+           )
+
+  (define-struct style
+    (
+     [style #:auto #:mutable]
+     )
+    #:auto-value (make-hash))
+
+  (define-struct css-stylesheet
+    (
+     [sheet #:auto #:mutable]
+     )
+     #:auto-value (make-hashalw))
+
+  (define st-style style-style)
+  (define make-st make-style)
+  (define st? style?)
+  (define stylesheet? css-stylesheet?)
+  (define make-stylesheet make-css-stylesheet)
+  (define stylesheet-sheet css-stylesheet-sheet)
+  
+  
+  (define (css-style style_or_styles . args)
+    (if (symbol? style_or_styles)
+        (let ((css (if (null? args) "" (car args)))
+              (st (make-st)))
+          (hash-set! (st-style st) style_or_styles css)
+          st)
+        (let* ((st (make-st))
+               (h (st-style st)))
+          (for-each (lambda (st)
+                      (let ((entry (car st))
+                            (css (cadr st)))
+                        (hash-set! h entry css)))
+                    style_or_styles)
+          st)))
+
+  (define (set-css! st entry css)
+    (hash-set! (st-style st) entry css)
+    st)
+
+  (define (get-css st entry)
+    (hash-ref (st-style st) entry ""))
+
+  (define (clear-css! st entry)
+    (hash-remove! (st-style st) entry))
+
+  (define (css-style? st)
+    (st? st))
+
+  (define (css-keys st)
+    (hash-keys (st-style st)))
+
+  (define (css-style->list st)
+    (let* ((h (st-style st))
+           (keys (hash-keys h)))
+      (map (lambda (k)
+             (list k (hash-ref h k)))
+           keys)))
+
+  (define (css-style->string st . custom-sep)
+    (let* ((sep (if (null? custom-sep) " " (car custom-sep)))
+           (h (st-style st))
+           (keys (hash-keys h)))
+      (letrec ((f (lambda (keys)
+                    (if (null? keys)
+                        ""
+                        (let ((key (car keys)))
+                          (string-append (symbol->string key)
+                                         ": "
+                                         (hash-ref h key)
+                                         ";"
+                                         sep
+                                         (f (cdr keys))))
+                        ))
+                  ))
+        (string-trim (f keys)))))
+
+
+  (define re-style-split #px"\\s*[;]\\s*")
+  (define re-style-kv-split #px"\\s*[:]\\s*")
+  
+  (define (split-style-string style)
+    (let ((sp-style (regexp-split re-style-split style)))
+      (letrec ((f (lambda (entries)
+                    (if (null? entries)
+                        '()
+                        (let* ((entry (string-trim (car entries)))
+                               (kv (regexp-split re-style-kv-split entry))
+                               (key (car kv))
+                               (skey (if (string? key)
+                                         (string->symbol key)
+                                         key))
+                               (val (if (= (length kv) 2) (cadr kv) ""))
+                               (keyval (list skey val))
+                               )
+                          (if (string=? entry "")
+                              (f (cdr entries))
+                              (cons keyval (f (cdr entries)))))
+                        ))
+                  ))
+        (f sp-style))))
+
+
+  
+  (define (string->css-style style-str)
+    (css-style (split-style-string style-str)))
+
+
+  (define (stylesheet entry_or_entries . style)
+    (if (symbol? entry_or_entries)
+        (let* ((st (car style))
+               (ss (make-stylesheet))
+               (h (stylesheet-sheet ss)))
+          (if (css-style? st)
+              (begin
+                (hash-set! h entry_or_entries st)
+                ss)
+              (error "A css-style is expected")))
+        (let* ((ss (make-stylesheet))
+               (h (stylesheet-sheet ss)))
+          (for-each (lambda (entry)
+                      (let* ((key (car entry))
+                             (s (cadr entry)))
+                        (if (css-style? s)
+                            (hash-set! h key s)
+                            (error (format "A css-style is expected for ~a"
+                                           key)))
+                        ))
+                    entry_or_entries)
+          ss)))
+
+  (define (string->stylesheet str)
+    (error "Not implemented yet")
+    #t)
+
+  (define (stylesheet-entry->string e)
+    (if (list? e)
+        (if (null? e)
+            ""
+            (string-append (stylesheet-entry->string (car e))
+                           " "
+                           (stylesheet-entry->string (cdr e))))
+        (format "~a" e)))
+
+  (define (stylesheet->string ss)
+    (let* ((h (stylesheet-sheet ss))
+           (keys (hash-keys h))
+           (sep "\n"))
+      (letrec ((f (lambda (keys)
+                    (if (null? keys)
+                        ""
+                        (let* ((key (car keys))
+                               (st (hash-ref h key)))
+                          (string-append (stylesheet-entry->string key) " {\n  "
+                                         (css-style->string  st "\n  ")
+                                         "\n}\n"
+                                         (f (cdr keys))))))
+                  ))
+        (f keys))))
+
+  (define (stylesheet-set! ss key style)
+    (let ((h (stylesheet-sheet ss)))
+      (hash-set! h key style)
+      ss))
+
+  (define (stylesheet-get ss key)
+    (let ((h (stylesheet-sheet ss)))
+      (hash-ref h key (make-st))))
+
+  (define (stylesheet-clear! ss key)
+    (let ((h (stylesheet-sheet ss)))
+      (hash-remove! h key)))
+
+  (define (stylesheet-keys ss)
+    (let ((h (stylesheet-sheet ss)))
+      (hash-keys h)))
+  
+  
+  ); end of module

private/web-wire.rkt

@@ -7,10 +7,11 @@
            file/unzip
            net/url
            racket/port
-           roos
            data/queue
            json
            "../utils/utils.rkt"
+           "css.rkt"
+           html-printer
            )
 
   (provide ww-start
@@ -22,8 +23,6 @@
            ww-resize
            ww-set-title
            ww-set-icon
-
-           
    )
 
   (define current-win-release "https://github.com/hdijkema/web-wire/releases/download/0.1/web-wire-0.1-win64.zip")
@@ -127,21 +126,34 @@
   (define ww-quit #f)
 
   (define ww-debug #f)
-  (define (ww-set-debug yn)
-    (set! ww-debug yn))
   
-  (define (debug str)
+  (define (ww-set-debug yn) (set! ww-debug yn))
+
+  (define (do-debug str . var)
     (when ww-debug
-      (displayln str)))
+      (if (null? var)
+          (displayln (format "Debug: ~a" str))
+          (displayln (format "Debug: ~a: ~a" var str))
+          )))
 
   (define (err str)
     (displayln (format "Error: ~a" str)))
 
+  (define-syntax debug
+    (syntax-rules ()
+      ((_ str)
+       (do-debug str))
+      ((_ var str)
+       (do-debug str 'var))
+      ))
+  
   (define re-kind #px"([A-Z]+)[(]([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]+)([:](.*))?")
 
+  (define windows-evt-handlers (make-hash))
   (define windows (make-hash))
 
   (define handle-results (make-hash))
@@ -164,23 +176,38 @@
     (define protocol-version 0)
 
     (define (handle-event line)
+      (debug (format "Handling ~a" line))
       (let ((m (regexp-match re-event line)))
         (if (eq? m #f)
             (err (format "Cannot interpret input: ~a" line))
-            (let* ((evt (string->symbol (cadr m)))
+            (let* ((str-evt (cadr m))
+                   (evt (string->symbol str-evt))
                    (win-id (string->number (caddr m)))
                    (content (car (cddddr m)))
-                   (win (hash-ref windows win-id #f))
+                   (win* (hash-ref windows-evt-handlers win-id #f))
+                   (win (if (eq? win* #f) #f (weak-box-value win*)))
                    )
+              ;(debug content content)
               (unless (or (eq? evt 'closed) (eq? evt 'js-result))
                 (if (eq? win #f)
                     (begin
                       (err (format "No such window ~a" win-id))
-                      (err (format "Cannot handle event '~a" evt))
+                      (err (format "Cannot handle event '~a " evt))
                       (err (format "input: ~a" line))
                       )
-                    (queue-callback (lambda ()
+                    (if (string-prefix? str-evt "js-")
-                                      (win evt content)))
+                        (let* ((evt (string->symbol (substring str-evt 3)))
+                               (m (regexp-match re-js-event content))
+                               (element-id (string->symbol (cadr m)))
+                               (content (string-trim (cadddr m)))
+                               (h  (with-input-from-string content read-json))
+                               (data (if (string=? content "")
+                                         ""
+                                         (hash-ref h 'data #f)))
+                               )
+                          (queue-callback (lambda ()
+                                            (win 'js evt (list element-id data)))))
+                        (queue-callback (lambda () (win 'other evt content))))
                     ))
               (when (eq? evt 'js-result)
                 (let ((m (regexp-match re-js-result content)))
@@ -189,19 +216,13 @@
                       (let* ((handle (string->number (cadr m)))
                              (func (caddr m))
                              (content (cadddr m))
-                             (data (with-input-from-string
+                             (data (with-input-from-string content read-json))
-                                       (with-input-from-string
+                             (result (hash-ref data 'result))
-                                           content read-json)
-                                     read-json))
                              )
-                        ;(displayln handle)
-                        ;(displayln func)
-                        ;(displayln content)
-                        ;(displayln data)
                         (if (hash-has-key? handle-results handle)
                             (begin
                               ; a result is expected
-                              (hash-set! handle-results handle data)
+                              (hash-set! handle-results handle result)
                               (semaphore-post (hash-ref handle-semaphores handle)))
                             (debug (format "not awaiting ~a: ~a" handle content)))
                         )
@@ -209,7 +230,7 @@
               (when (eq? evt 'closed)
                 (if (eq? win #f)
                     (err (format "No such window ~a, cannot close" win-id))
-                    (hash-remove! windows win-id)))
+                    (hash-remove! windows-evt-handlers win-id)))
               ))
         ))
 
@@ -233,7 +254,11 @@
                          (set! more-lines (- more-lines 1))
                          ))
                    (cond
-                     ([eq? kind 'EVENT] (handle-event rest))
+                     ([eq? kind 'EVENT]
+                      (with-handlers ([exn:fail?
+                                       (lambda (e) (err (format "~a" e)))])
+                                      (handle-event rest))
+                      )
                      (else (debug (format "~a(~a):~a" kind lines rest)))
                      ))
                  ))
@@ -333,28 +358,25 @@
     )
 
   (define (ww-await handle cmd)
-    (call/cc (lambda (continuation)
+    (hash-set! handle-semaphores handle (make-semaphore 0))
-               (hash-set! handle-semaphores handle (make-semaphore 0))
+    (hash-set! handle-results handle #f)
-               (hash-set! handle-results handle #f)
+    (let* ((r (ww-cmd cmd))
-               (let* ((r (ww-cmd cmd))
+           (result (car r))
-                      (result (car r))
+           (content (cdr r))
-                      (content (cdr r))
+           )
-                      )
+      (if r
-                 (if r
+          (begin
-                     (begin
+            (semaphore-wait (hash-ref handle-semaphores handle))
-                       (semaphore-wait (hash-ref handle-semaphores handle))
+            (hash-remove! handle-semaphores handle)
-                       (hash-remove! handle-semaphores handle)
+            (let ((r (hash-ref handle-results handle)))
-                       (let ((r (hash-ref handle-results handle)))
+              (hash-remove! handle-results handle)
-                         (hash-remove! handle-results handle)
+              r))
-                         (continuation r)))
+          (begin
-                     (begin
+            (hash-remove! handle-semaphores handle)
-                       (hash-remove! handle-semaphores handle)
+            (hash-remove! handle-results handle)
-                       (hash-remove! handle-results handle)
+            #f)
-                       (continuation #f))
+          )
-                     )
+      )
-                 )
-               )
-             )
     )
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -363,6 +385,10 @@
 
   ;; Stop the QtWebEngine
   (define (ww-stop)
+    (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)))
 
@@ -594,8 +620,30 @@
   ;; 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" win-id js-handle
+           (cmd (format "get-attr ~a ~a ~a ~a" win-id js-handle
+                        (as-string element-id) (as-string attr))))
+      (ww-await js-handle cmd)))
+
+  ;; Delete attribute of element
+  (define (ww-del-attr win-id element-id attr)
+    (let* ((js-handle (new-handle))
+           (cmd (format "del-attr ~a ~a ~a" win-id js-handle
                         (as-string element-id))))
+      (ww-cmd cmd)))
+
+  ;; get value of an element
+  (define (ww-get-value win-id element-id)
+    (let* ((js-handle (new-handle))
+           (cmd (format "value ~a ~a ~a" win-id js-handle
+                        (as-string element-id))))
+      (ww-await js-handle cmd)))
+
+  ;; set value of an element
+  (define (ww-set-value win-id element-id val)
+    (let* ((js-handle (new-handle))
+           (cmd (format "value ~a ~a ~a ~a" win-id js-handle
+                        (as-string element-id)
+                        (as-string val))))
       (ww-await js-handle cmd)))
   
 
@@ -627,8 +675,9 @@
   ;; Has a class
   (define re-class-split #px"\\s+")
   
-  (define (ww-has-class? win-id element-id class)
+  (define (ww-has-class? win-id element-id class*)
-    (let ((cl (ww-get-attr win-id element-id "class")))
+    (let* ((cl (string-trim (ww-get-attr win-id element-id "class")))
+           (class (format "~a" class*)))
       (if (eq? cl #f)
           #f
           (let* ((cls (regexp-split re-class-split cl)))
@@ -646,46 +695,9 @@
       )
     )
 
-  ;; Style related stuff
-  (define (mk-style-string css-style)
-    (if (null? css-style)
-        ""
-        (let* ((kv (car css-style))
-               (key (car kv))
-               (val* (cdr kv))
-               (val (if (list? val*) (car val*) val*))
-               )
-          (string-append (format "~a" key) ": " (format "~a" val) "; "
-                         (mk-style-string (cdr css-style))))
-        ))
-
-  (define re-style-split #px"\\s*[;]\\s*")
-  (define re-style-kv-split #px"\\s*[:]\\s*")
-  
-  (define (split-style-string style)
-    (let ((sp-style (regexp-split re-style-split style)))
-      (letrec ((f (lambda (entries)
-                    (if (null? entries)
-                        '()
-                        (let* ((entry (string-trim (car entries)))
-                               (kv (regexp-split re-style-kv-split entry))
-                               (key (car kv))
-                               (skey (if (string? key)
-                                         (string->symbol key)
-                                         key))
-                               (val (if (= (length kv) 2) (cadr kv) ""))
-                               (keyval (cons skey val))
-                               )
-                          (if (string=? entry "")
-                              (f (cdr entries))
-                              (cons keyval (f (cdr entries)))))
-                        ))
-                  ))
-        (f sp-style))))
-
   ;; Add a style to an element
   (define (ww-add-style win-id element-id css-style)
-    (let* ((st (mk-style-string css-style))
+    (let* ((st (css-style->string css-style))
            (js-handle (new-handle))
            (cmd (format "add-style ~a ~a ~a ~a" win-id js-handle
                         (as-string element-id) (as-string st)))
@@ -694,7 +706,7 @@
 
   ;; Set a style of an element
   (define (ww-set-style win-id element-id css-style)
-    (let* ((st (mk-style-string css-style))
+    (let* ((st (css-style->string css-style))
            (js-handle (new-handle))
            (cmd (format "set-style ~a ~a ~a ~a" win-id js-handle
                         (as-string element-id) (as-string st)))
@@ -707,9 +719,25 @@
            (cmd (format "get-style ~a ~a ~a" win-id js-handle
                        (as-string element-id)))
            )
-      (split-style-string (ww-await js-handle cmd))))
+      (string->css-style (ww-await js-handle cmd))))
                       
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Finalizing stuff
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+  (define will (make-will-executor))
+
+  (define (register-finalizer obj proc)
+    (will-register will obj proc))
+
+  (void (thread (λ () (let loop () (will-execute will) (loop)))))
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Regexes
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define re-resize #px"([0-9]+)\\s+([0-9]+)")
+  (define re-move re-resize)
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; GUI classes
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -731,25 +759,69 @@
          (set! _std_x 50))
        )))
 
-  (define ww-base%
+  (define ww-element%
     (class object%
       (init-field [win-id #f] [id #f])
       
-      (define/public (enable)
+      (define/public (get-win-id)
-        (ww-remove-class win-id id 'disabled))
+        win-id)
 
-      (define/public (enabled)
+      (define/public (get-id)
-        (not (ww-has-class? win-id id 'disabled)))
+        id)
+
+      (define/public (win)
+        (let ((w (hash-ref windows win-id #f)))
+          w))
+
+      (define connected-callbacks (make-hash))
+
+      (define/public (callback evt . args)
+        (let ((cb (hash-ref connected-callbacks evt #f)))
+          (unless (eq? cb #f)
+            (with-handlers ([exn:fail?
+                             (λ (e)
+                               (err (format "callback for ~a: ~a" evt e)))])
+              (apply cb args)))))
+
+      (define/public (connect evt func)
+        (hash-set! connected-callbacks evt func))
+
+      (define/public (disconnect evt)
+        (hash-remove! connected-callbacks evt))
+
+      (define/public (add-style! st)
+        (ww-add-style win-id id st))
+
+      (define/public (set-style! st)
+        (ww-set-style win-id id st))
+
+      (define/public (style)
+        (ww-get-style win-id id))
+
+      (define/public (add-class! cl)
+        (ww-add-class win-id id cl))
+
+      (define/public (remove-class! cl)
+        (ww-remove-class win-id id cl))
+
+      (define/public (has-class? cl)
+        (ww-has-class? win-id id cl))
+
+      (define/public (enable)
+        (send this remove-class! 'disabled))
+
+      (define/public (enabled?)
+        (not (send this disabled?)))
 
       (define/public (disable)
-        (ww-add-class win-id id 'disabled))
+        (send this add-class! 'disabled))
 
-      (define/public (disabled)
+      (define/public (disabled?)
-        (ww-has-class? win-id id 'disabled))
+        (send this has-class? 'disabled))
 
       (define/public (display . args)
         (let ((d (if (null? args) "block" (car args))))
-          (ww-add-style win-id id (list (cons 'display d)))))
+          (send this add-style! (css-style 'display d))))
 
       (define/public (hide)
         (send this display "none"))
@@ -760,16 +832,28 @@
       (define/public (show-inline)
         (send this display "inline-block"))
 
+      (define/public (set-inner-html html-or-sexpr)
+        (if (string? html-or-sexpr)
+            (ww-set-inner-html win-id id html-or-sexpr)
+            (set-inner-html (xexpr->html5 html-or-sexpr))))
+
       (super-new)
       )
     )
 
-  (define ww-clicker%
+  (define ww-input%
-    (class ww-base%
+    (class ww-element%
+
+      (define/public (get)
+        (ww-get-value (send this get-win-id) (send this get-id)))
+
+      (define/public (set! v)
+        (ww-set-value (send this get-win-id) (send this get-id) v))
+          
       (super-new)))
 
   (define ww-window%
-    (class ww-base%
+    (class object%
       
       (init-field [profile 'default-profile]
                   [parent-id #f]
@@ -784,34 +868,97 @@
                   )
 
       (define win-id #f)
-      (define clickers (make-hash))
+      
+      (define elements (make-hash))
+      
+      (define (event-handler type evt content)
+        (displayln (format "win-id=~a '~a '~a ~a" win-id type evt content))
+        (cond
+          ([eq? evt 'page-loaded] (begin
+                                    (send this bind-buttons)
+                                    (send this bind-inputs)))
+          ([eq? evt 'click] (handle-click (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)))
+                                     (height* (string->number (caddr m)))
+                                     )
+                                (set! width width*)
+                                (set! height height*)))
+          ([eq? evt 'moved] (let* ((m (regexp-match re-move content))
+                                   (x* (string->number (cadr m)))
+                                   (y* (string->number (caddr m)))
+                                   )
+                              (set! x x*)
+                              (set! y y*)
+                              ))
+          )
+        )
+
+      (define/public (handle-click element-id data)
+        (let ((el (hash-ref elements element-id #f)))
+          (unless (eq? el #f)
+            (send el callback 'click data))))
+
+      (define/public (handle-change element-id data)
+        (let ((el (hash-ref elements element-id #f)))
+          (unless (eq? el #f)
+            (send el callback 'change (hash-ref data 'value)))))
 
       (define/public (get-win-id) win-id)
 
-      (define/public (bind-all)
+      (define/public (bind event selector cl)
-        (let ((button-ids (ww-bind win-id "click" "button")))
+        (let ((ids (ww-bind win-id event selector)))
-          (for-each
+          (for-each (λ (id)
-           (lambda (button-id)
+                      (hash-set! elements id
-             (hash-set! clickers button-id
+                                 (new cl [win-id win-id] [id id])))
-                        (new ww-clicker% [id button-id])))
+                    ids)))
-           button-ids))
 
-        (ww-bind win-id "input" "input[type=text]")
+      (define/public (bind-inputs)
+        (bind 'change 'input ww-input%)
+        (bind 'change 'textarea ww-input%)
         )
 
-      (define/public (handle-click content)
+      (define/public (bind-buttons)
-        
+        (bind 'click 'button ww-element%)
-        #t)
-        
-
-      (define (event-handler evt content)
-        (displayln (format "win-id=~a '~a ~a" win-id evt content))
-        (cond
-          ([eq? evt 'page-loaded] (send this bind-all))
-          ([eq? evt 'click] (handle-click content))
-          )
         )
 
+      (define/public (element id)
+        (let ((el (hash-ref elements id #f)))
+          (if (eq? el #f)
+              (begin
+                (hash-set! elements id (new ww-element%
+                                            [win-id win-id] [id id]))
+                (element id))
+              el)))
+
+      (define/public (move x y)
+        (ww-move win-id x y))
+
+      (define/public (resize x y)
+        (ww-resize win-id x y))
+
+      (define/public (get-x) x)
+      (define/public (get-y) y)
+      (define/public (get-width) width)
+      (define/public (get-height) height)
+      (define/public (geom) (list x y width height))
+      
+
+      (define/public (set-title! t)
+        (set! title t)
+        (ww-set-title win-id t))
+
+      (define/public (get-title)
+        title)
+
+      (define/public (set-html-file! file)
+        (set! html-file file)
+        (ww-set-html win-id html-file))
+
+      (define/public (get-html-file)
+        html-file)
+
       ; construct
       (begin
         ;(displayln (format "profile: ~a, ~a" profile parent-id))
@@ -821,7 +968,8 @@
         (when (eq? win-id #f)
           (error "Window could not be constructed"))
 
-        (hash-set! windows win-id event-handler)
+        (hash-set! windows-evt-handlers win-id (make-weak-box event-handler))
+        (hash-set! windows win-id (make-weak-box this))
 
         (ww-move win-id x y)
         (ww-resize win-id width height)
@@ -837,9 +985,16 @@
         (unless (eq? html-file #f)
           (ww-set-html win-id html-file))
 
+        (register-finalizer this
+                            (λ (me)
+                              (let ((win-id (send me get-win-id)))
+                                (ww-close (send me get-win-id))
+                                (hash-remove! windows win-id)
+                                (hash-remove! windows-evt-handlers win-id)
+                                )))
         )
 
-      (super-new [id win-id])
+      (super-new)
     ))
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;