"
 COPYRIGHT (c) 1997 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"


"{ Package: 'stx:libwidg2' }"

Model subclass:#TabItem
	instanceVariableNames:'rawLabel label enabled argument canvas adornments activeHelpText'
	classVariableNames:''
	poolDictionaries:''
	category:'Views-Support'
!

!TabItem class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1997 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

!

documentation
"
    describes one tab entry; could be used for tabs instead of a string. Whenever
    a value changed, a change notification is raised

    [see also:]
        TabItemEditor
        TabView
        NoteBookView
        UIPainter

    [author:]
        Claus Atzkern
"


!

examples
"
    labels derived from item
                                                                                [exBegin]                                      
    |top tab|

    top := StandardSystemView new label:'tabs at top'; extent:250@100.
    tab  := TabView origin:0.0 @ 0.0 corner:1.0 @ 0.5 in:top.

    tab direction:#top.
    tab list:(#( 'Foo' 'Bar' 'Baz' ) collect:[:l| TabItem label:l ]).
    tab action:[:aName|Transcript showCR:aName].
    top open.
                                                                                [exEnd]


    testing tab configuration and change notifications
                                                                                [exBegin]                                      
    |top tab list idx label|

    top := StandardSystemView new label:'tabs at top'; extent:250@100.
    tab  := TabView origin:0.0 @ 0.0 corner:1.0 @ 0.5 in:top.

    tab direction:#top.
    list := (#( 'Foo' 'Bar' 'Baz' ) collect:[:l| TabItem label:l ]).
    tab list:list.
    tab action:[:aName|Transcript showCR:aName].
    top openAndWait.

    [
        idx := 0.
        label := LabelAndIcon icon:(Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm' ))
                            string:'Test Tab'.

        [top shown] whileTrue:[
            |aTab lbl|

            (idx := idx + 1) > list size ifTrue:[idx := 1].

            aTab := list at:idx.
            lbl  := aTab label.

            Delay waitForSeconds:0.5. aTab label:label.
            Delay waitForSeconds:0.5. aTab enabled:false.
            Delay waitForSeconds:0.5. aTab enabled:true.
            Delay waitForSeconds:0.5. aTab foregroundColor:(Color red).
            Delay waitForSeconds:0.5. aTab foregroundColor:nil.
            aTab label:lbl.
        ]
    ] forkAt:1.
                                                                                [exEnd]

"
! !

!TabItem class methodsFor:'instance creation'!

label:aLabel
    ^ self new label:aLabel
!

new
    ^ self basicNew initialize
! !

!TabItem class methodsFor:'tests'!

test
    |top tab list item|

    top := StandardSystemView new label:'tabs at top'; extent:400@400.
    tab  := NoteBookView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.

    tab direction:#top.
    list := #( 'Foo' 'Bar' 'Baz' ) collect:[:l| TabItem label:l ].
    item := list at:1.
    item majorKey:ClockView.
    item := list at:2.
    item majorKey:CodingExamples_GUI::GUIDemoNoteBook.

    item := list at:3.
    item majorKey:CodingExamples_GUI::GUIDemoMenu.

    tab list:list.
    top open.
! !

!TabItem methodsFor:'accessing'!

accessCharacterPosition
    "get the index of the access character in the label text or string, or 0 if none
    "
    ^ self adornmentAt:#accessCharacterPosition ifAbsent:0
!

accessCharacterPosition:anIndex
    "get the index of the access character in the label text or string, or 0 if none
    "
    |idx|

    anIndex ~~ 0 ifTrue:[
        idx := anIndex
    ].
    self adornmentAt:#accessCharacterPosition put:idx
!

argument
    "returns a user defined argument or nil
    "
    ^ argument
!

argument:anArgument
    "set a user defined argument
    "
    (anArgument isString and:[anArgument isEmpty]) ifTrue:[
        argument := nil
    ] ifFalse:[
        argument := anArgument
    ].
    argument := anArgument
!

createNewBuilder
    "returns true if a new builder is used to create the canvas;
     the default is true
    "
    ^ self adornmentAt:#createNewBuilder ifAbsent:true

!

createNewBuilder:aBool
    "returns true if a new builder is used to create the canvas;
     the default is true
    "
    |flag|

    aBool == false ifTrue:[
        flag := false
    ].
    ^ self adornmentAt:#createNewBuilder put:flag

!

enabled
    "get the enabled state of the tab
    "
    ^ enabled ? true
!

enabled:aState
    "set the enabled state of the tab
    "
    |s|

    s := aState ? true.

    self enabled ~~ s ifTrue:[
        enabled := s.
        self changed:#enabled
    ]
!

foregroundColor
    "get the label color or nil
    "
    ^ self adornmentAt:#foregroundColor
!

foregroundColor:aColor
    "set the label color or nil
    "
    self foregroundColor ~= aColor ifTrue:[
        self adornmentAt:#foregroundColor put:aColor.
        self changed:#foregroundColor
    ].
!

label
    "get the label or selector to access a label/bitmap. To get the label to be shown
     use: #rawLabel
    "
    ^ label
!

label:aLabel
    "set the label or selector to access the label/bitmap
    "
    label := aLabel.

    (aLabel ~= rawLabel
    or:[aLabel isString 
        and:[rawLabel isString
        and:[(aLabel sameStringAndEmphasisAs:rawLabel) not]]])

    ifTrue:[
        rawLabel := aLabel.
        self changed
    ]
!

labelForegroundColor
    "get the label color or nil
    "
    ^ self foregroundColor
!

labelForegroundColor:aColor
    "set the label color or nil
    "
    self foregroundColor:aColor
!

shortcutKey
    "get the key to press to select the tab item from the keyboard; a symbol or nil
    "
    ^ self adornmentAt:#shortcutKey
!

shortcutKey:aKeyOrNil
    "set the key to press to select the tab item from the keyboard; a symbol or nil
    "
    |key|

    aKeyOrNil size ~~ 0 ifTrue:[
        key := aKeyOrNil asSymbol
    ].
    self adornmentAt:#shortcutKey put:key


! !

!TabItem methodsFor:'accessing canvas'!

canvas
    "returns the application or nil
    "
    |view cls wsel ckey builder appl|

    canvas notNil ifTrue:[
        ^ canvas
    ].

    (ckey := self majorKey) notNil ifTrue:[
        builder := self adornmentAt:#builder.

        (appl := builder application) notNil ifTrue:[
            (cls := appl resolveName:ckey) isNil ifTrue:[
                canvas := appl perform:ckey ifNotUnderstood:nil
            ]
        ] ifFalse:[
            cls := Smalltalk resolveName:ckey inClass:self class.
        ].

        canvas isNil ifTrue:[
            cls isNil ifTrue:[
                self majorKey:nil.
              ^ nil
            ].
            canvas := cls new.
        ].

        (canvas isKindOf:ApplicationModel) ifTrue:[
            view := SimpleView new.
            wsel := self minorKey ? #windowSpec.

            canvas builder notNil ifTrue:[
                builder := canvas builder
            ] ifFalse:[
                builder isNil ifTrue:[
                    builder := canvas createBuilder.
                ] ifFalse:[
                    canvas builder:builder.
                ].
            ].

            (appl notNil and:[canvas masterApplication isNil]) ifTrue:[
                canvas masterApplication:appl
            ].
            view client:canvas spec:wsel builder:builder.
            canvas window:(self setupCanvasView:view).
        ] ifFalse:[
            canvas := self setupCanvasView:canvas
        ].
    ].
    ^ canvas
!

canvasView
    "returns the view the canvas is running in or nil if no canvas
     specified or not yet created
    "
    |canvas|

    (canvas := self canvas) notNil ifTrue:[
        ^ canvas perform:#window ifNotUnderstood:[canvas]
    ].
    ^ nil
!

destroyCanvas

    canvas notNil ifTrue:[
        self canvasView destroy.
        canvas := nil
    ].
!

majorKey
    ^ self adornmentAt:#majorKey
!

majorKey:aMajorKey
    |key|

    aMajorKey notNil ifTrue:[
        aMajorKey isBehavior ifTrue:[
            key := aMajorKey name asSymbol
        ] ifFalse:[
            aMajorKey size ~~ 0 ifTrue:[
                key := aMajorKey asSymbol
            ]
        ]
    ].

    self majorKey ~~ key ifTrue:[
        self destroyCanvas
    ].
    self adornmentAt:#majorKey put:key.
!

minorKey
    ^ self adornmentAt:#minorKey
!

minorKey:aMinorKey
    self adornmentAt:#minorKey put:aMinorKey.
!

setupCanvasView:aView
    |frame isV isH auto|

    isH := self hasHorizontalScrollBar.
    isV := self hasVerticalScrollBar.

    (isH or:[isV]) ifFalse:[
        frame := aView
    ] ifTrue:[
        frame := ScrollableView for:ViewScroller.

        frame horizontalScrollable:isH.
        frame verticalScrollable:isV.

        isH ifTrue:[frame horizontalMini:(self miniScrollerHorizontal)].
        isV ifTrue:[frame verticalMini:(self miniScrollerVertical)].

        (auto := self autoHideScrollBars) notNil ifTrue:[
            frame autoHideScrollBars:auto
        ].
        frame scrolledView scrolledView:aView.
    ].
    frame objectAttributeAt:#isTabItem put:true.
  ^ frame
! !

!TabItem methodsFor:'accessing scrolling'!

autoHideScrollBars
    ^ self adornmentAt:#autoHideScrollBars
!

autoHideScrollBars:aBoolOrNil
    self adornmentAt:#autoHideScrollBars put:aBoolOrNil

!

hasHorizontalScrollBar
    ^ self adornmentAt:#hasHorizontalScrollBar ifAbsent:false

!

hasHorizontalScrollBar:aBool
    |flag|

    aBool == true ifTrue:[flag := true]
                 ifFalse:[self miniScrollerHorizontal:false].

    self adornmentAt:#hasHorizontalScrollBar put:flag

!

hasVerticalScrollBar
    ^ self adornmentAt:#hasVerticalScrollBar ifAbsent:false

!

hasVerticalScrollBar:aBool
    |flag|

    aBool == true ifTrue:[flag := true]
                 ifFalse:[self miniScrollerVertical:false].

    self adornmentAt:#hasVerticalScrollBar put:flag

!

miniScrollerHorizontal
    ^ self adornmentAt:#miniScrollerHorizontal ifAbsent:false

!

miniScrollerHorizontal:aBool
    |flag|

    aBool == true ifTrue:[
        flag := true
    ].
    self adornmentAt:#miniScrollerHorizontal put:flag

!

miniScrollerVertical
    ^ self adornmentAt:#miniScrollerVertical ifAbsent:false

!

miniScrollerVertical:aBool
    |flag|

    aBool == true ifTrue:[
        flag := true
    ].
    self adornmentAt:#miniScrollerVertical put:flag

! !

!TabItem methodsFor:'building'!

editAgument
    "used by TabItemEditor to get the argument
    "
    ^ argument isSymbol ifTrue:['#', argument] ifFalse:[argument]
!

editAgument:anArgument
    "used by TabItemEditor to set the argument
    "
    |arg size|

    anArgument size ~~ 0 ifTrue:[
        argument := anArgument withoutSeparators.

        (size := argument size) == 0 ifTrue:[
            argument := nil
        ] ifFalse:[
            (argument startsWith:$#) ifTrue:[
                size > 1 ifTrue:[
                    argument := (argument copyFrom:2) asSymbol
                ] ifFalse:[
                    argument := nil
                ]
            ]
        ]
    ] ifFalse:[
        argument := nil
    ]
!

rawLabel
    "returns the label to be shown
    "
    ^ rawLabel ? ' '


!

setAttributesFromClass:aClass
    "setup attributes from class
    "
    |key spec cls|

    rawLabel := nil.

    (aClass notNil and:[(cls := Smalltalk resolveName:aClass inClass:self class) notNil]) ifTrue:[
        (self translateLabel and:[label isString]) ifTrue:[
            rawLabel := cls perform:(label asSymbol) ifNotUnderstood:nil
        ].
        (self majorKey isNil and:[(key := self minorKey) notNil]) ifTrue:[
            Exception handle:[:ex|
            ] do:[
                spec := cls perform:(key asSymbol) ifNotUnderstood:nil.

                spec notNil ifTrue:[
                    canvas := SimpleView new.
                    canvas client:nil spec:spec builder:(UIBuilder new).
                    canvas := self setupCanvasView:canvas.
                ].
            ]
        ]        
    ].

    rawLabel isNil ifTrue:[
        rawLabel := label isNil ifTrue:[''] ifFalse:[label printString]
    ].
!

setAttributesWithBuilder:aBuilder
    "setup attributes dependent on the builder
    "
    |appl key builder |

    builder := self createNewBuilder ifTrue:[UIBuilder new] ifFalse:[aBuilder].
    self adornmentAt:#builder put:builder.

    (self translateLabel and:[label isString]) ifTrue:[
        rawLabel := aBuilder labelFor:(label asSymbol).
    ].

    rawLabel isNil ifTrue:[
        rawLabel := label printString.
    ].

    (aBuilder isEditing or:[(appl := aBuilder application) isNil]) ifFalse:[
        (key := self activeHelpKey) notNil ifTrue:[
            activeHelpText := appl helpTextForKey:key.
        ].
        builder application isNil ifTrue:[
            builder application:appl
        ].

        (self majorKey isNil and:[(key := self minorKey) notNil]) ifTrue:[
            canvas := SimpleView new.
            canvas client:appl spec:key builder:builder.
            canvas := self setupCanvasView:canvas.
        ]
    ].
!

translateLabel
    "returns true if the label derives from the application
    "
    ^ self adornmentAt:#translateLabel ifAbsent:false
!

translateLabel:aBool
    "returns true if the label derives from the application
    "
    |flag|

    aBool == true ifTrue:[
        flag := true.
    ].
    ^ self adornmentAt:#translateLabel put:flag
! !

!TabItem methodsFor:'converting'!

fromLiteralArrayEncoding:aLiteralEncodedArray
    "read my contents from a aLiteralEncodedArray
    "
    2 to:aLiteralEncodedArray size by:2 do:[:i |
        |selector value|

        selector := aLiteralEncodedArray at:i.

        (self respondsTo:selector) ifTrue:[
            value := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
            self perform:selector with:value
        ]
    ].


"

#(#TabItem 
        #label: 'claus' 
        #foregroundColor: #(#Color 0.0 0.0 100.0)
        #enabled: false

) decodeAsLiteralArray


"


!

literalArrayEncoding
    "return myself encoded as a literal array
    "
    |coll val|

    coll := OrderedCollection new.
    coll add:#TabItem.
    coll add:#label: ; add:(label literalArrayEncoding).

    self enabled ifFalse:[
        coll add:#enabled: ; add:false.
    ].

    argument notNil ifTrue:[
        coll add:#argument: ; add:(argument literalArrayEncoding).
    ].

    adornments size ~~ 0 ifTrue:[
        adornments keysAndValuesDo:[:key :val|
            key ~~ #builder ifTrue:[
                coll add:((key, ':') asSymbol).
                coll add:(val literalArrayEncoding).
            ]
        ]
    ].

  ^ coll asArray
"

#(#TabItem 
        #label: 'claus' 
        #translateLabel: true 
        #foregroundColor: #(#Color 0.0 0.0 100.0)
        #enabled: false

) decodeAsLiteralArray literalArrayEncoding

