added on-choose-directory method to name-message
original commit: 16a8f41c5e31187f6b1a6075cd0e56e4752744b2
This commit is contained in:
parent
add583b432
commit
b4f1db5997
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user