diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss index d1908421..c8c955b4 100644 --- a/collects/framework/frame.ss +++ b/collects/framework/frame.ss @@ -163,7 +163,7 @@ (if (or (not filename) (unbox b)) (bell) (let-values ([(start end) - (if (is-a? edit text%) + (if (is-a? edit original:text%) (values (send edit get-start-position) (send edit get-end-position)) (values #f #f))]) @@ -174,7 +174,7 @@ #f)]) (if status (begin - (when (is-a? edit text%) + (when (is-a? edit original:text%) (send edit set-position start end)) (send edit end-edit-sequence)) (begin @@ -311,7 +311,7 @@ (let loop ([edit edit]) (let ([snip (send edit get-focus-snip)]) (if (or (not snip) - (not (is-a? snip editor-snip%))) + (not (is-a? snip original:editor-snip%))) edit (loop (send snip get-this-media))))))) (define clear-search-highlight diff --git a/collects/framework/guiutils.ss b/collects/framework/guiutils.ss index af8984de..a7029f47 100644 --- a/collects/framework/guiutils.ss +++ b/collects/framework/guiutils.ss @@ -146,7 +146,7 @@ (cond [(<= end pos) eof] [(not snip) eof] - [(is-a? snip string-snip%) + [(is-a? snip original:string-snip%) (let ([t (send snip get-text (- pos (unbox box)) 1)]) (unless (= (string-length t) 1) (error 'read-snips/chars-from-buffer diff --git a/collects/framework/panel.ss b/collects/framework/panel.ss index 4d3219c4..4a557ee7 100644 --- a/collects/framework/panel.ss +++ b/collects/framework/panel.ss @@ -8,7 +8,13 @@ (define single-mixin (mixin (area-container<%>) (single<%>) args (inherit get-alignment) + (rename [super-on-new-child on-new-child]) (override + [on-new-child + (lambda (c) + (if current-active-child + (send c show #f) + (set! current-active-child c)))] [container-size (lambda (l) (values (apply max (map car l)) (apply max (map cadr l))))] diff --git a/collects/framework/text.ss b/collects/framework/text.ss index c7080062..6189a5aa 100644 --- a/collects/framework/text.ss +++ b/collects/framework/text.ss @@ -375,7 +375,7 @@ (if (and (= x -1) pop-out?) (pop-out) (values this x)))] - [(is-a? current-snip editor-snip%) + [(is-a? current-snip original:editor-snip%) (let-values ([(embedded embedded-pos) (let ([media (send current-snip get-this-media)]) (and (not (null? media)) @@ -489,7 +489,7 @@ (let loop ([s (find-first-snip)]) (cond [(null? s) #f] - [(is-a? s string-snip%) + [(is-a? s original:string-snip%) (loop (send s next))] [else #t])))]) (lambda (name format) diff --git a/collects/tests/framework/panel.ss b/collects/tests/framework/panel.ss index a59db65c..3079a341 100644 --- a/collects/tests/framework/panel.ss +++ b/collects/tests/framework/panel.ss @@ -62,13 +62,26 @@ (lambda (label choices callback) (let* ([panel (make-object vertical-panel% radios '(border))] [message (make-object message% label panel)] - [radio (make-object radio-box% #f choices panel callback)]) + [radio (make-object radio-box% #f choices panel (lambda (radio _) (callback radio)))] + [button (make-object button% + "Cycle" panel + (lambda (_1 _2) + (let ([before (send radio get-selection)] + [tot (send radio get-number)]) + (let loop ([n tot]) + (unless (zero? n) + (send radio set-selection (- tot n)) + (callback radio) + (sleep/yield 1) + (loop (- n 1)))) + (send radio set-selection before) + (callback radio))))]) radio))] [radio (make-radio "Active Child" (map (lambda (x) (send x get-label)) children) - (lambda (radio evt) + (lambda (radio) (let loop ([n (length children)] [cs children]) (cond @@ -88,14 +101,14 @@ (make-radio "Horizontal Alignment" (list "left" "center" "right") - (lambda (radio evt) + (lambda (radio) (set! horizontal-alignment (string->symbol (send radio get-item-label (send radio get-selection)))) (update-alignment)))] [vert (make-radio "Vertical Alignment" (list "top" "center" "bottom") - (lambda (radio evt) + (lambda (radio) (set! vertical-alignment (string->symbol (send radio get-item-label (send radio get-selection)))) (update-alignment)))] [buttons (make-object horizontal-panel% f)]