gui/collects/tests/framework/handler-test.ss
Robby Findler 33c16d492e ...
original commit: f75522f31ed1825eeaba116d1bf0e01cc6028f87
1999-05-24 21:38:01 +00:00

42 lines
1.3 KiB
Scheme

(let* ([filename "framework-group-test.ss"]
[tmp-filename (build-path (find-system-path 'temp-dir) filename)])
(test
'file-opened
(lambda (x) (equal? (list filename "MrEd REPL") x))
(lambda ()
(send-sexp-to-mred
`(begin (handler:edit-file ,tmp-filename)
(void)))
(wait-for-frame filename)
(send-sexp-to-mred
`(begin0 (map (lambda (x) (send x get-label)) (get-top-level-windows))
(send (car (get-top-level-windows)) close)))))
(test
'files-opened-twice
(lambda (x) (equal? (list filename "MrEd REPL") x))
(lambda ()
(send-sexp-to-mred
`(begin (handler:edit-file ,tmp-filename)
(void)))
(wait-for-frame filename)
(send-sexp-to-mred
`(begin (handler:edit-file ,tmp-filename)
(void)))
(wait-for-frame filename)
(send-sexp-to-mred
`(begin0 (map (lambda (x) (send x get-label)) (get-top-level-windows))
(send (car (get-top-level-windows)) close)))))
(test
'file-opened-in-editor
(lambda (x) (equal? filename x))
(lambda ()
(send-sexp-to-mred
`(begin (handler:edit-file ,tmp-filename)
(void)))
(wait-for-frame filename)
(send-sexp-to-mred
`(let ([f (car (get-top-level-windows))])
(send (send f get-editor) get-filename))))))