Object subclass:#Menu
	instanceVariableNames:'items groupSizes receiver'
	classVariableNames:''
	poolDictionaries:''
	category:'Views-Support'
!

!Menu class methodsFor:'documentation'!

documentation
"
    not yet finished Menu 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
"
! !

!Menu class methodsFor:'instance creation'!

labelArray: arrayOfString lines: linesArray values: valueArrayOrNil
    "return a menu with menu items built with labels from arrayOfString (not Symbols).  
     The linesArray describes which menu items are the last menu item in their group. 
     The valueArray contains value objects for each menu item 
     (or is nil if no value objects are specified)."

    | nLabel valueArray menuItems groupLengths |

    nLabel := arrayOfString size.

    valueArrayOrNil isNil ifTrue:[
        valueArray := arrayOfString isEmpty ifTrue: [
            valueArray := #()
        ] ifFalse:[
            valueArray := (1 to:nLabel)
        ]
    ] ifFalse:[
        valueArray := valueArrayOrNil
    ].

    nLabel ~~ valueArray size ifTrue: [
        ^ self error: 'illegal menu combination'
    ].

    menuItems := Array new:nLabel.
    1 to:nLabel do:[:i |
        |mi v|

        mi := MenuItem labeled: (arrayOfString at:i) asString.
        v := valueArray at: i.
        (v isKindOf: Menu) ifTrue: [mi submenu: v].
        menuItems at: i put: mi
    ].

    (linesArray == nil or:[linesArray isEmpty]) ifTrue:[
        groupLengths := (menuItems isEmpty)
                            ifTrue: [Array new: 0]
                            ifFalse: [Array with: menuItems size]
    ] ifFalse:[
        groupLengths := Array new: linesArray size + 1.
        groupLengths at: 1 put: linesArray first.
        2 to: linesArray size do: [:i | 
                groupLengths at: i put: (linesArray at: i) - (linesArray at: i - 1)
        ].
        groupLengths at: groupLengths size put: menuItems size - linesArray last
    ].

    ^ self new 
        menuItems: menuItems 
        menuItemGroups: groupLengths 
        values: valueArray

    "Modified: / 31.10.1997 / 03:19:14 / cg"
!

labelList:arrayOfGroupStrings values:valueArrayOrNil
    |labels lines|

    lines := arrayOfGroupStrings collect:[:each | each size].
    labels := OrderedCollection new.
    arrayOfGroupStrings do:[:group | labels addAll:group].
    ^ self labelArray:labels lines:lines values:valueArrayOrNil

    "Modified: 20.6.1997 / 10:46:45 / cg"
    "Created: 13.9.1997 / 10:35:46 / cg"
!

labels:aString lines:linesArray values:valueArrayOrNil
    ^ self 
        labelArray:(aString asCollectionOfLines)
        lines:linesArray
        values:valueArrayOrNil

    "Created: / 31.10.1997 / 03:12:20 / cg"
    "Modified: / 31.10.1997 / 03:23:42 / cg"
! !

!Menu methodsFor:'ST-80 compatibility'!

indexOfMenuItem:anItem

    ^ items indexOf:anItem

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

menuButtons
    "ST-80 seems to use a special menuButton class here.
     Here, kludge a collection of menuItems."

    ^ items

    "Created: / 27.10.1997 / 16:33:35 / cg"
! !

!Menu methodsFor:'accessing'!

addItem:aMenuItem
    items isNil ifTrue:[
        items := OrderedCollection new
    ].
    items add:aMenuItem.
!

addItem:aMenuItem value:aValue
    aMenuItem value:aValue.
    self addItem:aMenuItem.
!

addItemGroup:aCollectionOfItems
    groupSizes isNil ifTrue:[
        groupSizes := OrderedCollection new
    ].
    groupSizes add:aCollectionOfItems size.

    aCollectionOfItems do:[:item |
        self addItem:item
    ].

    "Created: / 27.10.1997 / 15:02:15 / cg"
!

addItemGroup:aGroup values:values
    groupSizes isNil ifTrue:[
        groupSizes := OrderedCollection new
    ].
    groupSizes add:items size.

    aGroup with:values do:[:item :value |
        self addItem:item value:value
    ].
!

addItemGroupLabels:labels values:values
    |items|

    items := labels with:values
                collect:[:label :value |
                            |item|

                            item := MenuItem new.
                            item label:label.
                            item value:value.
                        ].
    self addItemGroup:items

    "Created: / 27.10.1997 / 19:49:27 / cg"
