ok

private/web-racket.rkt

@@ -27,7 +27,7 @@
   (define re-move re-resize)
   (define re-file-open #px"([0-9]+)[:]([^:]+)[:](.*)")
   (define re-choose-dir re-file-open)
-  (define re-navigate #px"(.*)[:]([^:]+)$")
+  (define re-navigate #px"(.*)[:]([^:]+)[:]([^:]+)$")
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; GUI classes
@@ -89,6 +89,18 @@
       (define/public (style)
         (ww-get-style win-id id))
 
+      (define/public (get-attr a)
+        (ww-get-attr win-id id a))
+
+      (define/public (set-attr! a val)
+        (ww-set-attr win-id id a val))
+
+      (define/public (del-attr a)
+        (ww-del-attr win-id id a))
+
+      (define/public (get-attrs)
+        (ww-get-attrs win-id id))
+
       (define/public (add-class! cl)
         (ww-add-class win-id id cl))
 
@@ -166,6 +178,7 @@
       
       (init-field [profile 'default-profile]
                   [parent-id #f]
+                  [parent #f]
                   [title "Racket HTML Window"]
                   [x _std_x]
                   [y _std_y]
@@ -182,11 +195,9 @@
       (define elements (make-hash))
       
       (define (event-handler type evt content)
-        (displayln (format "win-id=~a '~a '~a ~a" win-id type evt content))
+        (ww-debug (format "win-id=~a '~a '~a ~a" win-id type evt content))
         (cond
-          ([eq? evt 'page-loaded] (begin
+          ([eq? evt 'page-loaded] (send this html-loaded))
-                                    (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))
@@ -209,9 +220,11 @@
                                           (unless (eq? cb #f)
                                             (cb))))
           ([eq? evt 'navigate] (let* ((m (regexp-match re-navigate content))
-                                     (url (ww-from-string (cadr m)))
+                                      (url (ww-from-string (cadr m)))
-                                     (type (string->symbol (caddr m))))
+                                      (type (string->symbol (caddr m)))
-                                (send this handle-navigate url type)))
+                                      (kind (string->symbol (cadddr m)))
+                                      )
+                                (send this handle-navigate url type kind)))
           )
         )
 
@@ -225,12 +238,15 @@
           (unless (eq? el #f)
             (send el callback 'change (hash-ref data 'value)))))
 
-      (define/public (handle-navigate url type)
+      (define/public (handle-navigate url type kind)
-        (cond
+        (let ((method (if (eq? kind 'set-html) 'set-html-file! 'set-url)))
-          ([eq? type 'link-clicked]
+          (cond
-           (send this set-url url))
+            ([eq? type 'link-clicked]
-          (else (ww-error (format "Don't know what to do for ~a - ~a" type url)))
+             (dynamic-send this method url))
-          ))
+            (else (ww-error (format "Don't know what to do for ~a - ~a" type url)))
+            )
+          )
+        )
 
       (define/public (get-win-id) win-id)
 
@@ -249,7 +265,7 @@
                       (let* ((id (car info))
                              (tag (cadr info))
                              (type (caddr info)))
-                        (displayln (format "bind: ~a ~a ~a" id tag type))
+                        (ww-debug (format "bind: ~a ~a ~a" id tag type))
                         (let ((cl (if (null? forced-cl)
                                       (cl-selector tag type)
                                       (car forced-cl))))
@@ -267,10 +283,10 @@
         )
 
       (define/public (element id)
-        (let ((el (hash-ref elements id #f)))
+        (let ((el (hash-ref elements id 'no-element-with-id-in-hash)))
-          (if (eq? el #f)
+          (if (eq? el 'no-element-with-id-in-hash)
               (let ((info (ww-element-info win-id id)))
-                (let* ((id (car info))
+                (let* ((el-id (car info))
                        (tag (cadr info))
                        (type (caddr info))
                        (exist (cadddr info))
@@ -279,10 +295,14 @@
                     (ww-debug (format "Element ~a does not exist!" id)))
                   (let* ((cl (cl-selector tag type))
                          (obj (new cl [win-id win-id] [id id])))
-                    (hash-set! elements id obj)))
+                    (hash-set! elements el-id obj)
+                    ))
                 (element id))
               el)))
 
+      (define/public (get-elements selector)
+        (ww-get-elements win-id selector))
+
       (define/public (move x y)
         (ww-move win-id x y))
 
@@ -295,7 +315,6 @@
       (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))
@@ -310,6 +329,10 @@
       (define/public (set-url url)
         (ww-set-url win-id url))
 
+      (define/public (html-loaded)
+        (send this bind-buttons)
+        (send this bind-inputs))
+
       (define/public (get-html-file)
         html-file)
 
@@ -404,6 +427,14 @@
         (when (= (hash-count windows) 0)
           (ww-start))
 
+        (when (eq? parent-id #f)
+          (unless (eq? parent #f)
+            (set! parent-id (send parent get-win-id))))
+
+        (when (eq? parent #f)
+          (unless (eq? parent-id #f)
+            (set! parent (ww-get-window-for-id parent-id))))
+        
         (next-window-init-position)
         
         (set! win-id (ww-new profile parent-id))
@@ -449,14 +480,35 @@
                               ("Cut" cut) ("Paste" paste)))
       ))
 
+  (define test-dialog%
+    (class ww-window%
+      (super-new [html-file "../../web-wire/test/dialog.html"]
+                 [width 400]
+                 [height 300])
+
+      (define/override (html-loaded)
+        (super html-loaded)
+        (let* ((btn (send this element 'ok-btn)))
+          (send btn connect 'click (λ (data)
+                                     (send this close)))))
+      ))
+
   (define test-window%
     (class ww-window%
       (super-new [html-file "../../web-wire/test/test1.html"])
 
+      (define/override (html-loaded)
+        (super html-loaded)
+        (let* ((btn (send this element 'app-button)))
+          (send btn connect  'click (λ (data)
+                                (new test-dialog% [parent this]))))
+          )
+
       (begin
         (send this set-menu test-menu)
         (send this connect-menu 'quit (λ () (send this close)))
         )
-      ))
+      )
+    )
     
   ); end of module

private/web-wire.rkt

@@ -45,6 +45,7 @@
 
            ww-set-attr
            ww-get-attr
+           ww-get-attrs
            ww-del-attr
            
            ww-set-style
@@ -58,6 +59,8 @@
            ww-set-value
            ww-get-value
 
+           ww-get-elements
+
            ww-set-show-state
            ww-show-state
 
@@ -71,6 +74,7 @@
 
            windows
            windows-evt-handlers
+           ww-get-window-for-id
 
            ww-from-string
    )
@@ -230,6 +234,9 @@
   (define windows-evt-handlers (make-hash))
   (define windows (make-hash))
 
+  (define (ww-get-window-for-id win-id)
+    (hash-ref windows win-id #f))
+
   (define handle-results (make-hash))
   (define handle-semaphores (make-hash))
 
@@ -326,7 +333,10 @@
                         (more-lines (- lines 1))
                         )
                    (while (> more-lines 0)
-                       (let ((line (string-trim (read-line err-ww))))
+                       (let* ((line* (read-line err-ww))
+                              (line (if (eof-object? line*)
+                                        ""
+                                        (string-trim line*))))
                          (set! rest (string-append rest "\n" line))
                          (set! more-lines (- more-lines 1))
                          ))
@@ -425,13 +435,18 @@
           (ww-error
            (format "Unexpected: (eq? ww-from-ww #f), for command '~a" cmd))
           (cons #f 'nil))
-        (let ((line-in (string-trim (read-line ww-from-ww))))
+        (let* ((line-in* (read-line ww-from-ww))
+               (line-in (if (eof-object? line-in*)
+                            "NOK(1):eof:0"
+                            (string-trim line-in*)))
+               )
           (let ((ok (string-prefix? line-in "OK("))
-                (nok (string-prefix? line-in "NOK("))
+                (nok (or (string=? line-in "")
+                         (string-prefix? line-in "NOK(")))
                 )
             (let ((m (regexp-match re-kind line-in)))
               (unless m
-                (error (format "Input not expected: ~a" line-in)))
+                (ww-debug (format "Input not expected: \"~a\", maybe ww-quit issued" line-in)))
               (let* ((kind (cadr m))
                      (lines (string->number (caddr m)))
                      (result-str (substring line-in (string-length (car m))))
@@ -439,11 +454,17 @@
                      )
                 ;(displayln result-str)
                 ;(displayln (format "~a ~a ~a" kind lines more-lines))
-                (while (> more-lines 0)
+                (let ((rdln (λ ()
-                       (set! result-str (string-append
+                              (let ((l (read-line ww-from-ww)))
-                                         result-str "\n"
+                                (if (eof-object? l)
-                                         (string-trim (read-line ww-from-ww))))
+                                    ""
-                       (set! more-lines (- more-lines 1)))
+                                    (string-trim l))))))
+                  (while (> more-lines 0)
+                         (set! result-str (string-append
+                                           result-str "\n"
+                                           (rdln)))
+                         (set! more-lines (- more-lines 1)))
+                  )
                 (cons ok result-str)
                 ))))
         )
@@ -743,6 +764,35 @@
                         (as-string element-id) (as-string attr))))
       (ww-await js-handle cmd)))
 
+  
+  ;; Get all attributes of an element with given id
+  (define (mk-attrs _attrs)
+      (let* ((attrs (make-hash)))
+        (for-each (λ (attr-val)
+                    (hash-set! attrs
+                               (string->symbol (car attr-val))
+                               (cadr attr-val)))
+                  _attrs)
+        attrs)
+    )
+  
+  (define (ww-get-attrs win-id element-id)
+    (let* ((js-handle (new-handle))
+           (cmd (format "get-attrs ~a ~a ~a" win-id js-handle
+                        (as-string element-id))))
+      (mk-attrs (ww-await js-handle cmd))))
+
+  ;; Get info of all elements for a selector
+  (define (ww-get-elements win-id selector)
+    (let* ((js-handle (new-handle))
+           (cmd (format "get-elements ~a ~a ~a" win-id js-handle
+                        (as-string selector))))
+      (map (λ (item)
+             (cons (string->symbol (car item))
+                   (mk-attrs (cadr item)))
+             )
+           (ww-await js-handle cmd))))
+
   ;; Delete attribute of element
   (define (ww-del-attr win-id element-id attr)
     (let* ((js-handle (new-handle))
@@ -791,8 +841,13 @@
     (let* ((js-handle (new-handle))
            (cmd (format "element-info ~a ~a ~a" win-id js-handle
                         (as-string id))))
-      (ww-await js-handle cmd)))
+      (let ((result (ww-await js-handle cmd)))
-
+        (list (if (symbol? id)
+                  (string->symbol (car result))
+                  (car result))
+              (string->symbol (cadr result))
+              (string->symbol (caddr result))
+              (cadddr result)))))
 
   ;; Add a class to an element
   (define (ww-add-class win-id element-id class)