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
        "Answer a menu with menu items 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)."

        | valueArray menuItems groupLengths |
        valueArrayOrNil isNil
                ifTrue: [valueArray := arrayOfString isEmpty
                                                ifTrue: [#()]
                                                ifFalse:        [1 to: arrayOfString size]]
                ifFalse: [valueArray := valueArrayOrNil].
        arrayOfString size ~= valueArray size
                ifTrue: [^self error: 'illegal menu combination'].

        menuItems := Array new: arrayOfString size.
        1 to: arrayOfString size 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: 20.6.1997 / 10:46:45 / 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:aGroup values:values
    groupSizes isNil ifTrue:[
        groupSizes := OrderedCollection new
    ].
    groupSizes add:items size.

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

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
    "Answer 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


!

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
!

menuItems
    ^ items
!

menuItems:aCollectionOfMenuItems menuItemGroups:sizes values:values
    |idx newItems nItems|

    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.!

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"
! !

!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'!

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
    "
    |sm item|

    items notNil ifTrue:[
        items do:[:anItem|
            (aOneArgBlock value:anItem) ifTrue:[
                ^ anItem
            ].
            (sm := anItem submenu) notNil ifTrue:[
                item := anItem submenu menuAndSubmenusDetectItem:aOneArgBlock.
                item notNil ifTrue:[
                    ^ item
                ]
            ]
        ]
    ].
  ^ nil
! !

!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'!

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

!Menu methodsFor:'startup'!

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

    |menu result|

    menu := MenuPanel menu:self.
    result := menu startUp.
  ^ result ? 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.14 1997-06-26 05:54:49 ca Exp $'
! !