!

addItemLabel:label value:value
    |item|

    item := MenuItem new.
    item label:label.
    item value:value.
    self addItem:item

    "Created: / 27.10.1997 / 19:47:12 / cg"
!

atNameKey:aNameKey
    "return the menuItem for the given nameKey; nil if no such item is in the menu.
     Searches in allItems (i.e. also in subMenus)"

    self allItemsDo:[:anItem|
        anItem nameKey == aNameKey ifTrue:[^ anItem]
    ].
    ^ nil

    "Modified: / 27.10.1997 / 15:12:00 / cg"
!

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

    ^ groupSizes!

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

    groupSizes := something.!

labelAt:anIndex
    "gets the label of the menu item at the given index or nil
    "
    |item|

    (item := self menuItemAt:anIndex) notNil ifTrue:[
        ^ item label
    ].
  ^ nil

!

labelAtValue:aValue
    "gets the label of the menu item assigned to value
    "
    |item|

    item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue ].

    item notNil ifTrue:[
        ^ item label
    ].
  ^ nil

!

labels
    "return a collection of labels from my items"

    ^ items collect:[:anItem | anItem label]

    "Created: 25.2.1997 / 19:47:53 / cg"
!

lines
    "return the indexes of the menu items that are the last menu item in their group (except the very last)."

    | lines |

    groupSizes size <= 1 ifTrue: [^Array new].
    lines := Array new: groupSizes size - 1.
    lines at: 1 put: groupSizes first.
    2 to: groupSizes size -1 do: 
            [:i |
            lines at: i put: (lines at: i - 1) + (groupSizes at: i)].
    ^lines

    "Modified: / 31.10.1997 / 03:19:51 / cg"
!

menuItemAt:index
    "gets the menu item at the given index. When the index is out of bounds
     nil is returned
    "
    (index > 0 and:[index <= items size]) ifTrue:[
        ^ items at:index
    ].
  ^ nil
!

menuItemLabeled:anItemLabel
    "return the menuItem for the given nameKey; nil if no such item is in the menu.
     Searches all items (i.e. also submenu items)"

    self allItemsDo:[:anItem|
                |l|

                ((l := anItem label) sameAs: anItemLabel) ifTrue:[
                    ^ anItem
                ].
                (l includes:$&) ifTrue:[
                    ((l copyWithout:$&) sameAs: anItemLabel) ifTrue:[
                        ^ anItem
                    ]
                ]
             ].
    ^ nil

    "Created: / 13.9.1997 / 10:25:16 / cg"
    "Modified: / 27.10.1997 / 15:23:33 / cg"
!

menuItems
    ^ items
!

menuItems:aCollectionOfMenuItems menuItemGroups:sizes values:values
    items := aCollectionOfMenuItems.
    groupSizes := sizes.

    values notNil ifTrue:[
        items with:values do:[:anItem :aValue |anItem value:aValue]
    ].

    "Modified: 20.6.1997 / 10:45:30 / cg"
!

numberOfItems
    ^ items size

    "Created: 6.3.1997 / 15:15:53 / cg"
!

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

    ^ receiver!

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

    receiver := something.!

removeItem:aMenuItem
    |idx|
    items notNil ifTrue:[
        idx := items identityIndexOf:aMenuItem.
        idx ~~ 0 ifTrue:[
            items removeAtIndex:idx
        ]
    ].

    "Created: 13.9.1997 / 10:27:31 / cg"
!

valueAt:index
    "return a collection of values from my items"

    ^ (items at:index) value

    "Created: 25.2.1997 / 19:49:41 / cg"
!

valueAt:anIndex put:aValue
    "put value an an index"

    (items at:anIndex) value:aValue

    "Created: 6.3.1997 / 15:15:48 / cg"
!

values
    "return a collection of values from my items"

    ^ items collect:[:anItem | anItem value]

    "Created: 25.2.1997 / 19:49:29 / cg"
!

values:aCollectionOfValues
    "return a collection of values from my items"

    |s|

    s := aCollectionOfValues readStream.
    self itemsDo:[:item |
        |val|

        val := s next.
        item value:val
    ].
    s atEnd ifFalse:[self halt]

    "Created: / 27.10.1997 / 15:15:47 / cg"
!

