racket/collects/tests/aligned-pasteboard/test-pasteboard-lib.ss
2008-02-23 09:42:03 +00:00

118 lines
3.0 KiB
Scheme

(require
"utils.ss"
mzlib/etc
mzlib/class
mred
(lib "private/aligned-pasteboard/pasteboard-lib.ss" "mrlib")
(lib "aligned-pasteboard.ss" "mrlib"))
;; pasteboard-root: ((is-a?/c aligned-pasteboard<%>) -> (is-a?/c aligned-pasteboard<%>))
;; gets the top most aligned pasteboard in the tree of pasteboards and containers
(let*
([pb1 (instantiate vertical-pasteboard% ())]
[pb2 (instantiate horizontal-pasteboard% ())]
[pb3 (instantiate vertical-pasteboard% ())]
[es2 (instantiate aligned-editor-snip% () (editor pb2))]
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
(send pb1 insert es2)
(send pb2 insert es3)
(test equal?
(pasteboard-root pb3)
pb1)
(test equal?
(pasteboard-root pb2)
pb1)
(test equal?
(pasteboard-root pb1)
pb1)
)
(let*
([pb1 (instantiate vertical-pasteboard% ())]
[pb2 (instantiate horizontal-pasteboard% ())]
[pb3 (instantiate vertical-pasteboard% ())]
[es1 (instantiate aligned-editor-snip% () (editor pb1))]
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))])
(send pb2 insert es1)
(send pb2 insert es3)
(test equal?
(pasteboard-root pb3)
pb2)
(test equal?
(pasteboard-root pb2)
pb2)
(test equal?
(pasteboard-root pb1)
pb2)
)
;; pasteboard-parent: ((is-a?/c pasteboard%) . -> . (is-a?/c aligned-editor-container<%>))
;; gets the canvas or snip that the pasteboard is displayed in
(let*
([pb1 (instantiate vertical-pasteboard% ())]
[pb2 (instantiate horizontal-pasteboard% ())]
[pb3 (instantiate vertical-pasteboard% ())]
[es2 (instantiate aligned-editor-snip% () (editor pb2))]
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
(send pb1 insert es2)
(send pb2 insert es3)
(test equal?
(pasteboard-parent pb1)
canvas)
(test equal?
(pasteboard-parent pb2)
es2)
(test equal?
(pasteboard-parent pb3)
es3)
)
(let*
([pb1 (instantiate vertical-pasteboard% ())]
[pb2 (instantiate horizontal-pasteboard% ())]
[pb3 (instantiate vertical-pasteboard% ())]
[es2 (instantiate aligned-editor-snip% () (editor pb2))]
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
(send pb1 insert es2)
(send pb1 insert es3)
(test equal?
(pasteboard-parent pb1)
canvas)
(test equal?
(pasteboard-parent pb2)
es2)
(test equal?
(pasteboard-parent pb3)
es3)
)
(tests-done)