creating delayed reactor

more debug info in process-file

.gitignore

@@ -4,6 +4,7 @@
 
 # DrRacket autosave files
 *.rkt~
+*.scrbl~
 *.rkt.bak
 \#*.rkt#
 \#*.rkt#*#

Makefile

@@ -4,4 +4,8 @@ all:
 
 clean:
 	find . -name "*.rkt~" -type f -exec rm -f {} \;
-	find . -name "compiled" -type d -exec rm -rf {} \;
+	find . -name "*.scrbl~" -type f -exec rm -f {} \;
+	DIRS=`find . -name "compiled" -type d`;rm -rf $$DIRS
+	find scrbl -name "*.html" -type f -exec rm {} \;
+	find scrbl -name "*.css" -type f -exec rm {} \;
+	find scrbl -name "*.js" -type f -exec rm {} \;

example/index.html

@@ -17,7 +17,7 @@ Some input text: <input type="Text" id="inp1" value="Default input value" />
 Some input date: <input type="Date" id="inp2" value="2026-01-01" />
 </p>
 <p>
-Some color input: <input type="Color" id="inp3" value="#8732422" />
+Some color input: <input type="Color" id="inp3" value="#873242" />
 </p>
 
 <div id="test" class="yellow">

example1/example-1.html

@@ -34,6 +34,7 @@
 	<div class="buttons">
 		<button class="btn-2" id="dialog-button">Open a dialog</button>
 		<button class="btn-1" id="select-dir-button">Select a directory</button>
+		<button class="btn-2" id="devtools">Open Devtools</button>
 	</div>
 	<h2>Menu responses</h2>
 	<table>

example1/example.rkt

@@ -4,75 +4,82 @@
          racket/runtime-path
          racket/gui
          simple-ini/class
+         racket/string
+         net/url
+         simple-log
          )
 
 (provide
  (all-from-out racket/gui)
+ (all-from-out "../main.rkt")
  example-1-window%
+ run-example
  )
 
+(define ww-debug displayln)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Example 1
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-runtime-path html-start "example-1.html")
 (define-runtime-path dialog-html "example-1-dialog.html")
+(define-runtime-path cur-dir ".")
 
