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

put-file et al.

Browse Source 
original commit: 62355b54257f92d38773a0e6cdca79e2e56e33ad
This commit is contained in:
Matthew Flatt 1998-12-15 17:24:53 +00:00
parent 27ab7edd88
commit a2d3675fd8
1 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/mred/wrap/mred.ss
View File

@ -4376,7 +4376,7 @@
(send files enable #t) (send files enable #t)
(update-ok) (update-ok)
(wx:end-busy-cursor)))))] (wx:end-busy-cursor)))))]
[get-filename (lambda () (and ok? (simplify-path (build-path dir (or typed-name (send files get-string-selection))))))] [get-filename (lambda () (simplify-path (build-path dir (or typed-name (send files get-string-selection)))))]
[done (lambda () [done (lambda ()
(let ([name (get-filename)]) (let ([name (get-filename)])
(unless (and put? (file-exists? name) (unless (and put? (file-exists? name)
@ -4387,9 +4387,16 @@
(send bp stretchable-height #f) (send bp stretchable-height #f)
(send m stretchable-width #t) (send m stretchable-width #t)
(reset-directory) (reset-directory)
(when filename
(let ([d (send dir-text get-value)])
(send dir-text set-value (build-path d filename))
(set! typed-name filename)
(send ok-button enable #t)))
(when put-file
(send dir-text focus))
(send f center) (send f center)
(send f show #t) (send f show #t)
(get-filename)))])]) (and ok? (get-filename))))])])
sel)) sel))
(define get-file (mk-file-selector 'get-file #f)) (define get-file (mk-file-selector 'get-file #f))