suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix platform-independent file dialog

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-31 09:41:10 -07:00
parent aa4a0faab4
commit 00124220bd
1 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/mred/private/path-dialog.rkt
View File

@ -685,26 +685,29 @@
(make-object message% (protect& message) p))) (make-object message% (protect& message) p)))
(define dir-text (define dir-text
(let ([c (class (if win? combo-field% text-field%) (super-new) (let* ([c%
(if win?
(class combo-field%
(super-new [choices '()])
(define/override (on-popup e)
(let ([m (send this get-menu)])
(for-each (lambda (i) (send i delete))
(send m get-items))
(for-each (lambda (r)
(define l (path->string r))
(make-object menu-item% l m
(lambda _
(enter-text r)
(do-enter))))
(filesystem-root-list)))))
text-field%)]
[c (class c%
(super-new)
(define editor (send this get-editor)) (define editor (send this get-editor))
(define/public (lock) (send editor lock #t)) (define/public (lock) (send editor lock #t))
(define/public (unlock) (send editor lock #f)) (define/public (unlock) (send editor lock #f))
(define/override (on-popup e)
(when win?
(let ([m (send this get-menu)])
(for-each (lambda (i) (send i delete))
(send m get-items))
(for-each (lambda (r)
(define l (path->string r))
(make-object menu-item% l m
(lambda _
(enter-text r)
(do-enter))))
(filesystem-root-list)))))
(lock))]) (lock))])
(if win? (new c [label #f] [parent this] [init-value ""])))
(new c [label #f] [parent this] [init-value ""] [choices '()])
(new c [label #f] [parent this] [init-value ""]))))
(define path-list (define path-list
(new (class list-box% (new (class list-box%