Menu.st
author Claus Gittinger <cg@exept.de>
Thu, 21 May 1998 16:43:07 +0200
changeset 940 418cfd9b298d
parent 939 f6df8fbf6b4a
child 950 01920811b83b
permissions -rw-r--r--
checkin from browser
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
    "Created: / 21.5.1998 / 16:42:40 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   190
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   191
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   192
lines
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   193
    "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
   194
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   195
    |lines groupSz|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   196
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   197
    (groupSz := groupSizes size) <= 1 ifTrue: [^ Array new].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   198
    lines := Array new:(groupSz - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   199
    lines at:1 put:groupSizes first.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   200
    2 to:(groupSz-1) do:[:i |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   201
        lines at:i put:(lines at:(i - 1)) + (groupSizes at:i)
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   202
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   203
    ^ lines
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   204
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   205
    "Modified: / 2.2.1998 / 13:28:19 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   206
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   207
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   208
menuItemAt:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   209
    "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
   210
     nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   211
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   212
    (index > 0 and:[index <= items size]) ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   213
	^ items at:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   214
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   215
  ^ nil
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   216
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   217
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   218
menuItemLabeled:anItemLabel
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   219
    "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
   220
     Searches all items (i.e. also submenu items)"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   221
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   222
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   223
		|l|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   224
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   225
		((l := anItem label) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   226
		    ^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   227
		].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   228
		(l includes:$&) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   229
		    ((l copyWithout:$&) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   230
			^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   231
		    ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   232
		]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   233
	     ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   234
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   235
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   236
    "Created: / 13.9.1997 / 10:25:16 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   237
    "Modified: / 27.10.1997 / 15:23:33 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   238
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   239
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   240
menuItems
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   241
    ^ items
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   242
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   243
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   244
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
   245
    |n|
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   246
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
    items := aCollectionOfMenuItems.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   248
    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
   249
    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
   250
        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
   251
        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
   252
            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
   253
        ]
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   254
    ].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   256
    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
   257
        items with:values do:[:anItem :aValue |anItem value:aValue]
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   258
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   259
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   260
    "Modified: / 19.4.1998 / 11:47:34 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   263
numberOfItems
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   264
    "return the number of items in this menu"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   265
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   266
    ^ items size
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   267
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   268
    "Created: / 6.3.1997 / 15:15:53 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   269
    "Modified: / 2.2.1998 / 13:26:40 / cg"
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   270
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   271
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   272
receiver
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   273
    "return the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   274
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   275
    ^ receiver
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   276
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   277
    "Modified: / 2.2.1998 / 13:26:20 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   278
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   279
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   280
receiver:something
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   281
    "set the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   282
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   283
    receiver := something.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   284
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   285
    "Modified: / 2.2.1998 / 13:26:29 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   286
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   287
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
valueAt:index
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
    ^ (items at:index) value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
    "Created: 25.2.1997 / 19:49:41 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   296
