Menu.st
author ca
Thu, 28 May 1998 15:23:08 +0200
changeset 950 01920811b83b
parent 940 418cfd9b298d
child 972 09bc0765dbc1
permissions -rw-r--r--
add detectItem: ... change category of adding and deleting items
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
Object subclass:#Menu
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
     2
	instanceVariableNames:'items groupSizes receiver'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	classVariableNames:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	poolDictionaries:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	category:'Views-Support'
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
documentation
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
    not yet finished Menu class - this will eventually replace
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
    most of the MenuView and PopUpMenu stuff.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
    (and hopefully be ST-80 compatible ...)
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
    For now, only a subset of the full protocol is implemented.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
    [author:]
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    19
	Claus Gittinger
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
    [see also:]
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    22
	MenuItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    23
	PopUpMenu
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    27
!Menu class methodsFor:'instance creation'!
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    28
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    29
labelArray: arrayOfString lines: linesArray values: valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    30
    "return a menu with menu items built with labels from arrayOfString (not Symbols).  
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    31
     The linesArray describes which menu items are the last menu item in their group. 
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    32
     The valueArray contains value objects for each menu item 
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    33
     (or is nil if no value objects are specified)."
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    34
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    35
    | nLabel valueArray menuItems groupLengths |
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    36
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    37
    nLabel := arrayOfString size.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    38
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    39
    valueArrayOrNil isNil ifTrue:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    40
        (valueArray := arrayOfString isEmpty) ifTrue: [
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    41
            valueArray := #()
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    42
        ] ifFalse:[
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    43
            valueArray := (1 to:nLabel)
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    44
        ]
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    45
    ] ifFalse:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    46
        valueArray := valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    47
    ].
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    48
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    49
    nLabel ~~ valueArray size ifTrue: [
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    50
        ^ self error: 'illegal menu combination'
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    51
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    52
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    53
    menuItems := Array new:nLabel.
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    54
    1 to:nLabel do:[:i |
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    55
        |mi v|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    56
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    57
        mi := MenuItem labeled: (arrayOfString at:i) asString.
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    58
        v := valueArray at: i.
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    59
        (v isKindOf: Menu) ifTrue: [mi submenu: v].
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    60
        menuItems at: i put: mi
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    61
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    62
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    63
    (linesArray == nil or:[linesArray isEmpty]) ifTrue:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    64
        groupLengths := (menuItems isEmpty)
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    65
                            ifTrue: [Array new: 0]
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    66
                            ifFalse: [Array with: menuItems size]
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    67
    ] ifFalse:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    68
        groupLengths := Array new: linesArray size + 1.
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    69
        groupLengths at: 1 put: linesArray first.
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    70
        2 to: linesArray size do: [:i | 
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    71
                groupLengths at: i put: (linesArray at: i) - (linesArray at: i - 1)
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    72
        ].
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    73
        groupLengths at: groupLengths size put: menuItems size - linesArray last.
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    74
    ].
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    75
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    76
    ^ self new 
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    77
        menuItems: menuItems 
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    78
        menuItemGroups: groupLengths 
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    79
        values: valueArray
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    80
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    81
    "Modified: / 19.4.1998 / 11:30:18 / cg"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    82
!
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    83
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    84
labelList:arrayOfGroupStrings values:valueArrayOrNil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    85
    |labels lines|
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    86
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    87
    lines := arrayOfGroupStrings collect:[:each | each size].
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    88
    labels := OrderedCollection new.
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    89
    arrayOfGroupStrings do:[:group | labels addAll:group].
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    90
    ^ self labelArray:labels lines:lines values:valueArrayOrNil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    91
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    92
    "Modified: 20.6.1997 / 10:46:45 / cg"
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
    93
    "Created: 13.9.1997 / 10:35:46 / cg"
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    94
!
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    95
738
f7e6b6cd3855 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
    96
labels:aString lines:linesArray values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    97
    ^ self 
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    98
	labelArray:(aString asCollectionOfLines)
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    99
	lines:linesArray
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   100
	values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   101
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   102
    "Created: / 31.10.1997 / 03:12:20 / cg"
