diff --git a/collects/framework/private/panel.rkt b/collects/framework/private/panel.rkt index 5e71738020..055b14eae4 100644 --- a/collects/framework/private/panel.rkt +++ b/collects/framework/private/panel.rkt @@ -649,12 +649,13 @@ (define discrete-sizes<%> (interface ((class->interface panel%)) get-orientation set-orientation)) - (define (discrete-get-widths c) (cond [(is-a? c switchable-button%) - (list (send c get-large-width) - (send c get-small-width))] + (if (send c get-label-visible) + (list (send c get-large-width) + (send c get-small-width)) + (list (send c get-without-label-small-width)))] [(is-a? c discrete-sizes<%>) (send c get-discrete-widths)] [else diff --git a/collects/mrlib/scribblings/switchable-button.scrbl b/collects/mrlib/scribblings/switchable-button.scrbl index d999d4df6e..093ec599a6 100644 --- a/collects/mrlib/scribblings/switchable-button.scrbl +++ b/collects/mrlib/scribblings/switchable-button.scrbl @@ -14,8 +14,9 @@ The @racket[panel:discrete-sizes-mixin] explicitly uses @racket[switchable-button%]s via their - @method[switchable-button% get-small-width] and - @method[switchable-button% get-large-width] methods. + @method[switchable-button% get-small-width], + @method[switchable-button% get-large-width], and + @method[switchable-button% get-without-label-small-width] methods. See @racket[panel:discrete-sizes-mixin] for more details. @defconstructor/auto-super[([label (or/c string? (is-a?/c bitmap%) #f)] @@ -66,4 +67,11 @@ mode (i.e., when @racket[set-label-visible] has been called with @racket[#t]). } + + @defmethod[(get-without-label-small-width) exact-nonnegative-integer?]{ + Returns the width of the button when + it is not in label-visible + mode (i.e., when @racket[set-label-visible] has been called + with @racket[#f]). + } } diff --git a/collects/mrlib/switchable-button.rkt b/collects/mrlib/switchable-button.rkt index b9838caa4e..4c270ca2a1 100644 --- a/collects/mrlib/switchable-button.rkt +++ b/collects/mrlib/switchable-button.rkt @@ -7,7 +7,10 @@ (define margin 2) (define w-circle-space 6) (define h-circle-space 6) -(define rhs-pad 2) ;; extra space outside the bitmap, but inside the mouse highlighting (on the right) + +;; extra space outside the bitmap, +;; but inside the mouse highlighting (on the right) +(define rhs-pad 2) (define half-gray (make-object color% 127 127 127)) (define one-fifth-gray (make-object color% 200 200 200)) @@ -245,10 +248,16 @@ (- (/ (send bitmap get-width) 2)) (- rhs-pad))) (send dc draw-text label text-start (- (/ ch 2) (/ th 2))) - (draw-the-bitmap (+ text-start tw gap) (- (/ ch 2) (/ (send bitmap get-height) 2)))])] + (draw-the-bitmap (+ text-start tw gap) + (- (/ ch 2) (/ (send bitmap get-height) 2)))])] [else - (draw-the-bitmap (- (/ cw 2) (/ (send (if with-label? bitmap alternate-bitmap) get-width) 2)) - (- (/ ch 2) (/ (send (if with-label? bitmap alternate-bitmap) get-height) 2)))]) + (draw-the-bitmap + (- (/ cw 2) + (/ (send (if with-label? bitmap alternate-bitmap) get-width) + 2)) + (- (/ ch 2) + (/ (send (if with-label? bitmap alternate-bitmap) get-height) + 2)))]) (send dc set-pen pen) (send dc set-alpha alpha) @@ -266,12 +275,14 @@ (if with-label? disable-bitmap alternate-disable-bitmap) (send bm get-loaded-mask))))) - (define/public (set-label-visible h?) + (define/public (set-label-visible in-h?) + (define h? (and in-h? #t)) (unless (equal? with-label? h?) (set! with-label? h?) (update-sizes) (update-float (and with-label? in?)) (refresh))) + (define/public (get-label-visible) with-label?) (define/private (update-sizes) (define dc (get-dc)) @@ -306,7 +317,7 @@ margin margin)))) - (define/private (get-without-label-small-width) + (define/public (get-without-label-small-width) (inexact->exact (floor (+ (send alternate-bitmap get-width) @@ -358,11 +369,14 @@ (define label "Run") (define bitmap (make-object bitmap% (build-path (collection-path "icons") "run.png") 'png/mask)) (define foot (make-object bitmap% (build-path (collection-path "icons") "foot.png") 'png/mask)) - (define foot-up (make-object bitmap% (build-path (collection-path "icons") "foot-up.png") 'png/mask)) + (define foot-up + (make-object bitmap% (build-path (collection-path "icons") "foot-up.png") 'png/mask)) (define b1 (new switchable-button% [parent p] [label label] [bitmap bitmap] [callback void])) (define b2 (new switchable-button% [parent p] [label label] [bitmap bitmap] [callback void])) - (define b3 (new switchable-button% [parent p] [label "Step"] [bitmap foot] [alternate-bitmap foot-up] [callback void])) + (define b3 (new switchable-button% [parent p] [label "Step"] [bitmap foot] + [alternate-bitmap foot-up] + [callback void])) (define sb (new button% [parent p] [stretchable-width #t] [label "b"])) (define swap-button (new button%