diff --git a/collects/meta/props b/collects/meta/props index 94760d6a86..6ab667db44 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -788,11 +788,9 @@ path/s is either such a string or a list of them. "collects/mred/private/wx/cocoa" drdr:command-line #f "collects/mred/private/wx/win32" drdr:command-line #f "collects/mrlib" responsible (mflatt robby) -"collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl" drdr:command-line (racket "-f" *) -"collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rktl" drdr:command-line (gracket "-f" *) +"collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rkt" drdr:command-line (gracket *) "collects/mrlib/private/aligned-pasteboard/tests/example-min.rkt" drdr:command-line #f "collects/mrlib/private/aligned-pasteboard/tests/example.rkt" drdr:command-line #f -"collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rktl" drdr:command-line (racket "-f" *) "collects/mrlib/private/aligned-pasteboard/tests/minimal.rkt" drdr:command-line #f "collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin-aligned.rkt" drdr:command-line #f "collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin.rkt" drdr:command-line #f @@ -800,14 +798,13 @@ path/s is either such a string or a list of them. "collects/mrlib/private/aligned-pasteboard/tests/more-tests-min.rkt" drdr:command-line #f "collects/mrlib/private/aligned-pasteboard/tests/more-tests-text.rkt" drdr:command-line #f "collects/mrlib/private/aligned-pasteboard/tests/more-tests.rkt" drdr:command-line #f +"collects/mrlib/private/aligned-pasteboard/tests/old-bugs" drdr:command-line #f "collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.rkt" drdr:command-line #f "collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.rkt" drdr:command-line #f -"collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rktl" drdr:command-line (racket "-f" *) "collects/mrlib/private/aligned-pasteboard/tests/test-locked-pasteboard.rkt" drdr:command-line #f -"collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rktl" drdr:command-line (racket "-f" *) -"collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rktl" drdr:command-line (gracket "-f" *) -"collects/mrlib/private/aligned-pasteboard/tests/test.rktl" drdr:command-line (gracket "-f" *) -"collects/mrlib/private/aligned-pasteboard/tests/test2.rktl" drdr:command-line (gracket "-f" *) +"collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt" drdr:command-line (gracket *) +"collects/mrlib/private/aligned-pasteboard/tests/test.rkt" drdr:command-line (gracket *) +"collects/mrlib/private/aligned-pasteboard/tests/test2.rkt" drdr:command-line (gracket *) "collects/mysterx" responsible (mflatt) "collects/mysterx/main.rkt" drdr:command-line (mzc *) "collects/mysterx/mysterx.rkt" drdr:command-line (mzc *) @@ -981,15 +978,6 @@ path/s is either such a string or a list of them. "collects/teachpack/htdp/graphing.ss" drdr:command-line (mzc *) "collects/test-box-recovery" responsible (mflatt) "collects/test-engine" responsible (kathyg) -"collects/tests/aligned-pasteboard" responsible (mflatt robby) -"collects/tests/aligned-pasteboard/example.rktl" drdr:command-line #f -"collects/tests/aligned-pasteboard/old-bugs/big-min.rktl" drdr:command-line #f -"collects/tests/aligned-pasteboard/old-bugs/missing-min.rktl" drdr:command-line #f -"collects/tests/aligned-pasteboard/test-alignment.rktl" drdr:command-line #f -"collects/tests/aligned-pasteboard/test-pasteboard-lib.rktl" drdr:command-line #f -"collects/tests/aligned-pasteboard/test-snip-lib.rktl" drdr:command-line #f -"collects/tests/aligned-pasteboard/test.rktl" drdr:command-line (gracket "-f" *) -"collects/tests/aligned-pasteboard/test2.rktl" drdr:command-line (gracket "-f" *) "collects/tests/compiler" responsible (jay) "collects/tests/compiler/demodularizer/demod-test.rkt" drdr:timeout 600 "collects/tests/compiler/regression.rkt" responsible (mflatt) diff --git a/collects/mrlib/private/aligned-pasteboard/alignment.rkt b/collects/mrlib/private/aligned-pasteboard/alignment.rkt index 3aa0f44bb4..784e268fab 100644 --- a/collects/mrlib/private/aligned-pasteboard/alignment.rkt +++ b/collects/mrlib/private/aligned-pasteboard/alignment.rkt @@ -1,23 +1,26 @@ #| -This code computes the sizees for the rectangles in the space using the on dimension -off dimension method of referencing sizes. This means for example instead of saying -width we say off dimension for vertical alignment. Inorder to consume and return -the values in terms of width and height manipulation had to be done. I chose to create -a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect -stucts on to them. This code is a bit long but more readable than the other two options -I came up with. - 1) define all functions to be letrec bound functions inside align. align then take - accessors for the rect struct. The caller of align swaps the order of ondimension - and off dimension accessors for vertical or horizontal code. This method does not - allow the use of the readable, short, consis pattern matching code. As some of the - matching code is easily removed this may be a good option but a large letrec - is harder to write tests for. - 2) define a pattern matcher syntax that will match the struct rect but swap the fields - based on wich on is the on or off dimension. This would have been shorter but much - more confusing. -The current implementation requires align to map over the rects and allocate new stucts -for each one on both passing into and returning from stretch-to-fit; This is not a bottle -neck and it is the most readable solution. +This code computes the sizes for the rectangles in the space using the +on dimension off dimension method of referencing sizes. This means for +example instead of saying width we say off dimension for vertical +alignment. Inorder to consume and return the values in terms of width +and height manipulation had to be done. I chose to create a struct +abs-rect (abstract rectangle) and have code map horizontal and vertical +rect stucts on to them. This code is a bit long but more readable than +the other two options I came up with. + 1) define all functions to be letrec bound functions inside align. + align then take accessors for the rect struct. The caller of align + swaps the order of ondimension and off dimension accessors for + vertical or horizontal code. This method does not allow the use of + the readable, short, consis pattern matching code. As some of the + matching code is easily removed this may be a good option but a + large letrec is harder to write tests for. + 2) define a pattern matcher syntax that will match the struct rect but + swap the fields based on wich on is the on or off dimension. This + would have been shorter but much more confusing. +The current implementation requires align to map over the rects and +allocate new stucts for each one on both passing into and returning from +stretch-to-fit; This is not a bottle neck and it is the most readable +solution. |# (module alignment mzscheme diff --git a/collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl b/collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rkt similarity index 58% rename from collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl rename to collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rkt index 5d2e5127e6..7c767553e9 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl +++ b/collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rkt @@ -1,25 +1,26 @@ -(require mzlib/class mzlib/list mred mzlib/etc - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt" +#lang racket/gui + +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt" "../snip-lib.rkt") -(define f (new frame% (label "test") (width 200) (height 200))) +(define f (new frame% [label "test"] [width 200] [height 200])) (define e (new text%)) -(define c (new editor-canvas% (editor e) (parent f))) +(define c (new editor-canvas% [editor e] [parent f])) (define vpb1 (new vertical-pasteboard%)) -(define aes1 (new aligned-editor-snip% (editor vpb1))) +(define aes1 (new aligned-editor-snip% [editor vpb1])) (define vpb2 (new vertical-pasteboard%)) -(define aes2 (new aligned-editor-snip% (editor vpb2))) +(define aes2 (new aligned-editor-snip% [editor vpb2])) -(define t (new text%)) +(define t (new text%)) (define es (new editor-snip% (editor t))) (send vpb1 insert aes2 false) (send vpb2 insert es) (send e insert aes1) (send f show #t) +(sleep 0.2) (send f show #f) (send t begin-edit-sequence) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/debug.rkt b/collects/mrlib/private/aligned-pasteboard/tests/debug.rkt index 3c18771bf4..9640e8994e 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/debug.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/debug.rkt @@ -1,80 +1,57 @@ -(module debug mzscheme - (require - mzlib/class) - - (provide - debug-snip - debug-pasteboard - debug-canvas) - - ;;debug-snip: -> (void) - ;;get the relevant info about the snip that contains the two others pasteboards - (define debug-snip - (lambda (snip) - (printf "--- aligned-editor-snip% --\n") - (let ((l (box 0)) - (t (box 0)) - (r (box 0)) - (b (box 0))) - (send snip get-inset l t r b) - (printf "get-inset: ~sX~s ~sX~s\n" (unbox l) (unbox r) (unbox t) (unbox b))) - - (let ((l (box 0)) - (t (box 0)) - (r (box 0)) - (b (box 0))) - (send snip get-margin l t r b) - (printf "get-margin: ~sX~s ~sX~s\n" (unbox l) (unbox r) (unbox t) (unbox b))) - - (printf "get-max-height: ~s\n" (send snip get-max-height)) - (printf "get-max-width: ~s\n" (send snip get-max-width)) - (printf "get-min-height: ~s\n" (send snip get-min-height)) - (printf "get-min-width: ~s\n" (send snip get-min-width)) - ;(printf "snip-width: ~s\n" (send pasteboard snip-width snip)) - ;(printf "snip-height: ~s\n" (send pasteboard snip-height snip)) - )) - - ;;debug-pasteboard: -> (void) - ;;displays to the repl the sizes i'm interested in - (define debug-pasteboard - (lambda (pasteboard) - (printf "--- aligned-pasteboard% ---\n") - (let ((tmp1 (box 0)) - (tmp2 (box 0))) - (send pasteboard get-extent tmp1 tmp2) - (printf "get-extent: ~sX~s\n" (unbox tmp1) (unbox tmp2))) - (printf "get-max-height: ~s\n" (send pasteboard get-max-height)) - (let ((tmp (call-with-values (lambda () (send pasteboard get-max-view-size)) cons))) - (printf "get-max-view-size: ~sX~s\n" (car tmp) (cdr tmp))) - (printf "get-max-width: ~s\n" (send pasteboard get-max-width)) - (printf "get-min-height: ~s\n" (send pasteboard get-min-height)) - (printf "get-min-width: ~s\n" (send pasteboard get-min-width)) - (let ((tmp1 (box 0)) - (tmp2 (box 0))) - (send pasteboard get-view-size tmp1 tmp2) - (printf "get-view-size: ~sX~s\n" (unbox tmp1) (unbox tmp2))) - )) - - ;;debug-canvas: -> (void) - ;;just some help counting pixels - (define debug-canvas - (lambda (canvas) - (printf "--- aligned-editor-canvas% ---\n") - ;;values - (let ((tmp (call-with-values (lambda () (send canvas get-client-size)) cons))) - (printf "~a: ~sX~s\n" (symbol->string (quote get-client-size)) (car tmp) (cdr tmp))) - (let ((tmp (call-with-values (lambda () (send canvas get-graphical-min-size)) cons))) - (printf "~a: ~sX~s\n" (symbol->string (quote get-graphical-min-size)) (car tmp) (cdr tmp))) - (let ((tmp (call-with-values (lambda () (send canvas get-size)) cons))) - (printf "~a: ~sX~s\n" (symbol->string (quote get-size)) (car tmp) (cdr tmp))) - ;;1 value - (printf "~a: ~s\n" (symbol->string (quote get-height)) (send canvas get-height)) - (printf "~a: ~s\n" (symbol->string (quote get-width)) (send canvas get-width)) - (printf "~a: ~s\n" (symbol->string (quote horiz-margin)) (send canvas horiz-margin)) - (printf "~a: ~s\n" (symbol->string (quote min-client-height)) (send canvas min-client-height)) - (printf "~a: ~s\n" (symbol->string (quote min-client-width)) (send canvas min-client-width)) - (printf "~a: ~s\n" (symbol->string (quote min-height)) (send canvas min-height)) - (printf "~a: ~s\n" (symbol->string (quote min-width)) (send canvas min-width)) - (printf "~a: ~s\n" (symbol->string (quote vert-margin)) (send canvas vert-margin)) - )) +#lang racket/gui + +(provide debug-snip debug-pasteboard debug-canvas) + +;; debug-snip: -> (void) +;; get the relevant info about the snip that contains the two others +;; pasteboards +(define (debug-snip snip) + (printf "--- aligned-editor-snip% --\n") + (let ([l (box 0)] [t (box 0)] [r (box 0)] [b (box 0)]) + (send snip get-inset l t r b) + (printf "get-inset: ~sX~s ~sX~s\n" + (unbox l) (unbox r) (unbox t) (unbox b))) + (let ([l (box 0)] [t (box 0)] [r (box 0)] [b (box 0)]) + (send snip get-margin l t r b) + (printf "get-margin: ~sX~s ~sX~s\n" + (unbox l) (unbox r) (unbox t) (unbox b))) + (printf "get-max-height: ~s\n" (send snip get-max-height)) + (printf "get-max-width: ~s\n" (send snip get-max-width)) + (printf "get-min-height: ~s\n" (send snip get-min-height)) + (printf "get-min-width: ~s\n" (send snip get-min-width)) + ;; (printf "snip-width: ~s\n" (send pasteboard snip-width snip)) + ;; (printf "snip-height: ~s\n" (send pasteboard snip-height snip)) ) + +;; debug-pasteboard: -> (void) +;; displays to the repl the sizes i'm interested in +(define (debug-pasteboard pasteboard) + (printf "--- aligned-pasteboard% ---\n") + (let ([t1 (box 0)] [t2 (box 0)]) + (send pasteboard get-extent t1 t2) + (printf "get-extent: ~sX~s\n" (unbox t1) (unbox t2))) + (printf "get-max-height: ~s\n" (send pasteboard get-max-height)) + (let ([t (call-with-values (λ () (send pasteboard get-max-view-size)) cons)]) + (printf "get-max-view-size: ~sX~s\n" (car t) (cdr t))) + (printf "get-max-width: ~s\n" (send pasteboard get-max-width)) + (printf "get-min-height: ~s\n" (send pasteboard get-min-height)) + (printf "get-min-width: ~s\n" (send pasteboard get-min-width)) + (let ([t1 (box 0)] [t2 (box 0)]) + (send pasteboard get-view-size t1 t2) + (printf "get-view-size: ~sX~s\n" (unbox t1) (unbox t2)))) + +;; debug-canvas: -> (void) +;; just some help counting pixels +(define (debug-canvas canvas) + (printf "--- aligned-editor-canvas% ---\n") + ;; values + (define-syntax-rule (show* what ...) + (begin (let ([t (call-with-values (λ () (send canvas what)) cons)]) + (printf "~a: ~sX~s\n" 'what (car t) (cdr t))) + ...)) + (show* get-client-size get-graphical-min-size get-size) + ;; 1 value + (define-syntax-rule (show1 what ...) + (begin (printf "~a: ~s\n" 'what (send canvas what)) ...)) + (show1 get-height get-width horiz-margin min-client-height min-client-width + min-height min-width vert-margin)) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rkt b/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rkt new file mode 100644 index 0000000000..7f4bea8220 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rkt @@ -0,0 +1,19 @@ +#lang racket/gui + +(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt") + +(define f (new frame% (label "test"))) +(define e (new text%)) +(define c (new editor-canvas% (editor e) (parent f))) +(define pb (new vertical-pasteboard%)) +(define actual (new text%)) +(define act-line (new aligned-editor-snip% (editor (new vertical-pasteboard%)))) +(define t (new aligned-editor-snip% (editor pb))) +(send e insert t) +(send* pb (begin-edit-sequence) (insert act-line #f) (end-edit-sequence)) + +;; Eli: for some reason, this used to pass the result into this +;; function: +;; (define (converges? x) #t) +;; I take it that the requirement is that it finishes after some time, +;; so there's no need for the function. diff --git a/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rktl b/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rktl deleted file mode 100644 index 6528e60793..0000000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rktl +++ /dev/null @@ -1,14 +0,0 @@ -(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt") - -(define (converges? x) #t) - -(converges? - (let* ((f (new frame% (label "test"))) - (e (new text%)) - (c (new editor-canvas% (editor e) (parent f))) - (pb (new vertical-pasteboard%)) - (actual (new text%)) - (act-line (new aligned-editor-snip% (editor (new vertical-pasteboard%)))) - (t (new aligned-editor-snip% (editor pb)))) - (send e insert t) - (send* pb (begin-edit-sequence) (insert act-line #f) (end-edit-sequence)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/example-min.rkt b/collects/mrlib/private/aligned-pasteboard/tests/example-min.rkt index 712076b49a..b8423f6b4c 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/example-min.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/example-min.rkt @@ -1,9 +1,6 @@ -(require - mzlib/class - mred - mzlib/etc - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt") +#lang racket/gui + +(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt") (define f (new frame% (label "") (width 400) (height 400))) (define e (new horizontal-pasteboard%)) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/example.rkt b/collects/mrlib/private/aligned-pasteboard/tests/example.rkt index 40240169cd..9c0d9968b5 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/example.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/example.rkt @@ -1,81 +1,23 @@ -(require - mzlib/class - mred - mzlib/etc - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt") +#lang racket/gui -; -; -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; -; +(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt") -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) +(define frame (new frame% [label "Frame"] [width 400] [height 400])) +(define pasteboard (new horizontal-pasteboard%)) +(define canvas (new aligned-editor-canvas% [parent frame] [editor pasteboard])) -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define vp1 - (instantiate vertical-pasteboard% ())) - -(define ae-snip1 - (instantiate aligned-editor-snip% () - (editor vp1))) - -(define vp2 - (instantiate vertical-pasteboard% ())) - -(define ae-snip2 - (instantiate aligned-editor-snip% () - (editor vp2))) - -(define vp3 - (instantiate vertical-pasteboard% ())) - -(define ae-snip3 - (instantiate aligned-editor-snip% () - (editor vp3))) - -(define vp4 - (instantiate vertical-pasteboard% ())) - -(define ae-snip4 - (instantiate aligned-editor-snip% () - (editor vp4))) - -(define vp5 - (instantiate vertical-pasteboard% ())) - -(define ae-snip5 - (instantiate aligned-editor-snip% () - (editor vp5))) - -(define t-snip1 - (instantiate editor-snip% () - (editor (instantiate text% ())))) - -(define t-snip2 - (instantiate editor-snip% () - (editor (instantiate text% ())))) +(define vp1 (new vertical-pasteboard%)) +(define ae-snip1 (new aligned-editor-snip% [editor vp1])) +(define vp2 (new vertical-pasteboard%)) +(define ae-snip2 (new aligned-editor-snip% [editor vp2])) +(define vp3 (new vertical-pasteboard%)) +(define ae-snip3 (new aligned-editor-snip% [editor vp3])) +(define vp4 (new vertical-pasteboard%)) +(define ae-snip4 (new aligned-editor-snip% [editor vp4])) +(define vp5 (new vertical-pasteboard%)) +(define ae-snip5 (new aligned-editor-snip% [editor vp5])) +(define t-snip1 (new editor-snip% [editor (instantiate text% ())])) +(define t-snip2 (new editor-snip% [editor (instantiate text% ())])) (send pasteboard insert ae-snip1 false) (send pasteboard insert ae-snip2 false) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rkt b/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rkt new file mode 100644 index 0000000000..d6e82fbc7f --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rkt @@ -0,0 +1,8 @@ +#lang racket/gui + +(require mrlib/aligned-pasteboard) + +(with-handlers ([exn? (lambda (x) #f)]) + (send (new pasteboard%) + insert (new aligned-editor-snip% [editor (new horizontal-pasteboard%)])) + #t) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rktl b/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rktl deleted file mode 100644 index b4a5a80cd8..0000000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rktl +++ /dev/null @@ -1,4 +0,0 @@ -(require mrlib/aligned-pasteboard) -(with-handlers ([exn? (lambda (x) #f)]) - (send (new pasteboard%) insert (new aligned-editor-snip% (editor (new horizontal-pasteboard%)))) - #t) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/minimal.rkt b/collects/mrlib/private/aligned-pasteboard/tests/minimal.rkt index eac247ec31..f81944a991 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/minimal.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/minimal.rkt @@ -1,12 +1,13 @@ -(require - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt") +#lang racket/gui -(define f (new frame% (label "test") (width 200) (height 200))) -(define e (new vertical-pasteboard%)) -(define c (new aligned-editor-canvas% (editor e) (parent f))) +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt") + +(define f (new frame% [label "test"] [width 200] [height 200])) +(define e (new vertical-pasteboard%)) +(define c (new aligned-editor-canvas% [editor e] [parent f])) (define pb (new vertical-pasteboard%)) -(define s (new aligned-editor-snip% (editor pb) (stretchable-height #f) (stretchable-width #f))) +(define s (new aligned-editor-snip% + [editor pb] [stretchable-height #f] [stretchable-width #f])) (send pb insert (make-object string-snip% "Long snip")) (send pb insert (make-object string-snip% "Longer snip")) (send e insert s) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin-aligned.rkt b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin-aligned.rkt index 4d037c12de..04c991b084 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin-aligned.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin-aligned.rkt @@ -1,15 +1,16 @@ -(require - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt") +#lang racket/gui + +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt") (define pb (new horizontal-pasteboard%)) (send* pb (insert (make-object string-snip% "Call") #f) - (insert (new editor-snip% (editor (new text%))) #f)) -(define z (new aligned-editor-snip% (editor pb) (stretchable-height #f) (stretchable-width #f))) -(define f (new frame% (label "more-tests-text") (width 200) (height 200))) + (insert (new editor-snip% [editor (new text%)]) #f)) +(define z (new aligned-editor-snip% + [editor pb] [stretchable-height #f] [stretchable-width #f])) +(define f (new frame% [label "more-tests-text"] [width 200] [height 200])) (define e (new vertical-pasteboard%)) -(define c (new aligned-editor-canvas% (editor e) (parent f))) +(define c (new aligned-editor-canvas% [editor e] [parent f])) (send e insert z) (send f show #t) @@ -17,12 +18,12 @@ ;; exploration (require "../snip-lib.rkt") (define (margin snip) - (let ([left (box 0)] - [top (box 0)] - [right (box 0)] - [bottom (box 0)]) - (send snip get-margin left top right bottom) - (list (cons 'left (unbox left)) - (cons 'right (unbox right)) - (cons 'top (unbox top)) - (cons 'bottom (unbox bottom))))) + (define left (box 0)) + (define top (box 0)) + (define right (box 0)) + (define bottom (box 0)) + (send snip get-margin left top right bottom) + (list (cons 'left (unbox left)) + (cons 'right (unbox right)) + (cons 'top (unbox top)) + (cons 'bottom (unbox bottom)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin.rkt b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin.rkt index d4e0de58dd..98f542f83d 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-margin.rkt @@ -1,15 +1,15 @@ -(require - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt") +#lang racket/gui + +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt") (define pb (new horizontal-pasteboard%)) (send* pb (insert (make-object string-snip% "Call") #f) - (insert (new editor-snip% (editor (new text%))) #f)) -(define z (new aligned-editor-snip% (editor pb))) -(define f (new frame% (label "more-tests-text") (width 200) (height 200))) + (insert (new editor-snip% [editor (new text%)]) #f)) +(define z (new aligned-editor-snip% [editor pb])) +(define f (new frame% [label "more-tests-text"] [width 200] [height 200])) (define e (new pasteboard%)) -(define c (new editor-canvas% (editor e) (parent f))) +(define c (new editor-canvas% [editor e] [parent f])) (send e insert z) (send f show #t) @@ -17,12 +17,12 @@ ;; exploration (require "../snip-lib.rkt") (define (margin snip) - (let ([left (box 0)] - [top (box 0)] - [right (box 0)] - [bottom (box 0)]) - (send snip get-margin left top right bottom) - (list (cons 'left (unbox left)) - (cons 'right (unbox right)) - (cons 'top (unbox top)) - (cons 'bottom (unbox bottom))))) + (define left (box 0)) + (define top (box 0)) + (define right (box 0)) + (define bottom (box 0)) + (send snip get-margin left top right bottom) + (list (cons 'left (unbox left)) + (cons 'right (unbox right)) + (cons 'top (unbox top)) + (cons 'bottom (unbox bottom)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.rkt b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.rkt index 65b97c7dd4..c1185a48b1 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.rkt @@ -1,18 +1,17 @@ -(require - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt") +#lang racket/gui + +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt") (define editor (new vertical-pasteboard%)) (define pb (new horizontal-pasteboard%)) (send* pb (insert (make-object string-snip% "Call") #f) - (insert (new editor-snip% (editor (new text%))) #f)) -(send editor insert (new aligned-editor-snip% (editor pb))) -(define f (new frame% (label "more-test-jacob") (width 200) (height 200))) + (insert (new editor-snip% [editor (new text%)]) #f)) +(send editor insert (new aligned-editor-snip% [editor pb])) +(define f (new frame% [label "more-test-jacob"] [width 200] [height 200])) (define e (new vertical-pasteboard%)) -(define c (new aligned-editor-canvas% (editor e) (parent f))) -(define t (new aligned-editor-snip% - (editor editor))) +(define c (new aligned-editor-canvas% [editor e] [parent f])) +(define t (new aligned-editor-snip% [editor editor])) (send e insert t) (send f show #t) @@ -23,18 +22,17 @@ (send t-e get-aligned-min-width) (send t get-aligned-min-width) (define fs (send t-e find-first-snip)) -(define fs (send t-e find-first-snip)) (define fs-e (send fs get-editor)) (send fs-e find-first-snip) (send fs-e get-aligned-min-width) (send fs get-aligned-min-width) (define (margin snip) - (let ([left (box 0)] - [top (box 0)] - [right (box 0)] - [bottom (box 0)]) - (send snip get-margin left top right bottom) - (list (cons 'left (unbox left)) - (cons 'right (unbox right)) - (cons 'top (unbox top)) - (cons 'bottom (unbox bottom))))) + (define left (box 0)) + (define top (box 0)) + (define right (box 0)) + (define bottom (box 0)) + (send snip get-margin left top right bottom) + (list (cons 'left (unbox left)) + (cons 'right (unbox right)) + (cons 'top (unbox top)) + (cons 'bottom (unbox bottom)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min.rkt b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min.rkt index 9f0bbaf019..7fc0e97a5a 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min.rkt @@ -1,20 +1,18 @@ -(require - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt") +#lang racket/gui + +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt") (define editor (new vertical-pasteboard%)) (define pb (new horizontal-pasteboard%)) (send* pb (insert (make-object string-snip% "Call") #f) - (insert (new editor-snip% (editor (new text%))) #f)) -(send editor insert (new aligned-editor-snip% (editor pb))) -(define f (new frame% (label "more-test-jacob") (width 200) (height 200))) + (insert (new editor-snip% [editor (new text%)]) #f)) +(send editor insert (new aligned-editor-snip% [editor pb])) +(define f (new frame% [label "more-test-jacob"] [width 200] [height 200])) (define e (new vertical-pasteboard%)) -(define c (new aligned-editor-canvas% (editor e) (parent f))) +(define c (new aligned-editor-canvas% [editor e] [parent f])) (define t (new aligned-editor-snip% - (editor editor) - (stretchable-height #f) - (stretchable-width #f))) + [editor editor] [stretchable-height #f] [stretchable-width #f])) (send e insert t) (send f show #t) @@ -25,18 +23,17 @@ (send t-e get-aligned-min-width) (send t get-aligned-min-width) (define fs (send t-e find-first-snip)) -(define fs (send t-e find-first-snip)) (define fs-e (send fs get-editor)) (send fs-e find-first-snip) (send fs-e get-aligned-min-width) (send fs get-aligned-min-width) (define (margin snip) - (let ([left (box 0)] - [top (box 0)] - [right (box 0)] - [bottom (box 0)]) - (send snip get-margin left top right bottom) - (list (cons 'left (unbox left)) - (cons 'right (unbox right)) - (cons 'top (unbox top)) - (cons 'bottom (unbox bottom))))) + (define left (box 0)) + (define top (box 0)) + (define right (box 0)) + (define bottom (box 0)) + (send snip get-margin left top right bottom) + (list (cons 'left (unbox left)) + (cons 'right (unbox right)) + (cons 'top (unbox top)) + (cons 'bottom (unbox bottom)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-text.rkt b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-text.rkt index 3f6cea5b64..4d18327ef7 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-text.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-text.rkt @@ -1,27 +1,24 @@ -;; Note this test case fails when the snip 'y' is stretchable. There is lots of extra space. Finding out -;; why will probably fix the test case's extra space. -(require - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt") +#lang racket/gui + +;; Note this test case fails when the snip 'y' is stretchable. There is +;; lots of extra space. Finding out why will probably fix the test +;; case's extra space. +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt") (define editor (new vertical-pasteboard%)) (define pb (new horizontal-pasteboard%)) -(define z (new editor-snip% (editor (new text%)))) +(define z (new editor-snip% [editor (new text%)])) (send* pb (insert (make-object string-snip% "Call") #f) (insert z #f)) (define y (new aligned-editor-snip% - (editor pb) - (stretchable-width #t) - (stretchable-height #t))) + [editor pb] [stretchable-width #t] [stretchable-height #t])) (send editor insert y) -(define f (new frame% (label "more-tests-text") (width 200) (height 200))) +(define f (new frame% [label "more-tests-text"] [width 200] [height 200])) (define e (new pasteboard%)) -(define c (new editor-canvas% (editor e) (parent f))) +(define c (new editor-canvas% [editor e] [parent f])) (define t (new aligned-editor-snip% - (editor editor) - (stretchable-height #f) - (stretchable-width #f))) + [editor editor] [stretchable-height #f] [stretchable-width #f])) (send e insert t) (send f show #t) @@ -31,12 +28,12 @@ (eq-hash-code t) (require "../snip-lib.rkt") (define (margin snip) - (let ([left (box 0)] - [top (box 0)] - [right (box 0)] - [bottom (box 0)]) - (send snip get-margin left top right bottom) - (list (cons 'left (unbox left)) - (cons 'right (unbox right)) - (cons 'top (unbox top)) - (cons 'bottom (unbox bottom))))) + (define left (box 0)) + (define top (box 0)) + (define right (box 0)) + (define bottom (box 0)) + (send snip get-margin left top right bottom) + (list (cons 'left (unbox left)) + (cons 'right (unbox right)) + (cons 'top (unbox top)) + (cons 'bottom (unbox bottom)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/more-tests.rkt b/collects/mrlib/private/aligned-pasteboard/tests/more-tests.rkt index 2514fae1f4..c3fa3f8e40 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/more-tests.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/more-tests.rkt @@ -1,16 +1,13 @@ -;; some more advanced aligned-pasteboard tests take from the test-case-boxes +#lang racket/gui -(require - mzlib/class - mred - mzlib/etc - "../aligned-editor-container.rkt" - "../aligned-pasteboard.rkt") +;; some more advanced aligned-pasteboard tests take from the +;; test-case-boxes + +(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt") ;; a text-case snip (define test-case-box% (class aligned-editor-snip% - ;; these edit-sequences are looping (define/public (hide-entries) (send* editor @@ -19,7 +16,6 @@ (release-snip exp-line) (release-snip act-line) (end-edit-sequence))) - ;; these edit-sequences are looping (define/public (show-entries) (send* editor @@ -28,51 +24,43 @@ (insert exp-line false) (insert act-line false) (end-edit-sequence))) - - (field - [editor (new vertical-pasteboard%)] - [turn-button (new image-snip%)] - [comment (new text%)] - [result (new image-snip%)] - [call (new text%)] - [expected (new text%)] - [actual (new text%)] - [top-line (make-top-line turn-button comment result)] - [call-line (make-line "Call" call)] - [exp-line (make-line "Expected" expected)] - [act-line (make-line "Actual" actual)]) - + (field [editor (new vertical-pasteboard%)] + [turn-button (new image-snip%)] + [comment (new text%)] + [result (new image-snip%)] + [call (new text%)] + [expected (new text%)] + [actual (new text%)] + [top-line (make-top-line turn-button comment result)] + [call-line (make-line "Call" call)] + [exp-line (make-line "Expected" expected)] + [act-line (make-line "Actual" actual)]) (send editor insert top-line) (show-entries) - - (super-new - (editor editor) - (stretchable-height #f) - (stretchable-width #f)))) + (super-new [editor editor] [stretchable-height #f] [stretchable-width #f]))) ;; the top line of the test-case (define (make-top-line turn-snip comment result-snip) - (let ([pb (new horizontal-pasteboard%)]) - (send* pb - (insert turn-snip false) - (insert (text-field comment) false) - (insert result-snip false)) - (new aligned-editor-snip% - (stretchable-height false) - (editor pb)))) + (define pb (new horizontal-pasteboard%)) + (send* pb + (insert turn-snip false) + (insert (text-field comment) false) + (insert result-snip false)) + (new aligned-editor-snip% [stretchable-height false] [editor pb])) ;; a line labeled with the given string and containing a given text (define (make-line str text) - (let ([pb (new horizontal-pasteboard%)]) - (send* pb - (insert (make-object string-snip% str) false) - (insert (text-field text) false)) - (new aligned-editor-snip% (editor pb)))) + (define pb (new horizontal-pasteboard%)) + (send* pb + (insert (make-object string-snip% str) false) + (insert (text-field text) false)) + (new aligned-editor-snip% [editor pb])) ;; a text field fit to be in a test-case (no borders or margins etc.) -;;STATUS: this should really return a stretchable-snip<%> not an editor-snip% of fixed size. +;; STATUS: this should really return a stretchable-snip<%> not an +;; editor-snip% of fixed size. (define (text-field text) - (new editor-snip% (editor text))) + (new editor-snip% [editor text])) ;; To make case 3 work, I need to send the forward set-aligned-min-sizes ;; from the snip. Currently that call only originates in the on-size of @@ -85,11 +73,11 @@ [(2) (cons text% editor-canvas%)] [(3) (cons pasteboard% editor-canvas%)])) -(define f (new frame% (label "test") (width 200) (height 250))) +(define f (new frame% [label "test"] [width 200] [height 250])) (define e (new (car top))) (define c (new (cdr top) (editor e) (parent f))) (define t (new test-case-box%)) (send e insert t) (send f show #t) -;(send t hide-entries) -;(send t show-entries) +;; (send t hide-entries) +;; (send t show-entries) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/old-bugs/big-min.rkt b/collects/mrlib/private/aligned-pasteboard/tests/old-bugs/big-min.rkt new file mode 100644 index 0000000000..b5c21dce49 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/old-bugs/big-min.rkt @@ -0,0 +1,23 @@ +#lang racket/gui + +(require mrlib/aligned-pasteboard) + +(define frame (new frame% [label "big-min"] [width 400] [height 500])) +(define test-suite (new vertical-pasteboard%)) +(new aligned-editor-canvas% [parent frame] [editor test-suite]) + +(define top-string #f) + +(define (new*) + (define main-pb (new horizontal-pasteboard%)) + (define pb (new vertical-pasteboard%)) + (define snip (new aligned-editor-snip% [editor pb])) + (define string (make-object string-snip% "Testing String Snip")) + (set! top-string string) + (send main-pb insert snip false) + (send main-pb insert string false) + (new aligned-editor-snip% [editor main-pb])) + +(send frame show #t) +(define (add) (send test-suite insert (new*))) +(add) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/old-bugs/missing-min.rkt b/collects/mrlib/private/aligned-pasteboard/tests/old-bugs/missing-min.rkt new file mode 100644 index 0000000000..29a6b37a94 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/old-bugs/missing-min.rkt @@ -0,0 +1,18 @@ +#lang racket/gui + +(require mrlib/aligned-pasteboard) + +(define f (new frame% [label "test"] [width 400] [height 500])) +(define pb1 (new vertical-pasteboard%)) +(define ec (new aligned-editor-canvas% + [parent f] [editor pb1] [style '(no-hscroll)])) + +(define pb2 (new vertical-pasteboard%)) +(define es2 (new aligned-editor-snip% [editor pb2])) + +(define t (new text%)) +(define es3 (new editor-snip% [editor t])) + +(send pb1 insert es2) +(send pb2 insert es3) +(send f show true) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/snip-dumper.rkt b/collects/mrlib/private/aligned-pasteboard/tests/snip-dumper.rkt index 546aad3d78..4640c17370 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/snip-dumper.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/snip-dumper.rkt @@ -1,70 +1,45 @@ -(module snip-dumper mzscheme - - (require - mzlib/class - mred) - - (provide - dump-children - (struct snip-dump (left top right bottom children)) - dump=?) - - ;;dump=?: ((union snip-dump? (listof snip-dump?)) . -> . boolean?) - (define (dump=? dump1 dump2) - (cond - [(and (list? dump1) (list? dump2) - (eq? (length dump1) (length dump2))) - (andmap dump=? dump1 dump2)] - [(and (snip-dump? dump1) (snip-dump? dump2)) - (and - (dump=? (snip-dump-left dump1) - (snip-dump-left dump2)) - (dump=? (snip-dump-top dump1) - (snip-dump-top dump2)) - (dump=? (snip-dump-right dump1) - (snip-dump-right dump2)) - (dump=? (snip-dump-bottom dump1) - (snip-dump-bottom dump2)) - (dump=? (snip-dump-children dump1) - (snip-dump-children dump2)))] - [else (equal? dump1 dump2)])) - - ;; type snip-dump = - ;; (make-single number number number number (union #f (listof snip-dump))) - ;; if children is #f, this indicates that the snip was not an - ;; editor-snip. In contrast, if it is null, this indicates that - ;; the snip is an editor-snip, but has no children. - (define-struct snip-dump (left top right bottom children)) - - ;; dump-pb : snip -> snip-dump - (define (dump-snip snip) - (let ([outer-pb (send (send snip get-admin) get-editor)] - [bl (box 0)] - [bt (box 0)] - [br (box 0)] - [bb (box 0)]) - (send outer-pb get-snip-location snip bl bt #t) - (send outer-pb get-snip-location snip br bb #f) - (make-snip-dump - (unbox bl) - (unbox bt) - (unbox br) - (unbox bb) - (dump-snips snip)))) - - ;; dump-snips : snip -> (union #f (listof snip-dump)) - (define (dump-snips snip) - (cond - [(is-a? snip editor-snip%) - (dump-children (send snip get-editor))] - [else #f])) - - ;; dump-children : editor<%> -> (listof snip-dump) - (define (dump-children editor) - (let loop ([snip (send editor find-first-snip)]) - (cond - [snip - (cons (dump-snip snip) - (loop (send snip next)))] - [else null]))) - ) +#lang racket/gui + +(provide dump-children (struct-out snip-dump) dump=?) + +;;dump=?: ((union snip-dump? (listof snip-dump?)) . -> . boolean?) +(define (dump=? dump1 dump2) + (cond [(and (list? dump1) (list? dump2) (eq? (length dump1) (length dump2))) + (andmap dump=? dump1 dump2)] + [(and (snip-dump? dump1) (snip-dump? dump2)) + (and (dump=? (snip-dump-left dump1) (snip-dump-left dump2)) + (dump=? (snip-dump-top dump1) (snip-dump-top dump2)) + (dump=? (snip-dump-right dump1) (snip-dump-right dump2)) + (dump=? (snip-dump-bottom dump1) (snip-dump-bottom dump2)) + (dump=? (snip-dump-children dump1) (snip-dump-children dump2)))] + [else (equal? dump1 dump2)])) + +;; type snip-dump = +;; (make-single number number number number (union #f (listof snip-dump))) +;; if children is #f, this indicates that the snip was not an +;; editor-snip. In contrast, if it is null, this indicates that +;; the snip is an editor-snip, but has no children. +(define-struct snip-dump (left top right bottom children)) + +;; dump-pb : snip -> snip-dump +(define (dump-snip snip) + (define outer-pb (send (send snip get-admin) get-editor)) + (define bl (box 0)) + (define bt (box 0)) + (define br (box 0)) + (define bb (box 0)) + (send outer-pb get-snip-location snip bl bt #t) + (send outer-pb get-snip-location snip br bb #f) + (make-snip-dump (unbox bl) (unbox bt) (unbox br) (unbox bb) + (dump-snips snip))) + +;; dump-snips : snip -> (union #f (listof snip-dump)) +(define (dump-snips snip) + (and (is-a? snip editor-snip%) (dump-children (send snip get-editor)))) + +;; dump-children : editor<%> -> (listof snip-dump) +(define (dump-children editor) + (let loop ([snip (send editor find-first-snip)]) + (if snip + (cons (dump-snip snip) (loop (send snip next))) + '()))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.rkt b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.rkt index fa2b1a46a9..41850cda64 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.rkt @@ -1,24 +1,19 @@ -(require - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt" - "../stretchable-editor-snip.rkt" - "../snip-lib.rkt") +#lang racket/gui -(define f (new frame% (label "") (width 500) (height 500))) +(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt" + "../stretchable-editor-snip.rkt" "../snip-lib.rkt") + +(define f (new frame% [label ""] [width 500] [height 500])) (define e (new vertical-pasteboard%)) -(define c (new aligned-editor-canvas% (parent f) (editor e))) +(define c (new aligned-editor-canvas% [parent f] [editor e])) -(define pb (new vertical-pasteboard%)) +(define pb (new vertical-pasteboard%)) (define aes (new aligned-editor-snip% - (editor pb) - (stretchable-width #f) - (stretchable-height #f))) -(define t2 (new text%)) + [editor pb] [stretchable-width #f] [stretchable-height #f])) +(define t2 (new text%)) (define ses (new stretchable-editor-snip% - (editor t2) - (min-width 100) - (stretchable-width #t) - (stretchable-height #f))) + [editor t2] [min-width 100] + [stretchable-width #t] [stretchable-height #f])) (send e insert aes) (send pb insert ses) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.rkt b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.rkt index 4489c1d0a7..a7cf3ff990 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.rkt @@ -1,25 +1,20 @@ -(require - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt" - "../stretchable-editor-snip.rkt" - "../snip-lib.rkt") +#lang racket/gui -(define f (new frame% (label "") (width 500) (height 500))) +(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt" + "../stretchable-editor-snip.rkt" "../snip-lib.rkt") + +(define f (new frame% [label ""] [width 500] [height 500])) (define e (new vertical-pasteboard%)) -(define c (new aligned-editor-canvas% (parent f) (editor e))) +(define c (new aligned-editor-canvas% [parent f] [editor e])) -(define pb (new vertical-pasteboard%)) +(define pb (new vertical-pasteboard%)) (define aes (new aligned-editor-snip% - (editor pb) - (stretchable-width #f) - (stretchable-height #f))) -(define t1 (new text%)) -(define es (new editor-snip% (editor t1))) -(define t2 (new text%)) + [editor pb] [stretchable-width #f] [stretchable-height #f])) +(define t1 (new text%)) +(define es (new editor-snip% [editor t1])) +(define t2 (new text%)) (define ses (new stretchable-editor-snip% - (editor t2) - (stretchable-width #t) - (stretchable-height #f))) + [editor t2] [stretchable-width #t] [stretchable-height #f])) (send t1 insert "String") (send e insert aes) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rkt new file mode 100644 index 0000000000..4625061c8f --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rkt @@ -0,0 +1,159 @@ +#lang racket/gui + +(require mzlib/etc mzlib/list mzlib/match) +(require "../alignment.rkt" "test-macro.rkt") + +;;los-equal? ((listof rect?) (listof rect?) . -> . boolean?) +;;tests the equality of the list of structures +(define (los-equal? a b) + (equal? (map rect->list a) (map rect->list b))) + +;;rect->list (rect? . -> . vector?) +;;a vector of the fields in the rect +(define rect->list + (match-lambda + [($ rect ($ dim x width stretchable-width?) + ($ dim y height stretchable-height?)) + (list x width stretchable-width? y height stretchable-height?)])) + +;; empty pasteboard +(test los-equal? (align 'vertical 100 100 empty) '()) + +;; empty pasteboard +(test los-equal? (align 'horizontal 100 100 empty) '()) + +;; one unstretchable snip +(test los-equal? + (align 'vertical 100 100 + (list (make-rect (make-dim 0 10 false) (make-dim 0 10 false)))) + (list (make-rect (make-dim 0 10 false) (make-dim 0 10 false)))) + +(test los-equal? + (align 'horizontal 100 100 + (list (make-rect (make-dim 0 10 false) (make-dim 0 10 false)))) + (list (make-rect (make-dim 0 10 false) (make-dim 0 10 false)))) + +;;one stretchable snip +(test los-equal? + (align 'vertical 100 100 + (list (make-rect (make-dim 0 10 true) (make-dim 0 10 true)))) + (list (make-rect (make-dim 0 100 true) (make-dim 0 100 true)))) + +;; two stretchable snips +(test los-equal? + (align 'vertical 10 10 + (list (make-rect (make-dim 0 0 true) (make-dim 0 0 true)) + (make-rect (make-dim 0 0 true) (make-dim 0 0 true)))) + (list (make-rect (make-dim 0 10 true) (make-dim 0 5 true)) + (make-rect (make-dim 0 10 true) (make-dim 5 5 true)))) + +;; three stretchable, one too big +(test los-equal? + (align 'vertical 50 100 + (list (make-rect (make-dim 0 0 true) (make-dim 0 50 true)) + (make-rect (make-dim 0 0 true) (make-dim 0 0 true)) + (make-rect (make-dim 0 0 true) (make-dim 0 0 true)))) + (list (make-rect (make-dim 0 50 true) (make-dim 0 50 true)) + (make-rect (make-dim 0 50 true) (make-dim 50 25 true)) + (make-rect (make-dim 0 50 true) (make-dim 75 25 true)))) + +;; three stetchable, one too big, and an unstetchable +(test los-equal? + (align 'vertical 50 100 + (list (make-rect (make-dim 0 0 true) (make-dim 0 50 true)) + (make-rect (make-dim 0 0 true) (make-dim 0 0 true)) + (make-rect (make-dim 0 0 true) (make-dim 0 0 true)) + (make-rect (make-dim 0 50 false) (make-dim 0 10 false)))) + (list (make-rect (make-dim 0 50 true) (make-dim 0 50 true)) + (make-rect (make-dim 0 50 true) (make-dim 50 20 true)) + (make-rect (make-dim 0 50 true) (make-dim 70 20 true)) + (make-rect (make-dim 0 50 false) (make-dim 90 10 false)))) + +;; failure from test-suite frame +;; wrong answer given was (list (make-rect 0 0 335.0 10 #t)) +(test los-equal? + (align 'vertical 335.0 563.0 + (list (make-rect (make-dim 0 10.0 #t) (make-dim 0 10.0 #t)))) + (list (make-rect (make-dim 0 335.0 true) (make-dim 0 563.0 true)))) + +;; sort of like the previous failed test but with a nonsizable snip +(test los-equal? + (align 'vertical 563.0 335.0 + (list (make-rect (make-dim 0 10.0 #t) (make-dim 0 10.0 #t)) + (make-rect (make-dim 0 10.0 false) (make-dim 0 10.0 false)))) + (list (make-rect (make-dim 0 563.0 true) (make-dim 0 325.0 true)) + (make-rect (make-dim 0 10.0 false) (make-dim 325.0 10.0 false)))) + +;; something that requires a little modulo in division +(test los-equal? + (align 'vertical 10 10 + (list (make-rect (make-dim 0 0 true) (make-dim 0 0 true)) + (make-rect (make-dim 0 0 true) (make-dim 0 0 true)) + (make-rect (make-dim 0 0 true) (make-dim 0 0 true)))) + (list (make-rect (make-dim 0 10 true) (make-dim 0 4 true)) + (make-rect (make-dim 0 10 true) (make-dim 4 3 true)) + (make-rect (make-dim 0 10 true) (make-dim 7 3 true)))) + +;; 1 snip only stretches in off dimention +(test los-equal? + (align 'vertical 100 400 + (list (make-rect (make-dim 0 10 true) (make-dim 0 30 false)))) + (list (make-rect (make-dim 0 100 true) (make-dim 0 30 false)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following examples of usage were taken from the test-suite tool ;; +;; and turned into test cases ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(test los-equal? (align 'vertical 563.0 335.0 (list)) '()) + +(test los-equal? + (align 'vertical 563.0 335.0 + (list (make-rect (make-dim 0 241 #t) (make-dim 0 114 #f)))) + (list (make-rect (make-dim 0 563.0 #t) (make-dim 0 114 #f)))) + +(test los-equal? + (align 'vertical 551.0 102.0 + (list (make-rect (make-dim 0 34 #t) (make-dim 0 47 #t)) + (make-rect (make-dim 0 231 #t) (make-dim 0 57 #t)))) + (list (make-rect (make-dim 0 551.0 #t) (make-dim 0 47 #t)) + (make-rect (make-dim 0 551.0 #t) (make-dim 47 57 #t)))) + +(test los-equal? + (align 'vertical 539.0 35.0 + (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) + (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) + (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) + (make-rect (make-dim 0 11 #f) (make-dim 13 24 #f)))) + +(test los-equal? + (align 'horizontal 539.0 45.0 + (list (make-rect (make-dim 0 65 #t) (make-dim 0 47 #t)) + (make-rect (make-dim 0 48 #t) (make-dim 0 47 #t)) + (make-rect (make-dim 0 63 #t) (make-dim 0 47 #t)) + (make-rect (make-dim 0 45 #f) (make-dim 0 44 #f)))) + (list (make-rect (make-dim 0 165.0 true) (make-dim 0 45.0 true)) + (make-rect (make-dim 165.0 165.0 true) (make-dim 0 45.0 true)) + (make-rect (make-dim 330.0 164.0 true) (make-dim 0 45.0 true)) + (make-rect (make-dim 494.0 45 false) (make-dim 0 44 false)))) + +(test los-equal? + (align 'vertical 153.0 33.0 + (list (make-rect (make-dim 0 55 #f) (make-dim 0 13 #f)) + (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) + (list (make-rect (make-dim 0 55 false) (make-dim 0 13 false)) + (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) + +(test los-equal? + (align 'vertical 153.0 33.0 + (list (make-rect (make-dim 0 38 #f) (make-dim 0 13 #f)) + (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) + (list (make-rect (make-dim 0 38 false) (make-dim 0 13 false)) + (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) + +(test los-equal? + (align 'vertical 152.0 33.0 + (list (make-rect (make-dim 0 26 #f) (make-dim 0 13 #f)) + (make-rect (make-dim 0 53 #f) (make-dim 0 24 #f)))) + (list (make-rect (make-dim 0 26 false) (make-dim 0 13 false)) + (make-rect (make-dim 0 53 false) (make-dim 13 24 false)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rktl b/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rktl deleted file mode 100644 index d04ef444d2..0000000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rktl +++ /dev/null @@ -1,245 +0,0 @@ -(require mzlib/etc mzlib/list mzlib/match "../alignment.rkt" "test-macro.rkt") - -;;los-equal? ((listof rect?) (listof rect?) . -> . boolean?) -;;tests the equality of the list of structures -(define (los-equal? a b) - (equal? - (map rect->list a) - (map rect->list b))) - -;;rect->list (rect? . -> . vector?) -;;a vector of the fields in the rect -(define rect->list - (match-lambda - [($ rect ($ dim x width stretchable-width?) ($ dim y height stretchable-height?)) - (list x width stretchable-width? y height stretchable-height?)])) - -;;empty pasteboard -(test - los-equal? - (align 'vertical 100 100 empty) - empty) - -;;empty pasteboard -(test - los-equal? - (align 'horizontal 100 100 empty) - empty) - -;;one unstretchable snip -(test - los-equal? - (align 'vertical - 100 100 - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - -(test - los-equal? - (align 'horizontal - 100 100 - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - -;;one stretchable snip -(test - los-equal? - (align 'vertical - 100 100 - (list (make-rect (make-dim 0 10 true) - (make-dim 0 10 true)))) - (list (make-rect (make-dim 0 100 true) - (make-dim 0 100 true)))) - -;;two stretchable snips -(test - los-equal? - (align 'vertical - 10 - 10 - (list - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list - (make-rect (make-dim 0 10 true) - (make-dim 0 5 true)) - (make-rect (make-dim 0 10 true) - (make-dim 5 5 true)))) - -;;three stretchable, one too big -(test - los-equal? - (align 'vertical - 50 100 - (list (make-rect (make-dim 0 0 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list (make-rect (make-dim 0 50 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 50 true) - (make-dim 50 25 true)) - (make-rect (make-dim 0 50 true) - (make-dim 75 25 true)))) - -;;three stetchable, one too big, and an unstetchable -(test - los-equal? - (align 'vertical - 50 100 - (list (make-rect (make-dim 0 0 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 50 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 50 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 50 true) - (make-dim 50 20 true)) - (make-rect (make-dim 0 50 true) - (make-dim 70 20 true)) - (make-rect (make-dim 0 50 false) - (make-dim 90 10 false)))) - -;;failure from test-suite frame -;;wrong answer given was (list (make-rect 0 0 335.0 10 #t)) -(test - los-equal? - (align 'vertical - 335.0 - 563.0 - (list - (make-rect (make-dim 0 10.0 #t) - (make-dim 0 10.0 #t)))) - (list (make-rect (make-dim 0 335.0 true) - (make-dim 0 563.0 true)))) - -;;sort of like the previous failed test but with a nonsizable snip -(test - los-equal? - (align 'vertical - 563.0 - 335.0 - (list - (make-rect (make-dim 0 10.0 #t) - (make-dim 0 10.0 #t)) - (make-rect (make-dim 0 10.0 false) - (make-dim 0 10.0 false)))) - (list (make-rect (make-dim 0 563.0 true) - (make-dim 0 325.0 true)) - (make-rect (make-dim 0 10.0 false) - (make-dim 325.0 10.0 false)))) - -;;something that requires a little modulo in division -(test - los-equal? - (align 'vertical - 10 - 10 - (list - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list (make-rect (make-dim 0 10 true) - (make-dim 0 4 true)) - (make-rect (make-dim 0 10 true) - (make-dim 4 3 true)) - (make-rect (make-dim 0 10 true) - (make-dim 7 3 true)))) - -;; 1 snip only stretches in off dimention -(test - los-equal? - (align 'vertical - 100 - 400 - (list - (make-rect (make-dim 0 10 true) - (make-dim 0 30 false)))) - (list (make-rect (make-dim 0 100 true) - (make-dim 0 30 false)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following examples of usage were taken from the test-suite tool and turned into test cases ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(test - los-equal? - (align 'vertical 563.0 335.0 (list)) - empty) - -(test - los-equal? - (align 'vertical 563.0 335.0 - (list (make-rect (make-dim 0 241 #t) (make-dim 0 114 #f)))) - (list (make-rect (make-dim 0 563.0 #t) (make-dim 0 114 #f)))) - -(test - los-equal? - (align 'vertical 551.0 102.0 - (list (make-rect (make-dim 0 34 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 231 #t) (make-dim 0 57 #t)))) - (list (make-rect (make-dim 0 551.0 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 551.0 #t) (make-dim 47 57 #t)))) - -(test - los-equal? - (align 'vertical 539.0 35.0 - (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 13 24 #f)))) - -(test - los-equal? - (align 'horizontal 539.0 45.0 - (list (make-rect (make-dim 0 65 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 48 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 63 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 45 #f) (make-dim 0 44 #f)))) - (list - (make-rect (make-dim 0 165.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 165.0 165.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 330.0 164.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 494.0 45 false) (make-dim 0 44 false)))) - -(test - los-equal? - (align 'vertical 153.0 33.0 - (list (make-rect (make-dim 0 55 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 55 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) - -(test - los-equal? - (align 'vertical 153.0 33.0 - (list (make-rect (make-dim 0 38 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 38 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) - -(test - los-equal? - (align 'vertical 152.0 33.0 - (list (make-rect (make-dim 0 26 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 53 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 26 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 53 false) (make-dim 13 24 false)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-locked-pasteboard.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-locked-pasteboard.rkt index 5e37448fcf..cd51713453 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-locked-pasteboard.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/test-locked-pasteboard.rkt @@ -1,19 +1,21 @@ -(require - "../locked-pasteboard.rkt" - mrlib/click-forwarding-editor) +#lang racket/gui -(define f (new frame% (width 400) (height 500) (label "test"))) -(define e (new (click-forwarding-editor-mixin (locked-pasteboard-mixin pasteboard%)))) -(define c (new editor-canvas% (parent f) (editor e))) +(require "../locked-pasteboard.rkt" mrlib/click-forwarding-editor) + +(define f (new frame% [width 400] [height 500] [label "test"])) +(define e (new (click-forwarding-editor-mixin + (locked-pasteboard-mixin pasteboard%)))) +(define c (new editor-canvas% [parent f] [editor e])) (define t (new text%)) -(define s (new editor-snip% (editor t))) +(define s (new editor-snip% [editor t])) (send e insert s 0 100) (define t2 (new text%)) -(define s2 (new editor-snip% (editor t2))) +(define s2 (new editor-snip% [editor t2])) (send e insert s2 100 0) (send f show #t) -;; This test is not automated. To test it try to use the pasteboard that appears. -;(test:mouse-click 'left 0 100) -;(test:keystroke #\A) -;(string=? (send s get-text) "A") -;(send f show #f) +;; This test is not automated. To test it try to use the pasteboard that +;; appears. +;; (test:mouse-click 'left 0 100) +;; (test:keystroke #\A) +;; (string=? (send s get-text) "A") +;; (send f show #f) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-macro.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-macro.rkt index 096735e6b3..6431d91176 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-macro.rkt +++ b/collects/mrlib/private/aligned-pasteboard/tests/test-macro.rkt @@ -1,17 +1,12 @@ -(module test-macro mzscheme - (require mzlib/etc) - (provide test) - - ;; test: (lambda (a?) ((a? a? . -> . boolean?) a? a? . -> . (void)) - ;; tests to see if the expression is true and prints and error if it's not - (define-syntax test - (syntax-rules (identity) - ((_ test actual expected) - (let ([result - (with-handlers - ([exn? identity]) - actual)]) - (unless (and (not (exn? result)) - (test result expected)) - (eprintf "test failed: ~s != ~s\n" result expected)))))) - ) +#lang racket/base + +(provide test) + +;; test: (lambda (a?) ((a? a? . -> . boolean?) a? a? . -> . (void)) +;; tests to see if the expression is true and prints and error if it's not +(define-syntax test + (syntax-rules (identity) + [(_ = actual expected) + (let ([result (with-handlers ([exn? (λ (x) x)]) actual)]) + (unless (and (not (exn? result)) (= result expected)) + (eprintf "test failed: ~s != ~s\n" result expected)))])) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rkt new file mode 100644 index 0000000000..2c0d1a7d17 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rkt @@ -0,0 +1,113 @@ +#lang racket/gui + +(require "test-macro.rkt" "../pasteboard-lib.rkt" + "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt") + +;; (printf "running tests for pasteboard-lib.rkt\n") + +;; 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 (new vertical-pasteboard%)] + [pb2 (new horizontal-pasteboard%)] + [pb3 (new vertical-pasteboard%)] + [es2 (new aligned-editor-snip% [editor pb2])] + [es3 (new aligned-editor-snip% [editor pb3])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new 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 (new vertical-pasteboard%)] + [pb2 (new horizontal-pasteboard%)] + [pb3 (new vertical-pasteboard%)] + [es1 (new aligned-editor-snip% [editor pb1])] + [es3 (new aligned-editor-snip% [editor pb3])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new 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 (new vertical-pasteboard%)] + [pb2 (new horizontal-pasteboard%)] + [pb3 (new vertical-pasteboard%)] + [es2 (new aligned-editor-snip% [editor pb2])] + [es3 (new aligned-editor-snip% [editor pb3])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new 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 (new vertical-pasteboard%)] + [pb2 (new horizontal-pasteboard%)] + [pb3 (new vertical-pasteboard%)] + [es2 (new aligned-editor-snip% [editor pb2])] + [es3 (new aligned-editor-snip% [editor pb3])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new 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)) + +#| +;; num-sizeable: ((is-a?/c aligned-pasteboard<%>) . -> . number?) +;; the number of snips in the pasteboard that can be resized +(let* ([pb1 (new vertical-pasteboard% ())] + [es1 (new editor-snip% [editor (new text%)])] + [es2 (new editor-snip% [editor (new text%)])] + [es3 (new editor-snip% [editor (new text%)])] + [es4 (new editor-snip% [editor (new text%)])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new aligned-editor-canvas% [parent frame] [editor pb1])]) + (send frame show #t) + (send pb1 insert es1) + (send pb1 insert es2) + (send pb1 insert es3) + (send pb1 insert es4) + ;; + (test = (num-sizeable pb1) 0) + (send pb1 delete es1) + (test = (num-sizeable pb1) 0) + (send frame show #f)) + +(let* ([pb1 (new vertical-pasteboard%)] + [es1 (new aligned-editor-snip% [editor (new vertical-pasteboard%)])] + [es2 (new aligned-editor-snip% [editor (new vertical-pasteboard%)])] + [es3 (new aligned-editor-snip% [editor (new vertical-pasteboard%)])] + [es4 (new aligned-editor-snip% [editor (new vertical-pasteboard%)])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new aligned-editor-canvas% [parent frame] [editor pb1])]) + (send frame show #t) + (send pb1 insert es1) + (send pb1 insert es2) + (send pb1 insert es3) + (send pb1 insert es4) + ;; + (test = (num-sizeable pb1) 4) + (send pb1 delete es1) + (test = (num-sizeable pb1) 3) + (send pb1 erase) + (test = (num-sizeable pb1) 0) + (send frame show #f)) + +(printf "tests done\n") +|# diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rktl b/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rktl deleted file mode 100644 index 4bda573e82..0000000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rktl +++ /dev/null @@ -1,202 +0,0 @@ -(require mzlib/etc mzlib/class "test-macro.rkt" mred - "../pasteboard-lib.rkt" - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt") - -;; (printf "running tests for pasteboard-lib.rkt\n") - -;;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) - ) - -#| -;;num-sizeable: ((is-a?/c aligned-pasteboard<%>) . -> . number?) -;;the number of snips in the pasteboard that can be resized -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (test - = - (num-sizeable pb1) - 0) - - (send pb1 delete es1) - - (test - = - (num-sizeable pb1) - 0) - - (send frame show false) - ) - -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - [es2 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - [es3 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - [es4 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (test - = - (num-sizeable pb1) - 4) - - (send pb1 delete es1) - - (test - = - (num-sizeable pb1) - 3) - - (send pb1 erase) - - (test - = - (num-sizeable pb1) - 0) - - (send frame show false) - ) - -(printf "tests done\n") -|# diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt new file mode 100644 index 0000000000..a1449dcbca --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt @@ -0,0 +1,128 @@ +#lang racket/gui + +(require "test-macro.rkt" "../snip-lib.rkt" + "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt") + +;; (printf "running tests for snip-lib.rkt\n") + +;; snip-width: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?) +;; the width of a snip in the given pasteboard +(let* ([pb1 (new vertical-pasteboard%)] + [es1 (new editor-snip% [editor pb1])] + [pb2 (new vertical-pasteboard%)] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new aligned-editor-canvas% [parent frame] [editor pb2])]) + (send frame show #t) + (send pb2 insert es1) + (send es1 resize 20 20) + (sleep/yield 0.3) + (test equal? (snip-width #;pb2 es1) 20.0) + (send es1 resize 200 90) + (sleep/yield 0.3) + (test equal? (snip-width #;pb2 es1) 200.0) + (send frame show #f)) + +;; snip-height: +;; ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?) +;; the height of a snip in the given pasteboard +(let* ([pb1 (new vertical-pasteboard%)] + [es1 (new editor-snip% [editor pb1])] + [pb2 (new vertical-pasteboard%)] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new aligned-editor-canvas% [parent frame] [editor pb2])]) + (send frame show #t) + (send pb2 insert es1) + (send es1 resize 20 20) + (sleep/yield 0.3) + (test equal? (snip-height #;pb2 es1) 20.0) + (send es1 resize 200 90) + (sleep/yield 0.3) + (test equal? (snip-height #;pb2 es1) 90.0) + (send frame show #f)) + +;; snip-min-width: ((is-a?/c snip%) . -> . number?) +;; the minimum width of the snip + +;; snip-min-height: ((is-a?/c snip%) . -> . number?) +;; the minimum height of the snip + +;; snip-parent: ((is-a?/c snip%) . -> . (is-a?/c editor<%>)) +;; the pasteboard that contains the snip +(let* ([pb1 (new pasteboard%)] + [es1 (new editor-snip% [editor pb1])] + [pb2 (new pasteboard%)] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new editor-canvas% [parent frame] [editor pb2])]) + (send frame show #t) + (send pb2 insert es1) + (test equal? (snip-parent es1) pb2) + (send frame show #f)) + +(let* ([pb1 (new horizontal-pasteboard%)] + [pb2 (new horizontal-pasteboard%)] + [pb3 (new horizontal-pasteboard%)] + [pb4 (new horizontal-pasteboard%)] + [pb5 (new horizontal-pasteboard%)] + [es2 (new aligned-editor-snip% [editor pb2])] + [es3 (new aligned-editor-snip% [editor pb3])] + [es4 (new aligned-editor-snip% [editor pb4])] + [es5 (new aligned-editor-snip% [editor pb5])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new aligned-editor-canvas% [parent frame] [editor pb1])]) + (send frame show #t) + (send pb1 insert es2) + (send pb2 insert es3) + (send pb3 insert es4) + (send pb4 insert es5) + (test equal? (snip-parent es2) pb1) + (test equal? (snip-parent es3) pb2) + (test equal? (snip-parent es4) pb3) + (test equal? (snip-parent es5) pb4) + (send frame show #f)) + +;; fold-snip: (lambda (b?) ((any? b? . -> . b?) b? (is-a?/c snip%) . -> . b?)) +;; the application of f on all snips from snip to the end in a foldl +;; foldr mannor +(let* ([pb1 (new vertical-pasteboard%)] + [es1 (new editor-snip% [editor (new text%)])] + [es2 (new editor-snip% [editor (new text%)])] + [es3 (new editor-snip% [editor (new text%)])] + [es4 (new editor-snip% [editor (new text%)])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new aligned-editor-canvas% [parent frame] [editor pb1])]) + (send frame show #t) + (send pb1 insert es1) + (send pb1 insert es2) + (send pb1 insert es3) + (send pb1 insert es4) + (send es1 resize 100 100) + (send es2 resize 100 100) + (send es3 resize 100 100) + (send es4 resize 100 100) + (test = (fold-snip (λ (snip total-height) + (+ (snip-height #;pb1 snip) total-height)) + 0 es1) + 400) + (send frame show #f)) + +;; for-each-snip: +;; (((is-a?/c snip%) . -> . (void)) (is-a/c? snip%) . -> . (void)) +;; applies the function to all the snips +(let* ([pb1 (new vertical-pasteboard%)] + [es1 (new editor-snip% [editor (new text%)])] + [es2 (new editor-snip% [editor (new text%)])] + [es3 (new editor-snip% [editor (new text%)])] + [es4 (new editor-snip% [editor (new text%)])] + [frame (new frame% [label "l"] [width 10] [height 10])] + [canvas (new aligned-editor-canvas% [parent frame] [editor pb1])] + [count 0]) + (send frame show #t) + (send pb1 insert es1) + (send pb1 insert es2) + (send pb1 insert es3) + (send pb1 insert es4) + (for-each-snip (λ (snip) (set! count (add1 count))) es1) + (test = count 4) + (send frame show #f)) + +;; (printf "tests done\n") diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rktl b/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rktl deleted file mode 100644 index 899b725f06..0000000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rktl +++ /dev/null @@ -1,203 +0,0 @@ -(require mzlib/etc mzlib/class mred "test-macro.rkt" - "../snip-lib.rkt" - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt") - -;;(printf "running tests for snip-lib.rkt\n") - -;;snip-width: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?) -;;the width of a snip in the given pasteboard -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate vertical-pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - (send es1 resize 20 20) - (sleep/yield 1) - (test - equal? - (snip-width #;pb2 es1) - 20.0) - - (send es1 resize 200 90) - (sleep/yield 1) - (test - equal? - (snip-width #;pb2 es1) - 200.0) - - (send frame show false) - ) - -;;snip-height: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?) -;;the height of a snip in the given pasteboard -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate vertical-pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - (send es1 resize 20 20) - (sleep/yield 1) - (test - equal? - (snip-height #;pb2 es1) - 20.0) - - (send es1 resize 200 90) - (sleep/yield 1) - (test - equal? - (snip-height #;pb2 es1) - 90.0) - - (send frame show false) - ) - -;;snip-min-width: ((is-a?/c snip%) . -> . number?) -;;the minimum width of the snip - -;;snip-min-height: ((is-a?/c snip%) . -> . number?) -;;the minimum height of the snip - -;;snip-parent: ((is-a?/c snip%) . -> . (is-a?/c editor<%>)) -;;the pasteboard that contains the snip -(let* - ([pb1 (instantiate pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate editor-canvas% () (parent frame) (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - - (test - equal? - (snip-parent es1) - pb2) - - (send frame show false) - ) - -(let* - ([pb1 (instantiate horizontal-pasteboard% ())] - [pb2 (instantiate horizontal-pasteboard% ())] - [pb3 (instantiate horizontal-pasteboard% ())] - [pb4 (instantiate horizontal-pasteboard% ())] - [pb5 (instantiate horizontal-pasteboard% ())] - [es2 (instantiate aligned-editor-snip% () (editor pb2))] - [es3 (instantiate aligned-editor-snip% () (editor pb3))] - [es4 (instantiate aligned-editor-snip% () (editor pb4))] - [es5 (instantiate aligned-editor-snip% () (editor pb5))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - (send pb1 insert es2) - (send pb2 insert es3) - (send pb3 insert es4) - (send pb4 insert es5) - - (test - equal? - (snip-parent es2) - pb1) - - (test - equal? - (snip-parent es3) - pb2) - - (test - equal? - (snip-parent es4) - pb3) - - (test - equal? - (snip-parent es5) - pb4) - - (send frame show false) - ) - -;;fold-snip: (lambda (b?) ((any? b? . -> . b?) b? (is-a?/c snip%) . -> . b?)) -;;the application of f on all snips from snip to the end in a foldl foldr mannor -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (send es1 resize 100 100) - (send es2 resize 100 100) - (send es3 resize 100 100) - (send es4 resize 100 100) - - (test - = - (fold-snip - (lambda (snip total-height) - (+ (snip-height #;pb1 snip) - total-height)) - 0 - es1) - 400) - - (send frame show false) - ) - - -;;for-each-snip: (((is-a?/c snip%) . -> . (void)) (is-a/c? snip%) . -> . (void)) -;;applies the function to all the snips -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))] - [count 0]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (for-each-snip - (lambda (snip) - (set! count (add1 count))) - es1) - - (test - = - count - 4) - - (send frame show false) - ) -;;(printf "tests done\n") diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test.rkt new file mode 100644 index 0000000000..087829fa70 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/test.rkt @@ -0,0 +1,147 @@ +#lang racket/gui + +(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt" + "snip-dumper.rkt") + + +; ;; +; ; +; ; +; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; +; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; +; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; +; ; ;; ; ; ; ; ; ; ; ; ; ; +; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; +; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; +; ; +; ;;; + +(printf "running test.rkt\n") + +(define frame (new frame% [label "Frame"] [width 400] [height 400])) +(define pasteboard (new horizontal-pasteboard%)) +(define canvas (new aligned-editor-canvas% [parent frame] [editor pasteboard])) +(define insider (new vertical-pasteboard%)) +(define insider2 (new vertical-pasteboard%)) +(define insider3 (new vertical-pasteboard%)) +(define insider4 (new vertical-pasteboard%)) +(define insider5 (new vertical-pasteboard%)) +(define insider6 (new vertical-pasteboard%)) +(define insider7 (new vertical-pasteboard%)) +(define pb-snip (new aligned-editor-snip% [editor insider])) +(define pb-snip2 (new aligned-editor-snip% [editor insider2])) +(define pb-snip3 (new aligned-editor-snip% [editor insider3])) +(define pb-snip4 (new aligned-editor-snip% [editor insider4])) +(define pb-snip5 (new aligned-editor-snip% [editor insider5])) +(define pb-snip6 (new aligned-editor-snip% [editor insider6])) +(define pb-snip7 (new aligned-editor-snip% [editor insider7])) +(define t-snip (new editor-snip% [editor (new text%)])) +(define i-snip (new image-snip%)) +(define i-snip2 (new image-snip%)) +(define t-snip2 (new editor-snip% [editor (new text%)])) +(define t-snip3 (new editor-snip% [editor (new text%)])) + +(send pasteboard begin-edit-sequence) +(send frame show #t) +(send pasteboard insert pb-snip) +(send pasteboard insert t-snip) +(send pasteboard insert i-snip) +(send pasteboard insert i-snip2) +(send pasteboard insert pb-snip2) +(send pasteboard insert t-snip2) +(send insider insert t-snip3) +(send insider2 insert pb-snip3) +(send insider2 insert pb-snip4) +(send pasteboard insert pb-snip5) +(send pasteboard insert pb-snip6) +(send pasteboard insert pb-snip7) +(send pasteboard end-edit-sequence) + + +; ; ; +; ; ; +;;;;;;; ;;;;; ;;;; ;;;;; ;;;; +; ; ; ; ; ; ; ; ; +; ; ;;;;;; ;;;; ; ;;;; +; ; ; ; ; ; +; ; ;; ; ; ; ; ; ; +; ;;;;; ;;;; ;;;; ;;;;; ;;;; + +;; Eli: Looks like these tests are supposed to return #t, so most are +;; failing (wasn't visible when this was running via "gracket -f") + +(dump=? + (dump-children pasteboard) + (list + (make-snip-dump 57.0 368.0 0.0 0.0 '()) + (make-snip-dump 114.0 368.0 57.0 0.0 '()) + (make-snip-dump 171.0 368.0 114.0 0.0 '()) + (make-snip-dump 182.0 24.0 171.0 0.0 '()) + (make-snip-dump 249.0 368.0 182.0 0.0 + (list (make-snip-dump 55.0 178.0 0.0 0.0 '()) + (make-snip-dump 55.0 356.0 0.0 178.0 '()))) + (make-snip-dump 269.0 20.0 249.0 0.0 #f) + (make-snip-dump 289.0 20.0 269.0 0.0 #f) + (make-snip-dump 300.0 24.0 289.0 0.0 '()) + (make-snip-dump 368.0 368.0 300.0 0.0 + (list (make-snip-dump 11.0 24.0 0.0 0.0 '()))))) + +(send frame resize 0 0) +(sleep/yield 0.5) + +(dump=? + (dump-children pasteboard) + (list + (make-snip-dump 10.0 34.0 0.0 0.0 '()) + (make-snip-dump 20.0 34.0 10.0 0.0 '()) + (make-snip-dump 30.0 34.0 20.0 0.0 '()) + (make-snip-dump 41.0 24.0 30.0 0.0 '()) + (make-snip-dump 61.0 34.0 41.0 0.0 + (list (make-snip-dump 10.0 11.0 0.0 0.0 '()) + (make-snip-dump 10.0 22.0 0.0 11.0 '()))) + (make-snip-dump 81.0 20.0 61.0 0.0 #f) + (make-snip-dump 101.0 20.0 81.0 0.0 #f) + (make-snip-dump 112.0 24.0 101.0 0.0 '()) + (make-snip-dump 133.0 34.0 112.0 0.0 + (list (make-snip-dump 11.0 24.0 0.0 0.0 '()))))) + +(send frame resize 800 600) +(sleep/yield 0.5) + +(dump=? + (dump-children pasteboard) + (list (make-snip-dump 137.0 568.0 0.0 0.0 '()) + (make-snip-dump 274.0 568.0 137.0 0.0 '()) + (make-snip-dump 411.0 568.0 274.0 0.0 '()) + (make-snip-dump 422.0 24.0 411.0 0.0 '()) + (make-snip-dump 569.0 568.0 422.0 0.0 + (list (make-snip-dump 135.0 278.0 0.0 0.0 '()) + (make-snip-dump 135.0 556.0 0.0 278.0 '()))) + (make-snip-dump 589.0 20.0 569.0 0.0 #f) + (make-snip-dump 609.0 20.0 589.0 0.0 #f) + (make-snip-dump 620.0 24.0 609.0 0.0 '()) + (make-snip-dump 768.0 568.0 620.0 0.0 + (list (make-snip-dump 11.0 24.0 0.0 0.0 '()))))) + +(send frame resize 400 400) +(send pasteboard delete i-snip) +(send pasteboard delete i-snip2) + +(dump=? + (dump-children pasteboard) + (list (make-snip-dump 65.0 368.0 0.0 0.0 '()) + (make-snip-dump 130.0 368.0 65.0 0.0 '()) + (make-snip-dump 195.0 368.0 130.0 0.0 '()) + (make-snip-dump 206.0 24.0 195.0 0.0 '()) + (make-snip-dump 281.0 368.0 206.0 0.0 + (list (make-snip-dump 63.0 178.0 0.0 0.0 '()) + (make-snip-dump 63.0 356.0 0.0 178.0 '()))) + (make-snip-dump 292.0 24.0 281.0 0.0 '()) + (make-snip-dump 368.0 368.0 292.0 0.0 + (list (make-snip-dump 11.0 24.0 0.0 0.0 '()))))) + +(send pasteboard erase) +(dump=? (dump-children pasteboard) '()) + +(send frame show #f) +(printf "done\n") diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test.rktl b/collects/mrlib/private/aligned-pasteboard/tests/test.rktl deleted file mode 100644 index e7e9ead862..0000000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test.rktl +++ /dev/null @@ -1,226 +0,0 @@ -(require mzlib/class mred mzlib/etc mzlib/list - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt" - "snip-dumper.rkt") - - -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; - -(printf "running test.rktl\n") - -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) - -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define insider - (instantiate vertical-pasteboard% ())) - -(define insider2 - (instantiate vertical-pasteboard% ())) - -(define insider3 - (instantiate vertical-pasteboard% ())) - -(define insider4 - (instantiate vertical-pasteboard% ())) - -(define insider5 - (instantiate vertical-pasteboard% ())) - -(define insider6 - (instantiate vertical-pasteboard% ())) - -(define insider7 - (instantiate vertical-pasteboard% ())) - -(define pb-snip - (instantiate aligned-editor-snip% () - (editor insider))) - -(define pb-snip2 - (instantiate aligned-editor-snip% () - (editor insider2))) - -(define pb-snip3 - (instantiate aligned-editor-snip% () - (editor insider3))) - -(define pb-snip4 - (instantiate aligned-editor-snip% () - (editor insider4))) - -(define pb-snip5 - (instantiate aligned-editor-snip% () - (editor insider5))) - -(define pb-snip6 - (instantiate aligned-editor-snip% () - (editor insider6))) - -(define pb-snip7 - (instantiate aligned-editor-snip% () - (editor insider7))) - -(define t-snip - (instantiate editor-snip% () - (editor - (instantiate text% ())))) - -(define i-snip - (instantiate image-snip% ())) - -(define i-snip2 - (instantiate image-snip% ())) - -(define t-snip2 - (instantiate editor-snip% () - (editor - (instantiate text% ())))) -(define t-snip3 - (instantiate editor-snip% () - (editor - (instantiate text% ())))) - -(send pasteboard begin-edit-sequence) -(send frame show true) -(send pasteboard insert pb-snip) -(send pasteboard insert t-snip) -(send pasteboard insert i-snip) -(send pasteboard insert i-snip2) -(send pasteboard insert pb-snip2) -(send pasteboard insert t-snip2) -(send insider insert t-snip3) -(send insider2 insert pb-snip3) -(send insider2 insert pb-snip4) -(send pasteboard insert pb-snip5) -(send pasteboard insert pb-snip6) -(send pasteboard insert pb-snip7) -(send pasteboard end-edit-sequence) - - - - -; ; ; -; ; ; -;;;;;;; ;;;;; ;;;; ;;;;; ;;;; -; ; ; ; ; ; ; ; ; -; ; ;;;;;; ;;;; ; ;;;; -; ; ; ; ; ; -; ; ;; ; ; ; ; ; ; -; ;;;;; ;;;; ;;;; ;;;;; ;;;; - - - - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 57.0 368.0 0.0 0.0 empty) - (make-snip-dump 114.0 368.0 57.0 0.0 empty) - (make-snip-dump 171.0 368.0 114.0 0.0 empty) - (make-snip-dump 182.0 24.0 171.0 0.0 empty) - (make-snip-dump - 249.0 - 368.0 - 182.0 - 0.0 - (list (make-snip-dump 55.0 178.0 0.0 0.0 empty) (make-snip-dump 55.0 356.0 0.0 178.0 empty))) - (make-snip-dump 269.0 20.0 249.0 0.0 false) - (make-snip-dump 289.0 20.0 269.0 0.0 false) - (make-snip-dump 300.0 24.0 289.0 0.0 empty) - (make-snip-dump 368.0 368.0 300.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 0 0) -(sleep/yield 1) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 10.0 34.0 0.0 0.0 empty) - (make-snip-dump 20.0 34.0 10.0 0.0 empty) - (make-snip-dump 30.0 34.0 20.0 0.0 empty) - (make-snip-dump 41.0 24.0 30.0 0.0 empty) - (make-snip-dump - 61.0 - 34.0 - 41.0 - 0.0 - (list (make-snip-dump 10.0 11.0 0.0 0.0 empty) (make-snip-dump 10.0 22.0 0.0 11.0 empty))) - (make-snip-dump 81.0 20.0 61.0 0.0 false) - (make-snip-dump 101.0 20.0 81.0 0.0 false) - (make-snip-dump 112.0 24.0 101.0 0.0 empty) - (make-snip-dump 133.0 34.0 112.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 800 600) -(sleep/yield 1) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 137.0 568.0 0.0 0.0 empty) - (make-snip-dump 274.0 568.0 137.0 0.0 empty) - (make-snip-dump 411.0 568.0 274.0 0.0 empty) - (make-snip-dump 422.0 24.0 411.0 0.0 empty) - (make-snip-dump - 569.0 - 568.0 - 422.0 - 0.0 - (list (make-snip-dump 135.0 278.0 0.0 0.0 empty) (make-snip-dump 135.0 556.0 0.0 278.0 empty))) - (make-snip-dump 589.0 20.0 569.0 0.0 false) - (make-snip-dump 609.0 20.0 589.0 0.0 false) - (make-snip-dump 620.0 24.0 609.0 0.0 empty) - (make-snip-dump 768.0 568.0 620.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 400 400) -(send pasteboard delete i-snip) -(send pasteboard delete i-snip2) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 65.0 368.0 0.0 0.0 empty) - (make-snip-dump 130.0 368.0 65.0 0.0 empty) - (make-snip-dump 195.0 368.0 130.0 0.0 empty) - (make-snip-dump 206.0 24.0 195.0 0.0 empty) - (make-snip-dump - 281.0 - 368.0 - 206.0 - 0.0 - (list (make-snip-dump 63.0 178.0 0.0 0.0 empty) (make-snip-dump 63.0 356.0 0.0 178.0 empty))) - (make-snip-dump 292.0 24.0 281.0 0.0 empty) - (make-snip-dump 368.0 368.0 292.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send pasteboard erase) -(dump=? - (dump-children pasteboard) - empty - ) - -(send frame show false) -(printf "done\n") diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test2.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test2.rkt new file mode 100644 index 0000000000..c804b6570c --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/test2.rkt @@ -0,0 +1,114 @@ +#lang racket/gui + +(require "../aligned-pasteboard.rkt" "../aligned-editor-container.rkt" + "snip-dumper.rkt") + +; ;; +; ; +; ; +; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; +; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; +; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; +; ; ;; ; ; ; ; ; ; ; ; ; ; +; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; +; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; +; ; +; ;;; + +(printf "running test2.rkt\n") + +(define frame (new frame% [label "Frame"] [width 400] [height 400])) +(define pasteboard (new horizontal-pasteboard%)) +(define canvas (new aligned-editor-canvas% [parent frame] [editor pasteboard])) +(define vp1 (new vertical-pasteboard%)) +(define ae-snip1 (new aligned-editor-snip% [editor vp1])) +(define vp2 (new vertical-pasteboard%)) +(define ae-snip2 (new aligned-editor-snip% [editor vp2])) +(define vp3 (new vertical-pasteboard%)) +(define ae-snip3 (new aligned-editor-snip% [editor vp3])) +(define vp4 (new vertical-pasteboard%)) +(define ae-snip4 (new aligned-editor-snip% [editor vp4])) +(define vp5 (new vertical-pasteboard%)) +(define ae-snip5 (new aligned-editor-snip% [editor vp5])) + +(send pasteboard insert ae-snip1) +(send pasteboard insert ae-snip2) +(send pasteboard insert ae-snip5) +(send vp2 insert ae-snip3) +(send vp2 insert ae-snip4) +(send frame show #t) + + +; ; ; +; ; ; +; ;;;;; ;;;;; ;;;; ;;;;; ;;;; +; ; ; ; ; ; ; ; ; +; ; ;;;;;; ;;;; ; ;;;; +; ; ; ; ; ; +; ; ;; ; ; ; ; ; ; +; ;;;;; ;;;; ;;;; ;;;;; ;;;; + +;; Eli: Looks like these tests are supposed to return #t, so most are +;; failing (wasn't visible when this was running via "gracket -f") + +(sleep/yield 0.5) +(dump=? + (dump-children pasteboard) + (list (make-snip-dump 120.0 368.0 0.0 0.0 '()) + (make-snip-dump 249.0 368.0 120.0 0.0 + (list (make-snip-dump 117.0 178.0 0.0 0.0 '()) + (make-snip-dump 117.0 356.0 0.0 178.0 '()))) + (make-snip-dump 368.0 368.0 249.0 0.0 '()))) + +(send frame resize 0 0) +(sleep/yield 0.5) +(dump=? + (dump-children pasteboard) + (list (make-snip-dump 10.0 30.0 0.0 0.0 '()) + (make-snip-dump 30.0 30.0 10.0 0.0 + (list (make-snip-dump 10.0 10.0 0.0 0.0 '()) + (make-snip-dump 10.0 19.0 0.0 9.0 '()))) + (make-snip-dump 40.0 30.0 30.0 0.0 '()))) + +(send frame resize 800 600) +(sleep/yield 0.5) +(dump=? + (dump-children pasteboard) + (list + (make-snip-dump 253.0 568.0 0.0 0.0 '()) + (make-snip-dump 516.0 568.0 253.0 0.0 + (list (make-snip-dump 251.0 278.0 0.0 0.0 '()) + (make-snip-dump 251.0 556.0 0.0 278.0 '()))) + (make-snip-dump 768.0 568.0 516.0 0.0 '()))) + +(send pasteboard delete ae-snip5) +(dump=? + (dump-children pasteboard) + (list (make-snip-dump 389.0 568.0 0.0 0.0 + (list (make-snip-dump 377.0 278.0 0.0 0.0 '()) + (make-snip-dump 377.0 556.0 0.0 278.0 '()))) + (make-snip-dump 768.0 568.0 389.0 0.0 '()))) + +(send pasteboard insert ae-snip5) +(dump=? + (dump-children pasteboard) + (list + (make-snip-dump 253.0 568.0 0.0 0.0 '()) + (make-snip-dump 516.0 568.0 253.0 0.0 + (list (make-snip-dump 251.0 278.0 0.0 0.0 '()) + (make-snip-dump 251.0 556.0 0.0 278.0 '()))) + (make-snip-dump 768.0 568.0 516.0 0.0 '()))) + +(send pasteboard delete ae-snip5) +(send pasteboard delete ae-snip1) +(dump=? + (dump-children pasteboard) + (list (make-snip-dump 768.0 568.0 0.0 0.0 + (list (make-snip-dump 756.0 278.0 0.0 0.0 '()) + (make-snip-dump 756.0 556.0 0.0 278.0 '()))))) + +(send pasteboard erase) +(dump=? (dump-children pasteboard) '()) + +(send frame show #f) +(printf "done\n") diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test2.rktl b/collects/mrlib/private/aligned-pasteboard/tests/test2.rktl deleted file mode 100644 index dbef96e60f..0000000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test2.rktl +++ /dev/null @@ -1,185 +0,0 @@ -(require mzlib/class mred mzlib/etc mzlib/list - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt" - "snip-dumper.rkt") - -; -; -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; -; - -(printf "running test2.rktl\n") - -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) - -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define vp1 - (instantiate vertical-pasteboard% ())) - -(define ae-snip1 - (instantiate aligned-editor-snip% () - (editor vp1))) - -(define vp2 - (instantiate vertical-pasteboard% ())) - -(define ae-snip2 - (instantiate aligned-editor-snip% () - (editor vp2))) - -(define vp3 - (instantiate vertical-pasteboard% ())) - -(define ae-snip3 - (instantiate aligned-editor-snip% () - (editor vp3))) - -(define vp4 - (instantiate vertical-pasteboard% ())) - -(define ae-snip4 - (instantiate aligned-editor-snip% () - (editor vp4))) - -(define vp5 - (instantiate vertical-pasteboard% ())) - -(define ae-snip5 - (instantiate aligned-editor-snip% () - (editor vp5))) - -(send pasteboard insert ae-snip1) -(send pasteboard insert ae-snip2) -(send pasteboard insert ae-snip5) -(send vp2 insert ae-snip3) -(send vp2 insert ae-snip4) -(send frame show true) - -; -; -; -; ; ; -; ; ; -; ;;;;; ;;;;; ;;;; ;;;;; ;;;; -; ; ; ; ; ; ; ; ; -; ; ;;;;;; ;;;; ; ;;;; -; ; ; ; ; ; -; ; ;; ; ; ; ; ; ; -; ;;;;; ;;;; ;;;; ;;;;; ;;;; -; -; -; - -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 120.0 368.0 0.0 0.0 empty) - (make-snip-dump - 249.0 - 368.0 - 120.0 - 0.0 - (list (make-snip-dump 117.0 178.0 0.0 0.0 empty) (make-snip-dump 117.0 356.0 0.0 178.0 empty))) - (make-snip-dump 368.0 368.0 249.0 0.0 empty)) - ) - -(send frame resize 0 0) -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 10.0 30.0 0.0 0.0 empty) - (make-snip-dump - 30.0 - 30.0 - 10.0 - 0.0 - (list (make-snip-dump 10.0 10.0 0.0 0.0 empty) (make-snip-dump 10.0 19.0 0.0 9.0 empty))) - (make-snip-dump 40.0 30.0 30.0 0.0 empty)) - ) - -(send frame resize 800 600) -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 253.0 568.0 0.0 0.0 empty) - (make-snip-dump - 516.0 - 568.0 - 253.0 - 0.0 - (list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 516.0 0.0 empty)) - ) - -(send pasteboard delete ae-snip5) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump - 389.0 - 568.0 - 0.0 - 0.0 - (list (make-snip-dump 377.0 278.0 0.0 0.0 empty) (make-snip-dump 377.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 389.0 0.0 empty)) - ) - -(send pasteboard insert ae-snip5) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 253.0 568.0 0.0 0.0 empty) - (make-snip-dump - 516.0 - 568.0 - 253.0 - 0.0 - (list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 516.0 0.0 empty)) - ) - -(send pasteboard delete ae-snip5) -(send pasteboard delete ae-snip1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump - 768.0 - 568.0 - 0.0 - 0.0 - (list (make-snip-dump 756.0 278.0 0.0 0.0 empty) (make-snip-dump 756.0 556.0 0.0 278.0 empty)))) - ) - -(send pasteboard erase) -(dump=? - (dump-children pasteboard) - empty - ) - -(send frame show false) -(printf "done\n") diff --git a/collects/tests/aligned-pasteboard/debug.rkt b/collects/tests/aligned-pasteboard/debug.rkt deleted file mode 100644 index 3c18771bf4..0000000000 --- a/collects/tests/aligned-pasteboard/debug.rkt +++ /dev/null @@ -1,80 +0,0 @@ -(module debug mzscheme - (require - mzlib/class) - - (provide - debug-snip - debug-pasteboard - debug-canvas) - - ;;debug-snip: -> (void) - ;;get the relevant info about the snip that contains the two others pasteboards - (define debug-snip - (lambda (snip) - (printf "--- aligned-editor-snip% --\n") - (let ((l (box 0)) - (t (box 0)) - (r (box 0)) - (b (box 0))) - (send snip get-inset l t r b) - (printf "get-inset: ~sX~s ~sX~s\n" (unbox l) (unbox r) (unbox t) (unbox b))) - - (let ((l (box 0)) - (t (box 0)) - (r (box 0)) - (b (box 0))) - (send snip get-margin l t r b) - (printf "get-margin: ~sX~s ~sX~s\n" (unbox l) (unbox r) (unbox t) (unbox b))) - - (printf "get-max-height: ~s\n" (send snip get-max-height)) - (printf "get-max-width: ~s\n" (send snip get-max-width)) - (printf "get-min-height: ~s\n" (send snip get-min-height)) - (printf "get-min-width: ~s\n" (send snip get-min-width)) - ;(printf "snip-width: ~s\n" (send pasteboard snip-width snip)) - ;(printf "snip-height: ~s\n" (send pasteboard snip-height snip)) - )) - - ;;debug-pasteboard: -> (void) - ;;displays to the repl the sizes i'm interested in - (define debug-pasteboard - (lambda (pasteboard) - (printf "--- aligned-pasteboard% ---\n") - (let ((tmp1 (box 0)) - (tmp2 (box 0))) - (send pasteboard get-extent tmp1 tmp2) - (printf "get-extent: ~sX~s\n" (unbox tmp1) (unbox tmp2))) - (printf "get-max-height: ~s\n" (send pasteboard get-max-height)) - (let ((tmp (call-with-values (lambda () (send pasteboard get-max-view-size)) cons))) - (printf "get-max-view-size: ~sX~s\n" (car tmp) (cdr tmp))) - (printf "get-max-width: ~s\n" (send pasteboard get-max-width)) - (printf "get-min-height: ~s\n" (send pasteboard get-min-height)) - (printf "get-min-width: ~s\n" (send pasteboard get-min-width)) - (let ((tmp1 (box 0)) - (tmp2 (box 0))) - (send pasteboard get-view-size tmp1 tmp2) - (printf "get-view-size: ~sX~s\n" (unbox tmp1) (unbox tmp2))) - )) - - ;;debug-canvas: -> (void) - ;;just some help counting pixels - (define debug-canvas - (lambda (canvas) - (printf "--- aligned-editor-canvas% ---\n") - ;;values - (let ((tmp (call-with-values (lambda () (send canvas get-client-size)) cons))) - (printf "~a: ~sX~s\n" (symbol->string (quote get-client-size)) (car tmp) (cdr tmp))) - (let ((tmp (call-with-values (lambda () (send canvas get-graphical-min-size)) cons))) - (printf "~a: ~sX~s\n" (symbol->string (quote get-graphical-min-size)) (car tmp) (cdr tmp))) - (let ((tmp (call-with-values (lambda () (send canvas get-size)) cons))) - (printf "~a: ~sX~s\n" (symbol->string (quote get-size)) (car tmp) (cdr tmp))) - ;;1 value - (printf "~a: ~s\n" (symbol->string (quote get-height)) (send canvas get-height)) - (printf "~a: ~s\n" (symbol->string (quote get-width)) (send canvas get-width)) - (printf "~a: ~s\n" (symbol->string (quote horiz-margin)) (send canvas horiz-margin)) - (printf "~a: ~s\n" (symbol->string (quote min-client-height)) (send canvas min-client-height)) - (printf "~a: ~s\n" (symbol->string (quote min-client-width)) (send canvas min-client-width)) - (printf "~a: ~s\n" (symbol->string (quote min-height)) (send canvas min-height)) - (printf "~a: ~s\n" (symbol->string (quote min-width)) (send canvas min-width)) - (printf "~a: ~s\n" (symbol->string (quote vert-margin)) (send canvas vert-margin)) - )) - ) diff --git a/collects/tests/aligned-pasteboard/example.rktl b/collects/tests/aligned-pasteboard/example.rktl deleted file mode 100644 index ea6c0e5b8b..0000000000 --- a/collects/tests/aligned-pasteboard/example.rktl +++ /dev/null @@ -1,84 +0,0 @@ -(require mzlib/class mred mzlib/etc - "../aligned-pasteboard.rkt" - "../aligned-editor-container.rkt") - -; -; -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; -; - -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) - -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define vp1 - (instantiate vertical-pasteboard% ())) - -(define ae-snip1 - (instantiate aligned-editor-snip% () - (editor vp1))) - -(define vp2 - (instantiate vertical-pasteboard% ())) - -(define ae-snip2 - (instantiate aligned-editor-snip% () - (editor vp2))) - -(define vp3 - (instantiate vertical-pasteboard% ())) - -(define ae-snip3 - (instantiate aligned-editor-snip% () - (editor vp3))) - -(define vp4 - (instantiate vertical-pasteboard% ())) - -(define ae-snip4 - (instantiate aligned-editor-snip% () - (editor vp4))) - -(define vp5 - (instantiate vertical-pasteboard% ())) - -(define ae-snip5 - (instantiate aligned-editor-snip% () - (editor vp5))) - -(define t-snip1 - (instantiate editor-snip% () - (editor (instantiate text% ())))) - -(define t-snip2 - (instantiate editor-snip% () - (editor (instantiate text% ())))) - -(send pasteboard insert ae-snip1 false) -(send pasteboard insert ae-snip2 false) -(send pasteboard insert ae-snip5 false) -(send vp2 insert ae-snip3 false) -(send vp2 insert ae-snip4 false) -(send vp1 insert t-snip1 false) -(send vp5 insert t-snip2 false) -(send frame show true) diff --git a/collects/tests/aligned-pasteboard/old-bugs/big-min.rktl b/collects/tests/aligned-pasteboard/old-bugs/big-min.rktl deleted file mode 100644 index d26e6d4bb5..0000000000 --- a/collects/tests/aligned-pasteboard/old-bugs/big-min.rktl +++ /dev/null @@ -1,25 +0,0 @@ -(require - mzlib/class - mred - mzlib/etc - mrlib/aligned-pasteboard) - -(define frame (instantiate frame% () (label "big-min") (width 400) (height 500))) -(define test-suite (instantiate vertical-pasteboard% ())) -(instantiate aligned-editor-canvas% () (parent frame) (editor test-suite)) - -(define top-string false) - -(define (new) - (let* ([main-pb (instantiate horizontal-pasteboard% ())] - [pb (instantiate vertical-pasteboard% ())] - [snip (instantiate aligned-editor-snip% () (editor pb))] - [string (make-object string-snip% "Testing String Snip")]) - (set! top-string string) - (send main-pb insert snip false) - (send main-pb insert string false) - (instantiate aligned-editor-snip% () (editor main-pb)))) - -(send frame show true) -(define (add) (send test-suite insert (new))) -(add) diff --git a/collects/tests/aligned-pasteboard/old-bugs/missing-min.rktl b/collects/tests/aligned-pasteboard/old-bugs/missing-min.rktl deleted file mode 100644 index 0094386a6e..0000000000 --- a/collects/tests/aligned-pasteboard/old-bugs/missing-min.rktl +++ /dev/null @@ -1,20 +0,0 @@ -(require - mzlib/class - mzlib/etc - mrlib/aligned-pasteboard - mzlib/class - mred) - -(define f (instantiate frame% () (label "test") (width 400) (height 500))) -(define pb1 (instantiate vertical-pasteboard% ())) -(define ec (instantiate aligned-editor-canvas% () (parent f) (editor pb1) (style '(no-hscroll)))) - -(define pb2 (instantiate vertical-pasteboard% ())) -(define es2 (instantiate aligned-editor-snip% () (editor pb2))) - -(define t (instantiate text% ())) -(define es3 (instantiate editor-snip% () (editor t))) - -(send pb1 insert es2) -(send pb2 insert es3) -(send f show true) diff --git a/collects/tests/aligned-pasteboard/snip-dumper.rkt b/collects/tests/aligned-pasteboard/snip-dumper.rkt deleted file mode 100644 index 546aad3d78..0000000000 --- a/collects/tests/aligned-pasteboard/snip-dumper.rkt +++ /dev/null @@ -1,70 +0,0 @@ -(module snip-dumper mzscheme - - (require - mzlib/class - mred) - - (provide - dump-children - (struct snip-dump (left top right bottom children)) - dump=?) - - ;;dump=?: ((union snip-dump? (listof snip-dump?)) . -> . boolean?) - (define (dump=? dump1 dump2) - (cond - [(and (list? dump1) (list? dump2) - (eq? (length dump1) (length dump2))) - (andmap dump=? dump1 dump2)] - [(and (snip-dump? dump1) (snip-dump? dump2)) - (and - (dump=? (snip-dump-left dump1) - (snip-dump-left dump2)) - (dump=? (snip-dump-top dump1) - (snip-dump-top dump2)) - (dump=? (snip-dump-right dump1) - (snip-dump-right dump2)) - (dump=? (snip-dump-bottom dump1) - (snip-dump-bottom dump2)) - (dump=? (snip-dump-children dump1) - (snip-dump-children dump2)))] - [else (equal? dump1 dump2)])) - - ;; type snip-dump = - ;; (make-single number number number number (union #f (listof snip-dump))) - ;; if children is #f, this indicates that the snip was not an - ;; editor-snip. In contrast, if it is null, this indicates that - ;; the snip is an editor-snip, but has no children. - (define-struct snip-dump (left top right bottom children)) - - ;; dump-pb : snip -> snip-dump - (define (dump-snip snip) - (let ([outer-pb (send (send snip get-admin) get-editor)] - [bl (box 0)] - [bt (box 0)] - [br (box 0)] - [bb (box 0)]) - (send outer-pb get-snip-location snip bl bt #t) - (send outer-pb get-snip-location snip br bb #f) - (make-snip-dump - (unbox bl) - (unbox bt) - (unbox br) - (unbox bb) - (dump-snips snip)))) - - ;; dump-snips : snip -> (union #f (listof snip-dump)) - (define (dump-snips snip) - (cond - [(is-a? snip editor-snip%) - (dump-children (send snip get-editor))] - [else #f])) - - ;; dump-children : editor<%> -> (listof snip-dump) - (define (dump-children editor) - (let loop ([snip (send editor find-first-snip)]) - (cond - [snip - (cons (dump-snip snip) - (loop (send snip next)))] - [else null]))) - ) diff --git a/collects/tests/aligned-pasteboard/test-alignment.rktl b/collects/tests/aligned-pasteboard/test-alignment.rktl deleted file mode 100644 index 885602fa46..0000000000 --- a/collects/tests/aligned-pasteboard/test-alignment.rktl +++ /dev/null @@ -1,248 +0,0 @@ -(require "utils.rkt" mzlib/etc mzlib/list mzlib/match - mrlib/private/aligned-pasteboard/alignment) - -;; los-equal? ((listof rect?) (listof rect?) . -> . boolean?) -;; tests the equality of the list of structures -(define (los-equal? a b) - (equal? - (map rect->list a) - (map rect->list b))) - -;; rect->list (rect? . -> . vector?) -;; a vector of the fields in the rect -(define rect->list - (match-lambda - [($ rect ($ dim x width stretchable-width?) ($ dim y height stretchable-height?)) - (list x width stretchable-width? y height stretchable-height?)])) - -;; empty pasteboard -(test - los-equal? - (align 'vertical 100 100 empty) - empty) - -;; empty pasteboard -(test - los-equal? - (align 'horizontal 100 100 empty) - empty) - -;; one unstretchable snip -(test - los-equal? - (align 'vertical - 100 100 - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - -(test - los-equal? - (align 'horizontal - 100 100 - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - -;; one stretchable snip -(test - los-equal? - (align 'vertical - 100 100 - (list (make-rect (make-dim 0 10 true) - (make-dim 0 10 true)))) - (list (make-rect (make-dim 0 100 true) - (make-dim 0 100 true)))) - -;; two stretchable snips -(test - los-equal? - (align 'vertical - 10 - 10 - (list - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list - (make-rect (make-dim 0 10 true) - (make-dim 0 5 true)) - (make-rect (make-dim 0 10 true) - (make-dim 5 5 true)))) - -;; three stretchable, one too big -(test - los-equal? - (align 'vertical - 50 100 - (list (make-rect (make-dim 0 0 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list (make-rect (make-dim 0 50 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 50 true) - (make-dim 50 25 true)) - (make-rect (make-dim 0 50 true) - (make-dim 75 25 true)))) - -;; three stetchable, one too big, and an unstetchable -(test - los-equal? - (align 'vertical - 50 100 - (list (make-rect (make-dim 0 0 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 50 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 50 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 50 true) - (make-dim 50 20 true)) - (make-rect (make-dim 0 50 true) - (make-dim 70 20 true)) - (make-rect (make-dim 0 50 false) - (make-dim 90 10 false)))) - -;; failure from test-suite frame -;; wrong answer given was (list (make-rect 0 0 335.0 10 #t)) -(test - los-equal? - (align 'vertical - 335.0 - 563.0 - (list - (make-rect (make-dim 0 10.0 #t) - (make-dim 0 10.0 #t)))) - (list (make-rect (make-dim 0 335.0 true) - (make-dim 0 563.0 true)))) - -;; sort of like the previous failed test but with a nonsizable snip -(test - los-equal? - (align 'vertical - 563.0 - 335.0 - (list - (make-rect (make-dim 0 10.0 #t) - (make-dim 0 10.0 #t)) - (make-rect (make-dim 0 10.0 false) - (make-dim 0 10.0 false)))) - (list (make-rect (make-dim 0 563.0 true) - (make-dim 0 325.0 true)) - (make-rect (make-dim 0 10.0 false) - (make-dim 325.0 10.0 false)))) - -;; something that requires a little modulo in division -(test - los-equal? - (align 'vertical - 10 - 10 - (list - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list (make-rect (make-dim 0 10 true) - (make-dim 0 4 true)) - (make-rect (make-dim 0 10 true) - (make-dim 4 3 true)) - (make-rect (make-dim 0 10 true) - (make-dim 7 3 true)))) - -;; 1 snip only stretches in off dimention -(test - los-equal? - (align 'vertical - 100 - 400 - (list - (make-rect (make-dim 0 10 true) - (make-dim 0 30 false)))) - (list (make-rect (make-dim 0 100 true) - (make-dim 0 30 false)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following examples of usage were taken from the test-suite tool and turned into test cases ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(test - los-equal? - (align 'vertical 563.0 335.0 (list)) - empty) - -(test - los-equal? - (align 'vertical 563.0 335.0 - (list (make-rect (make-dim 0 241 #t) (make-dim 0 114 #f)))) - (list (make-rect (make-dim 0 563.0 #t) (make-dim 0 114 #f)))) - -(test - los-equal? - (align 'vertical 551.0 102.0 - (list (make-rect (make-dim 0 34 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 231 #t) (make-dim 0 57 #t)))) - (list (make-rect (make-dim 0 551.0 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 551.0 #t) (make-dim 47 57 #t)))) - -(test - los-equal? - (align 'vertical 539.0 35.0 - (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 13 24 #f)))) - -(test - los-equal? - (align 'horizontal 539.0 45.0 - (list (make-rect (make-dim 0 65 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 48 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 63 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 45 #f) (make-dim 0 44 #f)))) - (list - (make-rect (make-dim 0 165.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 165.0 165.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 330.0 164.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 494.0 45 false) (make-dim 0 44 false)))) - -(test - los-equal? - (align 'vertical 153.0 33.0 - (list (make-rect (make-dim 0 55 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 55 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) - -(test - los-equal? - (align 'vertical 153.0 33.0 - (list (make-rect (make-dim 0 38 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 38 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) - -(test - los-equal? - (align 'vertical 152.0 33.0 - (list (make-rect (make-dim 0 26 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 53 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 26 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 53 false) (make-dim 13 24 false)))) - -(tests-done) diff --git a/collects/tests/aligned-pasteboard/test-pasteboard-lib.rktl b/collects/tests/aligned-pasteboard/test-pasteboard-lib.rktl deleted file mode 100644 index 11d4f3862b..0000000000 --- a/collects/tests/aligned-pasteboard/test-pasteboard-lib.rktl +++ /dev/null @@ -1,113 +0,0 @@ -(require "utils.rkt" mzlib/etc mzlib/class mred - mrlib/private/aligned-pasteboard/pasteboard-lib - mrlib/aligned-pasteboard) - -;; 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) diff --git a/collects/tests/aligned-pasteboard/test-snip-lib.rktl b/collects/tests/aligned-pasteboard/test-snip-lib.rktl deleted file mode 100644 index dbc9f6cfd6..0000000000 --- a/collects/tests/aligned-pasteboard/test-snip-lib.rktl +++ /dev/null @@ -1,159 +0,0 @@ -(require "utils.rkt" - mzlib/etc mzlib/class mred - mrlib/private/aligned-pasteboard/snip-lib - mrlib/private/aligned-pasteboard/aligned-pasteboard - mrlib/private/aligned-pasteboard/aligned-editor-container) - -(printf "running tests for snip-lib.rkt\n") - -;;snip-min-width: ((is-a?/c snip%) . -> . number?) -;;the width of a snip in the given pasteboard -(let* ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate vertical-pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) - (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - (send es1 resize 20 20) - (sleep/yield 1) - (test = (snip-min-width es1) 20) - - (send es1 resize 200 90) - (sleep/yield 1) - (test = (snip-min-width es1) 200) - - (send frame show false) - ) - -;;snip-min-height: ((is-a?/c snip%) . -> . number?) -;;the height of a snip in the given pasteboard -(let* ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate vertical-pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) - (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - (send es1 resize 20 20) - (sleep/yield 1) - (test = (snip-min-height es1) 20) - - (send es1 resize 200 90) - (sleep/yield 1) - (test = (snip-min-height es1) 90) - - (send frame show false) - ) - -;;snip-parent: ((is-a?/c snip%) . -> . (is-a?/c editor<%>)) -;;the pasteboard that contains the snip -(let* ([pb1 (instantiate pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate editor-canvas% () (parent frame) (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - - (test equal? (snip-parent es1) pb2) - - (send frame show false) - ) - -(let* ([pb1 (instantiate horizontal-pasteboard% ())] - [pb2 (instantiate horizontal-pasteboard% ())] - [pb3 (instantiate horizontal-pasteboard% ())] - [pb4 (instantiate horizontal-pasteboard% ())] - [pb5 (instantiate horizontal-pasteboard% ())] - [es2 (instantiate aligned-editor-snip% () (editor pb2))] - [es3 (instantiate aligned-editor-snip% () (editor pb3))] - [es4 (instantiate aligned-editor-snip% () (editor pb4))] - [es5 (instantiate aligned-editor-snip% () (editor pb5))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - (send pb1 insert es2) - (send pb2 insert es3) - (send pb3 insert es4) - (send pb4 insert es5) - - (test equal? (snip-parent es2) pb1) - - (test equal? (snip-parent es3) pb2) - - (test equal? (snip-parent es4) pb3) - - (test equal? (snip-parent es5) pb4) - - (send frame show false) - ) - -;;fold-snip: (lambda (b?) ((any? b? . -> . b?) b? (is-a?/c snip%) . -> . b?)) -;;the application of f on all snips from snip to the end in a foldl foldr mannor -(let* ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (send es1 resize 100 100) - (send es2 resize 100 100) - (send es3 resize 100 100) - (send es4 resize 100 100) - - (test = - (fold-snip (lambda (snip total-height) - (+ (snip-min-height snip) - total-height)) - 0 - es4) - 400) - - (send frame show false) - ) - -;;for-each-snip: (((is-a?/c snip%) . -> . (void)) (is-a/c? snip%) . -> . (void)) -;;applies the function to all the snips -(let* ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) - (editor pb1))] - [count 0]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (for-each-snip (lambda (snip) (set! count (add1 count))) es4) - - (test = count 4) - - (send frame show false) - ) -(tests-done) diff --git a/collects/tests/aligned-pasteboard/test.rktl b/collects/tests/aligned-pasteboard/test.rktl deleted file mode 100644 index 731576a36c..0000000000 --- a/collects/tests/aligned-pasteboard/test.rktl +++ /dev/null @@ -1,226 +0,0 @@ -;;note: turns out these tests are window manager specific - -(require mzlib/class mred mzlib/etc mzlib/list mrlib/aligned-pasteboard - "snip-dumper.rkt") - - -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; - -(printf "running test1.rkt\n") - -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) - -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define insider - (instantiate vertical-pasteboard% ())) - -(define insider2 - (instantiate vertical-pasteboard% ())) - -(define insider3 - (instantiate vertical-pasteboard% ())) - -(define insider4 - (instantiate vertical-pasteboard% ())) - -(define insider5 - (instantiate vertical-pasteboard% ())) - -(define insider6 - (instantiate vertical-pasteboard% ())) - -(define insider7 - (instantiate vertical-pasteboard% ())) - -(define pb-snip - (instantiate aligned-editor-snip% () - (editor insider))) - -(define pb-snip2 - (instantiate aligned-editor-snip% () - (editor insider2))) - -(define pb-snip3 - (instantiate aligned-editor-snip% () - (editor insider3))) - -(define pb-snip4 - (instantiate aligned-editor-snip% () - (editor insider4))) - -(define pb-snip5 - (instantiate aligned-editor-snip% () - (editor insider5))) - -(define pb-snip6 - (instantiate aligned-editor-snip% () - (editor insider6))) - -(define pb-snip7 - (instantiate aligned-editor-snip% () - (editor insider7))) - -(define t-snip - (instantiate editor-snip% () - (editor - (instantiate text% ())))) - -(define i-snip - (instantiate image-snip% ())) - -(define i-snip2 - (instantiate image-snip% ())) - -(define t-snip2 - (instantiate editor-snip% () - (editor - (instantiate text% ())))) -(define t-snip3 - (instantiate editor-snip% () - (editor - (instantiate text% ())))) - -(send pasteboard begin-edit-sequence) -(send frame show true) -(send pasteboard insert pb-snip) -(send pasteboard insert t-snip) -(send pasteboard insert i-snip) -(send pasteboard insert i-snip2) -(send pasteboard insert pb-snip2) -(send pasteboard insert t-snip2) -(send insider insert t-snip3) -(send insider2 insert pb-snip3) -(send insider2 insert pb-snip4) -(send pasteboard insert pb-snip5) -(send pasteboard insert pb-snip6) -(send pasteboard insert pb-snip7) -(send pasteboard end-edit-sequence) - - - - -; ; ; -; ; ; -;;;;;;; ;;;;; ;;;; ;;;;; ;;;; -; ; ; ; ; ; ; ; ; -; ; ;;;;;; ;;;; ; ;;;; -; ; ; ; ; ; -; ; ;; ; ; ; ; ; ; -; ;;;;; ;;;; ;;;; ;;;;; ;;;; - - - - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 57.0 368.0 0.0 0.0 empty) - (make-snip-dump 114.0 368.0 57.0 0.0 empty) - (make-snip-dump 171.0 368.0 114.0 0.0 empty) - (make-snip-dump 182.0 24.0 171.0 0.0 empty) - (make-snip-dump - 249.0 - 368.0 - 182.0 - 0.0 - (list (make-snip-dump 55.0 178.0 0.0 0.0 empty) (make-snip-dump 55.0 356.0 0.0 178.0 empty))) - (make-snip-dump 269.0 20.0 249.0 0.0 false) - (make-snip-dump 289.0 20.0 269.0 0.0 false) - (make-snip-dump 300.0 24.0 289.0 0.0 empty) - (make-snip-dump 368.0 368.0 300.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 0 0) -(sleep/yield 1) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 10.0 34.0 0.0 0.0 empty) - (make-snip-dump 20.0 34.0 10.0 0.0 empty) - (make-snip-dump 30.0 34.0 20.0 0.0 empty) - (make-snip-dump 41.0 24.0 30.0 0.0 empty) - (make-snip-dump - 61.0 - 34.0 - 41.0 - 0.0 - (list (make-snip-dump 10.0 11.0 0.0 0.0 empty) (make-snip-dump 10.0 22.0 0.0 11.0 empty))) - (make-snip-dump 81.0 20.0 61.0 0.0 false) - (make-snip-dump 101.0 20.0 81.0 0.0 false) - (make-snip-dump 112.0 24.0 101.0 0.0 empty) - (make-snip-dump 133.0 34.0 112.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 800 600) -(sleep/yield 1) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 137.0 568.0 0.0 0.0 empty) - (make-snip-dump 274.0 568.0 137.0 0.0 empty) - (make-snip-dump 411.0 568.0 274.0 0.0 empty) - (make-snip-dump 422.0 24.0 411.0 0.0 empty) - (make-snip-dump - 569.0 - 568.0 - 422.0 - 0.0 - (list (make-snip-dump 135.0 278.0 0.0 0.0 empty) (make-snip-dump 135.0 556.0 0.0 278.0 empty))) - (make-snip-dump 589.0 20.0 569.0 0.0 false) - (make-snip-dump 609.0 20.0 589.0 0.0 false) - (make-snip-dump 620.0 24.0 609.0 0.0 empty) - (make-snip-dump 768.0 568.0 620.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 400 400) -(send pasteboard delete i-snip) -(send pasteboard delete i-snip2) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 65.0 368.0 0.0 0.0 empty) - (make-snip-dump 130.0 368.0 65.0 0.0 empty) - (make-snip-dump 195.0 368.0 130.0 0.0 empty) - (make-snip-dump 206.0 24.0 195.0 0.0 empty) - (make-snip-dump - 281.0 - 368.0 - 206.0 - 0.0 - (list (make-snip-dump 63.0 178.0 0.0 0.0 empty) (make-snip-dump 63.0 356.0 0.0 178.0 empty))) - (make-snip-dump 292.0 24.0 281.0 0.0 empty) - (make-snip-dump 368.0 368.0 292.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send pasteboard erase) -(dump=? - (dump-children pasteboard) - empty - ) - -(send frame show false) -(printf "done\n") diff --git a/collects/tests/aligned-pasteboard/test2.rktl b/collects/tests/aligned-pasteboard/test2.rktl deleted file mode 100644 index cb7e447285..0000000000 --- a/collects/tests/aligned-pasteboard/test2.rktl +++ /dev/null @@ -1,185 +0,0 @@ -;;note: turns out these tests are window manager specific - -(require mzlib/class mred mzlib/etc mzlib/list mrlib/aligned-pasteboard - "snip-dumper.rkt") - -; -; -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; -; - -(printf "running test2.rkt\n") - -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) - -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define vp1 - (instantiate vertical-pasteboard% ())) - -(define ae-snip1 - (instantiate aligned-editor-snip% () - (editor vp1))) - -(define vp2 - (instantiate vertical-pasteboard% ())) - -(define ae-snip2 - (instantiate aligned-editor-snip% () - (editor vp2))) - -(define vp3 - (instantiate vertical-pasteboard% ())) - -(define ae-snip3 - (instantiate aligned-editor-snip% () - (editor vp3))) - -(define vp4 - (instantiate vertical-pasteboard% ())) - -(define ae-snip4 - (instantiate aligned-editor-snip% () - (editor vp4))) - -(define vp5 - (instantiate vertical-pasteboard% ())) - -(define ae-snip5 - (instantiate aligned-editor-snip% () - (editor vp5))) - -(send pasteboard insert ae-snip1) -(send pasteboard insert ae-snip2) -(send pasteboard insert ae-snip5) -(send vp2 insert ae-snip3) -(send vp2 insert ae-snip4) -(send frame show true) - -; -; -; -; ; ; -; ; ; -; ;;;;; ;;;;; ;;;; ;;;;; ;;;; -; ; ; ; ; ; ; ; ; -; ; ;;;;;; ;;;; ; ;;;; -; ; ; ; ; ; -; ; ;; ; ; ; ; ; ; -; ;;;;; ;;;; ;;;; ;;;;; ;;;; -; -; -; - -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 120.0 368.0 0.0 0.0 empty) - (make-snip-dump - 249.0 - 368.0 - 120.0 - 0.0 - (list (make-snip-dump 117.0 178.0 0.0 0.0 empty) (make-snip-dump 117.0 356.0 0.0 178.0 empty))) - (make-snip-dump 368.0 368.0 249.0 0.0 empty)) - ) - -(send frame resize 0 0) -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 10.0 30.0 0.0 0.0 empty) - (make-snip-dump - 30.0 - 30.0 - 10.0 - 0.0 - (list (make-snip-dump 10.0 10.0 0.0 0.0 empty) (make-snip-dump 10.0 19.0 0.0 9.0 empty))) - (make-snip-dump 40.0 30.0 30.0 0.0 empty)) - ) - -(send frame resize 800 600) -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 253.0 568.0 0.0 0.0 empty) - (make-snip-dump - 516.0 - 568.0 - 253.0 - 0.0 - (list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 516.0 0.0 empty)) - ) - -(send pasteboard delete ae-snip5) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump - 389.0 - 568.0 - 0.0 - 0.0 - (list (make-snip-dump 377.0 278.0 0.0 0.0 empty) (make-snip-dump 377.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 389.0 0.0 empty)) - ) - -(send pasteboard insert ae-snip5) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 253.0 568.0 0.0 0.0 empty) - (make-snip-dump - 516.0 - 568.0 - 253.0 - 0.0 - (list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 516.0 0.0 empty)) - ) - -(send pasteboard delete ae-snip5) -(send pasteboard delete ae-snip1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump - 768.0 - 568.0 - 0.0 - 0.0 - (list (make-snip-dump 756.0 278.0 0.0 0.0 empty) (make-snip-dump 756.0 556.0 0.0 278.0 empty)))) - ) - -(send pasteboard erase) -(dump=? - (dump-children pasteboard) - empty - ) - -(send frame show false) -(printf "done\n")