..
original commit: faa8326ba00e528c230d38f9dc4813239550df81
This commit is contained in:
parent
92a4237c2d
commit
454f0d6420
|
@ -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 ())))
|
||||
|
|
|
@ -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?
|
||||
|
|
Loading…
Reference in New Issue
Block a user