choose-dir

example1/example.rkt

@@ -157,10 +157,15 @@
       )
 
     (define/override (choose-dir)
-      (let ((new-dir (super choose-dir "Select a folder" my-dir)))
+      (let ((handle (super choose-dir "Select a folder" my-dir)))
-        (displayln (format "choosen dir: ~a" new-dir))
+        (displayln (format "choosen dir handle: ~a" handle))
-        (unless (eq? new-dir #f)
+        )
-          (send this set-folder new-dir))))
+      )
+
+    (define/override (dir-choosen handle choosen dir)
+      (displayln (format "dir-choosen: ~a ~a ~a" handle choosen dir))
+      (when choosen
+        (send this set-folder dir)))
 
     (define/public (prefs)
       (new example-1-dialog% [parent this] [settings (send this clone-settings 'example-1-dialog)]))

private/web-racket.rkt

@@ -665,11 +665,15 @@
         )
 
       (define/public (choose-dir caption base-dir)
-        (let ((r (ww-choose-dir win-id caption base-dir)))
+        (let ((bdir (string-trim base-dir)))
-          (ww-debug (format "choose-dir: ~a" r))
+          (when (or (string=? bdir "") (string=? bdir ".") (string=? bdir ".."))
-          (if (eq? r 'cmd-nok)
+            (set! bdir (path->string (find-system-path 'home-dir))))
-              #f
+          (ww-debug (format "ww-choose-dir ~a ~a ~a" win-id caption bdir))
-              r)))
+          (let ((r (ww-choose-dir win-id caption bdir)))
+            (ww-debug (format "choose-dir: ~a" r))
+            (if (eq? r 'cmd-nok)
+                #f
+                r))))
 
       (define/public (dir-choosen handle choosen dir)
         (ww-debug (format "dir-choosen: handle=~a, choosen=~a, dir=~a" handle choosen dir))

private/web-wire.rkt

@@ -222,7 +222,10 @@
              (payload* (substring evt (string-length (list-ref m 0))))
              (payload (if (string=? payload* "")
                           (make-hash)
-                          (with-input-from-string (substring payload* 1) read-json)))
+                          (begin
+                            (write payload*)(newline)
+                            (with-input-from-string (substring payload* 1) read-json)))
+                      )
             )
         (if (eq? evt-handler #f)
             (ww-error (format "process-event: no event handler to handle event ~a" evt))