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

...

Browse Source 
original commit: 8925778e585816a6db7bd0019885ed6732b18fc1
This commit is contained in:
Robby Findler 1998-09-06 01:32:32 +00:00
parent 5a81f9b91c
commit 6a3821fe01
3 changed files with 19 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/framework/fileutil.ss
View File

@ -5,9 +5,9 @@
(define generate-autosave-name
(lambda (name)
(let-values ([(base name dir?)
(if (null? name)
(values (current-directory) "mredauto" #f)
(split-path name))])
(if name
(split-path name)
(values (current-directory) "mredauto" #f))])
(let* ([base (if (string? base)
base
(current-directory))]

30
collects/framework/finder.ss
View File

@ -378,13 +378,11 @@
(cond
[(and (char? code)
(or (char=? code #\newline)
(char=? code #\return))) ; CR or LF
[(or (equal? code 'numpad-return)
(equal? code #\return)))
(do-ok)]
[(and (char? code)
(char=? code #\tab))
[(equal? code #\tab)
(set-focus-to-directory-edit)]
; look for letter at beginning of a filename
@ -471,7 +469,7 @@
(let ([code (send key get-key-code)])
(cond
[(or (equal? code #\return)
(equal? code #\newline))
(equal? code 'numpad-enter))
(do-ok)
(set-focus-to-name-list)]
[(equal? code #\tab)
@ -680,8 +678,8 @@
; list of args. Should the opt-lambda's be placed in the dispatching function?
(define std-put-file
(opt-lambda ([name ()]
[directory ()]
(opt-lambda ([name #f]
[directory #f]
[replace? #f]
[prompt "Select file"]
[filter #f]
@ -694,13 +692,13 @@
[name (or (and (string? name)
(mzlib:file:file-name-from-path name))
name)]
[f (wx:put-file
[f (put-file
prompt
parent-win
directory
name
".ss")])
(if (or (null? f)
(if (or (not f)
(and filter
(not (filter-match? filter
f
@ -719,19 +717,15 @@
[else f]))))))
(define std-get-file
(opt-lambda ([directory ()]
(opt-lambda ([directory #f]
[prompt "Select file"]
[filter #f]
[filter-msg "That filename does not have the right form."]
[parent-win (dialog-parent-parameter)])
(let ([f (wx:file-selector
(let ([f (get-file
prompt
directory
null
null
"*"
wx:const-open
parent-win)])
parent-win
directory)])
(if (null? f)
#f
(if (or (not filter) (filter-match? filter f filter-msg))

25
collects/framework/group.ss
View File

@ -46,17 +46,10 @@ when adding a frame, do this:
(unit/sig mred:group^
(import [mred:preferences : mred:preferences^]
[mred:editor-frame : mred:editor-frame^]
[mred:gui-utils : mred:gui-utils^]
[mred:exit : mred:exit^]
[mred:autosave : mred:autosave^]
[mred:handler : mred:handler^]
(import [exit : framework:exit^]
[mzlib:function : mzlib:function^]
[mzlib:file : mzlib:file^])
(mred:debug:printf 'invoke "mred:group@")
(define frame-group%
(let-struct frame (frame id)
(class null ()
@ -136,8 +129,6 @@ when adding a frame, do this:
(set! empty-test test)
(set! empty-close-down close-down))]
[get-frames (lambda () (map frame-frame frames))]
[frame% mred:editor-frame:editor-frame%]
[get-frame% (lambda () frame%)]
[frame-title-changed
(lambda (frame)
@ -207,14 +198,6 @@ when adding a frame, do this:
(escape #f))))
frames)
#t))]
[new-frame
(lambda (filename)
(if (string? filename)
(mred:handler:edit-file filename this #f
(lambda (fn group)
(make-object (get-frame%)
fn #t group)))
(make-object (get-frame%) filename #t this)))]
[locate-file
(lambda (name)
(let* ([normalized
@ -267,13 +250,13 @@ when adding a frame, do this:
(send the-frame-group set-empty-callbacks
(lambda ()
(at-most-one (void)
(lambda () (mred:exit:exit #t))))
(lambda () (exit:exit #t))))
(lambda ()
(at-most-one #t
(lambda ()
(mred:exit:run-exit-callbacks)))))
(exit:run-exit-callbacks)))))
(mred:exit:insert-exit-callback
(exit:insert-exit-callback
(lambda ()
(at-most-one
#t