-(define test-menu (menu 'main-menu
-                   (menu-item 'm-file "File"
+(define test-menu (wv-menu 'main-menu
+                   (wv-menu-item 'm-file "File"
                                  #:submenu
-                                   (menu (menu-item 'm-open "Open File")
-                                         (menu-item 'm-close "Close File")
-                                         (menu-item 'm-select-dir "Select Folder" #:separator #t)
-                                         (menu-item 'm-quit "Quit" #:separator #t)))
-                   (menu-item 'm-edit "Edit"
+                                 (wv-menu (wv-menu-item 'm-open "Open File")
+                                          (wv-menu-item 'm-close "Close File")
+                                          (wv-menu-item 'm-select-dir "Select Folder" #:separator #t)
+                                          (wv-menu-item 'm-quit "Quit" #:separator #t)))
+                   (wv-menu-item 'm-edit "Edit"
                                  #:submenu
-                                   (menu (menu-item 'm-copy "Copy")
-                                         (menu-item 'm-cut  "Cut")
-                                         (menu-item 'm-paste "Paste")
-                                         (menu-item 'm-prefs "Preferences" #:separator #t)
+                                 (wv-menu (wv-menu-item 'm-copy "Copy")
+                                          (wv-menu-item 'm-cut  "Cut")
+                                          (wv-menu-item 'm-paste "Paste")
+                                          (wv-menu-item 'm-prefs "Preferences" #:separator #t)
                                           ))
-                   (menu-item 'm-auto "Processes"
+                   (wv-menu-item 'm-auto "Processes"
                                  #:submenu
-                                   (menu (menu-item 'm-start "Start counter")
-                                         (menu-item 'm-sub "Submenu"
+                                 (wv-menu (wv-menu-item 'm-start "Start counter")
+                                          (wv-menu-item 'm-sub "Submenu"
                                                         #:submenu
-                                                    (menu (menu-item 'm-sub1 "Submenu 1")
-                                                          (menu-item 'm-sub2 "Submenu 2")
-                                                          (menu-item 'm-sub3 "Submenu 3")
+                                                        (wv-menu (wv-menu-item 'm-sub1 "Submenu 1")
+                                                                 (wv-menu-item 'm-sub2 "Submenu 2")
+                                                                 (wv-menu-item 'm-sub3 "Submenu 3")
                                                                  )
                                                         )
-                                         (menu-item 'm-stop "Stop counter")
+                                          (wv-menu-item 'm-stop "Stop counter")
                                           )
                                  )
                    ))
 
 (define example-1-dialog%
-  (class ww-webview-dialog%
+  (class wv-dialog%
     (inherit-field settings)
-    (super-new [html-file dialog-html]
-               [width 400]
-               [height 300])
+    (super-new [html-path "example-1-dialog.html"]
+               )
 
-    (define/override (html-loaded)
-      (super html-loaded)
+    (define/override (page-loaded oke)
+      (super page-loaded oke)
 
-      (ww-debug "html-loaded for example-1-dialog%")
-      (let* ((btn (send this element 'ok-btn)))
-        (send btn connect 'click (λ (data)
-                                   (send this close))))
+      ;(ww-debug "html-loaded for example-1-dialog%")
+      (send this bind! 'ok-btn 'click (λ (el evt data)
+                                        (send this close)))
 
-      (let* ((inp1 (send this element 'inp1))
-             (inp2 (send this element 'inp2))
-             (inp3 (send this element 'inp3)))
+      (let* ((inp1 (send this element 'inp1 'text))
+             (inp2 (send this element 'inp2 'text))
+             (inp3 (send this element 'inp3 'text)))
         (send inp1 set! (send settings get 'inp1 "<input 1 not set yet>"))
         (send inp2 set! (send settings get 'inp2 "<input 2 not set yet>"))
         (send inp3 set! (send settings get 'inp3 "<input 3 not set yet>"))
-        (send inp1 on-change!
-              (λ (val)
-                (send settings set! 'inp1 val)))
-        (send inp2 on-change! (λ (val) (send settings set! 'inp2 val)))
-        (send inp3 on-change! (λ (val) (send settings set! 'inp3 val)))
+        (send this bind! 'inp1 'change (λ (el evt data)
+                                         (displayln (format "~a ~a ~a" el evt data))
+                                         (displayln (format "get = ~a" (send el get)))
+                                         (send settings set! 'inp1 (send el get))))
+        (send this bind! 'inp2 'change (λ (el evt data) (send settings set! 'inp2 (send el get))))
+        (send this bind! 'inp3 'change (λ (el evt data) (send settings set! 'inp3 (send el get))))
         )
       )
     )
@@ -86,28 +93,44 @@
        var))))
 
 (define example-1-window%
-  (class ww-webview%
+  (class wv-window%
 
-    (inherit-field settings)
-    (super-new [html-file html-start]
+    (inherit-field settings wv-context)
+    (super-new [html-path "example-1.html"]
                )
 
+    (define my-page 'first)
+    (define has-page #f)
     (define go-on-counter #f)
     (define c-counter 0)
     (define counter-inc 1)
     (define counter-thread #f)
     (define div-counter #f)
-    (define my-dir (send settings get 'folder "."))
+    (define my-dir (send settings get/global 'folder "."))
 
 
     (define/override (can-close?)
+      (unless (eq? counter-thread #f)
+        (send this message 'warning "Cannot close window"
+              "Cannot close this window while the counter runs"))
       (eq? counter-thread #f))
 
-    (define/public (reset-counter)
+    (define start-stop-btn #f)
+
+    (define/public (stop-counter)
+      (when (and (eq? my-page 'first)
+                 has-page)
+        (send start-stop-btn set-innerHTML! "Start Counter")
+        )
       (set! go-on-counter #f)
       (set! counter-thread #f)
       )
     
+    (define/public (reset-counter)
+      (stop-counter)
+      (set! c-counter 0)
+      )
+
     (define/public (inc-counter)
       (set! c-counter (+ c-counter counter-inc))
       (when (>= c-counter 1000)
@@ -117,25 +140,30 @@
       (send this update-counter))
 
     (define/public (update-counter)
-      (send div-counter set-inner-html! (format "Count = ~a" c-counter))
+      (when (and (eq? my-page 'first) has-page)
+        (send div-counter set-innerHTML! (format "Count = ~a" c-counter))
         (when (and (> c-counter 0) (<= c-counter 100))
           (send div-counter set-style!
-              (css-style '((background white)))))
+                '((background white) (color blue))))
         (when (and (> c-counter 100) (<= c-counter 200))
           (send div-counter set-style!
-              (css-style '((background green) (color white)))))
+                '((background green) (color white))))
         (when (and (> c-counter 200) (<= c-counter 300))
           (send div-counter set-style!
-              (css-style '((background yellow) (font-size: 120%)))))
+                '((background yellow) (color black) (font-size: 120%))))
         (when (and (> c-counter 300) (<= c-counter 400))
           (send div-counter set-style!
-              (css-style '((color white) (background orange) (font-size 110%)))))
+                '((color white) (background orange) (font-size 110%))))
         (when (and (> c-counter 400))
           (send div-counter set-style!
-              (css-style '((color white) (background red) (font-size 120%) (font-weight bold)))))
+                '((color white) (background red) (font-size 120%) (font-weight bold))))
+        )
       )
 
     (define/public (start-counter)
+      (when (and (eq? my-page 'first) has-page)
+        (displayln "start-counter innerhtml")
+        (send start-stop-btn set-innerHTML! "Stop Counter"))
       (set! counter-thread
             (thread
              (λ ()
@@ -150,64 +178,95 @@
 
     (define/public (set-folder new-dir)
       (set! my-dir new-dir)
-      (send settings set 'folder new-dir)
+      (send settings set/global! 'folder new-dir)
+      (when (and (eq? my-page 'first) has-page)
         (let ((el (send this element 'folder)))
-        (send el set-inner-html! (format "Selected folder: <b>~a</b>" my-dir))
+          (displayln "set-folder innerhtml")
+          (send el set-innerHTML! (format "Selected folder: <b>~a</b>" my-dir))
+          )
         )
       )
 
-    (define/override (choose-dir)
-      (let ((handle (super choose-dir "Select a folder" my-dir)))
-        (displayln (format "choosen dir handle: ~a" handle))
+    (define/public (choose-dir*)
+      (let ((result (send this choose-dir "Select a folder" my-dir)))
+        (unless (eq? result 'showing)
+          (displayln (format "choosen dir handle: ~a" result))
+          (unless (eq? result #f)
+            (send this set-folder result))
+          )
         )
       )
-
-    (define/override (dir-choosen handle choosen dir)
-      (displayln (format "dir-choosen: ~a ~a ~a" handle choosen dir))
-      (when choosen
-        (send this set-folder dir)))
 
     (define/public (prefs)
-      (new example-1-dialog% [parent this] [settings (send this clone-settings 'example-1-dialog)]))
+      ;(stop-counter)
+      ;(set! go-on-counter #f)
+      (new example-1-dialog%
+           [parent this]
+           )
+      ) ; (send this clone-settings 'example-1-dialog)]))
 
-    (define/override (handle-navigate url type kind)
+    (define/override (navigation-request type url)
+      (displayln url)
+
+      (when (eq? my-page 'first)
         (send this reset-counter)
-      (super handle-navigate url type kind))
+        (displayln "counter reset")
+        )
       
-    (define/override (html-loaded)
-      (ww-debug "HTML LOADED")
-      (super html-loaded)
+      (if (string-suffix? (url->string url) "example-1-second.html")
+          (set! my-page 'second)
+          (set! my-page 'first))
       
+      (super navigation-request type url)
+
+      (displayln "Super called")
+      )
+
+    (define/override (page-loaded oke)
+      (ww-debug (format "HTML LOADED ~a ~a" oke (current-milliseconds)))
+      (set! has-page oke)
+      (super page-loaded oke)
+      (displayln "super called")
+      (unless (eq? oke #f)
+
+        (displayln "Hi")
         (set! div-counter (send this element 'div-counter))
+        (displayln "Hi1")
         (send this update-counter)
         (send this set-folder my-dir)
 
         (ww-debug "CONNECTING BUTTONS")
-      (let* ((dialog-btn (send this element 'dialog-button))
-             (start-stop-btn (send this element 'start-stop-button))
-             (choose-dir-btn (send this element 'select-dir-button))
-             )
-        (send dialog-btn connect 'click
-              (λ (data) (send this prefs)))
+        (send this bind! 'dialog-button 'click (λ (el evt data)
+                                                 (send this prefs)))
 
-        (send start-stop-btn connect 'click
-              (λ (data)
+        (set! start-stop-btn (send this element 'start-stop-button))
+        (send this bind! 'start-stop-button 'click
+              (λ (el evt data)
                 (if (eq? counter-thread #f)
                     (begin
                       (send this start-counter)
-                      (send start-stop-btn set-inner-html! "Stop Counter"))
+                      )
                     (begin
                       (send this reset-counter)
-                      (send start-stop-btn set-inner-html! "Start Counter"))
                       )
                     )
                 )
-        (send choose-dir-btn connect 'click
-              (λ (data)
-                (send this choose-dir)))
               )
 
-      (ww-debug "SETTING MENU")
+        (send this bind! 'devtools 'click
+              (λ (el evt data) (send this devtools)))
+
+        (send this bind! 'select-dir-button 'click
+              (λ (el evt data)
+                (send this choose-dir*)))
+        )
+
+      (displayln (format "setting menu ~a" (current-milliseconds)))
+      (send this set-menu! test-menu)
+      (send this connect-menu! 'm-quit (λ ()
+                                         (send this reset-counter)
+                                         (send this close)
+                                         (send this quit)))
       (let* ((div-open (send this element 'div-open))
              (c-open 0)
              (div-close (send this element 'div-close))
@@ -218,40 +277,29 @@
              (c-cut 0)
              (div-paste (send this element 'div-paste))
              (c-paste 0)
-             )
-        
-        (send this set-menu! test-menu)
-        (send this connect-menu! 'm-quit
-              (λ ()
-                (send this reset-counter)
-                (send this close))
-              )
-        (let ((make-menu-executor (λ (item elem string count)
+             (mk (λ (item el str count)
                    (send this connect-menu! item
                          (λ ()
-                                            (send elem set-inner-html! (format "~a ~a" string (count)))))))
-              )
-          (make-menu-executor 'm-open div-open "Open file" (inc c-open))
-          (make-menu-executor 'm-close div-close "Close file" (inc c-close))
-          (make-menu-executor 'm-copy div-copy "Edit Copy" (inc c-copy))
-          (make-menu-executor 'm-cut div-cut "Edit Cut" (inc c-cut))
-          (make-menu-executor 'm-paste div-paste "Edit Paste" (inc c-paste))
-
-          (send this connect-menu! 'm-start
-                (λ () (send this start-counter)))
-          
-          (send this connect-menu! 'm-stop
-                (λ () (send this reset-counter)))
-
-          (send this connect-menu! 'm-prefs
-                (λ () (send this prefs)))
-
-          (send this connect-menu! 'm-select-dir
-                (λ () (send this choose-dir)))
-                                     
+                           (send el set-innerHTML! (format "~a ~a" str (count))))
                          )
                    )
                  )
+             )
+        (mk 'm-open div-open "Open file" (inc c-open))
+        (mk 'm-close div-close "Close file" (inc c-close))
+        (mk 'm-copy div-copy "Edit Copy" (inc c-copy))
+        (mk 'm-cut div-cut "Edit Cut" (inc c-cut))
+        (mk 'm-paste div-paste "Edit Paste" (inc c-paste))
+        )
+
+      (send this connect-menu! 'm-start (λ () (send this start-counter)))
+      (send this connect-menu! 'm-stop (λ () (send this reset-counter)))
+      (send this connect-menu! 'm-prefs (λ () (send this prefs)))
+      (send this connect-menu! 'm-select-dir (λ () (send this choose-dir*)))
+        
+      
+      (displayln "page-loaded done")
+      )
 
     (begin
       (displayln "Yes this works!")
@@ -259,9 +307,25 @@
     )
   )
 
+(webview-set-loglevel 'debug)
+(define log-file (build-path (find-system-path 'temp-dir) "example1.log"))
+(displayln (format "logging to ~a" log-file))
+(sl-log-to-file log-file)
+
 (define (run-example)
   (let* ((ini (new ini% [file 'web-racket-example1]))
-         (settings (new ww-simple-ini% [ini ini] [section 'example-1-window]))
-         (window (new example-1-window% [settings settings]))
+         (context (new wv-context% [base-path cur-dir] [ini ini]))
+         (window (new example-1-window%
+                      [wv-context context]
+                      [title "This is an example1 window"]
+                      )
+                 )
          )
     window))
+
+(define (run)
+  (let ((window (run-example)))
+    (webview-wait-for-quit)
+    (webview-exit)
+    (exit)
+    ))

info.rkt

@@ -0,0 +1,62 @@
+#lang info
+
+(define pkg-authors '(hnmdijkema))
+(define version "0.1.5")
+(define license 'MIT)   
+(define collection "racket-webview")
+(define pkg-desc "racket-webview - A Web Based GUI library, based on a Qt WebEngine backend")
+
+(define scribblings
+  '(
+    ("scrbl/racket-webview-intro.scrbl" () (gui-library) "racket-webview-introduction")
+    ("scrbl/wv-context.scrbl" () (gui-library) "wv-context")
+    ("scrbl/wv-settings.scrbl" () (gui-library) "wv-settings")
+    ("scrbl/wv-window.scrbl" () (gui-library) "wv-window")
+    ("scrbl/menu.scrbl" () (gui-library) "menu")
+    ("scrbl/wv-dialog.scrbl" () (gui-library) "wv-dialog")
+    ("scrbl/wv-element.scrbl" () (gui-library) "wv-element")
+    ("scrbl/wv-input.scrbl" () (gui-library) "wv-input")
+    ("scrbl/racket-webview-qt.scrbl" () (gui-library) "racket-webview-qt")
+    ("scrbl/racket-webview.scrbl" () (gui-library) "racket-webview")
+    ("scrbl/rgba.scrbl" () (gui-library) "rgba")
+    ("scrbl/mimetypes.scrbl" () (gui-library) "mimetypes")
+    ("scrbl/rktwebview-api.scrbl"  () (gui-library) "rktwebview-api")
+    ("scrbl/rktwebviewqt-internals.scrbl" () (gui-library) "rktwebviewqt-internals")
+    )
+  )
+
+(define deps
+ '("racket/base" 
+   "http-easy" 
+   "gregor" 
+   "racket/gui" 
+   "html-printer-lib" 
+   "racket/net" 
+   "simple-ini" 
+   "gregor-utils"
+   "racket-sprintf"
+   "lru-cache"
+   "racket-self-signed-cert"
+   "finalizer"
+   "web-server-lib"
+   "net-cookies-lib"
+   "simple-log"
+   )
+  )
+
+(define build-deps
+  '("racket-doc"
+    "draw-doc"
+    "rackunit-lib"
+    "scribble-lib"
+    "net-doc"
+    ))
+
+(define test-omit-paths 'all)
+
+(define test-ignore-stderrs
+  '(
+    (all "could not be loaded")
+    (all "download site could not be resolved")
+    )
+  )

js/boilerplate.css

@@ -0,0 +1,3 @@
+body {
+	font-family: sans-serif;
+}

js/boilerplate.js

@@ -2,7 +2,11 @@
 if (window.rkt_event_queue === undefined) { window.rkt_event_queue = []; }
 
 window.rkt_put_evt = function(evt) {
+   evt.timestamp = Date.now();
    window.rkt_event_queue.push(evt);
+   if (window.rkt_evt_frame_el) {
+      window.rkt_evt_frame_win.print();
+   }
 };
 
 window.rkt_event_info = function(e, id, evt) {
@@ -57,6 +61,7 @@ window.rkt_get_evt_handler = function(event_kind, el_id, selector, win_nr)
               let obj = {evt: event_kind, id: el_id, selector: selector, window: win_nr,
 						 js_evt: window.rkt_event_info(event_kind, el_id, e) };
               window.rkt_put_evt(obj);
+              e.preventDefault();
          }
       };
       window.rkt_bounds.set(handler_key, handler);
@@ -149,5 +154,8 @@ window.rkt_with_selector = function(selector, func) {
      return r;
 }
 
+window.addEventListener('contextmenu', function (e) { e.preventDefault(); });
+
+
 
 

js/menu.css

@@ -0,0 +1,113 @@
+div.menubar {
+   display: flex;
+   align-items: center;
+   width: 100%;
+   top: 0;
+   left: 0;
+   height: 2em;
+   background: #e0e0e0;
+   border-bottom: 1px solid black;
+   margin-bottom: 2px;
+}
+
+div.menubar-item {
+   display: inline-block;
+   height: 100%;
+   align-content: center;
+   padding-left: 0.5em;
+   padding-right: 0.5em;
+   cursor: default;
+}
+
+div.menu, div.submenu {
+   display: flex;
+   flex-direction: column;
+   background: #e0e0e0;
+   border: 1px solid black;
+   z-index: 9999;
+   margin-top: 0.4em;
+   margin-left: -0.5em;
+   position: absolute;
+}
+
+div.submenu {
+   position: absolute;
+   left: calc(100% + 1em);
+   top: 1em;
+}
+
+div.menu-item {
+   min-width: 150px;
+   height: 2em;
+   padding-left: 0.5em;
+   align-content: center;
+   align-items: center;
+   display: flex;
+   cursor: default;
+}
+
+div.menu-item span.menu-icon {
+   width: 2em;
+   height: 2em;
+   padding: 0;
+   margin: 0;
+   display: flex;
+   padding-left: 3px;
+}
+
+div.menu-item span.menu-name {
+   padding-left: 0.25em;
+   display: inline-block;
+   padding-right: 0.5em;
+}
+
+div.menu-item span.menu-submenu {
+   float: right;
+}
+
+span.menu-icon img {
+   width: 85%;
+   height: 85%;
+   align-self: center;
+}
+
+div.menu-item.separator {
+   border-top: 1px solid black;
+}
+
+div.menubar-item:hover, div.menu-item:hover {
+   background: #c0c0c0;;
+}
+
+.popup-menu, .popup-submenu {
+	display: flex;
+	flex-direction: column;
+	margin: 5px;
+	padding: 5px;
+	position: absolute;
+	z-index: 9999;
+	border: 1px solid black;
+	background: #e0e0e0;
+	color: black;
+}
+
+.popup-submenu {
+	display: none;
+}
+
+.menubar .menu-item span.menu-icon, .popup-menu .menu-item span.menu-icon {
+	min-width: unset;
+	width: unset;
+}
+
+.menubar .menu-item {
+	min-width: unset;
+	width: unset;
+	color: black;
+}
+
+.menu-item span.menu-name {
+	text-wrap: nowrap;
+}
+
+

js/menu.js

@@ -0,0 +1,132 @@
+
+
+window._web_wire_popup_menu = function(menu, x = -1, y = -1, kind = 'popup') {
+    if (menu.id == '#f') { menu.id = null; }
+    let menu_id = (kind == 'popup') ? '@@popup-menu@@' : '@@menubar@@';
+    let submenu_els = [];
+    let triggerMenuItem;
+    let clearPopupMenu = function() {
+        if (kind == 'popup') {
+            let el = document.getElementById(menu_id);
+            if (el !== null) {
+                el.innerHTML = '';
+                el.style.display = 'none';
+            }
+            if (menu.id !== null) {
+                // Delay this trigger, because one could have choosen a menu item and we want this
+                // to be triggered before the clear command is send.
+                // But if no menu item has been selected, the clear command should
+                // eventually be send.
+                setTimeout(function () {
+                    console.log("Sending clear trigger for menu clearance : " + menu.id);
+                    let obj = { evt: 'menu-item-choosen', id: menu.id, menu_item: menu.id };
+                    window.rkt_put_evt(obj);
+                }, 250);
+            }
+        } else {
+            // hide all submenus
+            submenu_els.forEach(function (el) { el.style.display = 'none'; });
+        }
+    };
+    triggerMenuItem = function(id) {
+        console.log("Triggering menu item : " + id);
+        let obj = { evt: 'menu-item-choosen', id: id, menu_item: id };
+        window.rkt_put_evt(obj);
+    };
+    let showSubMenu = function(menu_el, item_el, el, parent_type) {
+        if (parent_type == 'menu') {
+            el.style.display = 'flex';
+            let rect = item_el.getBoundingClientRect();
+            let r = rect.left;
+            let t = rect.height;
+            el.style.left = r + 'px';
+            el.style.top = t + 'px';
+        } else {
+            el.style.display = "flex";
+            let rect = menu_el.getBoundingClientRect();
+            let irect =item_el.getBoundingClientRect();
+            let r = rect.width + 5;
+            let t = irect.y - rect.y;
+            el.style.left =  r + "px";
+            el.style.top = t + "px";
+        }
+    };
+    let hideSubMenu = function(el) { el.style.display = "none"; };
+    let makePopupMenu = function(el, menu, visible, type) {
+        let i;
+        let N = menu.length;
+        for(i = 0; i < N; i++) {
+            let item = menu[i];
+            let item_el = document.createElement("div");
+            item_el.id = item.id;
+            item_el.classList.add("menu-item");
+            let item_el_icon = document.createElement('span');
+            item_el_icon.classList.add("menu-icon");
+            if (item.icon) {
+                let icon_img = document.createElement('img');
+                icon_img.setAttribute('src', item.icon);
+                item_el_icon.appendChild(icon_img);
+            }
+            if (item.separator) {
+                item_el.classList.add("separator");
+            }
+            let item_el_name = document.createElement('span');
+            item_el_name.classList.add('menu-name');
+            item_el_name.innerHTML = item.name;
+            let item_el_submenu = document.createElement('span');
+            item_el_submenu.classList.add('menu-submenu');
+            if (item.submenu) {
+                if (type == 'submenu' || kind == 'popup') {
+                    item_el_submenu.innerHTML = '&gt;';
+                }
+                item_el.setAttribute('type', 'submenu');
+                let submenu_el = document.createElement("div");
+                submenu_els.push(submenu_el);
+                submenu_el.classList.add("submenu");
+                submenu_el.classList.add("menu");
+                item_el.appendChild(submenu_el);
+                submenu_el.style.display = 'none';
+                makePopupMenu(submenu_el, item.submenu.menu, false, 'submenu');
+                item_el.addEventListener('mouseenter', function () { showSubMenu(el, item_el, submenu_el, type); });
+                item_el.addEventListener('mouseleave', function () { hideSubMenu(submenu_el); });
+            } else {
+                item_el.setAttribute('type', 'item');
+                item_el.addEventListener('click', function() { triggerMenuItem(item.id); });
+            }
+            item_el.appendChild(item_el_icon);
+            item_el.appendChild(item_el_name);
+            item_el.appendChild(item_el_submenu);
+            el.appendChild(item_el);
+        }
+    };
+    let el = document.getElementById(menu_id);
+    if (el === null) {
+        el = document.createElement("div");
+        el.id = menu_id;
+        el.classList.add((kind == 'popup') ? "popup-menu" : "menubar");
+        if (kind == 'popup') {
+            el.classList.add("menu");
+            document.body.appendChild(el);
+        } else {
+            document.body.prepend(el);
+        }
+    } else {
+        el.innerHTML = '';
+    }
+    makePopupMenu(el, menu.menu, true, 'menu');
+    el.style.left = x + "px";
+    el.style.top = y + "px";
+    el.style.display = "flex";
+    let clearer_f = function() {
+        clearPopupMenu();
+        document.body.removeEventListener('click', clearer_f);
+        document.body.removeEventListener('contextmenu', clearer_f);
+    };
+    document.body.addEventListener('click', clearer_f);
+    document.body.addEventListener('contextmenu', clearer_f);
+};
+
+window._web_wire_menu = function(_menubar) {
+    let menubar = JSON.parse(_menubar);
+    window._web_wire_popup_menu(menubar, -1, -1, 'menubar');
+};

main.rkt

@@ -0,0 +1,31 @@
+#lang racket/base
+
+(require "racket-webview-downloader.rkt")
+(require "racket-webview.rkt")
+(require "wv-context.rkt")
+(require "wv-window.rkt")
+(require "wv-dialog.rkt")
+(require "wv-element.rkt")
+(require "wv-input.rkt")
+(require "rgba.rkt")
+(require "mimetypes.rkt")
+(require "menu.rkt")
+(require "private/js-transform.rkt")
+
+(provide (all-from-out "wv-context.rkt"
+                       "wv-window.rkt"
+                       "wv-dialog.rkt"
+                       "wv-element.rkt"
+                       "wv-input.rkt"
+                       "rgba.rkt"
+                       "mimetypes.rkt"
+                       "menu.rkt"
+                       "racket-webview-downloader.rkt"
+                       "racket-webview.rkt"
+                       "private/js-transform.rkt"
+                       )
+         webview-set-loglevel
+         webview-version
+         webview-info
+	 webview-delayed-reactor
+         )

menu.rkt

@@ -0,0 +1,193 @@
+(module menu racket/base
+
+  (require json
+           net/url)
+  
+  (provide wv-menu
+           wv-menu-item
+           is-wv-menu?
+           wv-menu-set-callback!
+           wv-menu-set-icon!
+           wv-menu-set-title!
+           wv-menu->json
+           with-wv-menu-item
+           wv-menu-for-each
+           wv-menu-item-callback
+           wv-menu-item-id
+           wv-menu-id
+           )
+
+
+  
+  (define-struct ww-menu-item*
+    (id [title #:mutable] [icon-url #:mutable] [callback #:mutable] [submenu #:mutable] [separator #:mutable])
+    #:transparent)
+  
+  (define-struct ww-menu*
+    (id [items #:mutable])
+    #:transparent
+    )
+
+
+  (define (wv-menu-item-callback mi)
+    (ww-menu-item*-callback mi))
+
+  (define (wv-menu-item-id mi)
+    (ww-menu-item*-id mi))
+
+  (define (wv-menu-id m)
+    (ww-menu*-id m))
+  
+  (define (is-wv-menu? mnu)
+    (if (ww-menu*? mnu)
+        (if (list? (ww-menu*-items mnu))
+            (letrec ((f (lambda (m)
+                          (if (null? m)
+                              #t
+                              (if (ww-menu-item*? (car m))
+                                  (if (eq? (ww-menu-item*-submenu (car m)) #f)
+                                      (f (cdr m))
+                                      (and (is-wv-menu? (ww-menu-item*-submenu (car m)))
+                                           (f (cdr m))))
+                                  #f)
+                              ))
+                        ))
+              (f (ww-menu*-items mnu)))
+            #f)
+        #f))
+
+  (define (wv-menu . items)
+    (let ((menu-id #f))
+      (when (symbol? (car items))
+        (set! menu-id (car items))
+        (set! items (cdr items)))
+      (when (list? (car items))
+        (set! items (car items)))
+      (make-ww-menu* menu-id items)))
+
+  (define (wv-menu-item id title
+                     #:icon-url [icon-url #f]
+                     #:callback [callback (lambda args #t)]
+                     #:submenu [submenu #f]
+                     #:separator [separator #f])
+    (unless (symbol? id)
+      (error "menu-item needs an id of symbol?"))
+    (unless (string? title)
+      (error "menu-item needs a title of string?"))
+    (unless (or (eq? icon-url #f) (string? icon-url) (url? icon-url))
+      (error "menu-item's optional argument icon-file must be #f,  string? or path?"))
+    (unless (or (eq? submenu #f) (is-wv-menu? submenu))
+      (error "menu-item's optional argument submenu must be #f or is-menu?"))
+    (unless (boolean? separator)
+      (error "menu-item's optional argument separator must be boolean?"))
+    (let ((u (if (url? icon-url) (url->string icon-url) icon-url)))
+      (make-ww-menu-item* id title u callback submenu separator))
+    )
+
+  (define (wv-menu->hash menu . for-json)
+    (let ((fj (if (null? for-json) #f (car for-json))))
+      (unless (is-wv-menu? menu)
+        (error "menu->hash must be called with a menu"))
+      (let* ((items (ww-menu*-items menu))
+             (r (map (λ (item)
+                       (let ((h (make-hasheq)))
+                         (hash-set! h 'id (format "~a" (ww-menu-item*-id item)))
+                         (hash-set! h 'name (ww-menu-item*-title item))
+                         (unless (eq? (ww-menu-item*-icon-url item) #f)
+                           (hash-set! h 'icon (ww-menu-item*-icon-url item)))
+                         (unless (eq? (ww-menu-item*-submenu item) #f)
+                           (hash-set! h 'submenu (wv-menu->hash (ww-menu-item*-submenu item) fj)))
+                         (unless (eq? (ww-menu-item*-separator item) #f)
+                           (hash-set! h 'separator #t))
+                         h
+                         )) items))
+             )
+        (let ((h (make-hasheq)))
+          (hash-set! h 'menu r)
+          (hash-set! h 'id (if fj (format "~a" (ww-menu*-id menu)) (ww-menu*-id menu)))
+          h))))
+
+  (define (wv-menu-for-each menu cb)
+    (let ((items (ww-menu*-items menu)))
+      (letrec ((f (λ (items)
+                    (if (null? items)
+                        #t
+                        (let ((item (car items)))
+                          (let ((submenu (ww-menu-item*-submenu item)))
+                            (if (eq? submenu #f)
+                                (cb item)
+                                (wv-menu-for-each submenu cb)))
+                          (f (cdr items))
+                          )
+                        )
+                    )
+                  ))
+        (f items))))
+
+  (define (wv-menu->json menu)
+    (let ((o (open-output-string)))
+      (write-json (wv-menu->hash menu #t) o)
+      (get-output-string o)))
+
+  (define (find-wv-menu-item menu id)
+    (let ((items (ww-menu*-items menu)))
+      (letrec ((f (λ (items)
+                    (if (null? items)
+                        #f
+                        (let ((item (car items)))
+                          (if (eq? (ww-menu-item*-id item) id)
+                              item
+                              (let ((submenu (ww-menu-item*-submenu item)))
+                                (if (eq? submenu #f)
+                                    (f (cdr items))
+                                    (let ((found-item (find-wv-menu-item submenu id)))
+                                      (if (eq? found-item #f)
+                                          (f (cdr items))
+                                          found-item))
+                                    ))
+                              ))
+                        ))
+                  ))
+        (f items))))
+
+  (define (with-wv-menu-item menu id cb)
+    (unless (is-wv-menu? menu)
+      (error "menu must be of is-menu?"))
+    (unless (symbol? id)
+      (error "id must be of symbol?"))
+    (let ((item (find-wv-menu-item menu id)))
+      (if (eq? item #f)
+          (error (format "cannot find id'~a in given menu" id))
+          (cb item)))
+    menu)
+      
+  (define (wv-menu-set-title! menu id title)
+    (unless (string? title)
+      (error "title must be of string?"))
+    (with-wv-menu-item menu id
+      (λ (item)
+        (set-ww-menu-item*-title! item title))))
+  
+  (define (wv-menu-set-icon! menu id icon-url)
+    (unless (or (eq? icon-url #f) (url? icon-url) (string? icon-url))
+      (error "title must be of #f, string? or path?"))
+    (with-wv-menu-item menu id
+      (λ (item)
+        (let ((u (if (url? icon-url) (url->string icon-url) icon-url)))
+          (set-ww-menu-item*-icon-url! item u)))))
+
+  (define (wv-menu-set-callback! menu id cb)
+    (unless (procedure? cb)
+      (error "callback must be of procedure?"))
+    (with-wv-menu-item menu id
+      (λ (item)
+        (set-ww-menu-item*-callback! item cb))))
+          
+  ); end of module
+
+
+
+
+
+  
+  

mimetypes.rkt

@@ -722,4 +722,3 @@
 (addMimeType "Zip Archive" "application/zip" '(zip) "Wikipedia: Zip")
 (addMimeType "ZVUE Media Manager" "application/vnd.handheld-entertainment+xml" '(zmm) "IANA: ZVUE Media Manager")
 (addMimeType "Zzazz Deck" "application/vnd.zzazz.deck+xml" '(zaz) "IANA: Zzazz")
-

private/js-transform.rkt

@@ -0,0 +1,414 @@
+#lang racket/base
+
+(require "utils.rkt"
+         (for-syntax racket/base)
+         (for-syntax racket/string)
+         (for-syntax "syntax-helpers.rkt")
+         (for-syntax "utils.rkt")
+         "syntax-helpers.rkt"
+         racket/string
+         )
+
+(provide js)
+
+(define-syntax js-infix
+  (syntax-rules ()
+    ((_ op (a ...))
+     (string-join (list (js1 a) ...) (format "~a~a " (if (eq? 'op '\,) "" " ") 'op)))
+    )
+  )
+
+
+(define-syntax (if-defined stx)
+  (syntax-case stx ()
+    [(_ id iftrue iffalse)
+     (let ([where (identifier-binding #'id)])
+       (if where #'iftrue #'iffalse))]))
+
+
+(define-syntax js-prim-1
+  (syntax-rules ()
+    ((_ a)
+     (symstr 'a))))
+
+(define-syntax (js-primitive stx)
+  (syntax-case stx ()
+    ((js-primitive a)
+     (cond
+       ((number? (syntax->datum #'a)) #'(format "~a" a))
+       ((string? (syntax->datum #'a)) #'(format "\"~a\"" (esc-double-quote (format "~a" a))))
+       ((identifier? #'a) #'(js-prim-1 a))
+       (else #'(js-prim-1 a)))
+     )
+    )
+  )
+
+
+(define-syntax js-func
+  (syntax-rules ()
+    ((_ f)
+     (format "~a()" 'f)
+     )
+    ((_ f a ...)
+     (string-append (format "~a(" 'f)
+                    (js-infix \, (a ...))
+                    ")")
+     )
+    )
+  )
+
+
+(define-syntax js-def
+  (syntax-rules ()
+    ((_ (f) (b ...))
+     (string-append
+      (format "function ~a()" 'f)
+      " {\n"
+      (js b ...)
+      "\n}\n"
+      ))
+    ((_ (f a1) (b ...))
+     (string-append
+      (format "function ~a(~a)" 'f 'a1)
+      " {\n"
+      (js b ...)
+      "\n}\n"))
+    ((_ (f a1 ...) (b ...))
+     (string-append
+      (string-append (format "function ~a(" 'f)
+                     (js-infix \, (a1 ...))
+                     ")")
+      " {\n"
+      (js b ...)
+      "\n}\n"))
+    ((_ a (b))
+     (format "~a = ~a;" 'a (js1 b))
+     )
+    )
+  )
+
+(define-syntax js-lambda
+  (syntax-rules ()
+    ((_ () a ...)
+     (string-append
+      "function () { "
+      (js a ...)
+      " }\n"
+      )
+     )
+    ((_ (a ...) b1 ...)
+     (string-append
+      (string-append
+       "function ("
+       (js-infix \, (a ...))
+       ")"
+       )
+      " { "
+      (js b1 ...)
+      " }\n")
+     )
+    )
+  )
+
+(define-syntax js-set
+  (syntax-rules ()
+    ((_ a b)
+     (string-append
+      (format "~a = " 'a)
+      (js1 b)
+      ";"
+      )
+     )
+    )
+  )
+
+(define-syntax js-send*
+  (syntax-rules ()
+    ((_ a b)
+     (format "~a.~a()" (js1 a) (js1 b)))
+    ((_ a b (a1))
+     (format "~a.~a(~a)" (js1 a) (js1 b) (js1 a1)))
+    ((_ a b (a1 a2 ...))
+     (format "~a.~a(~a)" (js1 a) (js1 b)
+             (js-infix \,  (a1 a2 ...))))
+    )
+  )
+
+(define-syntax js-send
+  (syntax-rules ()
+    ((_ (a b))
+     (js-send* a b))
+    ((_ (a b c ...))
+     (js-send* a b (c ...))
+     )
+    )
+  )
+
+(define (make-cons a b)
+  (format "(~a.unshift(~a),~a)" b a b))
+
+
+
+(define-syntax js-let
+  (syntax-rules ()
+    ((_ (a b))
+     (string-append "let " (format "~a" 'a) " = " (js1 b) ";\n")
+     )
+    )
+  )
+
+(define-syntax js2-let*
+  (syntax-rules ()
+    ((_ (a ...) b1 ...)
+     (string-append "{\n"
+                    (string-append (js-let a) ...)
+                    (js b1) 
+                    ...
+                    "\n}\n")
+     )
+    )
+  )
+
+(define-syntax js2-if
+  (syntax-rules ()
+    ((_ c b1 b2)
+     (string-append "if (" (js1 c) ") {\n"
+                      (js1 b1) "; }\n"
+                      "else {\n"
+                      (js1 b2)
+                      "; }\n"
+                      )
+     )
+    )
+  )
+
+
+(define-syntax js-begin
+  (syntax-rules ()
+    ((_ a ...)
+     (string-append "{\n"
+                    (js a)
+                    ...
+                    " }\n"
+                    )
+     )
+    )
+  )
+  
+
+(define-syntax js-return
+  (syntax-rules ()
+    ((_ a)
+     (string-append "return (" (js1 a) ");\n"))
+    )
+  )
+
+(define-syntax js-list
+  (syntax-rules ()
+    ((_ ())
+     (format "[ ]"))
+    ((_ (a ...))
+     (string-append "[ "
+                    (js-infix \, (a ...))
+                    "]")
+     )
+    )
+  )
+
+(define-syntax js-cons
+  (syntax-rules ()
+    ((_ (a b))
+     (format "~a.concat(~a)" (js-list (a)) (js1 b)))
+    )
+  )
+
+(define-syntax js-quote
+  (syntax-rules ()
+    ((_ (a ...))
+     (js-primitive (a ...)))
+    ((_ a)
+     (string-append "\"" (js-primitive a) "\"")
+     )
+    )
+  )
+
+
+(define-syntax (js-op stx)
+  (syntax-case stx ()
+    ((_ a . args)
+     (cond
+       ((eq? (syntax->datum #'a) '+) #'(js-infix + args))
+       ((eq? (syntax->datum #'a) '*) #'(js-infix * args))
+       ((eq? (syntax->datum #'a) '/) #'(js-infix / args))
+       ((eq? (syntax->datum #'a) '-) #'(js-infix - args))
+       ((eq? (syntax->datum #'a) 'and) #'(js-infix && args))
+       ((eq? (syntax->datum #'a) 'or) #'(js-infix || args))
+       ((eq? (syntax->datum #'a) 'send) #'(js-send args))
+       ((eq? (syntax->datum #'a) 'list) #'(js-list args))
+       ((eq? (syntax->datum #'a) 'cons) #'(js-cons args))
+       (else
+        #'(error (format "Not support by js-op: a = ~a" (syntax->datum #'a)))
+        )
+       )
+     )
+    )
+  )
+
+(define (make-eval-result v)
+  (cond
+    ((or (symbol? v) (string? v))
+     (format "\"~a\"" (esc-double-quote (format "~a" v))))
+    ((list? v)
+     (string-append "[ "
+                    (string-join (map make-eval-result v) ", ")
+                    " ]"))
+    ((number? v)
+     (format "~a" v))
+    (else
+     (error "Not supported result by js-eval, supported: string, symbol, number or list of previous")
+     )
+    )
+  )
+
+(define-syntax js-eval
+  (syntax-rules ()
+    ((_ v)
+     (make-eval-result v))))
+
+(define-for-syntax js-ops '(+ * / - and or send list cons))
+
+(define-syntax (js1 stx)
+  (syntax-case stx ()
+    ((_ (a c b1 b2))
+     (cond
+       ((eq? (syntax->datum #'a) 'if) #'(js2-if c b1 b2))
+       ((memq (syntax->datum #'a) js-ops) #'(js-op a c b1 b2))
+       ((eq? (syntax->datum #'a) 'let*) #'(js2-let* c b1 b2))
+       ((eq? (syntax->datum #'a) 'begin) #'(js-begin c b1 b2))
+       (else
+        ; could be a function call
+        #'(js-func a c b1 b2)
+        ;#'(error (format "Not supported by js macro (a c b1 b2), a = ~a" (syntax->datum #'a)))
+        )
+       )
+     )
+    ((_ (a b c))
+     (cond
+       ((eq? (syntax->datum #'a) '>) #'(js-infix > (b c)))
+       ((eq? (syntax->datum #'a) '<) #'(js-infix < (b c)))
+       ((eq? (syntax->datum #'a) '>=) #'(js-infix >= (b c)))
+       ((eq? (syntax->datum #'a) '<=) #'(js-infix <= (b c)))
+       ((eq? (syntax->datum #'a) '==) #'(js-infix == (b c)))
+       ((eq? (syntax->datum #'a) '===) #'(js-infix === (b c)))
+       ((eq? (syntax->datum #'a) '!=) #'(js-infix != (b c)))
+       ((memq (syntax->datum #'a) js-ops) #'(js-op a b c))
+       ((eq? (syntax->datum #'a) 'define) #'(js-def b (c)))
+       ((eq? (syntax->datum #'a) 'lambda) #'(js-lambda b c))
+       ((eq? (syntax->datum #'a) 'λ) #'(js-lambda b c))
+       ((eq? (syntax->datum #'a) 'set!) #'(js-set b c))
+       ((eq? (syntax->datum #'a) 'let*) #'(js2-let* b c))
+       ((eq? (syntax->datum #'a) 'begin) #'(js-begin b c))
+       ((eq? (syntax->datum #'a) 'let) #'(error "let is not supported in js context, use let*"))
+       (else
+        ; could be a function call
+        #'(js-func a b c)
+        ;#'(error (format "Not supported by js macro (a b c), a = ~a" (syntax->datum #'a)))
+        )
+       )
+     )
+    ((_ (a b))
+     (cond
+       ((eq? (syntax->datum #'a) 'return) #'(js-return b))
+       ((eq? (syntax->datum #'a) 'quote) #'(js-quote b))
+       ((eq? (syntax->datum #'a) 'eval) #'(js-eval b))
+       ;string-append
+       ;                                     "\"" (esc-double-quote (format "~a" 'b)) "\""))
+       (else
+        ; could be a function call
+        #'(js-func a b)
+        ;#'(error (format "Not supported by js macro (a b c), a = ~a" (syntax->datum #'a)))
+        )
+       )
+     )
+    ((_ (a c b1 ...))
+     (cond
+       ((eq? (syntax->datum #'a) 'let*) #'(js2-let* c b1 ...))
+       ((eq? (syntax->datum #'a) 'define) #'(js-def c (b1 ...)))
+       ((memq (syntax->datum #'a) js-ops) #'(js-op a c b1 ...))
+       ((eq? (syntax->datum #'a) 'begin) #'(js-begin c b1 ...))
+       ((eq? (syntax->datum #'a) 'let) #'(error "let is not supported in js context, use let*"))
+       ((eq? (syntax->datum #'a) 'js2-if) #'(error "Unexpected"))
+       (else
+        ; could be a function call
+        #'(js-func a c b1 ...)
+        ;#'(error (format "Not supported by js macro (a c b1 ...) a = ~a" (syntax->datum #'a)))
+        )
+       )
+     )
+    ((_ (a b ...))
+     (cond
+       ((memq (syntax->datum #'a) js-ops) #'(js-op a b ...))
+       (else
+        ; could be a function call
+        #'(js-func a b ...)
+        ;#'(error "Not supported by js macro (a b ...)"))
+        )
+       )
+     )
+    ((_ (a))
+     #'(js-func a)
+     )
+    ((_ a)
+     #'(js-primitive a)
+     )
+    )
+  )
+
+(define-syntax js-dotcomma
+  (syntax-rules ()
+    ((_ s)
+     (string-append s ";\n"))
+    )
+  )
+
+
+(define-syntax js
+  (syntax-rules ()
+    ((_ js-statement ...)
+     (string-append
+      (js-dotcomma (js1 js-statement))
+      ...
+      )
+     )
+    )
+  )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; tests
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+#|
+(define t1
+  (js (set! window.myfunc (λ (x)
+                            (let* ((el (document.getElementById 'hi))
+                                   (y (* x x)))
+                              (el.setAttribute "x" (+ y ""))
+                              )
+                            )
+            )))
+
+(define t2 (js (define (f x)
+                 (if (and (> x 10) (< x 15))
+                     (begin (console.log x)
+                            (return x))
+                     (return (* x x))
+                     )
+                 )
+               )
+  )
+|#
+
+
+