From 5e895a0725f29d7d6a90b4735067175057bc99d1 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 29 Aug 2012 14:52:29 -0500 Subject: [PATCH] adjust contract for test:button-push so it isn't so ugly original commit: 977fd37913e04d9ae6f7127f037c428c6b86a630 --- collects/framework/test.rkt | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/collects/framework/test.rkt b/collects/framework/test.rkt index 10fe9046..2a61099d 100644 --- a/collects/framework/test.rkt +++ b/collects/framework/test.rkt @@ -852,25 +852,30 @@ (define test:mouse-click mouse-click) (define test:new-window new-window) +(define (label-of-enabled/shown-button-in-top-level-window? str) + (test:top-level-focus-window-has? + (λ (c) + (and (is-a? c button%) + (string=? (send c get-label) str) + (send c is-enabled?) + (send c is-shown?))))) + +(define (enabled-shown-button? btn) + (and (send btn is-enabled?) + (send btn is-shown?))) + +(define (button-in-top-level-focusd-window? btn) + (test:top-level-focus-window-has? + (λ (c) (eq? c btn)))) + (provide/doc (proc-doc/names test:button-push - (-> (or/c (λ (str) - (and (string? str) - (test:top-level-focus-window-has? - (λ (c) - (and (is-a? c button%) - (string=? (send c get-label) str) - (send c is-enabled?) - (send c is-shown?)))))) - + (-> (or/c (and/c string? + label-of-enabled/shown-button-in-top-level-window?) (and/c (is-a?/c button%) - (λ (btn) - (and (send btn is-enabled?) - (send btn is-shown?))) - (λ (btn) - (test:top-level-focus-window-has? - (λ (c) (eq? c btn)))))) + enabled-shown-button? + button-in-top-level-focusd-window?)) void?) (button) @{Simulates pushing @racket[button]. If a string is supplied, the