Menu.st
author ca
Wed, 04 Jun 1997 13:12:25 +0200
changeset 589 cc422fe7824f
parent 584 9a4c30f7586f
child 610 72dbf392e888
permissions -rw-r--r--
ST-80 compatibility; enumerating & indication

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 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 groupsSizes:sizes values:values
    |idx newItems nItems|

    items := aCollectionOfMenuItems.
    groupSizes := sizes.

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

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 groupsSizes: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: 25.2.1997 / 21:05:06 / 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) notNil 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.12 1997-06-04 11:12:25 ca Exp $'
! !