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

Make the cocoa file dialogs deal better with ";"-separated globs.

Browse Source 
* Note the ugly hack of adding "foo~" for every "foo" suffix.

* Note also that when "*.*" is in the glob list all files should be
  available but it looks like this isn't working yet for some reason.
This commit is contained in:
Eli Barzilay 2011-06-03 00:54:07 -04:00
parent 67d58b9041
commit e9487fb0c7
1 changed files with 24 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,8 +9,7 @@
"queue.rkt"
"frame.rkt")
(provide
(protect-out file-selector))
(provide (protect-out file-selector))
(import-class NSOpenPanel NSSavePanel NSURL NSArray)
@ -28,27 +27,35 @@
(not (send parent get-sheet))
parent)])
(let ([extensions (append
(if (and extension
(not (equal? "" extension)))
(list extension)
null)
(if (memq 'packages style) (list "app") null)
(for/list ([e (in-list filters)]
#:when (and (regexp-match #rx"[*][.][^.]+$" (cadr e))
(not (equal? (cadr e) "*.*"))))
(car (regexp-match #rx"[^.]+$" (cadr e)))))])
(let* ([globs (apply append
(map (lambda (f) (regexp-split #rx" *; *" (cadr f)))
filters))]
;; get suffixes from "*.foo" globs (and *only* such globs)
[extensions
(for/list ([g (in-list globs)]
#:when (and (regexp-match #rx"[*][.][^.]+$" g)
(not (equal? g "*.*"))))
(car (regexp-match #rx"[^.]+$" g)))]
[extensions
(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)])
(unless (null? extensions)
(when (memq 'put style)
(tellv ns setCanSelectHiddenExtension: #:type _BOOL #t))
(let ([a (tell NSArray
(let ([a (tell NSArray
arrayWithObjects: #:type (_list i _NSString) extensions
count: #:type _NSUInteger (length extensions))])
(tellv ns setAllowedFileTypes: a))
(let ([others? (ormap (lambda (e)
(equal? (cadr e) "*.*"))
filters)])
(tellv ns setAllowsOtherFileTypes: #:type _BOOL others?))))
(tellv ns setAllowsOtherFileTypes:
#:type _BOOL (and (member "*.*" globs) #t))))
(cond
[(memq 'multi style)