From 0b0c06b56ea6db8c35f9e717495fbff7cc139ebd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 28 Jan 2010 17:51:30 +0000 Subject: [PATCH] allow radio-box% to have no selected buttons svn: r17865 original commit: a09e671f347d4f1d2b5f8937df5ab26f135f7f5f --- collects/mred/private/check.ss | 2 +- collects/mred/private/mritem.ss | 33 +++++++++++-------- collects/scribblings/gui/blurbs.ss | 2 +- .../scribblings/gui/radio-box-class.scrbl | 18 +++++----- collects/tests/mred/item.ss | 5 ++- doc/release-notes/mred/HISTORY.txt | 7 ++++ 6 files changed, 43 insertions(+), 24 deletions(-) diff --git a/collects/mred/private/check.ss b/collects/mred/private/check.ss index 9872d355..d46c1996 100644 --- a/collects/mred/private/check.ss +++ b/collects/mred/private/check.ss @@ -117,7 +117,7 @@ (unless (and (integer? i) (exact? i) (not (negative? i))) (raise-type-error (who->name who) (if false-ok? - "non-negative exact integeror #f" + "non-negative exact integer or #f" "non-negative exact integer" ) i)))) diff --git a/collects/mred/private/mritem.ss b/collects/mred/private/mritem.ss index 226d144d..31231d5c 100644 --- a/collects/mred/private/mritem.ss +++ b/collects/mred/private/mritem.ss @@ -264,40 +264,47 @@ (check-container-parent cwho parent) (check-callback cwho callback) (check-orientation cwho style) - (check-non-negative-integer cwho selection))) + (check-non-negative-integer/false cwho selection))) (private-field [wx #f]) (private [check-button - (lambda (method n) - (check-non-negative-integer `(method radio-box% ,method) n) - (unless (< n (length chcs)) - (raise-mismatch-error (who->name `(method radio-box% ,method)) "no such button: " n)))]) + (lambda (method n false-ok?) + ((if false-ok? + check-non-negative-integer/false + check-non-negative-integer) + `(method radio-box% ,method) n) + (when n + (unless (< n (length chcs)) + (raise-mismatch-error (who->name `(method radio-box% ,method)) "no such button: " n))))]) (override [enable (entry-point (case-lambda [(on?) (send wx enable on?)] - [(which on?) (check-button 'enable which) + [(which on?) (check-button 'enable which #f) (send wx enable which on?)]))] [is-enabled? (entry-point (case-lambda [() (send wx is-enabled?)] - [(which) (check-button 'is-enabled? which) + [(which) (check-button 'is-enabled? which #f) (send wx is-enabled? which)]))]) (public [get-number (lambda () (length chcs))] [get-item-label (lambda (n) - (check-button 'get-item-label n) + (check-button 'get-item-label n #f) (list-ref chcs n))] [get-item-plain-label (lambda (n) - (check-button 'get-item-plain-label n) + (check-button 'get-item-plain-label n #f) (wx:label->plain-label (list-ref chcs n)))] - [get-selection (entry-point (lambda () (send wx get-selection)))] + [get-selection (entry-point (lambda () (let ([v (send wx get-selection)]) + (if (equal? v -1) + #f + v))))] [set-selection (entry-point (lambda (v) - (check-button 'set-selection v) - (send wx set-selection v)))]) + (check-button 'set-selection v #t) + (send wx set-selection (or v -1))))]) (sequence (as-entry (lambda () @@ -317,7 +324,7 @@ (length choices)) selection)))) label parent callback #f))) - (when (positive? selection) + (when (or (not selection) (positive? selection)) (set-selection selection))))) (define slider% diff --git a/collects/scribblings/gui/blurbs.ss b/collects/scribblings/gui/blurbs.ss index 72800aaa..a9210b94 100644 --- a/collects/scribblings/gui/blurbs.ss +++ b/collects/scribblings/gui/blurbs.ss @@ -203,7 +203,7 @@ information@|details|, even if the editor currently has delayed refreshing (see monitor @|whatsit| changes.}) (define (MonitorCallbackX a b c d) - (MonitorMethod a b @elem{the @|d|callback procedure (provided as an initialization argument)} c)) + (MonitorMethod a b @elem{the @|d| callback procedure (provided as an initialization argument)} c)) (define (MonitorCallback a b c) (MonitorCallbackX a b c "control")) diff --git a/collects/scribblings/gui/radio-box-class.scrbl b/collects/scribblings/gui/radio-box-class.scrbl index a9bc3275..17958e7a 100644 --- a/collects/scribblings/gui/radio-box-class.scrbl +++ b/collects/scribblings/gui/radio-box-class.scrbl @@ -28,7 +28,7 @@ Whenever the user changes the selected radio button, the radio box's 'vertical-label 'horizontal-label 'deleted)) '(vertical)] - [selection exact-nonnegative-integer? 0] + [selection (or/c exact-nonnegative-integer? #f) 0] [font (is-a?/c font%) normal-control-font] [enabled any/c #t] [vert-margin (integer-in 0 1000) 2] @@ -64,8 +64,9 @@ The @scheme[style] argument must include either @scheme['vertical] for a @HVLabelNote[@scheme[style]]{radio box} @DeletedStyleNote[@scheme[style] @scheme[parent]]{radio box} By default, the first radio button is initially selected. If - @scheme[selection] is positive, it is passed to @method[radio-box% - set-selection] to set the initial radio button selection. + @scheme[selection] is positive or @scheme[#f], it is passed to + @method[radio-box% set-selection] to set the initial radio button + selection. @FontKWs[@scheme[font]] @WindowKWs[@scheme[enabled]] @SubareaKWs[] @AreaKWs[] @@ -115,10 +116,10 @@ Returns the number of radio buttons in the radio box. } @defmethod[(get-selection) - exact-nonnegative-integer?]{ + (or/c exact-nonnegative-integer? #f)]{ -Gets the position of the selected radio button. Radio buttons are -numbered from @scheme[0]. +Gets the position of the selected radio button, returning @scheme[#f] +if no button is selected. Radio buttons are numbered from @scheme[0]. } @@ -139,10 +140,11 @@ box, @|MismatchExn|. } -@defmethod[(set-selection [n exact-nonnegative-integer?]) +@defmethod[(set-selection [n (or/c exact-nonnegative-integer? #f)]) void?]{ -Sets the selected radio button by position. (The control's callback +Sets the selected radio button by position, or deselects all radio + buttons if @scheme[n] is @scheme[#f]. (The control's callback procedure is @italic{not} invoked.) Radio buttons are numbered from @scheme[0]. If @scheme[n] is equal to or larger than the number of radio buttons in the radio box, @|MismatchExn|. diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss index 4dd6fd1b..f9ff3383 100644 --- a/collects/tests/mred/item.ss +++ b/collects/tests/mred/item.ss @@ -1299,6 +1299,7 @@ (define mismatch-err (mk-err exn:fail:contract?)) (define do-sel (lambda (sel n) (for-each (lambda (rb) (sel rb (n rb))) rbs))) + (define sel-false (lambda (sel) (do-sel sel (lambda (rb) #f)))) (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-middle (lambda (sel) (do-sel sel (lambda (rb) (floor (/ (send rb get-number) 2)))))) @@ -1311,7 +1312,9 @@ (make-object button% (format "Select First~a" title) hp2 (lambda (b e) (sel-first sel))) (make-object button% (format "Select Middle ~a" title) hp2 (lambda (b e) (sel-middle sel))) (make-object button% (format "Select Last~a" title) hp2 (lambda (b e) (sel-last sel))) - (make-object button% (format "Select N~a" title) hp2 (lambda (b e) (sel-N sel)))) + (make-object button% (format "Select N~a" title) hp2 (lambda (b e) (sel-N sel))) + (when (equal? title "") + (make-object button% (format "Select #f~a" title) hp2 (lambda (b e) (sel-false sel))))) (make-selectors "" normal-sel) (make-selectors " by Simulate" simulate-sel) (make-object button% "Check" p diff --git a/doc/release-notes/mred/HISTORY.txt b/doc/release-notes/mred/HISTORY.txt index cd20d38c..0a1e5ca6 100644 --- a/doc/release-notes/mred/HISTORY.txt +++ b/doc/release-notes/mred/HISTORY.txt @@ -1,3 +1,10 @@ +Version 4.2.4.1 + +Changed radio-box% to allow #f as a selection so that no buttons are + selected + +---------------------------------------------------------------------- + Version 4.2.4, January 2010 Minor bug fixes