diff --git a/private/web-racket.rkt b/private/web-racket.rkt index 3813d36..9e8e52f 100644 --- a/private/web-racket.rkt +++ b/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 - (send this bind-buttons) - (send this bind-inputs))) + ([eq? evt 'page-loaded] (send this html-loaded)) ([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))) - (type (string->symbol (caddr m)))) - (send this handle-navigate url type))) + (url (ww-from-string (cadr m))) + (type (string->symbol (caddr m))) + (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) - (cond - ([eq? type 'link-clicked] - (send this set-url url)) - (else (ww-error (format "Don't know what to do for ~a - ~a" type url))) - )) + (define/public (handle-navigate url type kind) + (let ((method (if (eq? kind 'set-html) 'set-html-file! 'set-url))) + (cond + ([eq? type 'link-clicked] + (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))) - (if (eq? el #f) + (let ((el (hash-ref elements id 'no-element-with-id-in-hash))) + (if (eq? el 'no-element-with-id-in-hash) (let ((info (ww-element-info win-id id))) - (let* ((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)) @@ -294,7 +314,6 @@ (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) @@ -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) @@ -403,6 +426,14 @@ (begin (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) @@ -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 \ No newline at end of file diff --git a/private/web-wire.rkt b/private/web-wire.rkt index 50e2501..a20a25b 100644 --- a/private/web-wire.rkt +++ b/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) - (set! result-str (string-append - result-str "\n" - (string-trim (read-line ww-from-ww)))) - (set! more-lines (- more-lines 1))) + (let ((rdln (λ () + (let ((l (read-line ww-from-ww))) + (if (eof-object? l) + "" + (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)