valueAt:anIndex put:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   297
    "put value an an index"
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
    (items at:anIndex) value:aValue
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
    "Created: 6.3.1997 / 15:15:48 / cg"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   302
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   303
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
values
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
    ^ items collect:[:anItem | anItem value]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
    "Created: 25.2.1997 / 19:49:29 / cg"
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   310
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   311
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   312
values:aCollectionOfValues
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   313
    "return a collection of values from my items"
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|
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   316
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   317
    s := aCollectionOfValues readStream.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   318
    self itemsDo:[:item |
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   319
	|val|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   320
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   321
	val := s next.
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   322
	item value:val
724
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
    s atEnd ifFalse:[self halt]
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
    "Created: / 27.10.1997 / 15:15:47 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   327
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   328
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   329
visibleMenuItemGroups
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   330
    |itemGroups visibleItemGroups nextItem|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   331
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   332
    itemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   333
    nextItem := 1.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   334
    groupSizes do:[:groupSize |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   335
        itemGroups addLast: (items copyFrom:nextItem to:nextItem + groupSize - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   336
        nextItem := nextItem + groupSize
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   337
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   338
    self hasHiddenItems ifFalse:[^ itemGroups].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   339
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   340
    "Remove the hidden items."
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   341
    visibleItemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   342
    itemGroups do:[:eachItemGroup |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   343
        |visibleItemGroup|
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   344
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   345
        visibleItemGroup := eachItemGroup reject:[:eachMenuItem | eachMenuItem hidden].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   346
        visibleItemGroup isEmpty ifFalse:[
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   347
            visibleItemGroups addLast: visibleItemGroup
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   348
        ]
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   349
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   350
    ^ visibleItemGroups
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   351
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   352
    "Created: / 27.10.1997 / 15:07:50 / cg"
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   353
    "Modified: / 2.2.1998 / 13:25:52 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   354
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   355
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   356
!Menu methodsFor:'accessing resource'!
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   357
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   358
findGuiResourcesIn:aResourceContainerOrApplication
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   359
    "setup a resource owner
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   360
    "
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   361
    aResourceContainerOrApplication notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   362
	items notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   363
	    items do:[:anItem| anItem findGuiResourcesIn:aResourceContainerOrApplication ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   364
	]
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   365
    ]
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   366
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   367
! !
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   368
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   369
!Menu methodsFor:'adding & removing'!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   370
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   371
addItem:aMenuItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   372
    items isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   373
	items := OrderedCollection new
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
    items add:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   376
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   377
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   378
addItem:aMenuItem beforeIndex:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   379
    items isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   380
        items := OrderedCollection new
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
    items add:aMenuItem beforeIndex:anIndex.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   383
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   384
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   385
addItem:aMenuItem value:aValue
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   386
    aMenuItem value:aValue.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   387
    self addItem:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   388
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   389
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   390
addItemGroup:aCollectionOfItems
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   391
    groupSizes isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   392
	groupSizes := OrderedCollection new
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
    groupSizes add:aCollectionOfItems size.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   395
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   396
    aCollectionOfItems do:[:item |
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   397
	self addItem:item
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   398
    ].
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
    "Created: / 27.10.1997 / 15:02:15 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   401
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   402
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   403
addItemGroup:aGroup values:values
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   404
    groupSizes isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   405
	groupSizes := OrderedCollection new
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
    groupSizes add:items size.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   408
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   409
    aGroup with:values do:[:item :value |
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   410
	self addItem:item value:value
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
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   413
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   414
addItemGroupLabels:labels values:values
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   415
    |items|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   416
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   417
    items := labels with:values
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   418
		collect:[:label :value |
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   419
			    |item|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   420
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   421
			    item := MenuItem new.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   422
			    item label:label.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   423
			    item value:value.
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
    self addItemGroup:items
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
    "Created: / 27.10.1997 / 19:49:27 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   428
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   429
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   430
addItemLabel:label value:value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   431
    |item|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   432
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   433
    item := MenuItem new.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   434
    item label:label.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   435
    item value:value.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   436
    self addItem:item
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
    "Created: / 27.10.1997 / 19:47:12 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   439
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   440
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   441
removeItem:aMenuItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   442
    "remove an item from the menu"
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
    |idx|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   445
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   446
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   447
        idx := items identityIndexOf:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   448
        idx ~~ 0 ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   449
            items removeAtIndex:idx
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
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   452
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   453
    "Created: / 13.9.1997 / 10:27:31 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   454
    "Modified: / 2.2.1998 / 13:26:49 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   455
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   456
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   457
removeItemAt:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   458
    "remove item at an index
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   459
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   460
    anIndex <= items size ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   461
        ^ items removeAtIndex:anIndex
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
    ^ nil
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   464
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   465
    "Created: / 21.5.1998 / 16:42:41 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   466
! !
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   467
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
!Menu methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   472
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
    |items groups values|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
    items := (aLiteralEncodedArray at:2) collect:[:item | item decodeAsLiteralArray].
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   476
    groups := aLiteralEncodedArray at:3.
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   477
    values := aLiteralEncodedArray at:4.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   478
    self menuItems:items menuItemGroups:groups values:values.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
    "extract from PD folder.st:
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   482
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   483
			#rawLabel: 'left' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   484
			#value: #left ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   485
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   486
			#rawLabel: 'center' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   487
			#value: #center ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   488
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   489
			#rawLabel: 'right' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   490
			#value: #right ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   491
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   492
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   493
	     nil 
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
       ) decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
    "
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   496
    "
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   497
     #(#Menu #(
740
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: 'Straighten Up' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   500
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   501
			#label: 'Inspect' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   502
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   503
			#label: 'Coredump' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   504
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   505
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   506
	    #(#straightenUp #inspect #halt ) 
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   507
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   508
    "
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   509
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   510
    "extract from iconicBrowser.st:
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   511
     #(#Menu #(
740
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: 'Straighten Up' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   514
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   515
			#label: 'Inspect' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   516
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   517
			#label: 'Coredump' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   518
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   519
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   520
	     #(1 2 3 )
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   521
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   522
    "
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   524
    "extract from refactory213.st:
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   525
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   526
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   527
		    #label: 'File List' 
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: 'File Editor...' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   530
		    #accessCharacterPosition: 6 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   531
		#(#MenuItem #label: 'Refactoring Tool...' 
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: 'Workspace' 
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: 'New Canvas' 
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: 'Palette' 
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: 'Canvas Tool' 
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: 'Image Editor' 
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: 'Menu Editor' 
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: 'Advanced' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   546
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   547
		#(#MenuItem #label: 'DLL and C Connect' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   548
		    #accessCharacterPosition: 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   549
		#(#MenuItem #label: 'System Transcript' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   550
		    #accessCharacterPosition: 8 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   551
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   552
	      #(4 5 2 1 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   553
	      #(#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
   554
	) decodeAsLiteralArray startUp
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   555
    "
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   556
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   557
    "submenus:
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   558
     #(#Menu #(
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   559
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   560
			#label: 'Foo' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   561
			#submenu: #(#Menu #(
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   562
					    #(#MenuItem #label: 'foo 1')     
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   563
					    #(#MenuItem #label: 'foo 2')     
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
					  nil
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   566
					  #(11 22)
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   567
				   )     
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   568
		 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   569
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   570
			#label: 'Inspect' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   571
		#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   572
			#label: 'Coredump' ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   573
	      ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   574
	     #(3 ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   575
	     #(1 2 3 )
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   576
       ) decodeAsLiteralArray startUp  
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   577
    "
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   578
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   579
    "Modified: 20.6.1997 / 10:45:51 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   580
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   581
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   582
literalArrayEncoding
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   583
    "return myself encoded as a literal array"
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   584
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   585
    |coll|
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   586
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   587
    coll := OrderedCollection new.
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   588
    coll add:#Menu.
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   589
    coll add:(items literalArrayEncoding).
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   590
    coll add:(groupSizes literalArrayEncoding).
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   591
    coll add:nil.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   592
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   595
!Menu methodsFor:'enumerating'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   596
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   597
allItemsDo:aOneArgBlock
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   598
    "evaluate block on each item and submenu items
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   599
    "
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   600
    self itemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   601
	|sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   602
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   603
	aOneArgBlock value:anItem.
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   604
	(sub := anItem submenu value) notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   605
	    sub allItemsDo:aOneArgBlock
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   606
	]
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   607
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   608
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   609
    "Modified: / 27.10.1997 / 15:09:08 / cg"
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   610
!
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   611
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   612
detectItem:aBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   613
    "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
   614
     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
   615
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   616
     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
   617
     evaluation of the exceptionBlock
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
    ^ self detectItem:aBlock ifNone:[self errorNotFound]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   620
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   621
    "Created: / 21.5.1998 / 16:42:40 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   622
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   623
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   624
detectItem:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   625
    "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
   626
     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
   627
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   628
     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
   629
     evaluation of the exceptionBlock
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
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   632
        ^ items detect:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   633
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   634
    ^ exceptionBlock value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   635
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   636
    "Created: / 21.5.1998 / 16:42:40 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   637
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   638
589
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   639
itemsDo:aOneArgBlock
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   640
    "evaluate the block for each item in the current menu
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   641
    "
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   642
    items notNil ifTrue:[items do:aOneArgBlock]
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   643
!
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   644
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   645
menuAndSubmenusDetectItem:aOneArgBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   646
    "evaluate the block for each item in the current menu and all
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   647
     submenus. In case that the block returns a non nil argument,
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   648
     the item will be returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   649
    "
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   650
    |item|
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   651
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   652
    items notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   653
	items do:[:anItem|
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   654
	    |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   655
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   656
	    (aOneArgBlock value:anItem) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   657
		^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   658
	    ].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   659
	    (sub := anItem submenu value) notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   660
		item := sub menuAndSubmenusDetectItem:aOneArgBlock.
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   661
		item notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   662
		    ^ item
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   663
		]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   664
	    ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   665
	]
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   666
    ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   667
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   668
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   669
    "Modified: / 27.10.1997 / 15:09:43 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   670
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   671
672
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   672
!Menu methodsFor:'kludged fixes'!
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   673
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   674
destroy
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   675
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   676
    "Created: 28.7.1997 / 10:16:52 / cg"
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   677
! !
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   678
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   679
!Menu methodsFor:'menu items'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   680
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   681
someMenuItemLabeled:aLabel
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   682
    "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
   683
     is not found, nil is returned
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   684
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   685
    ^ self someMenuItemLabeled:aLabel ifNone:nil
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
    "Created: / 14.11.1997 / 20:55:17 / cg"
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
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   690
someMenuItemLabeled:aLabel ifNone:exceptionBlock
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   691
    "get the menu item labeled aLabel; in case that the value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   692
     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
   693
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   694
    |item|
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
    item := self menuAndSubmenusDetectItem:[:anItem| anItem label = aLabel].
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
    item notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   699
	^ item
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   700
    ].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   701
    ^ exceptionBlock value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   702
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   703
    "Created: / 14.11.1997 / 20:56:13 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   704
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   705
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   706
someMenuItemWithValue:aValue
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 nil is 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
    ^ self someMenuItemWithValue:aValue ifNone:nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   711
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   712
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   713
someMenuItemWithValue:aValue ifNone:exceptionBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   714
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   715
     is not found, the given exceptionBlock is executed and returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   716
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   717
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   718
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   719
    item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   720
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   721
    item notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   722
	^ item
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   723
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   724
  ^ exceptionBlock value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   725
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   726
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   727
!Menu methodsFor:'queries'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   728
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   729
hasHiddenItems
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   730
    "test whether any item is hidden"
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
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   733
	anItem isHidden ifTrue:[^ true]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   734
    ].
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   735
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   736
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   737
    "Modified: / 27.10.1997 / 15:12:44 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   738
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   739
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   740
hasSubMenuAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   741
    "test whether the menu item at the given index has a submenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   742
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   743
    ^ (self menuItemAt:anIndex) hasSubmenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   744
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   745
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
!Menu methodsFor:'startup'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   748
show
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   749
    "realize the menu at its last position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   750
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   751
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   752
    ^ (MenuPanel menu:self) show ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   753
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   754
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   755
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   756
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   757
showAt:aPoint
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   758
    "realize the menu at aPoint; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   759
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   760
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   761
    ^ self showAt:aPoint resizing:true
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   762
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   763
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   764
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   765
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   766
showAt:aPoint resizing:aBoolean
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   767
    "realize the menu at aPoint; returns the value associated with the
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
     selected item, 0 if none was selected"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   770
    ^ (MenuPanel menu:self) showAt:aPoint resizing:aBoolean ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   771
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   772
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   773
showAtPointer
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   774
    "realize the menu at the current pointer position; 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
    ^ self startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   778
