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

gave parents to dialogs

Browse Source 
original commit: f25d08def87b0462ecb013f419bfb49e1e1976b1
This commit is contained in:
Robby Findler 1998-03-06 21:28:46 +00:00
parent 8b5c191856
commit 6e083e2f28
3 changed files with 809 additions and 800 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/mred/edit.ss
View File

@ -112,7 +112,10 @@
[the-format wx:const-media-ff-guess]
[show-dialog? #t])
(let ([filename (if (null? filename)
(mred:finder:get-file)
(parameterize ([mred:finder:dialog-parent-parameter
(or (get-frame)
null)])
(mred:finder:get-file))
filename)])
(and filename
(if (file-exists? filename)
@ -230,11 +233,17 @@
(public
[get-file (lambda (d)
(let ([v (mred:finder:get-file d)])
(let ([v (parameterize ([mred:finder:dialog-parent-parameter
(or (get-frame)
null)])
(mred:finder:get-file d))])
(if v
v
null)))]
[put-file (lambda (d f) (let ([v (mred:finder:put-file f d)])
[put-file (lambda (d f) (let ([v (parameterize ([mred:finder:dialog-parent-parameter
(or (get-frame)
null)])
(mred:finder:put-file f d))])
(if v
v
null)))]

18
collects/mred/finder.ss
View File

@ -16,6 +16,8 @@
(mred:debug:printf 'invoke "mred:finder@")
(define dialog-parent-parameter (make-parameter null))
(define filter-match?
(lambda (filter name msg)
(let-values ([(base name dir?) (split-path name)])
@ -635,7 +637,7 @@
[prompt "Select file"]
[filter #f]
[filter-msg "Invalid form"]
[parent-win null])
[parent-win (dialog-parent-parameter)])
(let* ([directory (if (and (null? directory)
(string? name))
(or (mzlib:file:path-only name) null)
@ -663,7 +665,7 @@
[prompt "Select file"]
[filter #f]
[filter-msg "Bad name"]
[parent-win null])
[parent-win (dialog-parent-parameter)])
(make-object finder-dialog%
parent-win ; parent window
#f ; save-mode?
@ -684,7 +686,7 @@
[prompt "Select files"]
[filter #f]
[filter-msg "Bad name"]
[parent-win null])
[parent-win (dialog-parent-parameter)])
(make-object
finder-dialog%
parent-win ; parent window
@ -712,10 +714,7 @@
[prompt "Select file"]
[filter #f]
[filter-msg "That filename does not have the right form."]
; quick-and-dirty solution ... probably should be first arg
[parent-win null])
[parent-win (dialog-parent-parameter)])
(let* ([directory (if (and (null? directory)
(string? name))
(or (mzlib:file:path-only name) null)
@ -754,10 +753,7 @@
[prompt "Select file"]
[filter #f]
[filter-msg "That filename does not have the right form."]
; quick-and-dirty solution ... probably should be 1st arg
[parent-win null])
[parent-win (dialog-parent-parameter)])
(let ([f (wx:file-selector
prompt
directory

8
collects/mred/keys.ss
View File

@ -7,7 +7,8 @@
[mred:handler : mred:handler^]
[mred:find-string : mred:find-string^]
[mred:scheme-paren : mred:scheme-paren^]
[mred:gui-utils : mred:gui-utils^])
[mred:gui-utils : mred:gui-utils^]
[mred:test : mred:testable-window^])
(mred:debug:printf 'invoke "mred:keymap@")
@ -176,7 +177,10 @@
(wx:message-box "Checkout Failed")))))]))))))))]
[save-file-as
(lambda (edit event)
(let ([file (mred:finder:put-file)])
(let ([file
(parameterize ([mred:finder:dialog-parent-parameter
(mred:test:test:get-active-frame)])
(mred:finder:put-file))])
(if file
(send edit save-file file)))
#t)]