738
f7e6b6cd3855 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   103
    "Modified: / 31.10.1997 / 03:23:42 / cg"
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   104
! !
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   105
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   106
!Menu methodsFor:'ST-80 compatibility'!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   107
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   108
indexOfMenuItem:anItem
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   109
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   110
    ^ items indexOf:anItem
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   111
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   112
    "Created: / 27.10.1997 / 16:34:19 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   113
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   114
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   115
menuButtons
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   116
    "ST-80 seems to use a special menuButton class here.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   117
     Here, kludge a collection of menuItems."
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   118
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   119
    ^ items
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   120
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   121
    "Created: / 27.10.1997 / 16:33:35 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   122
! !
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   123
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
!Menu methodsFor:'accessing'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   126
atNameKey:aNameKey
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   127
    "return the menuItem for the given nameKey; nil if no such item is in the menu.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   128
     Searches in allItems (i.e. also in subMenus)"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   129
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   130
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   131
	anItem nameKey == aNameKey ifTrue:[^ anItem]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   132
    ].
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   133
    ^ nil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   134
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   135
    "Modified: / 27.10.1997 / 15:12:00 / cg"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   136
!
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   137
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   138
groupSizes
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   139
    "return the value of the instance variable 'groupSizes' (automatically generated)"
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   140
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   141
    ^ groupSizes!
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   142
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   143
groupSizes:something
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   144
    "set the value of the instance variable 'groupSizes' (automatically generated)"
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   145
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   146
    groupSizes := something.!
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   147
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   148
labelAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   149
    "gets the label of the menu item at the given index or nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   150
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   151
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   152
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   153
    (item := self menuItemAt:anIndex) notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   154
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   155
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   156
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   157
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   158
    "Modified: / 2.2.1998 / 13:28:32 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   159
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   160
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   161
labelAtValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   162
    "gets the label of the menu item assigned to value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   163
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   164
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   165
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   166
    item := self menuAndSubmenusDetectItem:[:anItem | anItem value == aValue ].
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   167
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   168
    item notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   169
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   170
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   171
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   172
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   173
    "Modified: / 2.2.1998 / 13:28:28 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   174
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   175
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
labels
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
    "return a collection of labels from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
    ^ items collect:[:anItem | anItem label]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
    "Created: 25.2.1997 / 19:47:53 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   184
lastItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   185
    "returns last item
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   186
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   187
    ^ items notNil ifTrue:[items last] ifFalse:[nil]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   188
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   189
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   190
lines
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   191
    "return the indexes of the menu items that are the last menu item in their group (except the very last)."
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   192
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   193
    |lines groupSz|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   194
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   195
    (groupSz := groupSizes size) <= 1 ifTrue: [^ Array new].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   196
    lines := Array new:(groupSz - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   197
    lines at:1 put:groupSizes first.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   198
    2 to:(groupSz-1) do:[:i |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   199
        lines at:i put:(lines at:(i - 1)) + (groupSizes at:i)
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   200
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   201
    ^ lines
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   202
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   203
    "Modified: / 2.2.1998 / 13:28:19 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   204
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   205
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   206
menuItemAt:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   207
    "gets the menu item at the given index. When the index is out of bounds
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   208
     nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   209
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   210
    (index > 0 and:[index <= items size]) ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   211
	^ items at:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   212
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   213
  ^ nil
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   214
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   215
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   216
menuItemLabeled:anItemLabel
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   217
    "return the menuItem for the given nameKey; nil if no such item is in the menu.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   218
     Searches all items (i.e. also submenu items)"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   219
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   220
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   221
		|l|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   222
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   223
		((l := anItem label) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   224
		    ^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   225
		].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   226
		(l includes:$&) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   227
		    ((l copyWithout:$&) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   228
			^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   229
		    ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   230
		]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   231
	     ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   232
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   233
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   234
    "Created: / 13.9.1997 / 10:25:16 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   235
    "Modified: / 27.10.1997 / 15:23:33 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   236
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   237
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   238
menuItems
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   239
    ^ items
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   240
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   241
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   242
menuItems:aCollectionOfMenuItems menuItemGroups:sizes values:values
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   243
    |n|
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   244
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
    items := aCollectionOfMenuItems.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   246
    groupSizes := sizes.
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   247
    sizes size > 0 ifTrue:[
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   248
        n := sizes inject:0 into:[:sumSoFar :this | sumSoFar + this].
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   249
        n = items size ifTrue:[
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   250
            groupSizes := sizes copyWithoutLast:1
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   251
        ]
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   252
    ].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   254
    values notNil ifTrue:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   255
        items with:values do:[:anItem :aValue |anItem value:aValue]
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   256
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   257
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   258
    "Modified: / 19.4.1998 / 11:47:34 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   261
numberOfItems
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   262
    "return the number of items in this menu"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   263
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   264
    ^ items size
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   265
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   266
    "Created: / 6.3.1997 / 15:15:53 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   267
    "Modified: / 2.2.1998 / 13:26:40 / cg"
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   268
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   269
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   270
receiver
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   271
    "return the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   272
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   273
    ^ receiver
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   274
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   275
    "Modified: / 2.2.1998 / 13:26:20 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   276
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   277
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   278
receiver:something
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   279
    "set the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   280
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   281
    receiver := something.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   282
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   283
    "Modified: / 2.2.1998 / 13:26:29 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   284
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   285
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
valueAt:index
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
    ^ (items at:index) value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
    "Created: 25.2.1997 / 19:49:41 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   294
valueAt:anIndex put:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   295
    "put value an an index"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   296
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   297
    (items at:anIndex) value:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   298
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   299
    "Created: 6.3.1997 / 15:15:48 / cg"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   300
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   301
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
values
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
    ^ items collect:[:anItem | anItem value]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
    "Created: 25.2.1997 / 19:49:29 / cg"
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   308
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   309
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   310
values:aCollectionOfValues
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   311
    "return a collection of values from my items"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   312
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   313
    |s|
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   314
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   315
    s := aCollectionOfValues readStream.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   316
    self itemsDo:[:item |
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   317
	|val|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   318
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   319
	val := s next.
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   320
	item value:val
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   321
    ].
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   322
    s atEnd ifFalse:[self halt]
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   323
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   324
    "Created: / 27.10.1997 / 15:15:47 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   325
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   326
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   327
visibleMenuItemGroups
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   328
    |itemGroups visibleItemGroups nextItem|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   329
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   330
    itemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   331
    nextItem := 1.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   332
    groupSizes do:[:groupSize |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   333
        itemGroups addLast: (items copyFrom:nextItem to:nextItem + groupSize - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   334
        nextItem := nextItem + groupSize
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   335
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   336
    self hasHiddenItems ifFalse:[^ itemGroups].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   337
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   338
    "Remove the hidden items."
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   339
    visibleItemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   340
    itemGroups do:[:eachItemGroup |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   341
        |visibleItemGroup|
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   342
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   343
        visibleItemGroup := eachItemGroup reject:[:eachMenuItem | eachMenuItem hidden].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   344
        visibleItemGroup isEmpty ifFalse:[
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   345
            visibleItemGroups addLast: visibleItemGroup
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   346
        ]
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   347
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   348
    ^ visibleItemGroups
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   349
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   350
    "Created: / 27.10.1997 / 15:07:50 / cg"
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   351
    "Modified: / 2.2.1998 / 13:25:52 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   352
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   353
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   354
!Menu methodsFor:'accessing resource'!
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   355
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   356
findGuiResourcesIn:aResourceContainerOrApplication
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   357
    "setup a resource owner
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   358
    "
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   359
    aResourceContainerOrApplication notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   360
	items notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   361
	    items do:[:anItem| anItem findGuiResourcesIn:aResourceContainerOrApplication ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   362
	]
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   363
    ]
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   364
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   365
! !
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   366
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   367
!Menu methodsFor:'adding & removing'!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   368
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   369
addItem:aMenuItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   370
    items isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   371
	items := OrderedCollection new
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   372
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   373
    items add:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   374
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   375
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   376
addItem:aMenuItem beforeIndex:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   377
    items isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   378
        items := OrderedCollection new
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   379
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   380
    items add:aMenuItem beforeIndex:anIndex.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   381
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   382
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   383
addItem:aMenuItem value:aValue
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   384
    aMenuItem value:aValue.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   385
    self addItem:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   386
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   387
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   388
addItemGroup:aCollectionOfItems
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   389
    groupSizes isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   390
	groupSizes := OrderedCollection new
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   391
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   392
    groupSizes add:aCollectionOfItems size.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   393
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   394
    aCollectionOfItems do:[:item |
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   395
	self addItem:item
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   396
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   397
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   398
    "Created: / 27.10.1997 / 15:02:15 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   399
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   400
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   401
addItemGroup:aGroup values:values
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   402
    groupSizes isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   403
	groupSizes := OrderedCollection new
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   404
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   405
    groupSizes add:items size.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   406
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   407
    aGroup with:values do:[:item :value |
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   408
	self addItem:item value:value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   409
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   410
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   411
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   412
addItemGroupLabels:labels values:values
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   413
    |items|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   414
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   415
    items := labels with:values
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   416
		collect:[:label :value |
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   417
			    |item|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   418
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   419
			    item := MenuItem new.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   420
			    item label:label.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   421
			    item value:value.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   422
			].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   423
    self addItemGroup:items
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   424
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   425
    "Created: / 27.10.1997 / 19:49:27 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   426
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   427
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   428
addItemLabel:label value:value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   429
    |item|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   430
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   431
    item := MenuItem new.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   432
    item label:label.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   433
    item value:value.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   434
    self addItem:item
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   435
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   436
    "Created: / 27.10.1997 / 19:47:12 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   437
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   438
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   439
removeItem:aMenuItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   440
    "remove an item from the menu"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   441
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   442
    |idx|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   443
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   444
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   445
        idx := items identityIndexOf:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   446
        idx ~~ 0 ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   447
            items removeAtIndex:idx
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   448
        ]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   449
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   450
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   451
    "Created: / 13.9.1997 / 10:27:31 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   452
    "Modified: / 2.2.1998 / 13:26:49 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   453
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   454
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   455
removeItemAt:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   456
    "remove item at an index
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   457
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   458
    anIndex <= items size ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   459
        ^ items removeAtIndex:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   460
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   461
    ^ nil
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   462
! !
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   463
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
!Menu methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
    |items groups values|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
    items := (aLiteralEncodedArray at:2) collect:[:item | item decodeAsLiteralArray].
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   472
    groups := aLiteralEncodedArray at:3.
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   473
    values := aLiteralEncodedArray at:4.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   474
    self menuItems:items menuItemGroups:groups values:values.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   476
    "extract from PD folder.st:
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   477
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   478
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   479
			#rawLabel: 'left' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   480
			#value: #left ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   481
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   482
			#rawLabel: 'center' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   483
			#value: #center ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   484
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   485
			#rawLabel: 'right' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   486
			#value: #right ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   487
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   488
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   489
	     nil 
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
       ) decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
    "
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   492
    "
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   493
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   494
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   495
			#label: 'Straighten Up' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   496
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   497
			#label: 'Inspect' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   498
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   499
			#label: 'Coredump' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   500
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   501
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   502
	    #(#straightenUp #inspect #halt ) 
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   503
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   504
    "
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   505
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   506
    "extract from iconicBrowser.st:
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   507
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   508
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   509
			#label: 'Straighten Up' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   510
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   511
			#label: 'Inspect' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   512
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   513
			#label: 'Coredump' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   514
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   515
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   516
	     #(1 2 3 )
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   517
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   518
    "
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   520
    "extract from refactory213.st:
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   521
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   522
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   523
		    #label: 'File List' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   524
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   525
		#(#MenuItem #label: 'File Editor...' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   526
		    #accessCharacterPosition: 6 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   527
		#(#MenuItem #label: 'Refactoring Tool...' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   528
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   529
		#(#MenuItem #label: 'Workspace' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   530
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   531
		#(#MenuItem #label: 'New Canvas' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   532
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   533
		#(#MenuItem #label: 'Palette' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   534
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   535
		#(#MenuItem #label: 'Canvas Tool' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   536
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   537
		#(#MenuItem #label: 'Image Editor' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   538
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   539
		#(#MenuItem #label: 'Menu Editor' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   540
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   541
		#(#MenuItem #label: 'Advanced' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   542
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   543
		#(#MenuItem #label: 'DLL and C Connect' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   544
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   545
		#(#MenuItem #label: 'System Transcript' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   546
		    #accessCharacterPosition: 8 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   547
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   548
	      #(4 5 2 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   549
	      #(#openFileList #openFileEditor #openRefactoringTool #toolsNewWorkspace #toolsNewCanvas #toolsPalette #toolsCanvasTool #toolsMaskEditor #toolsMenuEditor nil #openExternalFinder #toggleSystemTranscript ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   550
	) decodeAsLiteralArray startUp
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   551
    "
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   552
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   553
    "submenus:
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   554
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   555
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   556
			#label: 'Foo' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   557
			#submenu: #(#Menu #(
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   558
					    #(#MenuItem #label: 'foo 1')     
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   559
					    #(#MenuItem #label: 'foo 2')     
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   560
					  )
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   561
					  nil
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   562
					  #(11 22)
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   563
				   )     
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   564
		 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   565
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   566
			#label: 'Inspect' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   567
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   568
			#label: 'Coredump' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   569
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   570
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   571
	     #(1 2 3 )
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   572
       ) decodeAsLiteralArray startUp  
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   573
    "
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   574
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   575
    "Modified: 20.6.1997 / 10:45:51 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   576
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   577
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   578
literalArrayEncoding
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   579
    "return myself encoded as a literal array"
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   580
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   581
    |coll|
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   582
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   583
    coll := OrderedCollection new.
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   584
    coll add:#Menu.
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   585
    coll add:(items literalArrayEncoding).
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   586
    coll add:(groupSizes literalArrayEncoding).
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   587
    coll add:nil.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   588
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   590
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   591
!Menu methodsFor:'enumerating'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   592
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   593
allItemsDo:aOneArgBlock
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   594
    "evaluate block on each item and submenu items
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   595
    "
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   596
    self itemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   597
	|sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   598
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   599
	aOneArgBlock value:anItem.
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   600
	(sub := anItem submenu value) notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   601
	    sub allItemsDo:aOneArgBlock
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   602
	]
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   603
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   604
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   605
    "Modified: / 27.10.1997 / 15:09:08 / cg"
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   606
!
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   607
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   608
detectItem:aBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   609
    "evaluate the argument, aBlock for each item in the menu until the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   610
     block returns true; in this case return the item which caused the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   611
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   612
     If none of the evaluations returns true, return the result of the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   613
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   614
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   615
    ^ self detectItem:aBlock ifNone:[self errorNotFound]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   616
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   617
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   618
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   619
detectItem:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   620
    "evaluate the argument, aBlock for each item in the menu until the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   621
     block returns true; in this case return the item which caused the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   622
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   623
     If none of the evaluations returns true, return the result of the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   624
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   625
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   626
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   627
        ^ items detect:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   628
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   629
    ^ exceptionBlock value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   630
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   631
589
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   632
itemsDo:aOneArgBlock
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   633
    "evaluate the block for each item in the current menu
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   634
    "
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   635
    items notNil ifTrue:[items do:aOneArgBlock]
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   636
!
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   637
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   638
menuAndSubmenusDetectItem:aOneArgBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   639
    "evaluate the block for each item in the current menu and all
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   640
     submenus. In case that the block returns a non nil argument,
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   641
     the item will be returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   642
    "
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   643
    |item|
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   644
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   645
    items notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   646
	items do:[:anItem|
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   647
	    |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   648
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   649
	    (aOneArgBlock value:anItem) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   650
		^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   651
	    ].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   652
	    (sub := anItem submenu value) notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   653
		item := sub menuAndSubmenusDetectItem:aOneArgBlock.
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   654
		item notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   655
		    ^ item
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   656
		]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   657
	    ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   658
	]
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   659
    ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   660
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   661
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   662
    "Modified: / 27.10.1997 / 15:09:43 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   663
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   664
672
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   665
!Menu methodsFor:'kludged fixes'!
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   666
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   667
destroy
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   668
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   669
    "Created: 28.7.1997 / 10:16:52 / cg"
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   670
! !
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   671
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   672
!Menu methodsFor:'menu items'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   673
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   674
someMenuItemLabeled:aLabel
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   675
    "get the menu item with that label; in case that the label
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   676
     is not found, nil is returned
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   677
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   678
    ^ self someMenuItemLabeled:aLabel ifNone:nil
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   679
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   680
    "Created: / 14.11.1997 / 20:55:17 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   681
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   682
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   683
someMenuItemLabeled:aLabel ifNone:exceptionBlock
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   684
    "get the menu item labeled aLabel; in case that the value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   685
     is not found, the given exceptionBlock is executed and its value returned
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   686
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   687
    |item|
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   688
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   689
    item := self menuAndSubmenusDetectItem:[:anItem| anItem label = aLabel].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   690
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   691
    item notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   692
	^ item
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   693
    ].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   694
    ^ exceptionBlock value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   695
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   696
    "Created: / 14.11.1997 / 20:56:13 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   697
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   698
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   699
someMenuItemWithValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   700
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   701
     is not found nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   702
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   703
    ^ self someMenuItemWithValue:aValue ifNone:nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   704
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   705
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   706
someMenuItemWithValue:aValue ifNone:exceptionBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   707
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   708
     is not found, the given exceptionBlock is executed and returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   709
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   710
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   711
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   712
    item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   713
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   714
    item notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   715
	^ item
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   716
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   717
  ^ exceptionBlock value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   718
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   719
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   720
!Menu methodsFor:'queries'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   721
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   722
hasHiddenItems
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   723
    "test whether any item is hidden"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   725
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   726
	anItem isHidden ifTrue:[^ true]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   727
    ].
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   728
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   729
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   730
    "Modified: / 27.10.1997 / 15:12:44 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   731
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   732
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   733
hasSubMenuAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   734
    "test whether the menu item at the given index has a submenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   735
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   736
    ^ (self menuItemAt:anIndex) hasSubmenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   737
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   738
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
!Menu methodsFor:'startup'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   741
show
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   742
    "realize the menu at its last position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   743
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   744
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   745
    ^ (MenuPanel menu:self) show ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   746
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   747
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   748
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   749
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   750
showAt:aPoint
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   751
    "realize the menu at aPoint; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   752
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   753
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   754
    ^ self showAt:aPoint resizing:true
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   755
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   756
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   757
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   758
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   759
showAt:aPoint resizing:aBoolean
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   760
    "realize the menu at aPoint; returns the value associated with the
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
     selected item, 0 if none was selected"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   763
    ^ (MenuPanel menu:self) showAt:aPoint resizing:aBoolean ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   764
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   765
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   766
showAtPointer
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   767
    "realize the menu at the current pointer position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   768
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   769
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   770
    ^ self startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   771
