"
 COPYRIGHT (c) 1998 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.
"


Object subclass:#MenuItem
	instanceVariableNames:'activeHelpKey enabled label value nameKey adornment
		translateLabel isButton startGroup isVisible hideMenuOnActivated'
	classVariableNames:''
	poolDictionaries:''
	category:'Views-Support'
!

Object subclass:#MenuItemAdornment
	instanceVariableNames:'color indication submenu submenuChannel shortcutKey labelText
		labelImage accessCharacterPosition argument choice choiceValue
		auxValue showBusyCursorWhilePerforming'
	classVariableNames:''
	poolDictionaries:''
	privateIn:MenuItem
!

!MenuItem class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1998 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
"
    not yet finished MenuItem class - this will eventually replace
    most of the MenuView and PopUpMenu stuff.
    (and hopefully be ST-80 compatible ...)

    For now, only a subset of the full protocol is implemented.

    [author:]
        Claus Gittinger

    [see also:]
        MenuItem
        PopUpMenu
"

! !

!MenuItem class methodsFor:'instance creation'!

label:aString
    "create and return a new menuItem, given a label string"

    ^ self new label:aString

    "Modified: / 4.8.1998 / 17:33:13 / cg"
    "Created: / 14.8.1998 / 19:19:14 / cg"
!

label:labelString value:selectorOrValue
    "create and return a new menuItem, given its label and value"

    ^ (self new) label:labelString; value:selectorOrValue; yourself

    "Created: / 4.8.1998 / 17:34:18 / cg"
!

labeled:aString
    "create and return a new menuItem, given a label string"

    ^ self new label:aString

    "Modified: / 4.8.1998 / 17:33:13 / cg"
! !

!MenuItem methodsFor:'Compatibility - ST80'!

isEnabled:aBoolean
    self enabled:aBoolean

    "Created: / 27.10.1997 / 16:34:55 / cg"
! !

!MenuItem methodsFor:'accessing'!

accessCharacterPosition
    "get the index of the access character in the label text or string, or nil if none
    "
    adornment notNil ifTrue:[
        ^ adornment accessCharacterPosition
    ].
    ^ nil
!

accessCharacterPosition:index
    "set the index of the access character in the label text or string, or nil if none
    "
    (index isNil and:[adornment isNil]) ifFalse:[
        self adornment accessCharacterPosition:index
    ]
!

activeHelpKey
    ^ activeHelpKey
!

activeHelpKey:aKey
    activeHelpKey := aKey
!

argument
    "get argument given to the value (selector)
    "
    adornment notNil ifTrue:[
        ^ adornment argument
    ].
    ^ nil
!

argument:something
    "set argument given to the value (selector)
    "
    |arg|

    (arg := something) notNil ifTrue:[
        arg isString ifTrue:[
            (arg size == 0 or:[(arg indexOfNonSeparatorStartingAt:1) == 0]) ifTrue:[
                arg := nil
            ]
        ]
    ].

    (arg isNil and:[adornment isNil]) ifFalse:[
        self adornment argument:arg
    ]
!

auxValue
    "an additional, arbitrary value"

    adornment notNil ifTrue:[
        ^ adornment auxValue
    ].
    ^ nil
!

auxValue:something
    "set the auxValue - an arbitrary user value
    "
    (something notNil or:[adornment notNil]) ifTrue:[
        self adornment auxValue:something
    ]

    "Modified: / 4.2.2000 / 12:38:44 / cg"
!

hideMenuOnActivated
    "hide the menu when the item was activated; the default is true
    "
    ^ hideMenuOnActivated ? true

!

hideMenuOnActivated:aBool
   "hide the menu when the item was activated; the default is true
   "
    hideMenuOnActivated := aBool ? true

!

isVisible
    ^ isVisible ? true
!

isVisible:something
    isVisible := something
!

label
    ^ self filteredLabel "/ label

    "Created: / 25.2.1997 / 19:48:16 / cg"
    "Modified: / 19.6.1998 / 00:02:55 / cg"
!

label:aString
    label := aString

    "Created: 25.2.1997 / 19:55:16 / cg"
!

labelImage
    "gets the labelImage
    "
    adornment notNil ifTrue:[
        ^ adornment labelImage value
    ].
  ^ nil
!

labelImage:aResourceRetriever
    "set the labelImage
    "
    aResourceRetriever notNil ifTrue:[
        self adornment labelImage:aResourceRetriever
    ]
