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

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

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