Asynchronous messages, file dialogs and call/cc stuff
This commit is contained in:
@@ -4,6 +4,8 @@
|
||||
racket/runtime-path
|
||||
racket/gui
|
||||
simple-ini/class
|
||||
racket/string
|
||||
net/url
|
||||
)
|
||||
|
||||
(provide
|
||||
@@ -55,8 +57,7 @@
|
||||
(define example-1-dialog%
|
||||
(class wv-dialog%
|
||||
(inherit-field settings)
|
||||
(super-new [window-context 'example-1-dialog]
|
||||
[file-not-found-handler (root-file-not-found-handler "example-1-dialog.html")]
|
||||
(super-new [html-path "example-1-dialog.html"]
|
||||
)
|
||||
|
||||
(define/override (page-loaded oke)
|
||||
@@ -93,11 +94,12 @@
|
||||
(define example-1-window%
|
||||
(class wv-window%
|
||||
|
||||
(inherit-field settings app-context)
|
||||
(super-new [file-not-found-handler (root-file-not-found-handler "example-1.html")]
|
||||
[window-context 'example-1-main]
|
||||
(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)
|
||||
@@ -107,18 +109,25 @@
|
||||
|
||||
|
||||
(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 start-stop-btn #f)
|
||||
|
||||
(define/public (stop-counter)
|
||||
(send start-stop-btn set-innerHTML! "Start 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! counter-thread #f)
|
||||
(set! c-counter 0)
|
||||
)
|
||||
|
||||
(define/public (inc-counter)
|
||||
@@ -130,26 +139,30 @@
|
||||
(send this update-counter))
|
||||
|
||||
(define/public (update-counter)
|
||||
(send div-counter set-innerHTML! (format "Count = ~a" c-counter))
|
||||
(when (and (> c-counter 0) (<= c-counter 100))
|
||||
(send div-counter set-style!
|
||||
'((background white))))
|
||||
(when (and (> c-counter 100) (<= c-counter 200))
|
||||
(send div-counter set-style!
|
||||
'((background green) (color white))))
|
||||
(when (and (> c-counter 200) (<= c-counter 300))
|
||||
(send div-counter set-style!
|
||||
'((background yellow) (color black) (font-size: 120%))))
|
||||
(when (and (> c-counter 300) (<= c-counter 400))
|
||||
(send div-counter set-style!
|
||||
'((color white) (background orange) (font-size 110%))))
|
||||
(when (and (> c-counter 400))
|
||||
(send div-counter set-style!
|
||||
'((color white) (background red) (font-size 120%) (font-weight bold))))
|
||||
(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!
|
||||
'((background white) (color blue))))
|
||||
(when (and (> c-counter 100) (<= c-counter 200))
|
||||
(send div-counter set-style!
|
||||
'((background green) (color white))))
|
||||
(when (and (> c-counter 200) (<= c-counter 300))
|
||||
(send div-counter set-style!
|
||||
'((background yellow) (color black) (font-size: 120%))))
|
||||
(when (and (> c-counter 300) (<= c-counter 400))
|
||||
(send div-counter set-style!
|
||||
'((color white) (background orange) (font-size 110%))))
|
||||
(when (and (> c-counter 400))
|
||||
(send div-counter set-style!
|
||||
'((color white) (background red) (font-size 120%) (font-weight bold))))
|
||||
)
|
||||
)
|
||||
|
||||
(define/public (start-counter)
|
||||
(send start-stop-btn set-innerHTML! "Stop 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
|
||||
(λ ()
|
||||
@@ -165,16 +178,21 @@
|
||||
(define/public (set-folder new-dir)
|
||||
(set! my-dir new-dir)
|
||||
(send settings set/global! 'folder new-dir)
|
||||
(let ((el (send this element 'folder)))
|
||||
(send el set-innerHTML! (format "Selected folder: <b>~a</b>" my-dir))
|
||||
(when (and (eq? my-page 'first) has-page)
|
||||
(let ((el (send this element 'folder)))
|
||||
(displayln "set-folder innerhtml")
|
||||
(send el set-innerHTML! (format "Selected folder: <b>~a</b>" my-dir))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define/override (choose-dir)
|
||||
(let ((result (super choose-dir "Select a folder" my-dir)))
|
||||
(displayln (format "choosen dir handle: ~a" result))
|
||||
(unless (eq? result 'canceled)
|
||||
(send this set-folder result))
|
||||
(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))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -186,43 +204,63 @@
|
||||
)
|
||||
) ; (send this clone-settings 'example-1-dialog)]))
|
||||
|
||||
;(define/override (handle-navigate url type kind)
|
||||
; (send this reset-counter)
|
||||
; (super handle-navigate url type kind))
|
||||
(define/override (navigation-request type url)
|
||||
(displayln url)
|
||||
|
||||
(when (eq? my-page 'first)
|
||||
(send this reset-counter)
|
||||
(displayln "counter reset")
|
||||
)
|
||||
|
||||
(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 "HTML LOADED")
|
||||
(ww-debug (format "HTML LOADED ~a" oke))
|
||||
(set! has-page oke)
|
||||
(super page-loaded oke)
|
||||
(displayln "super called")
|
||||
(unless (eq? oke #f)
|
||||
|
||||
(set! div-counter (send this element 'div-counter))
|
||||
(send this update-counter)
|
||||
(send this set-folder my-dir)
|
||||
(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")
|
||||
(send this bind! 'dialog-button 'click (λ (el evt data)
|
||||
(send this prefs)))
|
||||
(ww-debug "CONNECTING BUTTONS")
|
||||
(send this bind! 'dialog-button 'click (λ (el evt data)
|
||||
(send this prefs)))
|
||||
|
||||
(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)
|
||||
(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)
|
||||
)
|
||||
(begin
|
||||
(send this reset-counter)
|
||||
)
|
||||
)
|
||||
(begin
|
||||
(send this reset-counter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(send this bind! 'devtools 'click
|
||||
(λ (el evt data) (send this devtools)))
|
||||
(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)))
|
||||
|
||||
(send this bind! 'select-dir-button 'click
|
||||
(λ (el evt data)
|
||||
(send this choose-dir*)))
|
||||
)
|
||||
(displayln "page-loaded done")
|
||||
)
|
||||
|
||||
;(ww-debug "SETTING MENU")
|
||||
#|(let* ((div-open (send this element 'div-open))
|
||||
@@ -268,7 +306,6 @@
|
||||
|
||||
)
|
||||
)|#
|
||||
)
|
||||
|
||||
(begin
|
||||
(displayln "Yes this works!")
|
||||
@@ -278,9 +315,8 @@
|
||||
|
||||
(define (run-example)
|
||||
(let* ((ini (new ini% [file 'web-racket-example1]))
|
||||
(context (new wv-context% [base-path cur-dir] [ini ini]))
|
||||
(window (new example-1-window%
|
||||
[app-context 'example-1]
|
||||
[ini ini]
|
||||
[base-dir cur-dir]))
|
||||
[wv-context context]))
|
||||
)
|
||||
window))
|
||||
|
||||
Reference in New Issue
Block a user