!

nameKey
    ^ nameKey


!

nameKey:aNameKey
    nameKey := aNameKey.


!

rawLabel
    ^ label

    "Created: 25.2.1997 / 19:48:16 / cg"
!

rawLabel:aString
    label := aString

    "Created: 25.2.1997 / 19:11:02 / cg"
!

shortcutKeyCharacter
    "ignored for now"

    adornment notNil ifTrue:[
        ^ adornment shortcutKeyCharacter
    ].
    ^ nil
!

shortcutKeyCharacter:aKey
    "set the  key to press to select the menu item from the keyboard
    "
    (aKey notNil or:[adornment notNil]) ifTrue:[
        self adornment shortcutKeyCharacter:aKey
    ]

    "Modified: / 4.2.2000 / 12:39:30 / cg"
!

showBusyCursorWhilePerforming
    "get the flag which controls if a busy cursor is to be shown
     while performing the menu action. Defaults to false."

    adornment notNil ifTrue:[
        ^ adornment showBusyCursorWhilePerforming
    ].
    ^ nil
!

showBusyCursorWhilePerforming:aBoolean
    "set/clear the flag which controls if a busy cursor is to be shown
     while performing the menu action. Defaults to false."

    ((aBoolean == true) or:[adornment notNil]) ifTrue:[
        self adornment showBusyCursorWhilePerforming:aBoolean
    ]
!

startGroup
    "start group #left #right #center ... or nil
     at the moment only #right is implemented
    "
    ^ startGroup 
!

startGroup:aSymbol
    "start group #left #right #center ...
     at the moment only #right is implemented
    "
    (startGroup isNil or:[startGroup == #right]) ifTrue:[
        startGroup := aSymbol
    ] ifFalse:[
        self warn:('not supported group: ', aSymbol printString ).
    ]
!

submenu
    adornment notNil ifTrue:[
        ^ adornment submenu
    ].
    ^ nil

    "Created: 25.2.1997 / 20:57:24 / cg"
!

submenu:aMenu
    (aMenu notNil or:[adornment notNil]) ifTrue:[
        self adornment submenu:aMenu
    ]

    "Created: / 25.2.1997 / 20:56:20 / cg"
    "Modified: / 4.2.2000 / 12:40:02 / cg"
!

submenuChannel
    adornment notNil ifTrue:[
        ^ adornment submenuChannel
    ].
    ^ nil
!

submenuChannel:something
    (something notNil or:[adornment notNil]) ifTrue:[
        self adornment submenuChannel:something
    ]

    "Modified: / 4.2.2000 / 12:40:19 / cg"
!

value
    ^ value

    "Created: 25.2.1997 / 19:50:14 / cg"
!

value:something
    value := something

    "Created: 25.2.1997 / 19:11:13 / cg"
! !

!MenuItem methodsFor:'accessing-behavior'!

beOff
    "set indication off
    "
    self indication:false
!

beOn
    "set indication on
    "
    self indication:true
!

choice
    "return the menu items choice indicator (RadioButton)
    "
    adornment notNil ifTrue:[
        ^ adornment choice
    ].
    ^ nil

    "Created: / 14.8.1998 / 14:34:55 / cg"
    "Modified: / 14.8.1998 / 15:11:57 / cg"
!

choice:aChoice
    "set the menu items choice indicator (RadioButton)
    "
    (aChoice notNil or:[adornment notNil]) ifTrue:[
        self adornment choice:aChoice.
    ].

    "Created: / 14.8.1998 / 15:11:17 / cg"
!

choiceValue
    "return the menu items choiceValue (RadioButton)
    "
    adornment notNil ifTrue:[
        ^ adornment choiceValue
    ].
    ^ nil

    "Modified: / 14.8.1998 / 15:11:57 / cg"
    "Created: / 14.8.1998 / 15:38:05 / cg"
!

choiceValue:something
    "set the menu items choiceValue (RadioButton)
    "
    (something notNil or:[adornment notNil]) ifTrue:[
        self adornment choiceValue:something.
    ].

    "Created: / 14.8.1998 / 15:39:12 / cg"
!

disable
    enabled := false

    "Created: 25.2.1997 / 19:39:09 / cg"
!

enable
    enabled := true

    "Created: 25.2.1997 / 19:39:00 / cg"
!

enabled
    "returns a boolean, valueHolder or block
    "
    ^ enabled
!

enabled:something
    "a boolean, valueHolder or block
    "
    enabled := something
!

indication
    "return the menu items on/off indicator (CheckToggle)
    "
    adornment notNil ifTrue:[
        ^ adornment indication
    ].
    ^ nil

    "Modified: / 14.8.1998 / 15:11:37 / cg"
!

indication:anIndication
    "set the menu items an on/off indicator (CheckToggle)
    "
    (anIndication notNil or:[adornment notNil]) ifTrue:[
        self adornment indication:anIndication.
    ].

    "Modified: / 14.8.1998 / 15:11:25 / cg"
!

isButton
    "returns whether item looks like a Button
    "
    ^isButton ? false


!

isButton:anBoolean
    "sets whether item looks like a Button
    "
    isButton := anBoolean


!

translateLabel
    "returns whether label is translated
    "
    ^translateLabel ? false


!

translateLabel:anBoolean
    "sets whether label is translated
    "
    translateLabel := anBoolean


! !

!MenuItem methodsFor:'accessing-resource'!

findGuiResourcesIn:aResourceContainerOrApplication
    "setup a resource container
    "
    |lblImg m|

    self translateLabel ifTrue:[
        label := ResourceRetriever findResourceLabel: label in: aResourceContainerOrApplication
    ].

    adornment notNil ifTrue:[
        (lblImg := adornment labelImage) notNil ifTrue:[   
            lblImg findGuiResourcesIn:aResourceContainerOrApplication.
            lblImg labelText notNil ifTrue: [lblImg labelText: label].
        ].   
        (m := adornment submenu) notNil ifTrue:[
            m := m value.
            m notNil ifTrue:[
                m findGuiResourcesIn:aResourceContainerOrApplication
            ]
        ].
    ]

    "Modified: / 18.6.1998 / 16:54:25 / cg"
! !

!MenuItem methodsFor:'converting'!

fromLiteralArrayEncoding:aLiteralEncodedArray
    "read my contents from a aLiteralEncodedArray"

    |selector value|

    2 to:aLiteralEncodedArray size by:2 do:[:i |
        selector := aLiteralEncodedArray at:i.
        value    := (aLiteralEncodedArray at:i+1).
        selector == #argument: ifFalse:[
            value := value decodeAsLiteralArray
        ].
        self perform:selector with:value
    ].

    "
     #( #MenuItem #rawLabel: 'left' #nameKey: 'identifier'  #value: #left )
         decodeAsLiteralArray
    "

    "Modified: / 4.2.2000 / 12:50:28 / cg"