!
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   772
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   773
showCenteredIn:aView
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   774
    "realize the menu visible at the aView center; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   775
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   776
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   777
    ^ (MenuPanel menu:self) showCenteredIn:aView ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   778
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   779
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   780
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   781
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   782
startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   783
    "display the menu as a popUp; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   784
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   785
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   786
    ^ (MenuPanel menu:self) startUp ? 0
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   788
"   
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   789
	|m|
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   790
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   791
	m := #(#Menu #(
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   792
			#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   793
				#rawLabel: 'left' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   794
				#value: #left ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   795
			#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   796
				#rawLabel: 'center' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   797
				#value: #center ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   798
			#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   799
				#rawLabel: 'right' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   800
				#value: #right ) ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   801
		 #(2) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   802
		nil 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   803
	) decodeAsLiteralArray.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   804
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   805
      Transcript showCR:(m startUp)        
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   806
"
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   807
!
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   808
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   809
startUpAt:aPoint
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   810
    "display the menu as a popUp at aPoint; returns the value associated with the
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   811
     selected item, 0 if none was selected"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   812
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
   813
    ^ ((MenuPanel menu:self) startUpAt:aPoint) ? 0
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   814
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   815
"   
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   816
        |m|
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   817
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   818
        m := #(#Menu #(
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   819
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   820
                                #rawLabel: 'left' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   821
                                #value: #left ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   822
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   823
                                #rawLabel: 'center' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   824
                                #value: #center ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   825
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   826
                                #rawLabel: 'right' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   827
                                #value: #right ) ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   828
                 #(2) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   829
                nil 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   830
        ) decodeAsLiteralArray.
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   831
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   832
      Transcript showCR:(m startUpAt:100@100)        
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   833
"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   834
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   835
    "Created: / 21.5.1998 / 14:15:21 / cg"
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
   836
    "Modified: / 21.5.1998 / 14:17:46 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   840
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
version
950
01920811b83b add detectItem: ...
ca
parents: 940
diff changeset
   842
    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.31 1998-05-28 13:23:08 ca Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
! !