racket/collects/tests/framework/pasteboard.ss
2005-05-27 18:56:37 +00:00

51 lines
1.4 KiB
Scheme

(module pasteboard mzscheme
(require "test-suite-utils.ss")
(define (test-creation frame class name)
(test
name
(lambda (x) #t)
(lambda ()
(let ([frame-label
(send-sexp-to-mred
`(let* ([% (class ,frame
(override get-editor%)
[define (get-editor%)
,class])]
[f (instantiate % ())])
(preferences:set 'framework:exit-when-no-frames #f)
(send f show #t)
(send f get-label)))])
(wait-for-frame frame-label)
(queue-sexp-to-mred
`(send (get-top-level-focus-window) close))))))
(test-creation 'frame:editor%
'(editor:basic-mixin pasteboard%)
'editor:basic-mixin-creation)
(test-creation 'frame:editor%
'pasteboard:basic%
'pasteboard:basic-creation)
(test-creation 'frame:editor%
'(editor:file-mixin pasteboard:keymap%)
'editor:file-mixin-creation)
(test-creation 'frame:editor%
'pasteboard:file%
'pasteboard:file-creation)
(test-creation 'frame:editor%
'(editor:backup-autosave-mixin pasteboard:file%)
'editor:backup-autosave-mixin-creation)
(test-creation 'frame:editor%
'pasteboard:backup-autosave%
'pasteboard:backup-autosave-creation)
(test-creation 'frame:pasteboard%
'(editor:info-mixin pasteboard:backup-autosave%)
'editor:info-mixin-creation)
(test-creation 'frame:pasteboard%
'pasteboard:info%
'pasteboard:info-creation)
)