!

literalArrayEncoding
    "return myself encoded as a literal array"

    |coll something|

    coll := OrderedCollection new.
    coll add:#MenuItem.

    label notNil ifTrue:[
        coll add:#label: ; add:(label literalArrayEncoding)
    ].
    self translateLabel ifTrue:[
        coll add:#translateLabel: ; add:true
    ].
    self isButton ifTrue:[
        coll add:#isButton:; add:true
    ].
    hideMenuOnActivated == false ifTrue:[
        coll add:#hideMenuOnActivated: ; add:false
    ].
    nameKey notNil ifTrue:[
        coll add:#nameKey: ; add:(nameKey literalArrayEncoding)
    ].
    isVisible notNil ifTrue:[
        isVisible ~~ true ifTrue:[
            coll add:#isVisible: ; add:(isVisible literalArrayEncoding)
        ]
    ].
    startGroup notNil ifTrue:[
        coll add:#startGroup: ; add:(startGroup literalArrayEncoding)
    ].

    value notNil ifTrue:[
        coll add:#value: ; add:(value literalArrayEncoding).
    ].
    activeHelpKey notNil ifTrue:[
        coll add:#activeHelpKey: ; add:(activeHelpKey literalArrayEncoding).
    ].
    (something := self enabled) notNil ifTrue:[
        coll add:#enabled: ; add:(enabled literalArrayEncoding).
    ].

    adornment notNil ifTrue:[
        (something := self shortcutKeyCharacter) notNil ifTrue:[
            coll add:#shortcutKeyCharacter: ; add:(something literalArrayEncoding)
        ].

        (something := self accessCharacterPosition) notNil ifTrue:[
            coll add:#accessCharacterPosition: ; add:(something literalArrayEncoding)
        ].

        (something := self showBusyCursorWhilePerforming) == true ifTrue:[
            coll add:#showBusyCursorWhilePerforming: ; add:(something literalArrayEncoding)
        ].

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

        adornment labelImage notNil ifTrue:[
            coll add:#labelImage: ; add:(adornment labelImage literalArrayEncoding)
        ].
        (something := self indication) notNil ifTrue:[
            coll add:#indication: ; add:(something literalArrayEncoding)
        ].
        (something := self choice) notNil ifTrue:[
            coll add:#choice: ; add:(something literalArrayEncoding)
        ].
        (something := self choiceValue) notNil ifTrue:[
            coll add:#choiceValue: ; add:(something literalArrayEncoding)
        ].
        (something := self auxValue) notNil ifTrue:[
            coll add:#auxValue: ; add:(something literalArrayEncoding)
        ].

        (something := self submenuChannel) notNil ifTrue:[
            coll add:#submenuChannel: ; add:(something literalArrayEncoding)
        ].

        self hasSubmenu ifTrue:[
            coll add:#submenu:; add:(self submenu literalArrayEncoding)
        ].
    ].

  ^ coll asArray

    "Modified: / 14.8.1998 / 15:44:53 / cg"
