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

no message

Browse Source 
original commit: c05491e8b6caa1d905d113556bd9f2bfc254ba23
This commit is contained in:
Robby Findler 2001-06-29 02:06:14 +00:00
parent f22b17caf3
commit daf3bafc2a
3 changed files with 26 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -64,6 +64,7 @@
(rename [super-after-save-file after-save-file]
[super-after-load-file after-load-file])
[define last-saved-file-time #f]
(override after-save-file after-load-file)
[define after-save-file
(lambda (sucess?)

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

@ -583,7 +583,7 @@
(define editor-mixin
(mixin (standard-menus<%>) (-editor<%>)
(init (file-name #f))
(init (filename #f))
(inherit get-area-container get-client-size
show get-edit-target-window get-edit-target-object)
@ -601,8 +601,8 @@
(lambda ()
(super-on-close)
(send (get-editor) on-close))]
[define label (if file-name
(file-name-from-path file-name)
[define label (if filename
(file-name-from-path filename)
(gui-utils:next-untitled-name))]
[define label-prefix (application:current-app-name)]
[define do-label
@ -794,10 +794,10 @@
(do-label)
(cond
[(and file-name (file-exists? file-name))
(send (get-editor) load-file file-name 'guess #f)]
[file-name
(send (get-editor) set-filename file-name)]
[(and filename (file-exists? filename))
(send (get-editor) load-file filename 'guess #f)]
[filename
(send (get-editor) set-filename filename)]
[else (void)])
(let ([canvas (get-canvas)])
(when (is-a? canvas editor-canvas%)

23
collects/tests/framework/group-test.ss
View File

@ -99,6 +99,23 @@
(lambda (x) (send x get-label))
(send (car (send (send (get-top-level-focus-window) get-menu-bar) get-items)) get-items))
(send (get-top-level-focus-window) close)))))
(test
'windows-menu-unshown
(lambda (x)
(equal? x (list "test")))
(lambda ()
(send-sexp-to-mred
'(let ([frame1 (make-object frame:basic% "test")]
[frame2 (make-object frame:basic% "test-not-shown")])
(send frame1 show #t)))
(wait-for-frame "test")
(send-sexp-to-mred
'(begin0
(map
(lambda (x) (send x get-label))
(send (car (send (send (get-top-level-focus-window) get-menu-bar) get-items)) get-items))
(send (get-top-level-focus-window) close)))))
(test
'windows-menu-sorted1
@ -140,8 +157,4 @@
(map
(lambda (x) (send x get-label))
(send (car (send (send (car frames) get-menu-bar) get-items)) get-items))
(for-each (lambda (x) (send x close)) frames))))))
)
(for-each (lambda (x) (send x close)) frames)))))))