"{ Package: 'stx:libwidg2' }"

Button subclass:#LinkButton

	instanceVariableNames:'labelsAndActions mouseOverLabelIndex'

	classVariableNames:'DefaultLinkColor'

	poolDictionaries:''

	category:'Views-Layout'

!

!LinkButton class methodsFor:'documentation'!

documentation

"

    Looks like a Label, but behaves like a button with individually clickable text components.

    Can be used to create htmp-page-look-alike links in a view.

    [author:]

        cg (cg@CG-VOSTRO)

    [instance variables:]

    [class variables:]

    [see also:]

"

!

examples

"

    |v l|

    v := StandardSystemView new.

    l := LinkButton in:v.

    l labelsAndActions:{ 

                        'Hello' -> [ Transcript showCR:'Hello Clicked'].

                        ' ' -> nil.

                        'World' -> [ Transcript showCR:'World Clicked'].

                       }.

    l foregroundColor:Color blue.

    v open

"

! !

!LinkButton class methodsFor:'defaults'!

updateStyleCache

    "extract values from the styleSheet and cache them in class variables"

    <resource: #style ( #'linkButton.linkColor' )>

    DefaultLinkColor := StyleSheet colorAt:#'linkButton.linkColor' default:Color blue.

! !

!LinkButton methodsFor:'accessing'!

labelsAndActions

    "returns the collection of label->action associations. 

     For display, the label strings are drawn as one concatenated string (add separating spaces, if you have to).

     When clicked on a string, the corresponding action is called"

    ^ labelsAndActions

!

labelsAndActions:aCollectionOfAssociations

    "set the collection of label->action associations. 

     For display, the label strings are drawn as one concatenated string (add separating spaces, if you have to).

     When clicked on a string, the corresponding action is called"

    labelsAndActions := aCollectionOfAssociations.

    self label:((aCollectionOfAssociations collect:[:assoc | assoc key]) asStringWith:'')

! !

!LinkButton methodsFor:'initialization'!

defaultControllerClass

    ^ LinkButtonController

!

initStyle

    super initStyle.

    level := enterLevel := leaveLevel := onLevel := offLevel := 0.

    DefaultLinkColor notNil ifTrue:[

        foreground := DefaultLinkColor onDevice:device.

    ].

    activeFgColor := enteredFgColor := foreground.

    activeBgColor := enteredBgColor := viewBackground.

!

initialize

    super initialize.

    self enableMotionEvents

! !

!LinkButton methodsFor:'redrawing'!

actionAt:aPoint

    |pressAction|

    pressAction := self pressAction ? self releaseAction.

    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |

        (aPoint x between:leftX and:rightX) ifTrue:[

            ^ labelsAndActions notNil ifTrue:action ifFalse:pressAction

        ].

    ].

    ^ nil

!

drawStringLogo:aString x:x y:y

    "redefined to draw the part under the mouse pointer with an underined emphasis"

    |entered mousePoint|

    mousePoint := controller lastMousePoint.

    entered := controller entered.

    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |

        |l|

        l := lbl.

        (entered and:[mousePoint notNil and:[mousePoint x between:leftX and:rightX]]) ifTrue:[

            l := l allUnderlined

        ].

        self displayString:l x:leftX y:y.

    ].

!

labelsAndActionsWithPositionsDo:aFourArgBlock

    |leftX rightX w|

    leftX := labelOriginX.

    labelsAndActions isNil ifTrue:[

        w := (self font widthOf:logo on:device).

        rightX := leftX + w-1.

        aFourArgBlock 

            value:logo

            value:self pressAction

            value:leftX

            value:rightX.

        ^ self

    ].

    labelsAndActions do:[:assoc | 

        |lbl wEach|

        lbl := assoc key.

        wEach := (self font widthOf:lbl on:device).

        rightX := leftX + wEach-1.

        aFourArgBlock 

            value:assoc key

            value:assoc value

            value:leftX

            value:rightX.

        leftX := rightX+1.

    ].

    ^ nil

! !

!LinkButton class methodsFor:'documentation'!

version

! !