! !

!MenuItem methodsFor:'printing & storing'!

displayString
    ^ self classNameWithArticle , '(' , label storeString , ')'
! !

!MenuItem methodsFor:'private - accessing'!

adornment
    adornment isNil ifTrue:[
        adornment := MenuItemAdornment new
    ].
    ^ adornment

    "Created: 25.2.1997 / 20:57:05 / cg"
!

filteredLabel
    "return the label without any &-chars"

    |rawLabel l in out c pos emp e|

    rawLabel := self rawLabel.
    rawLabel isString ifFalse:[^ rawLabel].

    "/ be careful to preserve any emphasis ...
    "/ bad kludge ...
    rawLabel isText ifTrue:[
        emp := RunArray new.
    ].

    out := WriteStream on:''.
    in := rawLabel readStream.
    [in atEnd] whileFalse:[
        emp notNil ifTrue:[
            e := rawLabel emphasisAt:(in position).
        ].
        c := in next.
        c == $& ifTrue:[
            in peek == $& ifTrue:[
                out nextPut:c.
                emp notNil ifTrue:[
                    emp add:e
                ]
            ]
        ] ifFalse:[
            out nextPut:c.
            emp notNil ifTrue:[
                emp add:e
            ]
        ]
    ].
    l := out contents.
    emp notNil ifTrue:[
        ^ Text string:l emphasisCollection:emp
    ].
    ^ l.

    "Created: / 19.6.1998 / 00:02:10 / cg"
    "Modified: / 20.6.1998 / 17:15:18 / cg"
! !

!MenuItem methodsFor:'queries'!

hasChoice
    "test whether choice exists
    "
  ^ self choice notNil

    "Created: / 14.8.1998 / 14:34:29 / cg"
!

hasIndication
    "test whether indication on/off exists
    "
  ^ self indication notNil
!

hasSubmenu
    ^ self submenu notNil

    "Created: 25.2.1997 / 20:56:20 / cg"
!

isEnabled
    ^ enabled value ? true

    "Created: 25.2.1997 / 19:39:17 / cg"
!

isHidden
    "not yet supported"

    ^ false

    "Created: / 27.10.1997 / 15:13:43 / cg"
!

isOff
    "test whether indication on/off exists and is off
    "
    |indication|

    indication := self indication.
  ^ indication value == false
!

isOn
    "test whether indication on/off exists and is on
    "
    |indication|

    indication := self indication.
  ^ indication value == true
! !

!MenuItem::MenuItemAdornment methodsFor:'accessing'!

accessCharacterPosition
    "return the value of the instance variable 'accessCharacterPosition' (automatically generated)"

    ^ accessCharacterPosition!

accessCharacterPosition:something
    "set the value of the instance variable 'accessCharacterPosition' (automatically generated)"

    accessCharacterPosition := something.!

argument
    "return the value of the instance variable 'argument' (automatically generated)"

    ^ argument

    "Created: 25.2.1997 / 20:59:28 / cg"
!

argument:something
    "set the value of the instance variable 'argument' (automatically generated)"

    argument := something.

    "Created: 25.2.1997 / 20:59:28 / cg"