visibleMenuItemGroups
        | itemGroups visibleItemGroups nextItem |

        itemGroups := OrderedCollection new.
        nextItem := 1.
        groupSizes do: [:groupSize |
                itemGroups addLast: (items copyFrom: nextItem to: nextItem + groupSize - 1).
                nextItem := nextItem + groupSize].
        self hasHiddenItems ifFalse: [^itemGroups].

        "Remove the hidden items."
        visibleItemGroups := OrderedCollection new.
        itemGroups do: [:eachItemGroup |
                | visibleItemGroup |
                visibleItemGroup := eachItemGroup reject:
                                        [:eachMenuItem | eachMenuItem hidden].
                visibleItemGroup isEmpty ifFalse: [
                        visibleItemGroups addLast: visibleItemGroup]].
        ^visibleItemGroups

    "Created: / 27.10.1997 / 15:07:50 / cg"
! !

!Menu methodsFor:'accessing resource'!

findGuiResourcesIn:aResourceContainerOrApplication
    "setup a resource owner
    "
    aResourceContainerOrApplication notNil ifTrue:[
        items notNil ifTrue:[
            items do:[:anItem| anItem findGuiResourcesIn:aResourceContainerOrApplication ]
        ]
    ]

! !

!Menu methodsFor:'converting'!

fromLiteralArrayEncoding:aLiteralEncodedArray
    "read my contents from a aLiteralEncodedArray"

    |items groups values|

    items := (aLiteralEncodedArray at:2) collect:[:item | item decodeAsLiteralArray].
    groups := aLiteralEncodedArray at:3.
    values := aLiteralEncodedArray at:4.
    self menuItems:items menuItemGroups:groups values:values.

    "extract from PD folder.st:
     #(#Menu #(
                #(#MenuItem 
                        #rawLabel: 'left' 
                        #value: #left ) 
                #(#MenuItem 
                        #rawLabel: 'center' 
                        #value: #center ) 
                #(#MenuItem 
                        #rawLabel: 'right' 
                        #value: #right ) 
              ) 
             #(3 ) 
             nil 
       ) decodeAsLiteralArray
    "
    "
     #(#Menu #(
                #(#MenuItem 
                        #label: 'Straighten Up' ) 
                #(#MenuItem 
                        #label: 'Inspect' ) 
                #(#MenuItem 
                        #label: 'Coredump' ) 
              ) 
             #(3 ) 
            #(#straightenUp #inspect #halt ) 
       ) decodeAsLiteralArray startUp  
    "

    "extract from iconicBrowser.st:
     #(#Menu #(
                #(#MenuItem 
                        #label: 'Straighten Up' ) 
                #(#MenuItem 
                        #label: 'Inspect' ) 
                #(#MenuItem 
                        #label: 'Coredump' ) 
              ) 
             #(3 ) 
             #(1 2 3 )
       ) decodeAsLiteralArray startUp  
    "

    "extract from refactory213.st:
     #(#Menu #(
                #(#MenuItem 
                    #label: 'File List' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'File Editor...' 
                    #accessCharacterPosition: 6 ) 
                #(#MenuItem #label: 'Refactoring Tool...' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'Workspace' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'New Canvas' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'Palette' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'Canvas Tool' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'Image Editor' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'Menu Editor' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'Advanced' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'DLL and C Connect' 
                    #accessCharacterPosition: 1 ) 
                #(#MenuItem #label: 'System Transcript' 
                    #accessCharacterPosition: 8 ) 
              ) 
              #(4 5 2 1 ) 
              #(#openFileList #openFileEditor #openRefactoringTool #toolsNewWorkspace #toolsNewCanvas #toolsPalette #toolsCanvasTool #toolsMaskEditor #toolsMenuEditor nil #openExternalFinder #toggleSystemTranscript ) 
        ) decodeAsLiteralArray startUp
    "

    "submenus:
     #(#Menu #(
                #(#MenuItem 
                        #label: 'Foo' 
                        #submenu: #(#Menu #(
                                            #(#MenuItem #label: 'foo 1')     
                                            #(#MenuItem #label: 'foo 2')     
                                          )
                                          nil
                                          #(11 22)
                                   )     
                 ) 
                #(#MenuItem 
                        #label: 'Inspect' ) 
                #(#MenuItem 
                        #label: 'Coredump' ) 
              ) 
             #(3 ) 
             #(1 2 3 )
       ) decodeAsLiteralArray startUp  
    "

    "Modified: 20.6.1997 / 10:45:51 / cg"
