From b20cbfdb5ab29fa9809cfb0c437f3c2f4dbfaf85 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 29 Jan 2010 00:08:15 +0000 Subject: [PATCH 1/4] merge to trunk svn: r17877 original commit: 9789615ed9840f09a6708d27276cf892d334b653 --- collects/mred/private/check.ss | 2 +- collects/mred/private/mritem.ss | 33 +++++++++++-------- collects/scribblings/gui/blurbs.ss | 2 +- .../scribblings/gui/editor-overview.scrbl | 2 +- .../scribblings/gui/radio-box-class.scrbl | 18 +++++----- collects/tests/mred/item.ss | 5 ++- 6 files changed, 37 insertions(+), 25 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/editor-overview.scrbl b/collects/scribblings/gui/editor-overview.scrbl index b19728ba..b6b6e253 100644 --- a/collects/scribblings/gui/editor-overview.scrbl +++ b/collects/scribblings/gui/editor-overview.scrbl @@ -530,7 +530,7 @@ When an editor is loaded and a header/footer record is encountered, be loaded. See also @method[editor<%> write-headers-to-file] and - @method[editor<%> write-headers-to-file]. + @method[editor<%> read-header-from-file]. @section[#:tag "editoreol"]{End of Line Ambiguity} 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 From f4bb71a051ba62a7a98d204a615cfc86487938d0 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 23 Feb 2010 15:01:04 +0000 Subject: [PATCH 2/4] Fix up kernel.ss to include unwrapper, also fix arity check now that it takes one more. svn: r18300 original commit: aa7062a35e5fb63a0029e42c4412b6d39ec3a508 --- collects/mred/private/kernel.ss | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss index 794007f5..7c257f25 100644 --- a/collects/mred/private/kernel.ss +++ b/collects/mred/private/kernel.ss @@ -78,9 +78,9 @@ (syntax (define name (let ([c (dynamic-require ''#%mred-kernel 'name)]) (make-primitive-class - (lambda (class prop:object preparer dispatcher more-props) + (lambda (class prop:object preparer dispatcher unwrapper more-props) (kernel:primitive-class-prepare-struct-type! - c prop:object class preparer dispatcher more-props)) + c prop:object class preparer dispatcher unwrapper more-props)) kernel:initialize-primitive-object 'print-name super (list intf ...) 'args '(old ...) From 1ea14802884e1a1887e97d4d3dea98a89835b599 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 23 Feb 2010 20:57:22 +0000 Subject: [PATCH 3/4] Now that the C code is back at a compile-ready point, I'll check in. svn: r18306 original commit: e1cd160a40c09d13b6ae79e18a8ba53becf43571 --- collects/mred/private/kernel.ss | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss index 7c257f25..7b5042e6 100644 --- a/collects/mred/private/kernel.ss +++ b/collects/mred/private/kernel.ss @@ -78,9 +78,9 @@ (syntax (define name (let ([c (dynamic-require ''#%mred-kernel 'name)]) (make-primitive-class - (lambda (class prop:object preparer dispatcher unwrapper more-props) + (lambda (class prop:object preparer dispatcher prop:unwrap unwrapper more-props) (kernel:primitive-class-prepare-struct-type! - c prop:object class preparer dispatcher unwrapper more-props)) + c prop:object class preparer dispatcher prop:unwrap unwrapper more-props)) kernel:initialize-primitive-object 'print-name super (list intf ...) 'args '(old ...) From 8c6b445bfb6cccc87bc82ef684c4092c467f542d Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 23 Feb 2010 23:56:08 +0000 Subject: [PATCH 4/4] Okay, updates to all this crapola. Going to try and see what happens if I only attach prop:unwrap to wrapped objects. svn: r18313 original commit: 60b6c81f9f08c0b5c9598ade16b46060588fee02 --- collects/mred/private/kernel.ss | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss index 7b5042e6..552a2856 100644 --- a/collects/mred/private/kernel.ss +++ b/collects/mred/private/kernel.ss @@ -78,9 +78,9 @@ (syntax (define name (let ([c (dynamic-require ''#%mred-kernel 'name)]) (make-primitive-class - (lambda (class prop:object preparer dispatcher prop:unwrap unwrapper more-props) + (lambda (class prop:object preparer dispatcher prop:unwrap more-props) (kernel:primitive-class-prepare-struct-type! - c prop:object class preparer dispatcher prop:unwrap unwrapper more-props)) + c prop:object class preparer dispatcher prop:unwrap more-props)) kernel:initialize-primitive-object 'print-name super (list intf ...) 'args '(old ...)