-
This commit is contained in:
@@ -61,7 +61,9 @@
|
|||||||
webview-bind!
|
webview-bind!
|
||||||
|
|
||||||
webview-set-url!
|
webview-set-url!
|
||||||
|
webview-navigate!
|
||||||
webview-set-html!
|
webview-set-html!
|
||||||
|
webview-base-url
|
||||||
|
|
||||||
webview-set-innerHTML!
|
webview-set-innerHTML!
|
||||||
|
|
||||||
@@ -113,6 +115,7 @@
|
|||||||
[file-getter #:mutable]
|
[file-getter #:mutable]
|
||||||
[boilerplate-js #:mutable]
|
[boilerplate-js #:mutable]
|
||||||
[webserver-thread #:mutable]
|
[webserver-thread #:mutable]
|
||||||
|
[base-url #:mutable]
|
||||||
[request-count #:mutable]
|
[request-count #:mutable]
|
||||||
[sec-token-cache #:mutable]
|
[sec-token-cache #:mutable]
|
||||||
[cert-ou-token #:mutable]
|
[cert-ou-token #:mutable]
|
||||||
@@ -377,7 +380,7 @@
|
|||||||
(->* ((or/c symbol? string?) procedure? procedure?)
|
(->* ((or/c symbol? string?) procedure? procedure?)
|
||||||
(#:boilerplate-js procedure? #:parent (or/c wv? #f))
|
(#:boilerplate-js procedure? #:parent (or/c wv? #f))
|
||||||
wv?)
|
wv?)
|
||||||
(let* ((h (make-wv #f 0 -1 file-getter bj #f 0 (make-lru 250 #:cmp eq?)
|
(let* ((h (make-wv #f 0 -1 file-getter bj #f #f 0 (make-lru 250 #:cmp eq?)
|
||||||
(symbol->string (make-security-token)) (symbol->string context)))
|
(symbol->string (make-security-token)) (symbol->string context)))
|
||||||
(cert (generate-self-signed-cert 2048 365 '("127.0.0.1" "localhost")
|
(cert (generate-self-signed-cert 2048 365 '("127.0.0.1" "localhost")
|
||||||
"NL" "Dijkema"
|
"NL" "Dijkema"
|
||||||
@@ -401,6 +404,7 @@
|
|||||||
(base-req (format "https://127.0.0.1:~a" (wv-port h)))
|
(base-req (format "https://127.0.0.1:~a" (wv-port h)))
|
||||||
)
|
)
|
||||||
(set-wv-webserver-thread! h server)
|
(set-wv-webserver-thread! h server)
|
||||||
|
(set-wv-base-url! h base-req)
|
||||||
(rkt-webview-set-ou-token (wv-handle h) (wv-cert-ou-token h))
|
(rkt-webview-set-ou-token (wv-handle h) (wv-cert-ou-token h))
|
||||||
(rkt-webview-set-url! (wv-handle h) base-req)
|
(rkt-webview-set-url! (wv-handle h) base-req)
|
||||||
h)
|
h)
|
||||||
@@ -428,12 +432,31 @@
|
|||||||
|
|
||||||
(define/contract (webview-set-url! wv url)
|
(define/contract (webview-set-url! wv url)
|
||||||
(-> wv? (or/c string? url?) symbol?)
|
(-> wv? (or/c string? url?) symbol?)
|
||||||
(if (url? url)
|
(let ((u (if (string? url) (string->url url) url))
|
||||||
(rkt-webview-set-url! (wv-handle wv) (url->string url))
|
(bu (string->url (wv-base-url wv))))
|
||||||
(rkt-webview-set-url! (wv-handle wv) url)
|
(when (or (eq? (url-scheme u) #f) (eq? (url-host u) #f))
|
||||||
|
(set-url-host! u (url-host bu))
|
||||||
|
(set-url-port! u (url-port bu))
|
||||||
|
(set-url-scheme! u (url-scheme bu))
|
||||||
|
(set-url-path-absolute?! u #t)
|
||||||
|
)
|
||||||
|
(when (eq? (url-scheme u) #f)
|
||||||
|
(set-url-scheme! (url-scheme bu)))
|
||||||
|
(rkt-webview-set-url! (wv-handle wv) (url->string u))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(define/contract (webview-navigate! wv place)
|
||||||
|
(-> wv? string? symbol?)
|
||||||
|
(webview-run-js wv
|
||||||
|
(format "window.location = '~a';"
|
||||||
|
(esc-quote place))))
|
||||||
|
|
||||||
|
(define/contract (webview-base-url wv)
|
||||||
|
(-> wv? url?)
|
||||||
|
(string->url (wv-base-url wv)))
|
||||||
|
|
||||||
|
|
||||||
(define-syntax def-win-func
|
(define-syntax def-win-func
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ name name-to-wrap)
|
((_ name name-to-wrap)
|
||||||
|
|||||||
Reference in New Issue
Block a user