"{ Package: 'stx:libwidg2' }"

Button subclass:#LinkButton
	instanceVariableNames:'labelsAndActions'
	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 html-page-look-alike links in a view.

    [author:]
        cg (cg@CG-VOSTRO)

    [instance variables:]

    [class variables:]

    [see also:]

"
!

examples
"
                                                                    [exBegin]
    |v l|

    v := StandardSystemView new.
    l := LinkButton in:v.
    l label:
        (('Hello' actionForAll:[ Transcript showCR:'Hello Clicked']) 
        , ' '
        , ('World' actionForAll:[ Transcript showCR:'World Clicked'])).

    v open
                                                                    [exEnd]


                                                                    [exBegin]
    |v l|

    v := StandardSystemView new.
    l := LinkButton in:v.
    l label:
        ((('Hello' actionForAll:[ Transcript showCR:'Hello Clicked']) colorizeAllWith:(Color blue)) 
        , ' '
        , ('World' actionForAll:[ Transcript showCR:'World Clicked'])).

    v open
                                                                    [exEnd]


                                                                    [exBegin]
    |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
                                                                    [exEnd]


                                                                    [exBegin]
    |v l|

    v := StandardSystemView new.
    l := LinkButton in:v.
    l labelsAndActions:{ 
                        'Hello' -> nil.
                        ' ' -> nil.
                        'World' -> [ Transcript showCR:'World Clicked'].
                       }.
    l foregroundColor:Color blue.
    v open
                                                                    [exEnd]
"
! !

!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:[
        |color|
        self paint:(color := DefaultLinkColor onDevice:self graphicsDevice).
        self foreground:color.
    ].
    enteredFgColor := nil. "/ Color blue.

"/    activeFgColor := enteredFgColor := foreground.
"/    activeBgColor := enteredBgColor := viewBackground.

    "Modified: / 07-09-2011 / 04:29:29 / cg"
!

initialize
    super initialize.
    self enableMotionEvents
! !

!LinkButton methodsFor:'redrawing'!

actionAt:aPoint
    |pressAction emphasis|

    pressAction := self pressAction ? self releaseAction.
    labelsAndActions isNil ifTrue:[
        "take action from logo, which is normally a text"

        emphasis := logo emphasisAtPoint:aPoint on:self.
        (emphasis isNil or:[emphasis isSymbol]) ifTrue:[
            ^ pressAction.
        ].
        emphasis isAssociation ifTrue:[
            emphasis key == #actionBlock ifTrue:[
                ^ emphasis value.
            ].
            ^ pressAction.
        ].
        emphasis do:[:eachElement|
            eachElement isAssociation ifTrue:[
                eachElement key == #actionBlock ifTrue:[
                    ^ eachElement value.
                ].
            ].
        ].
        ^ pressAction.
    ].


    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |
        (aPoint x between:leftX and:rightX) ifTrue:[
            ^ labelsAndActions notNil ifTrue:action ifFalse:pressAction
        ].
    ].
    ^ nil
!

actionEmphasisIn:aText atPoint:aPoint
    "check for a actionBlock emphasis in aString at aPoint.
     Answer an Array with the whole emphasis and the actionBlock,
     or nil"
    
    |emphasis|

    emphasis := aText emphasisAtPoint:aPoint on:self.
    (emphasis isNil or:[emphasis isSymbol]) ifTrue:[
        ^ #(nil nil).
    ].
    emphasis isAssociation ifTrue:[
        emphasis key == #actionBlock ifTrue:[
            ^ Array with:emphasis with:emphasis value.
        ].
        ^ #(nil nil).
    ].
    emphasis detect:[:eachElement|
        eachElement isAssociation ifTrue:[
            eachElement key == #actionBlock ifTrue:[
                ^ Array with:emphasis with:eachElement value.
            ].
        ].
    ] ifNone:[].
    ^ #(nil nil).
!

drawStringLogo:aString x:x y:y
    "redefined to draw the part under the mouse pointer with an underined emphasis"

    |str entered mousePoint start len emphasis|

    mousePoint := controller lastMousePoint.
    entered := controller entered.

    labelsAndActions isNil ifTrue:[
        (entered not or:[mousePoint isNil]) ifTrue:[
            self displayString:aString x:x y:y.
            ^ self.
        ].

        str := aString.
        emphasis := (self actionEmphasisIn:aString atPoint:mousePoint) first.
        emphasis notNil ifTrue:[
            start := 1.
            aString emphasisCollection runsDo:[:eachLen :eachEmphasis|
                len isNil ifTrue:[
                    eachEmphasis == emphasis ifTrue:[
                        len := eachLen.
                    ] ifFalse:[
                        start := start + eachLen.  
                    ].
                ].
            ].
            len notNil ifTrue:[
                str := str deepCopy.
                str emphasisFrom:start to:start+len-1 add:#underline.
                "/ str emphasisFrom:start to:start+len-1 add:(#color -> foreground).
            ].
        ].
        self displayString:str x:x y:y.
        ^ self.
    ].

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

        l := lbl.
        action notNil ifTrue:[
            (entered and:[mousePoint notNil and:[mousePoint x between:leftX and:rightX]]) ifTrue:[
                l := l allUnderlined
            ].
        ].
        self displayString:l x:leftX y:y.
    ].

    "Modified: / 07-09-2011 / 04:47:13 / cg"
!

labelsAndActionsWithPositionsDo:aFourArgBlock
    |leftX rightX w|

    leftX := labelOriginX.
    labelsAndActions isNil ifTrue:[
        w := (self font widthOf:logo on:self graphicsDevice).
        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:self graphicsDevice).
        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.9 2014-02-18 14:48:35 stefan Exp $'
! !