-

private/racket-webview.rkt

@@ -61,7 +61,9 @@
          webview-bind!
          
          webview-set-url!
+         webview-navigate!
          webview-set-html!
+         webview-base-url
 
          webview-set-innerHTML!
          
@@ -113,6 +115,7 @@
    [file-getter #:mutable]
    [boilerplate-js #:mutable]
    [webserver-thread #:mutable]
+   [base-url #:mutable]
    [request-count #:mutable]
    [sec-token-cache #:mutable]
    [cert-ou-token #:mutable]
@@ -377,7 +380,7 @@
   (->* ((or/c symbol? string?) procedure? procedure?)
        (#:boilerplate-js procedure? #:parent (or/c wv? #f))
        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)))
          (cert (generate-self-signed-cert 2048 365 '("127.0.0.1" "localhost")
                                           "NL" "Dijkema"
@@ -401,6 +404,7 @@
          (base-req (format "https://127.0.0.1:~a" (wv-port h)))
          )
     (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-url! (wv-handle h) base-req)
     h)
@@ -428,11 +432,30 @@
   
 (define/contract (webview-set-url! wv url)
   (-> wv? (or/c string? url?) symbol?)
-  (if (url? url)
-      (rkt-webview-set-url! (wv-handle wv) (url->string url))
-      (rkt-webview-set-url! (wv-handle wv) url)
+  (let ((u (if (string? url) (string->url url) url))
+        (bu (string->url (wv-base-url wv))))
+    (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
   (syntax-rules ()