diff --git a/example1/example-1-dialog.html b/example1/example-1-dialog.html index a733a9f..1ce1f50 100644 --- a/example1/example-1-dialog.html +++ b/example1/example-1-dialog.html @@ -3,10 +3,10 @@ - This is test 1 Dialog + This is a Dialog for Example 1 -

Dialog test 1

+

Preferences for Example 1

diff --git a/example1/example-1.html b/example1/example-1.html index 86dda72..9b67683 100644 --- a/example1/example-1.html +++ b/example1/example-1.html @@ -14,6 +14,9 @@

This is Example 1

+
+ +

screen coöords

Opening a link to some website

@@ -60,12 +63,5 @@ -

Some pictures

-
- -
-
- -
diff --git a/example1/example.rkt b/example1/example.rkt index 9b5881d..e37d8fb 100644 --- a/example1/example.rkt +++ b/example1/example.rkt @@ -3,6 +3,7 @@ (require "../main.rkt" racket/runtime-path racket/gui + simple-ini/class ) (provide @@ -38,18 +39,35 @@ )) (define example-1-dialog% - (class ww-webview% + (class ww-webview-dialog% + (inherit-field settings) (super-new [html-file dialog-html] [width 400] [height 300]) (define/override (html-loaded) (super html-loaded) + (ww-debug "html-loaded for example-1-dialog%") (let* ((btn (send this element 'ok-btn))) (send btn connect 'click (λ (data) - (send this close))))) - )) + (send this close)))) + + (let* ((inp1 (send this element 'inp1)) + (inp2 (send this element 'inp2)) + (inp3 (send this element 'inp3))) + (send inp1 set! (send settings get 'inp1 "")) + (send inp2 set! (send settings get 'inp2 "")) + (send inp3 set! (send settings get 'inp3 "")) + (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))) + ) + ) + ) + ) (define-syntax inc (syntax-rules () @@ -60,14 +78,18 @@ (define example-1-window% (class ww-webview% + + (inherit-field settings) + (super-new [html-file html-start] + ) + (define go-on-counter #f) (define c-counter 0) (define counter-inc 1) (define counter-thread #f) (define div-counter #f) - (define my-dir ".") - - (super-new [html-file html-start]) + (define my-dir (send settings get 'folder ".")) + (define/override (can-close?) (eq? counter-thread #f)) @@ -104,14 +126,6 @@ (css-style '((color white) (background red) (font-size 120%) (font-weight bold))))) ) - (define/public (set-folder new-dir) - (set! my-dir new-dir) - (let ((el (send this element 'folder))) - (send el set-inner-html! (format "Selected folder: ~a" my-dir)) - ) - ) - - (define/public (start-counter) (set! counter-thread (thread @@ -125,6 +139,22 @@ (f))))) ) + (define/public (set-folder new-dir) + (set! my-dir new-dir) + (send settings set 'folder new-dir) + (let ((el (send this element 'folder))) + (send el set-inner-html! (format "Selected folder: ~a" my-dir)) + ) + ) + + (define/override (choose-dir) + (let ((new-dir (super choose-dir "Select a folder" my-dir))) + (unless (eq? new-dir #f) + (send this set-folder new-dir)))) + + (define/public (prefs) + (new example-1-dialog% [parent this] [settings (send this clone-settings 'example-1-dialog)])) + (define/override (handle-navigate url type kind) (send this reset-counter) (super handle-navigate url type kind)) @@ -140,10 +170,10 @@ (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) - (new example-1-dialog% [parent this]))) + (λ (data) (send this prefs))) (send start-stop-btn connect 'click (λ (data) @@ -157,6 +187,9 @@ ) ) ) + (send choose-dir-btn connect 'click + (λ (data) + (send this choose-dir))) ) (ww-debug "SETTING MENU") @@ -196,21 +229,24 @@ (λ () (send this reset-counter))) (send this connect-menu! 'm-prefs - (λ () (new example-1-dialog% [parent this]))) + (λ () (send this prefs))) (send this connect-menu! 'm-select-dir - (λ () - (let ((new-dir (send this choose-dir "Select a folder" my-dir))) - (unless (eq? new-dir #f) - (send this set-folder new-dir))))) + (λ () (send this choose-dir))) ) ) ) (begin - (displayln html-start) + (displayln "Yes this works!") ) ) ) +(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])) + ) + window)) diff --git a/example1/racket-logo.png b/example1/racket-logo.png new file mode 100644 index 0000000..4c4717e Binary files /dev/null and b/example1/racket-logo.png differ diff --git a/example1/styles.css b/example1/styles.css index 29f69ac..c31f01a 100644 --- a/example1/styles.css +++ b/example1/styles.css @@ -57,3 +57,12 @@ td span.counter { border: 1px solid grey; } +.right { + float: right; +} + +.right img.logo { + margin: 2em; + border: 2px solid grey; + max-width: 250px; +} diff --git a/info.rkt b/info.rkt index 350cc64..e0ee659 100644 --- a/info.rkt +++ b/info.rkt @@ -13,7 +13,7 @@ ) (define deps - '("racket/base" "net/http-easy" "file/unzip" "gregor" "html-printer")) + '("racket/base" "net/http-easy" "gregor" "html-printer" "simple-ini")) (define build-deps '("racket-doc" diff --git a/main.rkt b/main.rkt index c466c16..a771bed 100644 --- a/main.rkt +++ b/main.rkt @@ -2,10 +2,12 @@ (require "private/web-racket.rkt" "private/web-racket-version.rkt" + "settings/web-racket-ini.rkt" ) (provide (all-from-out "private/web-racket.rkt") (all-from-out "private/web-racket-version.rkt") + (all-from-out "settings/web-racket-ini.rkt") ) diff --git a/private/web-racket.rkt b/private/web-racket.rkt index fb77f8e..8aa76ce 100644 --- a/private/web-racket.rkt +++ b/private/web-racket.rkt @@ -17,6 +17,9 @@ (provide ww-element% ww-input% ww-webview% + ww-webview-dialog% + ww-settings% + ww-webview-message% ww-start ww-stop @@ -178,11 +181,17 @@ (define ww-input% (class ww-element% + (define cb #f) (define val #f) (define/public (get) val) + (define/public (on-change! callback) + (inp-set! cb callback) + (cb val) + ) + (define/public (set! v) (inp-set! val v) (ww-set-value (send this get-win-id) @@ -204,11 +213,15 @@ (inp-set! val (ww-get-value (send this get-win-id) (send this get-id))) (send this connect 'input (λ (data) - (ww-debug data) - (let ((js-evt (hash-ref data 'js-evt #f))) + (let ((js-evt (hash-ref data 'js_evt #f))) (unless (eq? js-evt #f) (when (hash-has-key? js-evt 'value) - (inp-set! val (hash-ref js-evt 'value))))))) + (let ((v (hash-ref js-evt 'value))) + (inp-set! val v) + (unless (eq? cb #f) + (cb v)) + )))) + )) (send (send this win) bind 'input (format "#~a" (send this get-id))) ) )) @@ -299,14 +312,15 @@ (class object% (init-field [profile 'default-profile] + [settings #f] [use-browser #f] [parent-id #f] [parent #f] [title "Racket HTML Window"] - [x _std_x] - [y _std_y] - [width _std_w] - [height _std_h] + [x (if (eq? settings #f) _std_x (send settings get 'window-x _std_x))] + [y (if (eq? settings #f) _std_y (send settings get 'window-y _std_y))] + [width (if (eq? settings #f) _std_w (send settings get 'window-width _std_w))] + [height (if (eq? settings #f) _std_h (send settings get 'window-height _std_h))] [icon #f] [menu #f] [html-file #f] @@ -317,6 +331,11 @@ (define menu-cbs (make-hash)) (define elements (make-hash)) (define html-handle #f) + + (define/public (clone-settings section) + (if (eq? settings #f) + #f + (send settings clone section))) (define (event-handler evt content) (ww-debug (format "win-id=~a '~a ~a" win-id evt content)) @@ -335,12 +354,19 @@ (height* (hash-ref content 'height)) ) (set! width width*) - (set! height height*))) + (set! height height*) + (unless (eq? settings #f) + (send settings set 'window-width width) + (send settings set 'window-height height)) + )) ([eq? evt 'moved] (let* ((x* (hash-ref content 'x)) (y* (hash-ref content 'y)) ) (set! x x*) (set! y y*) + (unless (eq? settings #f) + (send settings set 'window-x x) + (send settings set 'window-y y)) )) ([eq? evt 'close-request] (when (send this can-close?) (send this close))) @@ -477,10 +503,20 @@ (set! html-file file) (when folder (ww-cwd folder)) - (set! html-handle (ww-set-html win-id the-file)) + (set! html-handle (ww-set-html-file win-id the-file)) (ww-debug (format "html file set to ~a" the-file)) )) + (define/public (set-html html) + (let* ((tmpfile "/tmp/test.html") + (fh (open-output-file tmpfile #:exists 'replace))) + (displayln tmpfile) + (display html fh) + (close-output-port fh) + (send this set-html-file! tmpfile) + ) + ) + (define/public (set-url url) (send-url url)) @@ -568,13 +604,17 @@ (if (eq? r 'cmd-nok) #f r))) - + + (define/public (inherit-checks) + #t) ; Supers first (super-new) ; construct (begin + (send this inherit-checks) + (when (= (hash-count windows) 0) (ww-start)) @@ -626,12 +666,54 @@ )) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Classes representing WebView Dialogs + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define ww-webview-dialog% + (class ww-webview% + (super-new) + + (inherit-field parent) + + (define/override (inherit-checks) + (when (eq? parent #f) + (error "A parent must be given"))) + )) + + + (define ww-webview-message% + (class ww-webview-dialog% + (super-new) + + (send this set-html + "Message

[msg]

[submsg]

" + ) + ) + ) + (define (set-global-stylesheet st) (ww-set-stylesheet st)) (define (get-global-stylesheet) (ww-get-stylesheet)) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Classes for settings + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define ww-settings% + (class object% + (super-new) + (define/public (set key value) + (error "ww-settings%: set not implemented, override in your specific subclass")) + (define/public (get key . default) + (error "ww-settings%: get not implemented, override in your specific subclass")) + (define/public (clone new-section) + (error "ww-settings%: clone not implemented, override in your specific subclass")) + (define/public (set! key value) + (send this set key value)) + ) + ) ); end of module \ No newline at end of file diff --git a/private/web-wire.rkt b/private/web-wire.rkt index 864c872..ea75477 100644 --- a/private/web-wire.rkt +++ b/private/web-wire.rkt @@ -43,7 +43,7 @@ ww-set-menu - ww-set-html + ww-set-html-file ww-set-url ww-set-inner-html @@ -98,8 +98,9 @@ #f))) (define (as-string s) - (let ((s* (format "~a" s))) - (with-output-to-string (lambda () (write s*))))) + (format "~a" s)) + ;(let ((s* (format "~a" s))) + ; (with-output-to-string (lambda () (write s*))))) (define (ww-from-string s) (let ((s* (substring s 1 (- (string-length s) 1)))) @@ -814,13 +815,12 @@ set-url ((win-id ww-win?) (url string?)) () -> void) - ;; Set html of window - (def-cmd ww-set-html + ;; Set html of window to file + (def-cmd ww-set-html-file set-html ((win-id ww-win?) (html-file html-file-exists?)) () -> number) - ;; Set inner html of an Id of the HTML in the window (def-cmd ww-set-inner-html set-inner-html ((win-id ww-win?) diff --git a/private/webui-wire-ipc.rkt b/private/webui-wire-ipc.rkt index 253ea28..5428c08 100644 --- a/private/webui-wire-ipc.rkt +++ b/private/webui-wire-ipc.rkt @@ -34,7 +34,8 @@ (if (and (string? colon) (string=? colon ":") (is-int? str-length)) ; process line (let* ((length (string->number str-length)) - (input (read-string length process-stderr)) + (input-bytes (read-bytes length process-stderr)) + (input (bytes->string/utf-8 input-bytes)) (m (regexp-match re-kind input)) ) (read-eol process-stderr) @@ -88,7 +89,8 @@ (semaphore-post sem) (error "Unexpected input from webui-wire executable")) (let* ((length (string->number str-length)) - (input (read-string length process-stdout)) + (input-bytes (read-bytes length process-stdout)) + (input (bytes->string/utf-8 input-bytes)) ) (read-eol process-stdout) (semaphore-post sem) diff --git a/settings/web-racket-ini.rkt b/settings/web-racket-ini.rkt new file mode 100644 index 0000000..ffc3048 --- /dev/null +++ b/settings/web-racket-ini.rkt @@ -0,0 +1,39 @@ +(module web-racket-ini racket/gui + + (require simple-ini/class + "../private/web-racket.rkt" + ) + + (provide ww-simple-ini%) + + + (define ww-simple-ini% + (class ww-settings% + (init-field [ini (error "Initialize this ww-simple-ini% with a ini% object of the simple-ini package")] + [section (error "Initialize this ww-simple-ini% with a section to use in the ini")] + ) + + (super-new) + + (define/override (set key value) + (send ini set! section key value) + this + ) + + (define/override (get key . default) + (let ((d (if (null? default) #f (car default)))) + (send ini get section key d))) + + (define/override (clone new-section) + (new ww-simple-ini% [ini ini] [section new-section])) + + (begin + (unless (is-a? ini ini%) + (error "ini must be of type ini%")) + (unless (symbol? section) + (error "section must be a symbol")) + )) + ) + + + ) ; end of module
Input 1
Input 2