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

some fixes for multi-selections

Browse Source 
svn: r3153
This commit is contained in:
Eli Barzilay 2006-05-31 18:55:27 +00:00
parent d16aca9679
commit 99bec24645
1 changed files with 38 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/mred/private/path-dialog.ss
View File

@ -170,12 +170,12 @@
files)] files)]
[else (loop [else (loop
paths dirs paths dirs
(if (or (and globs (if (and (or (not globs)
(not (ormap (lambda (glob) (ormap (lambda (glob)
(regexp-match-positions (regexp-match-positions
glob name)) glob name))
globs))) globs))
(and show-file? (not (show-file? name)))) show-file? (not (show-file? name)))
files (cons name files)))])))))) files (cons name files)))]))))))
(define (find-completion str strs) (define (find-completion str strs)
@ -233,19 +233,36 @@
(let* ([value (send text get-value)] (let* ([value (send text get-value)]
[path (build-path* dir value)] [path (build-path* dir value)]
[empty? (equal? "" value)] [empty? (equal? "" value)]
[isdir? (directory-exists? path)] [selections (send path-list get-selections)])
[isfile? (file-exists? path)]) ;; turn off other selections if there is a value
(send ok-button set-label (when (and multi? (not empty?))
(cond [(and dir? empty?) "Choose"] (for-each
[(and isdir? (not empty?)) "Go"] (lambda (i)
[else "OK"])) (let ([s (send path-list get-string i)])
(when create-button (send path-list select i
(send create-button enable (not (or isdir? isfile? empty?)))) (and value (prefix? value s) ; optimize: save on replaces
(send ok-button enable (equal? value (regexp-replace
(or (and isdir? (not empty?)) ; go end-separators-re s ""))))))
(and (or (not empty?) dir?) selections)
(parameterize ([current-directory dir]) (set! selections (send path-list get-selections)))
(is-ok? (if empty? "." value) isdir? isfile?))))))) (let ([seln (length selections)]
[isdir? (directory-exists? path)]
[isfile? (file-exists? path)])
;; set ok-button label
(send ok-button set-label
(cond [(and dir? empty? (= 0 seln)) "Choose"]
[(and isdir? (not empty?) (<= 1 seln)) "Go"]
[else "OK"]))
(when create-button
(send create-button enable
(not (or isdir? isfile? empty? (<= 1 seln)))))
;; decide if the ok-button is enabled
(send ok-button enable
(or (and isdir? (not empty?)) ; go
(and (or (not empty?) dir?)
(parameterize ([current-directory dir])
(is-ok? (if empty? "." value)
isdir? isfile?))))))))
(define (new-selected-paths) (define (new-selected-paths)
(let ([sel (send path-list get-selections)]) (let ([sel (send path-list get-selections)])
@ -301,18 +318,13 @@
[(directory-exists? path) (set! dir? #t)])) [(directory-exists? path) (set! dir? #t)]))
(cond [(not path) (return dir)] ; chose this directory -- return it (cond [(not path) (return dir)] ; chose this directory -- return it
[dir? ; chose a directory -- go there [dir? ; chose a directory -- go there
(set-dir path) (set-dir path) (send* text* (erase) (select-all)) (set-ok?)]
(unless (and (equal? up-dir-name sel/)
(member up-dir-name paths))
(send text* erase))
(send text* select-all)]
[file? (return path)] ; chose existing file -- return it [file? (return path)] ; chose existing file -- return it
[(and /? (or (member sel paths) (file-exists? path))) [(and /? (or (member sel paths) (file-exists? path)))
(error-popup "bad input: '~a' is a file" sel)] (error-popup "bad input: '~a' is a file" sel)]
[/? (error-popup "bad input: no '~a' directory~a" sel [/? (error-popup "bad input: no '~a' directory~a" sel
(if create-button (if create-button
" (use the NewDir button)" " (use the NewDir button)" ""))]
""))]
[else (return path)])))) ; inexistent path -- return new file [else (return path)])))) ; inexistent path -- return new file
(define (enter-text str . no-focus?) (define (enter-text str . no-focus?)