"
! !

!TabItem methodsFor:'displaying'!

displayOn:aGC x:x y:y
    |s|

    (s := rawLabel ? label) isNil ifTrue:[
        ^ self
    ].
    s isNumber ifTrue:[
        s := s printString
    ].
    s displayOn:aGC x:x y:y
!

heightOn:aGC
    |s|

    (s := rawLabel ? label) isNil ifTrue:[
        ^ aGC font height
    ].
    ^ s heightOn:aGC
!

widthOn:aGC
    |s|

    (s := rawLabel ? label) isNil ifTrue:[
        ^ 4
    ].
    ^ s widthOn:aGC
! !

!TabItem methodsFor:'help'!

activeHelpKey
    ^ self adornmentAt:#activeHelpKey
!

activeHelpKey:aKey
    |key|

    aKey size > 0 ifTrue:[key := aKey asSymbol].
    self adornmentAt:#activeHelpKey put:key
!

activeHelpText
    ^ activeHelpText
! !

!TabItem methodsFor:'private'!

adornmentAt:aKey
    ^ self adornmentAt:aKey ifAbsent:nil
!

adornmentAt:aKey ifAbsent:exceptionBlock
    adornments isNil ifTrue:[
        ^ exceptionBlock value
    ].
    ^ adornments at:aKey ifAbsent:exceptionBlock
!

adornmentAt:aKey put:something

    something isNil ifTrue:[
        adornments notNil ifTrue:[
            adornments removeKey:aKey ifAbsent:nil.
        ]
    ] ifFalse:[
        adornments isNil ifTrue:[
            adornments := IdentityDictionary new.
        ].
        adornments at:aKey put:something.
    ].
    ^ something
! !

!TabItem methodsFor:'queries'!

isEnabled
    ^ self enabled
! !

!TabItem class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg2/TabItem.st,v 1.12 2001-02-16 20:28:20 cg Exp $'
! !