original commit: b683dc2d460ca6f6d2ad505d5e815dcc9132e7a3
This commit is contained in:
Robby Findler 2004-02-11 22:57:32 +00:00
parent 97d3a86558
commit c60450b8aa
2 changed files with 28 additions and 11 deletions

View File

@ -389,7 +389,10 @@
(preferences:get
'framework:auto-set-wrap?))))
(define file<%> (interface (-keymap<%>)))
(define file<%>
(interface (-keymap<%>)
get-filename/untitled-name
update-frame-filename))
(define file-mixin
(mixin (-keymap<%>) (file<%>)
(inherit get-filename lock get-style-list
@ -412,16 +415,31 @@
(file-or-directory-permissions
filename))))])
(lock lock?)))
(define/private (update-filename name)
(let ([filename (if name
(file-name-from-path (normalize-path name))
(gui-utils:next-untitled-name))])
(define/public (update-frame-filename)
(let* ([filename (get-filename)]
[name (if filename
(file-name-from-path (normalize-path filename))
(get-filename/untitled-name))])
(for-each (lambda (canvas)
(let ([tlw (send canvas get-top-level-window)])
(when (and (is-a? tlw frame:editor<%>)
(eq? this (send tlw get-editor)))
(send tlw set-label filename))))
(send tlw set-label name))))
(get-canvases))))
;; get-filename/untitled-name : -> string
;; returns a string representing the visible name for this file,
;; or "Untitled <n>" for some n.
(define untitled-name #f)
(define/public (get-filename/untitled-name)
(let ([filename (get-filename)])
(if filename
filename
(begin
(unless untitled-name
(set! untitled-name (gui-utils:next-untitled-name)))
untitled-name))))
(define/override (after-save-file success)
(when success
(check-lock))
@ -438,7 +456,7 @@
[(name temp?)
(super-set-filename name temp?)
(unless temp?
(update-filename name))]))
(update-frame-filename))]))
(define/override (get-keymaps)
(cons (keymap:get-file) (super-get-keymaps)))

View File

@ -1166,10 +1166,9 @@
[else (void)])
(let ([ed-fn (send (get-editor) get-filename)])
(set! label (if ed-fn
(or (file-name-from-path ed-fn)
(gui-utils:next-untitled-name))
(gui-utils:next-untitled-name))))
(set! label (or (and ed-fn
(file-name-from-path ed-fn))
(send (get-editor) get-filename/untitled-name))))
(do-label)
(let ([canvas (get-canvas)])
(when (is-a? canvas editor-canvas%)