added on-choose-directory method to name-message

original commit: 16a8f41c5e31187f6b1a6075cd0e56e4752744b2
This commit is contained in:
Robby Findler 2003-01-17 19:16:25 +00:00
parent add583b432
commit b4f1db5997

View File

@ -1,6 +1,5 @@
(module name-message mzscheme
(require (lib "string-constant.ss" "string-constants")
(lib "framework.ss" "framework")
(lib "class.ss")
(lib "file.ss")
(lib "list.ss")
@ -27,6 +26,9 @@
get-top-level-window)
(override on-event on-paint)
(define/public (on-choose-directory dir)
(void))
(define paths #f)
;; label : string
@ -71,11 +73,7 @@
[else
(make-object menu-item% (car paths) menu
(lambda (evt item)
(parameterize ([finder:dialog-parent-parameter
(get-top-level-window)])
(let ([file (finder:get-file (apply build-path (reverse paths)))])
(when file
(handler:edit-file file))))))
(on-choose-directory (apply build-path (reverse paths)))))
(loop (cdr paths))]))
(popup-menu menu
0