!
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   779
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   780
showCenteredIn:aView
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   781
    "realize the menu visible at the aView center; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   782
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   783
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   784
    ^ (MenuPanel menu:self) showCenteredIn:aView ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   785
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   786
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   787
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   788
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   789
startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   790
    "display the menu as a popUp; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   791
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   792
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   793
    ^ (MenuPanel menu:self) startUp ? 0
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   795
"   
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   796
	|m|
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   797
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   798
	m := #(#Menu #(
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   799
			#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   800
				#rawLabel: 'left' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   801
				#value: #left ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   802
			#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   803
				#rawLabel: 'center' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   804
				#value: #center ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   805
			#(#MenuItem 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   806
				#rawLabel: 'right' 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   807
				#value: #right ) ) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   808
		 #(2) 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   809
		nil 
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   810
	) decodeAsLiteralArray.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   811
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   812
      Transcript showCR:(m startUp)        
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   813
"
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
startUpAt:aPoint
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   817
    "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
   818
     selected item, 0 if none was selected"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   819
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
   820
    ^ ((MenuPanel menu:self) startUpAt:aPoint) ? 0
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   821
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   822
"   
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   823
        |m|
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   824
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   825
        m := #(#Menu #(
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   826
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   827
                                #rawLabel: 'left' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   828
                                #value: #left ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   829
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   830
                                #rawLabel: 'center' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   831
                                #value: #center ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   832
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   833
                                #rawLabel: 'right' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   834
                                #value: #right ) ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   835
                 #(2) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   836
                nil 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   837
        ) decodeAsLiteralArray.
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   838
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   839
      Transcript showCR:(m startUpAt:100@100)        
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   840
"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   841
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   842
    "Created: / 21.5.1998 / 14:15:21 / cg"
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
   843
    "Modified: / 21.5.1998 / 14:17:46 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
version
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   849
    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.30 1998-05-21 14:43:07 cg Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
! !