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

..

Browse Source 
original commit: faa8326ba00e528c230d38f9dc4813239550df81
This commit is contained in:
Robby Findler 2003-03-25 03:49:34 +00:00
parent 92a4237c2d
commit 454f0d6420
2 changed files with 27 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/framework/private/editor.ss
View File

@ -52,12 +52,12 @@
(opt-lambda ([input-filename #f]
[fmt 'same]
[show-errors? #t])
(let ([filename (if (or (not input-filename)
(let ([filename (if (or (not input-filename)
(equal? input-filename ""))
(let ([internal-filename (get-filename)])
(if (or (not internal-filename)
(equal? internal-filename ""))
(mred:get-file)
(put-file #f #f)
internal-filename))
input-filename)])
(with-handlers ([not-break-exn?
@ -86,7 +86,7 @@
(let ([internal-filename (get-filename)])
(if (or (not internal-filename)
(equal? internal-filename ""))
(mred:get-file)
(get-file #f)
internal-filename))
input-filename)])
(with-handlers ([not-break-exn?
@ -299,14 +299,14 @@
[else (make-object editor-snip% (make-object pasteboard:basic%))]))]
(override get-file put-file)
[define get-file (lambda (d)
(parameterize ([finder:dialog-parent-parameter
(get-top-level-window)])
(finder:get-file d)))]
[define put-file (lambda (d f) (parameterize ([finder:dialog-parent-parameter
(get-top-level-window)])
(finder:put-file f d)))]
(define/override (get-file d)
(parameterize ([finder:dialog-parent-parameter
(get-top-level-window)])
(finder:get-file d)))
(define/override (put-file d f)
(parameterize ([finder:dialog-parent-parameter
(get-top-level-window)])
(finder:put-file f d)))
(super-instantiate ())))

22
collects/framework/private/frame.ss
View File

@ -990,12 +990,22 @@
(define/public save-as
(opt-lambda ([format 'same])
(let* ([name (send (get-editor) get-filename)]
[file (parameterize ([finder:dialog-parent-parameter this])
(finder:put-file name))])
(if file
(send (get-editor) save-file/gui-error file format)
#f))))
(let* ([editor (get-editor)]
[name (send editor get-filename)])
(let-values ([(base name)
(if name
(let-values ([(base name dir?) (split-path name)])
(values base name))
(values #f #f))])
(let ([file (send editor put-file name base)])
(if file
(send editor save-file/gui-error file format)
#f))))))
(define/private (basename str)
(let-values ([(base name dir?) (split-path str)])
base))
(inherit get-checkable-menu-item% get-menu-item%)
(override file-menu:save-callback
file-menu:create-save? file-menu:save-as-callback file-menu:create-save-as?