!

auxValue
    "return the value of the instance variable 'auxValue' (automatically generated)"

    ^ auxValue!

auxValue:something
    "set the value of the instance variable 'auxValue' (automatically generated)"

    auxValue := something.!

choice
    "return the value of the instance variable 'choice' (automatically generated)"

    ^ choice

    "Created: / 14.8.1998 / 14:32:06 / cg"
!

choice:something
    "set the value of the instance variable 'choice' (automatically generated)"

    choice := something.

    "Created: / 14.8.1998 / 14:32:06 / cg"
!

choiceValue
    "return the value of the instance variable 'choiceValue' (automatically generated)"

    ^ choiceValue

    "Created: / 14.8.1998 / 15:39:26 / cg"
!

choiceValue:something
    "set the value of the instance variable 'choiceValue' (automatically generated)"

    choiceValue := something.

    "Created: / 14.8.1998 / 15:39:26 / cg"
!

color
    "return the value of the instance variable 'color' (automatically generated)"

    ^ color

    "Created: 25.2.1997 / 20:59:28 / cg"
!

color:something
    "set the value of the instance variable 'color' (automatically generated)"

    color := something.

    "Created: 25.2.1997 / 20:59:28 / cg"
!

indication
    "test whether the menu item has an on/off indicator (CheckToggle)
    "
    ^ indication

    "Created: 25.2.1997 / 20:59:28 / cg"
!

indication:something
    "test whether the menu item has an on/off indicator (CheckToggle)
    "
    indication := something.

    "Created: 25.2.1997 / 20:59:28 / cg"
!

labelImage
    "return the value of the instance variable 'labelImage' (automatically generated)"

    ^ labelImage!

labelImage:something
    "set the value of the instance variable 'labelImage' (automatically generated)"

    labelImage := something.!

labelText
    "get the text appear as the menu label
    "
    ^ labelText
!

labelText:something
    "set the text appear as the menu label
    "
    labelText := something.
!

shortcutKeyCharacter
    "get the  key to press to select the menu item from the keyboard
    "
    ^ shortcutKey
!

shortcutKeyCharacter:something
    "set the  key to press to select the menu item from the keyboard
    "
    shortcutKey := something.
!

showBusyCursorWhilePerforming
    "get the flag which controls if a busy cursor is to be shown
     while performing the menu action. Defaults to false."

    ^ showBusyCursorWhilePerforming ? false

!

showBusyCursorWhilePerforming:aBoolean
    "set/clear the flag which controls if a busy cursor is to be shown
     while performing the menu action. Defaults to false."

    showBusyCursorWhilePerforming := aBoolean

!

staticSubmenu
    "get the submenu or nil;
     only returns the subMenu if its a static subMenu (i.e. not
     provided by a valueHolder or block).
    "
    (submenu isValueModel or:[submenu isBlock]) ifTrue:[
        ^ nil
    ].
    ^ submenu

    "Modified: / 5.2.2000 / 16:49:54 / cg"
!

submenu
    "get the submenu or nil
    "
    ^ submenu value

    "Created: / 25.2.1997 / 20:59:28 / cg"
    "Modified: / 19.6.1998 / 00:33:58 / cg"
!

submenu:something
    "set the submenu or nil
    "
    (something isValueModel or:[something isBlock]) ifTrue:[
        submenuChannel notNil ifTrue:[
            "/ programmers error ?
            "/ how can I decide which one to use if there is both
            "/ a channel and a subMenu ...
            self halt:'overwriting submenuchannel'.
        ].
        submenuChannel := something
    ] ifFalse:[
        submenu := something.
    ]

    "Created: / 25.2.1997 / 20:59:28 / cg"
    "Modified: / 5.2.2000 / 16:53:28 / cg"
!

submenuChannel
    "get the submenuChannel or nil
    "
    ^ submenuChannel
!

submenuChannel:something
    "set the submenuChannel or nil
    "
    submenuChannel := something.
!

submenuHolder
    "get the submenuHolder or nil
    "
    ^ submenu

    "Modified: / 19.6.1998 / 00:33:58 / cg"
    "Created: / 19.6.1998 / 00:34:32 / cg"
! !

!MenuItem class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/MenuItem.st,v 1.37 2000-02-12 13:24:31 cg Exp $'
! !