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

cocoa: fix `get-file' when any extension is allowed

Browse Source
This commit is contained in:
Eli Barzilay 2011-06-03 01:38:40 -04:00
parent 6a1eefe080
commit 045369e3b9
1 changed files with 9 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/mred/private/wx/cocoa/filedialog.rkt
View File

@ -40,22 +40,18 @@
(if (memq 'packages style) (cons "app" extensions) extensions)]
[extensions
(if (and extension (not (equal? "" extension)))
(cons extension extensions) extensions)]
;; add "foo~" suffixes too.
[extensions
(append (for/list ([e (in-list extensions)]
#:when (not (regexp-match? #rx"~$" e)))
(string-append e "~"))
extensions)])
(cons extension extensions) extensions)])
(unless (null? extensions)
(when (memq 'put style)
(tellv ns setCanSelectHiddenExtension: #:type _BOOL #t))
(let ([a (tell NSArray
arrayWithObjects: #:type (_list i _NSString) extensions
count: #:type _NSUInteger (length extensions))])
(tellv ns setAllowedFileTypes: a))
(tellv ns setAllowsOtherFileTypes:
#:type _BOOL (and (member "*.*" globs) #t))))
(let ([allow-any? (member "*.*" globs)])
(when (or (not allow-any?)
(memq 'put style))
(let ([a (tell NSArray
arrayWithObjects: #:type (_list i _NSString) extensions
count: #:type _NSUInteger (length extensions))])
(tellv ns setAllowedFileTypes: a))
(tellv ns setAllowsOtherFileTypes: #:type _BOOL allow-any?)))))
(cond
[(memq 'multi style)