-

private/racket-webview-qt.rkt

@@ -35,6 +35,7 @@
          rkt-webview-exit
          rkt-webview-valid?
          rkt-webview-open-devtools
+         rkt-webview-choose-dir
          )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -265,6 +266,10 @@
 (define-rktwebview rkt_webview_set_title
   (_fun _int _string/utf-8 -> _rkt_result_t))
 
+;RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_choose_dir(rktwebview_t w, const char *title, const char *base_dir);
+(define-rktwebview rkt_webview_choose_dir
+  (_fun _int _string/utf-8 _string/utf-8 -> _rkt_js_result_t-pointer))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Initialize and start library
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -317,8 +322,10 @@
       'done))
 
 (define (rkt-webview-create parent evt-callback)
-  (let ((evt-queue (make-queue)))
-    (let ((wv (rkt_webview_create parent
+  (let* ((evt-queue (make-queue))
+         (parent-win (if (eq? parent #f) 0 (rkt-wv-win parent)))
+         )
+    (let ((wv (rkt_webview_create parent-win
                                   (λ (rkt-evt)
                                     (enqueue! evt-queue rkt-evt)))))
       (let ((handle (make-rkt-wv wv evt-queue evt-callback #t)))
@@ -386,6 +393,17 @@
 (define (rkt-webview-open-devtools wv)
   (rkt_webview_open_devtools (rkt-wv-win wv)))
 
+(define (rkt-webview-choose-dir wv title base-dir)
+  (let* ((r (rkt_webview_choose_dir (rkt-wv-win wv) title base-dir))
+         (value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8))
+         (result (rkt_js_result_t-result r)))
+    (rkt_webview_destroy_js_result r)
+    (list result value)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Administration
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (define (rkt-webview-valid? wv)
   (if (eq? (rkt-wv-valid wv) #f)
       #f
@@ -402,6 +420,9 @@
               open-windows))
   (stop-event-processing))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Cleanup on exit
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (plumber-add-flush! (current-plumber)
                     (λ (handle)

private/racket-webview.rkt

@@ -21,9 +21,11 @@
 (provide webview-create
          webview-devtools
          webview-close
+
          webview-run-js
          webview-call-js
          webview-call-js-result?
+         
          webview-move
          webview-resize
          webview-show
@@ -32,8 +34,12 @@
          webview-maximize
          webview-minimize
          webview-window-state
-         webview-bind!
          webview-set-title!
+
+         webview-choose-dir
+         
+         webview-bind!
+         
          webview-set-url!
          webview-set-html!
 
@@ -192,14 +198,15 @@
    
 (define (webview-create file-getter event-callback
                         #:boilerplate-js [bj (default-boilerplate-js)]
-                        #:parent [p 0])
+                        #:parent [p #f])
   (let* ((h (make-wv #f current-servlet-port -1 file-getter bj #f))
          (server (let ((s (start-web-server h)))
                    (sleep 1) ;;; TODO: Check if web server is up. 
                    s))
          (event-processor (λ (wv evt)
                             (event-callback h (util-parse-event evt))))
-         (wv (rkt-webview-create p event-processor))
+         (ph (if (wv? p) (wv-handle p) #f))
+         (wv (rkt-webview-create ph event-processor))
          (base-req (format "http://127.0.0.1:~a"
                            (wv-port h)))
          )
@@ -253,6 +260,25 @@
 (def-win-func webview-present rkt-webview-present)
 (def-win-func webview-window-state rkt-webview-window-state)
 
+(define/contract (webview-choose-dir wv title base-dir)
+  (-> wv? string? (or/c path? string?) (or/c hash? boolean?))
+  (let ((bd (if (path? base-dir) (path->string base-dir) base-dir)))
+    (let ((res (rkt-webview-choose-dir (wv-handle wv) title bd)))
+      (if (eq? res #f)
+          #f
+          (cond ((eq? (car res) 'oke)
+                 (let ((h (fromJson (cadr res))))
+                   (let ((r (make-hash)))
+                     (hash-set! r 'dir (hash-ref h 'dir))
+                     (hash-set! r 'state (string->symbol
+                                          (hash-ref h 'state)))
+                     r)))
+                (else #f))
+          )
+      )
+    )
+  )
+
 (define/contract (webview-set-title! wv title)
   (-> wv? string? symbol?)
   (rkt-webview-set-title! (wv-handle wv) title))
@@ -506,9 +532,6 @@
   )
 
                        
-
-
-
 #|(define/contract (webview-set-style! wv selector style-entries)
   (-> wv? (or/c symbol? string?) (or/c list? list-of-kv?) hash?)