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

.

Browse Source 
original commit: d345c15ae070713df4dbf7bcacd648b42c25761b
This commit is contained in:
Matthew Flatt 1998-10-12 03:28:55 +00:00
parent a26f432e8f
commit 26147e891a
2 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -158,7 +158,7 @@
m) m)
last-m)]) last-m)])
(set! last-m m) (set! last-m m)
(popup-menu m x y))))]) (popup-menu m (inexact->exact x) (inexact->exact y)))))])
(sequence (sequence
(apply super-init args)))) (apply super-init args))))
@ -987,13 +987,21 @@
(let ([e (make-object control-event% 'radio-box)]) (let ([e (make-object control-event% 'radio-box)])
(send rb set-selection p) (send rb set-selection p)
(send rb command e)))) (send rb command e))))
(define (mk-err exn?)
(lambda (f)
(lambda (rb p)
(with-handlers ([exn? void])
(f rb p)
(error "no exn raisd")))))
(define type-err (mk-err exn:application:type?))
(define mismatch-err (mk-err exn:application:mismatch?))
(define do-sel (lambda (sel n) (for-each (lambda (rb) (sel rb (n rb))) rbs))) (define do-sel (lambda (sel n) (for-each (lambda (rb) (sel rb (n rb))) rbs)))
(define sel-minus (lambda (sel) (do-sel sel (lambda (rb) -1)))) (define sel-minus (lambda (sel) (do-sel (type-err sel) (lambda (rb) -1))))
(define sel-first (lambda (sel) (do-sel sel (lambda (rb) 0)))) (define sel-first (lambda (sel) (do-sel sel (lambda (rb) 0))))
(define sel-middle (lambda (sel) (do-sel sel (lambda (rb) (floor (/ (send rb get-number) 2)))))) (define sel-middle (lambda (sel) (do-sel sel (lambda (rb) (floor (/ (send rb get-number) 2))))))
(define sel-last (lambda (sel) (do-sel sel (lambda (rb) (sub1 (send rb get-number)))))) (define sel-last (lambda (sel) (do-sel sel (lambda (rb) (sub1 (send rb get-number))))))
(define sel-N (lambda (sel) (do-sel sel (lambda (rb) (send rb get-number))))) (define sel-N (lambda (sel) (do-sel (mismatch-err sel) (lambda (rb) (send rb get-number)))))
(define (make-selectors title sel) (define (make-selectors title sel)
(define hp2 (make-object horizontal-panel% p)) (define hp2 (make-object horizontal-panel% p))
(send hp2 stretchable-height #f) (send hp2 stretchable-height #f)

7
collects/tests/mred/radiobox-steps.txt
View File

@ -19,9 +19,10 @@ Click "Select First", "Select Middle", "Select Last" then
in all radioboxes each time. (For the two-button box, the in all radioboxes each time. (For the two-button box, the
second one counts as `middle'.) second one counts as `middle'.)
Click "Select -1" and "Select N". Nothing should happen. Select the Click "Select -1" and "Select N". Nothing should happen (because the
last button in each box and try "Select -1" again. Nothing appropriate exceptions are caught). Select the last button in each
should happen. Return the selection to the first item in each box. box and try "Select -1" again. Nothing should happen. Return the
selection to the first item in each box.
Repeat the two steps for the "Select XXX by Simulate" buttons. In this Repeat the two steps for the "Select XXX by Simulate" buttons. In this
case, "Callback Ok" should be printed three times when any button case, "Callback Ok" should be printed three times when any button