Common dialogs now make a finder-dialog% instance each time they're called

original commit: 7b3f67d536ddd4fbc19002933caf511acbb60042
This commit is contained in:
Paul Steckler 1998-02-27 17:41:58 +00:00
parent 5f4dd0f07f
commit bf0fd68a46

View File

@ -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)