suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: 0ebde16a0f431e73b7f7a4fe7d01b65f936b6e84
This commit is contained in:
Matthew Flatt 1998-07-09 18:09:59 +00:00
parent b916a312c7
commit 82db08511e
2 changed files with 30 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/mred/choice-list-steps.txt
View File

@ -195,11 +195,13 @@ Multiple Selections >> Multiple-Selection Lists Only <<
------------------- -------------------
Click on each of the three items and make sure that "Selected N" Click on each of the three items and make sure that "Selected N"
and "Callback Ok" are printed in the console. and "Callback Ok" are printed in the console. (For most platforms
selecting an item deselects the other items, but some platforms
preserve the old selections. That's ok.)
Click "Check" and verify the item list *and* the selection list. Only Click "Check" and verify the item list *and* the selection list. Only
one item should be selected, and the only position of that item one item should be selected, and the only position of that item
(counting frmo 0) should be in the selection list. (counting from 0) should be in the selection list.
Use the shift key to select a second item. The console should show Use the shift key to select a second item. The console should show
"Selected N" and "Callback Ok" as usual. "Selected N" and "Callback Ok" as usual.
@ -215,6 +217,14 @@ Shift-click to select the remaining item. The console should show
Control-click on a selected item. It should become unselected (and the Control-click on a selected item. It should become unselected (and the
other two selected items should remain so). The console should report other two selected items should remain so). The console should report
"Selected -1", "Deselect", and "Callback Ok". "Deselected N" and "Callback Ok".
Click "Check" and verify the selection list.
...
Simulate should act like clicking, either extending the selection or
restarting it.
Drag and make sure each selection/desel causes a notification.

27
collects/tests/mred/item.ss
View File

@ -906,7 +906,8 @@
(list wx:const-event-type-listbox-command) (list wx:const-event-type-listbox-command)
(list wx:const-event-type-choice-command))) (list wx:const-event-type-choice-command)))
(define old-list null) (define old-list null)
(define multi? (= list-style wx:const-multiple)) (define multi? (or (= list-style wx:const-multiple)
(= list-style wx:const-extended)))
(define callback (define callback
(lambda (cx e) (lambda (cx e)
(when (zero? (send c number)) (when (zero? (send c number))
@ -915,15 +916,19 @@
(send e get-command-int) (send e get-command-int)
(send e get-command-string)) (send e get-command-string))
old-list)) old-list))
(printf "Selected ~a~n" (send e get-command-int))
(cond (cond
[(and multi? (= -1 (send e get-command-int))) [(= 0 (send e get-extra-long))
; deselection ; deselection
(unless (= -1 (send e get-command-int)) (printf "Deselected ~a~n" (send e get-command-int))
(error "selection index is not -1")) (unless multi?
(unless (null? (send e get-command-string)) (error "delselection in a single-selection list"))
(error "string selection not null:" (send e get-command-string))) (unless (< -1 (send e get-command-int) (length actual-content))
(printf "Deselect~n")] (error "deselection index is out of range"))
(unless (not (memv (send e get-command-int) (send c get-selections)))
(error "deselected item is actually selected"))
(unless (string=? (send e get-command-string)
(send c get-string (send e get-command-int)))
(error "string selection mismatch:" (send e get-command-string)))]
[(= 2 (send e get-extra-long)) [(= 2 (send e get-extra-long))
; double-click ; double-click
(unless (= -1 (send e get-command-int)) (unless (= -1 (send e get-command-int))
@ -933,6 +938,7 @@
(printf "Double-click~n")] (printf "Double-click~n")]
[else [else
; selection ; selection
(printf "Selected ~a~n" (send e get-command-int))
(if (or (not multi?) (<= (length (send c get-selections)) 1)) (if (or (not multi?) (<= (length (send c get-selections)) 1))
(begin (begin
(unless (= (send e get-command-int) (unless (= (send e get-command-int)
@ -1092,7 +1098,7 @@
(send e set-command-string (send e set-command-string
(if (< -1 p (length actual-content)) (if (< -1 p (length actual-content))
(list-ref actual-content p) (list-ref actual-content p)
"???")) null))
(when list? (send c set-first-item p)) (when list? (send c set-first-item p))
(send c command e))) (send c command e)))
" by Simulate" #t)) " by Simulate" #t))
@ -1313,7 +1319,8 @@
(send lp stretchable-in-x #f) (send lp stretchable-in-x #f)
(make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-single #f)) "Make List Frame") (make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-single #f)) "Make List Frame")
(make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-single #t)) "Make Empty List Frame") (make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-single #t)) "Make Empty List Frame")
(make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-multiple #f)) "Make Multilist Frame") (make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-multiple #f)) "Make MultiList Frame")
(make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-extended #f)) "Make MultiExtendList Frame")
(make-object mred:button% ap (lambda (b e) (gauge-frame)) "Make Gauge Frame") (make-object mred:button% ap (lambda (b e) (gauge-frame)) "Make Gauge Frame")
(define tp (make-object mred:horizontal-panel% ap)) (define tp (make-object mred:horizontal-panel% ap))
(send tp stretchable-in-x #f) (send tp stretchable-in-x #f)