!

literalArrayEncoding
    "return myself encoded as a literal array"

    |coll|

    coll := OrderedCollection new.
    coll add:#Menu.
    coll add:(items literalArrayEncoding).
    coll add:(groupSizes literalArrayEncoding).
    coll add:nil.
  ^ coll asArray
! !

!Menu methodsFor:'enumerating'!

allItemsDo:aOneArgBlock
    "evaluate block on each item and submenu items
    "
    self itemsDo:[:anItem|
        |sub|

        aOneArgBlock value:anItem.
        (sub := anItem submenu value) notNil ifTrue:[
            sub allItemsDo:aOneArgBlock
        ]
    ]

    "Modified: / 27.10.1997 / 15:09:08 / cg"
!

itemsDo:aOneArgBlock
    "evaluate the block for each item in the current menu
    "
    items notNil ifTrue:[items do:aOneArgBlock]
!

menuAndSubmenusDetectItem:aOneArgBlock
    "evaluate the block for each item in the current menu and all
     submenus. In case that the block returns a non nil argument,
     the item will be returned
    "
    |item|

    items notNil ifTrue:[
        items do:[:anItem|
            |sub|

            (aOneArgBlock value:anItem) ifTrue:[
                ^ anItem
            ].
            (sub := anItem submenu value) notNil ifTrue:[
                item := sub menuAndSubmenusDetectItem:aOneArgBlock.
                item notNil ifTrue:[
                    ^ item
                ]
            ]
        ]
    ].
    ^ nil

    "Modified: / 27.10.1997 / 15:09:43 / cg"
! !

!Menu methodsFor:'kludged fixes'!

destroy

    "Created: 28.7.1997 / 10:16:52 / cg"
! !

!Menu methodsFor:'menu items'!

someMenuItemWithValue:aValue
    "get the menu item assigned with the value; in case that the value
     is not found nil is returned
    "
    ^ self someMenuItemWithValue:aValue ifNone:nil
!

someMenuItemWithValue:aValue ifNone:exceptionBlock
    "get the menu item assigned with the value; in case that the value
     is not found, the given exceptionBlock is executed and returned
    "
    |item|

    item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue].

    item notNil ifTrue:[
        ^ item
    ].
  ^ exceptionBlock value
! !

!Menu methodsFor:'queries'!

hasHiddenItems
    "test whether any item is hidden"

    self allItemsDo:[:anItem|
        anItem isHidden ifTrue:[^ true]
    ].
    ^ false

    "Modified: / 27.10.1997 / 15:12:44 / cg"
!

hasSubMenuAt:anIndex
    "test whether the menu item at the given index has a submenu
    "
    ^ (self menuItemAt:anIndex) hasSubmenu
! !

!Menu methodsFor:'startup'!

show
    "realize the menu at its last position; returns the value associated with the
     selected item, 0 if none was selected"

    ^ (MenuPanel menu:self) show ? 0


!

showAt:aPoint
    "realize the menu at aPoint; returns the value associated with the
     selected item, 0 if none was selected"

    ^ self showAt:aPoint resizing:true


!

showAt:aPoint resizing:aBoolean
    "realize the menu at aPoint; returns the value associated with the
     selected item, 0 if none was selected"

    ^ (MenuPanel menu:self) showAt:aPoint resizing:aBoolean ? 0
!

showAtPointer
    "realize the menu at the current pointer position; returns the value associated with the
     selected item, 0 if none was selected"

    ^ self startUp
!

showCenteredIn:aView
    "realize the menu visible at the aView center; returns the value associated with the
     selected item, 0 if none was selected"

    ^ (MenuPanel menu:self) showCenteredIn:aView ? 0


!

startUp
    "display the menu as a popUp; returns the value associated with the
     selected item, 0 if none was selected"

    ^ (MenuPanel menu:self) startUp ? 0

"   
        |m|

        m := #(#Menu #(
                        #(#MenuItem 
                                #rawLabel: 'left' 
                                #value: #left ) 
                        #(#MenuItem 
                                #rawLabel: 'center' 
                                #value: #center ) 
                        #(#MenuItem 
                                #rawLabel: 'right' 
                                #value: #right ) ) 
                 #(2) 
                nil 
        ) decodeAsLiteralArray.

      Transcript showCR:(m startUp)        
"
! !

!Menu class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.22 1997-11-03 15:35:07 cg Exp $'
! !