OO framework

private/racket-webview-version.rkt

@@ -0,0 +1,11 @@
+#lang racket/base
+
+(provide webview-major
+         webview-minor
+         webview-patch
+         )
+
+(define webview-major 0)
+(define webview-minor 1)
+(define webview-patch 0)
+

private/rgba.rkt

@@ -0,0 +1,128 @@
+#lang racket/base
+
+(require racket/contract
+         racket-sprintf
+         )
+
+(provide rgba
+         hex->rgba
+         rgba->hex
+         rgba?
+         rgba-blue
+         rgba-red
+         rgba-green
+         rgba-alpha
+         rgba-blue!
+         rgba-red!
+         rgba-green!
+         rgba-alpha!
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Data structures
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-struct rgba*
+  ([red #:mutable] [green #:mutable] [blue #:mutable] [alpha #:mutable])
+  #:transparent
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Support functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (between-0-255? x)
+  (and (integer? x)
+       (>= x 0)
+       (<= x 255)))
+
+
+(define (optional-between-0-255? x)
+  (write x)
+  (newline)
+  (or (null? x)
+      (and (= (length x) 1)
+           (between-0-255? (car x)))))
+
+(define (hex2->int str)
+  (let ((s (string-downcase str))
+        (sub (- (char->integer #\a) 10))
+        (subnum (char->integer #\0)))
+    (let ((ac (string-ref s 0))
+          (bc (string-ref s 1)))
+      (let ((a (- (char->integer ac) (if (char>=? ac #\a) sub subnum)))
+            (b (- (char->integer bc) (if (char>=? bc #\a) sub subnum))))
+        (+ (* a 16) b)))))
+
+(define (hex-color? c)
+  (let ((re #px"[#]?([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})?"))
+    (let ((m (regexp-match re c)))
+      (not (eq? m #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (rgba? c)
+  (rgba*? c))
+
+(define/contract (rgba r g b . a)
+  (->* (between-0-255? between-0-255? between-0-255?) (between-0-255?) rgba?)
+  (make-rgba* r g b (if (null? a) 255 (car a)))
+  )
+
+(define/contract (hex->rgba h)
+  (-> hex-color? rgba?)
+  (let ((re #px"[#]?([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})?"))
+    (let ((m (regexp-match re h)))
+      (if (eq? m #f)
+          (error "Not a CSS hex color string")
+          (rgba (hex2->int (list-ref m 1))
+                (hex2->int (list-ref m 2))
+                (hex2->int (list-ref m 3))
+                (if (eq? (list-ref m 4) #f)
+                    255
+                    (hex2->int (list-ref m 4))))))))
+
+(define/contract (rgba->hex c)
+  (-> rgba? string?)
+  (string-append 
+      (sprintf "#%02x%02x%02x" (rgba-red c) (rgba-green c) (rgba-blue c))
+      (if (= (rgba-alpha c) 255)
+          ""
+          (sprintf "%02x" (rgba-alpha c)))))
+
+
+(define/contract (rgba-red! c r)
+  (-> rgba? between-0-255? rgba?)
+  (set-rgba*-red! c r))
+
+(define/contract (rgba-green! c g)
+  (-> rgba? between-0-255? rgba?)
+  (set-rgba*-green! c g))
+
+(define/contract (rgba-blue! c b)
+  (-> rgba? between-0-255? rgba?)
+  (set-rgba*-blue! c b))
+
+(define/contract (rgba-alpha! c a)
+  (-> rgba? between-0-255? rgba?)
+  (set-rgba*-alpha! c a))
+
+(define/contract (rgba-red c)
+  (-> rgba? between-0-255?)
+  (rgba*-red c))
+
+(define/contract (rgba-green c)
+  (-> rgba? between-0-255?)
+  (rgba*-green c))
+
+(define/contract (rgba-blue c)
+  (-> rgba? between-0-255?)
+  (rgba*-blue c))
+
+(define/contract (rgba-alpha c)
+  (-> rgba? between-0-255?)
+  (rgba*-alpha c))
+
+

private/wv-context.rkt

@@ -0,0 +1,42 @@
+#lang racket/base
+
+(require racket/class
+         "racket-webview.rkt"
+         "wv-settings.rkt"
+         )
+
+(provide wv-context%)
+
+(define wv-context%
+  (class object%
+    (init-field
+     base-path
+     [file-getter (webview-standard-file-getter base-path)]
+     [context-js  (λ () "")]
+     [boilerplate-js (webview-default-boilerplate-js context-js)]
+     [ini (error "You need to provide a 'ini' file settings interface for settings, e.g. simple-ini")]
+     )
+     
+    (define wv-context #f)
+    (define settings-obj #f)
+
+    (define/public (context)
+      wv-context)
+
+    (define/public (settings section)
+      (send settings-obj clone section)
+      )
+
+    (define/public (base-url)
+      (wv-context-base-url wv-context))
+
+    (super-new)
+    
+    (begin
+      (set! wv-context
+            (webview-new-context file-getter
+                                 #:boilerplate-js boilerplate-js))
+      (set! settings-obj (new wv-settings% [ini ini] [wv-context 'global]))
+      )
+    )
+  )

private/wv-dialog.rkt

@@ -0,0 +1,53 @@
+#lang racket/base
+
+(require racket/class
+         "wv-window.rkt"
+         )
+
+(provide wv-dialog%
+         )
+
+
+(define (default-w) 400)
+(define (default-h) 400)
+
+(define wv-dialog%
+  (class wv-window%
+    (inherit-field parent settings wv-context html-path x y width height)
+    
+    (super-new)
+
+    (define/override (init-size)
+      (displayln "init-size")
+      (let ((px (get-field x parent))
+            (py (get-field y parent))
+            (pw (get-field width parent))
+            (ph (get-field height parent))
+            )
+        (displayln px)
+        (displayln py)
+        (displayln pw)
+        (displayln ph)
+        (let ((dw (send settings get 'width (if (eq? width #f) (default-w) width)))
+              (dh (send settings get 'height (if (eq? height #f) (default-h) height)))
+              )
+          (displayln dw)
+          (displayln dh)
+          (let ((xx (/ (- pw dw) 2))
+                (yy (/ (- ph dh) 2)))
+            (let ((x (inexact->exact (round (exact->inexact (+ px xx)))))
+                  (y (inexact->exact (round (exact->inexact (+ py yy)))))
+                  )
+              (displayln "move")
+              (send this move x y)
+              (displayln "resize")
+              (send this resize dw dh)
+              )
+            )
+          )
+        )
+      )
+    )
+  )
+          
+    

private/wv-element.rkt

@@ -0,0 +1,93 @@
+#lang racket/base
+
+(require racket/class
+         "racket-webview.rkt"
+         )
+
+(provide wv-element%)
+
+(define wv-element%
+  (class object%
+    (init-field window
+                element-id
+                )
+
+    (define wv  (hash-ref (send window info) 'wv))
+    (define callbacks (make-hash))
+
+    (define/public (id)
+      element-id)
+
+    (define/public (add-event-callback! evt cb)
+      (hash-set! callbacks evt cb))
+
+    (define/public (remove-event-callback! evt)
+      (hash-remove! callbacks evt))
+
+    (define/public (event-callback-count)
+      (hash-count callbacks))
+
+    (define/public (dispatch-event evt data)
+      (let ((cb (hash-ref callbacks evt #f)))
+        (if (eq? cb #f)
+            'wv-unhandled-js-event
+            (begin
+              (cb this evt data)
+              'wv-handled-js-event))))
+    
+    (define/public (set-innerHTML! html)
+      (webview-set-innerHTML! wv element-id html)
+      this)
+
+    (define/public (add-class! cl)
+      (webview-add-class! wv element-id cl))
+    
+    (define/public (remove-class! cl)
+      (webview-remove-class! wv element-id cl))
+
+    (define/public (display . d)
+      (when (not (null? d))
+        (let ((d* (string->symbol (format "~a" (car d)))))
+          (webview-set-style! wv element-id 'display d*)))
+      (webview-get-style wv element-id 'display))
+
+    (define/public (visibility . v)
+      (when (not (null? v))
+          (let ((v* (string->symbol (format "~a" (car v)))))
+            (webview-set-style! wv element-id 'visibility v*)))
+      (webview-get-style wv element-id 'visibility))
+
+    (define/public (set-style! styles)
+      (webview-set-style! wv element-id styles))
+
+    (define/public (unset-style! styles)
+      (webview-unset-style! wv element-id styles))
+
+    (define (set-attr! attr-entries)
+      (webview-set-attr! wv element-id attr-entries))
+
+    (define (attr attr)
+      (webview-attr wv element-id attr))
+
+    (define (attr/number attr)
+      (webview-attr/number wv element-id attr))
+
+    (define (attr/symbol attr)
+      (webview-attr/symbol wv element-id attr))
+
+    (define (attr/boolean attr)
+      (webview-attr/boolean wv element-id attr))
+
+    (define (attr/date attr)
+      (webview-attr/date wv element-id attr))
+    
+    (define (attr/time attr)
+      (webview-attr/time wv element-id attr))
+
+    (define (attr/datetime attr)
+      (webview-attr/datetime wv element-id attr))
+
+    (super-new)
+    )
+  )
+

private/wv-input.rkt

@@ -0,0 +1,52 @@
+#lang racket/base
+
+(require racket/class
+         "wv-element.rkt"
+         "racket-webview.rkt"
+         )
+
+(provide wv-input/text%
+         wv-input/number%
+         wv-input/boolean%
+         wv-input/date%
+         wv-input/time%
+         wv-input/datetime%
+         wv-input/range%
+         wv-input/check%
+         wv-input/radio%
+         wv-input/color%)
+
+
+(define-syntax mk-cl
+  (syntax-rules (wv-element%)
+    ((_ cl-name setter getter)
+     (define cl-name
+       (class wv-element%
+         (inherit-field window
+                        element-id)
+         
+         (super-new)
+
+         (define wv (hash-ref (send window info) 'wv))
+
+         (define/public (get)
+           (getter wv element-id))
+
+         (define/public (set! v)
+           (setter wv element-id v))
+         )
+       )
+     )
+    )
+  )
+
+(mk-cl wv-input/text% webview-set-value! webview-value)
+(mk-cl wv-input/number% webview-set-value! webview-value/number)
+(mk-cl wv-input/boolean% webview-set-value! webview-value/boolean)
+(mk-cl wv-input/date% webview-set-value! webview-value/date)
+(mk-cl wv-input/time% webview-set-value! webview-value/time)
+(mk-cl wv-input/datetime% webview-set-value! webview-value/datetime)
+(mk-cl wv-input/range% webview-set-value! webview-value/number)
+(mk-cl wv-input/check% webview-set-value! webview-value/boolean)
+(mk-cl wv-input/radio% webview-set-value! webview-value/boolean)
+(mk-cl wv-input/color% webview-set-value! webview-value/color)

private/wv-settings.rkt

@@ -0,0 +1,38 @@
+#lang racket/base
+
+(require racket/class
+         simple-ini/class
+         )
+
+(provide wv-settings%)
+
+(define wv-settings%
+  (class object%
+    (init-field ini
+                wv-context
+                )
+
+    (define/public (get key . default-value)
+      (if (null? default-value)
+          (send ini get wv-context key)
+          (send ini get wv-context key (car default-value))))
+    
+    (define/public (set! key value)
+      (send ini set! wv-context key value))
+
+    (define/public (get/global key . default-value)
+      (if (null? default-value)
+          (send ini get 'global key)
+          (send ini get 'global key (car default-value))))
+
+    (define/public (set/global! key value)
+      (send ini set! 'global key value))
+    
+    (define/public (clone context)
+      (new wv-settings% [ini ini] [wv-context context]))
+
+    (super-new)
+    )
+  )
+
+                

private/wv-window.rkt

@@ -0,0 +1,460 @@
+#lang racket/base
+
+(require "racket-webview.rkt"
+         racket/class
+         simple-ini/class
+         "wv-element.rkt"
+         "wv-input.rkt"
+         "wv-settings.rkt"
+         "rgba.rkt"
+         net/url
+         net/sendurl
+         racket/string
+         )
+
+(provide wv-window%
+         (all-from-out "wv-element.rkt")
+         (all-from-out "wv-input.rkt")
+         (all-from-out "rgba.rkt")
+         (all-from-out "wv-settings.rkt")
+         webview-version
+         root-file-not-found-handler
+         )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Administration
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define default-x (let ((dx 100))
+                    (λ ()
+                      (set! dx (+ dx 25))
+                      dx)))
+(define default-y (let ((dy 100))
+                    (λ ()
+                      (set! dy (+ dy 25))
+                      dy)))
+                      
+(define default-w (λ () 800))
+(define default-h (λ () 600))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Classes
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define wv-window%
+  (class object%
+
+    (init-field [parent #f]
+                [wv-context (if (eq? parent #f)
+                                (error "wv context is mandatory")
+                                (get-field wv-context parent))]
+                [html-path   (error "html path is mandatory")]
+                [settings    (send wv-context settings (string->symbol (format "~a" html-path)))]
+                [title "Racket Webview Window"]
+                [width #f]
+                [height #f]
+                [x #f]
+                [y #f]
+                [wv #f]
+                )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Administration
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define/public (context)
+      wv-context)
+
+    (define/public (win-context)
+      (string->symbol (format "~a" html-path)))
+
+    (define element-hash (make-weak-hash))
+
+    (define/public (info)
+      (let ((h (make-hash)))
+        (hash-set! h 'wv-context (context))
+        (hash-set! h 'wv wv)
+        (hash-set! h 'html-path html-path)
+        (hash-set! h 'elements element-hash)
+        h))
+
+    (define/public (element id . type*)
+      (let ((elem (hash-ref element-hash id #f))
+            (type (if (null? type*) #f (car type*))))
+        (when (eq? elem #f)
+          (when (eq? type #f)
+            (let ((js-type (webview-call-js wv
+                                            (format
+                                             (string-append
+                                              "{ let el = document.getElementById('~a');\n"
+                                              "  let a = el.getAttribute('type');\n"
+                                              "  if (a === null) {\n"
+                                              "    return false;\n"
+                                              "  } else {\n"
+                                              "    return a;\n"
+                                              "  }\n"
+                                              "}")
+                                             id))))
+              (set! type (if (eq? js-type #f)
+                             #f
+                             (string->symbol (string-downcase js-type))))
+              )
+            )
+          (let ((cl (cond
+                      ((eq? type 'text) wv-input/text%)
+                      ((eq? type 'date) wv-input/date%)
+                      ((eq? type 'time) wv-input/time%)
+                      ((eq? type 'datetime-local) wv-input/datetime%)
+                      ((eq? type 'range) wv-input/range%)
+                      ((eq? type 'number) wv-input/number%)
+                      ((eq? type 'checkbox) wv-input/check%)
+                      ((eq? type 'radio) wv-input/radio%)
+                      ((eq? type 'color) wv-input/color%)
+                      (else wv-element%)
+                      )))
+            (set! elem (new cl [window this] [element-id id]))
+            (hash-set! element-hash id elem))
+          )
+        elem
+        )
+      )
+        
+    (define (connect! id type event callback)
+      (let ((elem (element id type)))
+        (send elem add-event-callback! event callback)
+        )
+      )
+
+    (define (disconnect! id event)
+      (let ((elem (hash-ref element-hash id #f)))
+        (unless (eq? elem #f)
+          (send elem remove-event-callback! event)
+          (when (= (send elem event-callback-count) 0)
+            (hash-remove! element-hash id))
+          )
+        )
+      )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Events
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define (event-handler wv evt)
+      (let ((event (hash-ref evt 'event 'unknown-event))
+            )
+        (cond
+        ((eq? event 'resize)
+         (send this resized (hash-ref evt 'w) (hash-ref evt 'h)))
+        ((eq? event 'move)
+         (send this moved (hash-ref evt 'x) (hash-ref evt 'y)))
+        ((eq? event 'page-loaded)
+         (send this page-loaded (hash-ref evt 'oke)))
+        ((or (eq? event 'show) (eq? event 'hide) (eq? event 'maximize))
+         (send this window-state-changed (webview-window-state wv)))
+        ((eq? event 'can-close?)
+         (when (send this can-close?)
+           (send this close)))
+        ((eq? event 'closed)
+         (send this closed))
+        ((eq? event 'js-evt)
+         (let* ((je (hash-copy (hash-ref evt 'js-evt)))
+                (e (make-hash)))
+           (hash-set! e 'evt (string->symbol (hash-ref je 'evt)))
+           (hash-set! e 'id (string->symbol (hash-ref je 'id #f)))
+           (hash-set! e 'data (hash-ref je 'js_evt (make-hash)))
+           (hash-set! e 'event 'js-evt)
+           (when (eq? (send this js-event e) 'wv-unhandled-js-event)
+             (displayln (format "Unhandled javascript event: ~a" e)))
+           ))
+        ((eq? event 'navigation-request)
+         (let ((type (string->symbol (hash-ref evt 'type)))
+               (url (string->url (hash-ref evt 'url))))
+           (send this navigation-request type url)))
+        ((or (eq? event 'file-save-ok)
+             (eq? event 'file-open-ok)
+             (eq? event 'choose-dir-ok))
+         (let ((file (hash-ref evt 'choosen))
+               (dir (hash-ref evt 'dir))
+               (filter (webview-filter->exts (hash-ref evt 'filter))))
+           (send this file-dialog-done 'ok file dir filter)))
+        ((or (eq? event 'file-save-cancel)
+             (eq? event 'file-open-cancel)
+             (eq? event 'choose-dir-cancel))
+         (send this file-dialog-done 'canceled #f #f #f))
+        ((or (eq? event 'msgbox-ok)
+             (eq? event 'msgbox-cancel)
+             (eq? event 'msgbox-yes)
+             (eq? event 'msgbox-no))
+         (send this message-done event))
+        (else
+         (displayln (format "Unhandled event: ~a (~a)" event evt)))
+        ))
+      )
+         
+    (define/public (moved xx yy)
+      (set! x xx)
+      (set! y yy)
+      (send settings set! 'x x)
+      (send settings set! 'y y)
+      )
+
+    (define/public (resized w h)
+      (set! width w)
+      (set! height h)
+      (send settings set! 'width w)
+      (send settings set! 'height h)
+      )
+
+    (define/public (window-state-changed st)
+      #t
+      )
+
+    (define/public (page-loaded oke)
+      #t)
+
+    (define/public (can-close?)
+      #t)
+
+    (define/public (closed)
+      #t)
+
+    (define/public (js-event js-event)
+      (let* ((evt (hash-ref js-event 'evt))
+             (id (hash-ref js-event 'id))
+             (el (hash-ref element-hash id #f))
+             )
+        (if (eq? el #f)
+          'wv-unhandled-js-event
+          (send el dispatch-event evt (hash-ref js-event 'data (make-hash))))
+        )
+      )
+
+    (define/public (navigation-request type url)
+      (let ((u (url->string url)))
+        (if (string-prefix? u (send wv-context base-url))
+            (begin
+              (webview-set-url! wv url)
+              'internal)
+            (begin
+              (send-url u)
+              'external)
+            )
+        )
+      )
+            
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Commands
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define/public (add-class! selector-or-id cl)
+      (webview-add-class! wv selector-or-id cl)
+      this)
+
+    (define/public (remove-class! selector-or-id cl)
+      (webview-remove-class! wv selector-or-id cl)
+      this)
+    
+    (define/public (devtools)
+      (webview-devtools wv)
+      this)
+    
+    (define/public (move x y)
+      (webview-move wv x y)
+      this)
+
+    (define/public (resize w h)
+      (webview-resize wv w h)
+      this)
+
+    (define/public (close)
+      (webview-close wv)
+      this)
+
+    (define/public (bind! selector events callback)
+      (let ((items (webview-bind! wv selector events))
+            (events* (if (symbol? events) (list events) events)))
+        (map (λ (item)
+                    (let ((id (car item))
+                          (type (string->symbol (string-downcase (caddr item))))
+                          )
+                      (for-each (λ (evt)
+                                  (connect! id type evt callback))
+                                events*)
+                      (hash-ref element-hash id)
+                      ))
+                  items)
+        )
+      )
+
+    (define/public (unbind! selector events)
+      (let ((items (webview-unbind! wv selector events))
+            (events* (if (symbol? events) (list events) events))
+            )
+        (for-each (λ (item)
+                    (let ((id (car item)))
+                      (for-each (λ (evt)
+                                  (send this disconnect! id evt))
+                                events*)
+                      ))
+                  items)
+        items
+        )
+      )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Files / Directories
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define __file_dialog_cc__ #f)
+
+    (define/public (file-dialog-done flag file dir filter)
+      (__file_dialog_cc__ (list flag file dir filter))
+      )
+
+    (define/public (choose-dir title base-dir)
+      (unless (eq? __file_dialog_cc__ #f)
+        (error "Cannot display more than one file/directory dialog"))
+      (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir))
+             (r (webview-choose-dir wv title bd)))
+        (if (eq? r 'oke)
+            (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c)))))
+              (if (void? r)
+                  'showing
+                  (begin
+                    (set! __file_dialog_cc__ #f)
+                    (if (eq? (car r ) 'ok)
+                        (cadr r)
+                        #f))))
+            #f)
+        )
+      )
+
+    (define/public (file-open title base-dir filters)
+      (unless (eq? __file_dialog_cc__ #f)
+        (error "Cannot display more than one file/directory dialog"))
+      (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir))
+             (r (webview-file-open wv title bd filters)))
+        (if (eq? r 'oke)
+            (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c)))))
+              (if (void? r)
+                  'showing
+                  (begin
+                    (set! __file_dialog_cc__ #f)
+                    (if (eq? (car r) 'ok)
+                        (cdr r)
+                        #f))
+                  )
+              )
+            #f)
+        )
+      )
+
+    (define/public (file-save title base-dir filters)
+      (unless (eq? __file_dialog_cc__ #f)
+        (error "Cannot display more than one file/directory dialog"))
+      (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir))
+             (r (webview-file-save wv title bd filters)))
+        (if (eq? r 'oke)
+            (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c)))))
+              (if (void? r)
+                  'showing
+                  (begin
+                    (set! __file_dialog_cc__ #f)
+                    (if (eq? (car r) 'ok)
+                        (cdr r)
+                        #f))
+                  )
+              )
+            #f)
+        )
+      )
+    
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Messagebox
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define __msg_box_cc__ #f)
+
+    (define/public (message-done evt)
+      (__msg_box_cc__ evt)
+      )
+
+    (define/public (message type title message #:sub [submessage ""])
+      (unless (eq? __msg_box_cc__ #f)
+        (error "Cannot display more than one message box"))
+      (let ((r (webview-messagebox wv type title message #:sub submessage)))
+        (if (eq? r 'oke)
+            (let ((r (call/cc (λ (c) (set! __msg_box_cc__ c)))))
+              (if (void? r)
+                  'showing
+                  (begin
+                    (set! __msg_box_cc__ #f)
+                    r)))
+            #f)
+        )
+      )
+    
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Construction
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define/public (init-size)
+      (let ((x* (send settings get 'x (if (eq? x #f) (default-x) x)))
+            (y* (send settings get 'y (if (eq? y #f) (default-y) y)))
+            (w* (send settings get 'width (if (eq? width #f) (default-w) width)))
+            (h* (send settings get 'height (if (eq? height #f) (default-h) height)))
+            )
+        (send this move x* y*)
+        (send this resize w* h*)
+        )
+      )
+
+    (super-new)
+    
+    (begin
+      ;; Create window
+      (write (list wv-context html-path event-handler parent))
+      (newline)
+      (set! wv (webview-create
+                (send wv-context context)
+                html-path
+                event-handler
+                #:parent (if (eq? parent #f)
+                             #f
+                             (get-field wv parent))))
+
+      ;; Move and resize window to settings
+      (send this init-size)
+      )
+    )
+  )
+
+
+
+(define (root-file-not-found-handler standard-file . not-found-handler)
+  (letrec ((handler 
+            (λ (file base-path path)
+              (if (string=? file "/")
+                  (handler standard-file base-path (build-path base-path standard-file))
+                  (if (string=? file "/index.html")
+                      (if (file-exists? path)
+                          path
+                          (handler standard-file base-path (build-path base-path standard-file)))
+                      (if (file-exists? path)
+                          path
+                          (if (null? not-found-handler)
+                              path
+                              ((car not-found-handler) file base-path path)
+                              )
+                          )
+                      )
+                  )
+              )
+            ))
+    handler)
+  )
+    
+