"{ 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
    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |
        (aPoint x between:leftX and:rightX) ifTrue:[
            ^ action
        ].
    ].
    ^ 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|

    leftX := labelOriginX.
    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
    ^ '$Header: /cvs/stx/stx/libwidg2/LinkButton.st,v 1.2 2009-03-09 14:01:02 cg Exp $'
! !