From d828a12e88dc375dd577692b6af71635ccb7c9da Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 8 Jul 1998 22:01:13 +0000 Subject: [PATCH] . original commit: 7d49c8b86fcd18c55322402431e8193611174ab9 --- collects/tests/mred/button-steps.txt | 17 ++ collects/tests/mred/checkbox-steps.txt | 21 +++ collects/tests/mred/choice-list-steps.txt | 196 ++++++++++++++++++++++ collects/tests/mred/item.ss | 125 +++++++++++--- 4 files changed, 335 insertions(+), 24 deletions(-) create mode 100644 collects/tests/mred/button-steps.txt create mode 100644 collects/tests/mred/checkbox-steps.txt create mode 100644 collects/tests/mred/choice-list-steps.txt diff --git a/collects/tests/mred/button-steps.txt b/collects/tests/mred/button-steps.txt new file mode 100644 index 00000000..cf0c3c0b --- /dev/null +++ b/collects/tests/mred/button-steps.txt @@ -0,0 +1,17 @@ +Click the "Hit Me" button. "Callback Ok" should appear in the console. + +Click "Check". "All Ok" should appear in the console. + +Repeat the above two steps. + +Click "Disable Test" and quickly click "Hit Me". The button should + become disabled for a second, then become re-enabled, but the + click on "Hit Me" should not invoke the callback. + +Repeat the first two steps above. + +Click "Set Default". If this is a "Button Frame", nothing should + happen. If this is a "Button Dialog Box", the "Hit Me" button *may* + become highlighted so that typing Return is the same as hitting the + button; whether this actually happens is platform-specific. + diff --git a/collects/tests/mred/checkbox-steps.txt b/collects/tests/mred/checkbox-steps.txt new file mode 100644 index 00000000..0ee77b23 --- /dev/null +++ b/collects/tests/mred/checkbox-steps.txt @@ -0,0 +1,21 @@ +Check the "On" checkbox. "Callback Ok" should appear in the console. + +Uncheck the "On" checkbox. "Callback Ok" should appear in the console. + +Click "Check". "All Ok" should appear in the console. + +Repeat the above three steps. + +Click "Toggle". The checkbox should become checked. + +Click "Toggle". The checkbox should become unchecked. + +Check the "On" checkbox. "Callback Ok" should appear in the console. + +Click "Toggle". The checkbox should become unchecked. + +Repeat the above four steps with "Simulation Toggle" instead of "Toggle". + However, with "Simulation Toggle", "Callback Ok" should be printed + each time "Simulation Toggle" is hit. + +Click "Check". "All Ok" should appear in the console. diff --git a/collects/tests/mred/choice-list-steps.txt b/collects/tests/mred/choice-list-steps.txt new file mode 100644 index 00000000..e2027b1e --- /dev/null +++ b/collects/tests/mred/choice-list-steps.txt @@ -0,0 +1,196 @@ +Set Up, Callbacks, Appending +---------------------------- + +The choice/list should contain "Alpha" "Beta" and "Gamma" for + starters, unless and empty choice/list was created. In a choice, + "Alpha" should be initially selected. + +If there are no items: + + * Click on the choice box. Make sure that nothing prints to the + console as a result. + + * Click "Append"; "Extra 1" should appear in the list of tiems. + For a choice, it should be immediately selected. + + * Click "Append" again. The selection should not change. + + * Start over with a fresh frame. Click the "Clear" button and + nothing should happen. + + * If its an empty list, start over with a fresh frame. Click the + "Reset" button and make sure "Alpha" "Beta" and "Gamma" are + added. + + * Start over with a fresh frame again; jump down to the `Clearing' + section (but don't click "Clear"). + +For a multi-selection list, jump down to "Multiple Selections". + +If there are items, select each once in order (single-click for + lists). After each solection, "Selected N" should appear in the + window (where N is the position of the item, counting from 0), + followed by "Callback Ok". This should be printed even if the + selection is technically unchanged. Select the last one a second time + to make sure. + +For a choice, click to pop-up the menu, but don't select anything. for + a list, click in an area without items and in the scroll bar(s). In + both cases, the selection should not change and nothing should print + in the console. + +Click the "Append" button. The seletion should not change, but a new + item "Extra 1" should appear. + +Click the "Append" button again. + +Select the first newly added item. + +Click on the "check" button. In the console, "content: " whould be + printed along with a list of strings. That list should match the + items in the choice/list. + +Selections +---------- + +Click "Select First". The selection should change to "Alpha", but + nothing should appear in the console. + +Click "Select Middle". The selection should change to "Gamma", but + nothing should appear in the console. + +Click "Select Last". The selection should change to "Extra 2"", but + nothing should appear in the console. + +Click "Select Bad -1" and Select Bad X". In both cases, nothing should + happen, and nothing should appear in the console. + +Repeat the above four steps for the "by name" buttons. (There's + nothing equivalent to -1 for the "by name" buttons.) + +Repeat the four steps for the "by Simulate" buttons; in addition to + having the selections change, the "Selected N" and "Callback Ok" + messages should print in the console. For the -1 and X cases, "event + selection value mismatch" should print in the console, and the + selection should not change. + +Click on the "check" button and check the content list. + +Clearing +-------- + +Choose clear. All items should disappear. + +Choose clear again. Nothing should happen. + +Click on all parts of the control. The callback should never be + invoked. + +Click on all the "Select" buttons. Nothing should happen, except for + the "by Simulate" buttons. for "by Simulate", the console should + contain an error messaage: "Callback for empty choice/list" + +Click on "Check". The empty item list should be reported in the + console. + +Click on "Append". For a choice, "Extra 3" should be immediately + selected. For a list box, nothing should be selected. + +Click "Append" again. The selection should not change. + +Select the second item, "Extra 4". Note the callback message in + the console for item 1. + +Click "Check" and see the list in the console: ("Extra 3" "Extra 4") + +Append one more, "Extra 5", and try all the selecting buttons again. + +Append 5 more items. The last one is very long, but it should look ok: + "This is a Really Long Named Item That Would Have Used the Short + Name, Yes This is a Really Long Named Item That Would Have Used the + Short Name Extra 10" + +Select the long-name item. + +Click "Check". The long name should be printed ok in the console. + +>> No More Tests for Choice Frames << + +Visible Range >> Lists Only << +------------- + +Scroll to the top and select the first item. Click "Visible + Indices". In the console, the top should be 0, and the visible count + equal to the number of items that are completely visible in the + item. If an item is only partly visible, it should not be counted. + +Scroll down exactly one item's height without changing the + selection. Click "Visible Incices" again. The top should change to 1 + but the count should be the same. + +On some platforms, you can scroll to partially show the first item. + Try it and hit "Visible Indices"; the partially shown item should + count as unshown. The visible count should not change. + +Make the window taller to show at least one more item. Try "Visible + Indices" again and make sure it changed. + +Click "Select Last". The list should scroll to the end. Try "Visible + Indices" again. + +Make the list box taller than all its items. (It may be necssary to + delete some items by selecting them and hitting the "Delete" button.) + Click "Visible Indices" and make sure that the visible count is equal + to the number of items. + +Delete on more item and try "Visible Indices" again. The count should + have gone down by one. + + +Deleting >> Lists Only << +-------- + +Select an item in the middle of the list. + +Hit "Delete". The item should disappear, and nothing shold be + selected. + +Append a new item. + +Select the third item in the list. Hit "Delete Above"; the second item + should disappear, and the selection should stick with its item as it + moves into 2nd place. Hit "Delete Above" again and the first item + should disappear, and the new first item should still be selected. + Click "Delete Above" one more time, and nothing should happen. + +Append two new items. + +Select the third to last item in the list. Test "Delete Below" by + clicking it three times, just like to "Delete Above". + +Append two new items. + +Click "Check" and inspect the item list in the console. + +Select the first item. Click the "Reset" button. The list should + contain "Alpha" "Beta" and "Gamma" with no selection. + +Click "Check" and inspect the item list in the console. + +Double-Click >> Lists Only << +------------ + +Double-click on "Alpha". The console should report the first click + in the normal way, and then report "Selected -1" followed by + "Double-click", then "Callback Ok". + +Double-click on "Gamma". Same as above, except that the initial + click is reported for position 2 instead of 0. + +Click "Check" and inspect the item list in the console. + +>> No More Tests for Single-Selection List Frames << + +Multiple Selections >> Multiple-Selection Lists Only << +------------------- + diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss index 15e17784..cd7600ea 100644 --- a/collects/tests/mred/item.ss +++ b/collects/tests/mred/item.ss @@ -808,7 +808,16 @@ (unless silent? (printf "Callback Ok~n"))) -(define (button-frame) +(define (instructions v-panel file) + (define c (make-object mred:media-canvas% v-panel)) + (define m (make-object mred:media-edit%)) + (send c set-media m) + (send m load-file (local-path file)) + (send m lock #t) + (send c user-min-width 520) + (send c user-min-height 200)) + +(define (button-frame mred:frame%) (define f (make-object mred:frame% null "Button Test")) (define p (make-object mred:vertical-panel% f)) (define old-list null) @@ -840,6 +849,11 @@ (printf "un-oh~n")) (send b enable #t))) "Disable Test")) + (define sd (make-object mred:button% p + (lambda (sd e) + (send b set-default)) + "Set Default")) + (instructions p "button-steps.txt") (send f show #t)) (define (checkbox-frame) @@ -876,10 +890,11 @@ old-list) (printf "All Ok~n")) "Check")) + (instructions p "checkbox-steps.txt") (send f show #t)) (define (choice-or-list-frame list? list-style empty?) - (define f (make-object mred:frame% null "Choice Test")) + (define f (make-object mred:frame% null (if list? "List Test" "Choice Test"))) (define p (make-object mred:vertical-panel% f)) (define-values (actual-content actual-user-data) (if empty? @@ -891,6 +906,7 @@ (list wx:const-event-type-listbox-command) (list wx:const-event-type-choice-command))) (define old-list null) + (define multi? (= list-style wx:const-multiple)) (define callback (lambda (cx e) (when (zero? (send c number)) @@ -899,13 +915,42 @@ (send e get-command-int) (send e get-command-string)) old-list)) - (unless (= (send e get-command-int) - (send c get-selection)) - (error "event selection value mismatch")) - (unless (string=? (send e get-command-string) - (send c get-string-selection) - (send c get-string (send c get-selection))) - (error "selection string mismatch")) + (printf "Selected ~a~n" (send e get-command-int)) + (cond + [(and multi? (= -1 (send e get-command-int))) + ; deselection + (unless (= -1 (send e get-command-int)) + (error "selection index is not -1")) + (unless (null? (send e get-command-string)) + (error "string selection not null:" (send e get-command-string))) + (printf "Deselect~n")] + [(= 2 (send e get-extra-long)) + ; double-click + (unless (= -1 (send e get-command-int)) + (error "selection index is not -1")) + (unless (null? (send e get-command-string)) + (error "string selection not null:" (send e get-command-string))) + (printf "Double-click~n")] + [else + ; selection + (if (or (not multi?) (<= (length (send c get-selections)) 1)) + (begin + (unless (= (send e get-command-int) + (send c get-selection)) + (error "event selection value mismatch")) + (unless (string=? (send e get-command-string) + (send c get-string-selection) + (send c get-string (send c get-selection))) + (error "selection string mismatch"))) + (begin + (unless (memv (send e get-command-int) + (send c get-selections)) + (error "event selection value mismatch")) + (unless (string=? (send e get-command-string) + (send c get-string (send e get-command-int))) + (error "selection string mismatch")) + (unless (null? (send c get-string-selection)) + (error "string selection not null"))))]) (check-callback-event c cx e commands #f))) (define c (if list? (make-object mred:list-box% p @@ -926,7 +971,9 @@ (set! counter (add1 counter)) (let ([naya (format "~aExtra ~a" (if (= counter 10) - "This is a Really Long Named Item That Would Have Used the Short Name " + (string-append + "This is a Really Long Named Item That Would Have Used the Short Name, Yes " + "This is a Really Long Named Item That Would Have Used the Short Name ") "") counter)] [naya-data (box 0)]) @@ -957,25 +1004,50 @@ (set! actual-user-data null) (send c clear)) "Clear")) + (define (delete p) + (send c delete p) + (when (<= 0 p (sub1 (length actual-content))) + (if (zero? p) + (begin + (set! actual-content (cdr actual-content)) + (set! actual-user-data (cdr actual-user-data))) + (begin + (set-cdr! (list-tail actual-content (sub1 p)) + (list-tail actual-content (add1 p))) + (set-cdr! (list-tail actual-user-data (sub1 p)) + (list-tail actual-user-data (add1 p))))))) (define db (if list? (make-object mred:button% cdp (lambda (b e) (let ([p (send c get-selection)]) - (when (<= 0 p (sub1 (length actual-content))) - (send c delete p) - (if (zero? p) - (begin - (set! actual-content (cdr actual-content)) - (set! actual-user-data (cdr actual-user-data))) - (begin - (set-cdr! (list-tail actual-content (sub1 p)) - (list-tail actual-content (add1 p))) - (set-cdr! (list-tail actual-user-data (sub1 p)) - (list-tail actual-user-data (add1 p)))))))) + (delete p))) "Delete") null)) + (define dab (if list? + (make-object mred:button% cdp + (lambda (b e) + (let ([p (send c get-selection)]) + (delete (sub1 p)))) + "Delete Above") + null)) + (define dbb (if list? + (make-object mred:button% cdp + (lambda (b e) + (let ([p (send c get-selection)]) + (delete (add1 p)))) + "Delete Below") + null)) + (define setb (if list? + (make-object mred:button% cdp + (lambda (b e) + (send c set '("Alpha" "Beta" "Gamma")) + (set! actual-content '("Alpha" "Beta" "Gamma")) + (set! actual-user-data (list null null null))) + "Reset") + null)) (define (make-selectors method mname numerical?) (define p2 (make-object mred:horizontal-panel% p)) + (send p2 stretchable-in-y #f) (when numerical? (make-object mred:button% p2 (lambda (b e) @@ -1056,12 +1128,14 @@ [s (caddr eis)]) (unless (= (send e get-command-int) i) (error "event selection value mismatch")) - (unless (string=? (send e get-command-string) s) - (error "selection string mismatch")) + (unless (or (and (null? s) (null? (send e get-command-string))) + (string=? (send e get-command-string) s)) + (error "selection string mismatch")) (check-callback-event c c e commands #t))) old-list) (printf "content: ~s~n" actual-content)) "Check")) + (instructions p "choice-list-steps.txt") (send f show #t)) (define (gauge-frame) @@ -1224,7 +1298,10 @@ (send mp1 set-label-position wx:const-vertical) (make-object mred:button% ap (lambda (b e) (menu-frame)) "Make Menus Frame") -(make-object mred:button% ap (lambda (b e) (button-frame)) "Make Button Frame") +(define bp (make-object mred:horizontal-panel% ap)) +(send bp stretchable-in-x #f) +(make-object mred:button% bp (lambda (b e) (button-frame mred:frame%)) "Make Button Frame") +(make-object mred:button% bp (lambda (b e) (button-frame mred:dialog-box%)) "Make Button Dialog Box") (make-object mred:button% ap (lambda (b e) (checkbox-frame)) "Make Checkbox Frame") (define cp (make-object mred:horizontal-panel% ap)) (send cp stretchable-in-x #f)