Common dialogs now make a finder-dialog% instance each time they're called
original commit: 7b3f67d536ddd4fbc19002933caf511acbb60042
This commit is contained in:
parent
5f4dd0f07f
commit
bf0fd68a46
|
@ -619,51 +619,29 @@
|
||||||
|
|
||||||
(show #t))))
|
(show #t))))
|
||||||
|
|
||||||
; make-common takes a dialog function
|
; make-common takes a dialog-maker
|
||||||
|
; used to make one dialog object per session, now created each time
|
||||||
|
|
||||||
(define make-common
|
(define make-common
|
||||||
(lambda (make-dialog)
|
(lambda (make-dialog)
|
||||||
(let ([s (make-semaphore 1)]
|
(lambda args
|
||||||
[v (box #f)]
|
(let ([result-box (box #f)])
|
||||||
[d #f]) ; d is a flag, what does it mean?
|
(apply make-dialog result-box args)
|
||||||
(lambda x
|
(unbox result-box)))))
|
||||||
(semaphore-wait s)
|
|
||||||
(if d
|
|
||||||
(let ([my-d d] ; this case isn't used currently
|
|
||||||
[my-v v])
|
|
||||||
(set! d #f)
|
|
||||||
(set! v #f)
|
|
||||||
(semaphore-post s)
|
|
||||||
(send my-d show #t)
|
|
||||||
(begin0 (unbox my-v)
|
|
||||||
(semaphore-wait s)
|
|
||||||
(set! d my-d)
|
|
||||||
(set! v my-v)
|
|
||||||
(semaphore-post s)))
|
|
||||||
(begin
|
|
||||||
(semaphore-post s)
|
|
||||||
(let* ([my-v (box #f)]
|
|
||||||
[my-d (apply make-dialog my-v x)])
|
|
||||||
(semaphore-wait s)
|
|
||||||
(unless d ; I don't understand this, since d, v not used - PAS
|
|
||||||
(set! d my-d)
|
|
||||||
(set! v my-v))
|
|
||||||
(begin0 (unbox my-v)
|
|
||||||
(semaphore-post s)))))))))
|
|
||||||
|
|
||||||
; the common versions of these functions have their visual
|
; the common versions of these functions have their visual
|
||||||
; interfaces under Scheme control
|
; interfaces under Scheme control
|
||||||
|
|
||||||
(define common-put-file
|
(define common-put-file
|
||||||
(make-common
|
(make-common
|
||||||
(opt-lambda (box
|
(opt-lambda (result-box
|
||||||
[parent-win null]
|
|
||||||
[name ()]
|
[name ()]
|
||||||
[directory ()]
|
[directory ()]
|
||||||
[replace? #f]
|
[replace? #f]
|
||||||
[prompt "Select file"]
|
[prompt "Select file"]
|
||||||
[filter #f]
|
[filter #f]
|
||||||
[filter-msg "Invalid form"])
|
[filter-msg "Invalid form"]
|
||||||
|
[parent-win null])
|
||||||
(let* ([directory (if (and (null? directory)
|
(let* ([directory (if (and (null? directory)
|
||||||
(string? name))
|
(string? name))
|
||||||
(or (mzlib:file:path-only name) null)
|
(or (mzlib:file:path-only name) null)
|
||||||
|
@ -676,7 +654,7 @@
|
||||||
#t
|
#t
|
||||||
replace?
|
replace?
|
||||||
#f
|
#f
|
||||||
box
|
result-box
|
||||||
directory
|
directory
|
||||||
name
|
name
|
||||||
prompt
|
prompt
|
||||||
|
@ -686,17 +664,18 @@
|
||||||
(define common-get-file
|
(define common-get-file
|
||||||
(make-common
|
(make-common
|
||||||
(opt-lambda
|
(opt-lambda
|
||||||
(box [parent-win null]
|
(result-box
|
||||||
[directory ()]
|
[directory ()]
|
||||||
[prompt "Select file"]
|
[prompt "Select file"]
|
||||||
[filter #f]
|
[filter #f]
|
||||||
[filter-msg "Bad name"])
|
[filter-msg "Bad name"]
|
||||||
|
[parent-win null])
|
||||||
(make-object finder-dialog%
|
(make-object finder-dialog%
|
||||||
parent-win ; parent window
|
parent-win ; parent window
|
||||||
#f ; save-mode?
|
#f ; save-mode?
|
||||||
#f ; replace-ok?
|
#f ; replace-ok?
|
||||||
#f ; multi-mode?
|
#f ; multi-mode?
|
||||||
box ; result-box
|
result-box ; boxed results
|
||||||
directory ; start-dir
|
directory ; start-dir
|
||||||
'() ; start-name
|
'() ; start-name
|
||||||
prompt ; prompt
|
prompt ; prompt
|
||||||
|
@ -706,7 +685,9 @@
|
||||||
|
|
||||||
(define common-get-file-list
|
(define common-get-file-list
|
||||||
(make-common
|
(make-common
|
||||||
(opt-lambda (box [directory ()][prompt "Select files"][filter #f]
|
(opt-lambda (box [directory ()]
|
||||||
|
[prompt "Select files"]
|
||||||
|
[filter #f]
|
||||||
[filter-msg "Bad name"])
|
[filter-msg "Bad name"])
|
||||||
(make-object finder-dialog% #f #f #t box directory '() prompt
|
(make-object finder-dialog% #f #f #t box directory '() prompt
|
||||||
filter filter-msg))))
|
filter filter-msg))))
|
||||||
|
@ -775,7 +756,7 @@
|
||||||
directory
|
directory
|
||||||
null
|
null
|
||||||
null
|
null
|
||||||
"*"
|
"*"
|
||||||
0
|
0
|
||||||
parent-win)])
|
parent-win)])
|
||||||
(if (null? f)
|
(if (null? f)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user