Menu.st
changeset 740 4f45cc61d4e0
parent 739 3a1354a9f3a2
child 759 405baa7e92d4
--- a/Menu.st	Wed Nov 12 22:26:53 1997 +0100
+++ b/Menu.st	Sat Nov 15 15:22:24 1997 +0100
@@ -16,11 +16,11 @@
     For now, only a subset of the full protocol is implemented.
 
     [author:]
-        Claus Gittinger
+	Claus Gittinger
 
     [see also:]
-        MenuItem
-        PopUpMenu
+	MenuItem
+	PopUpMenu
 "
 ! !
 
@@ -37,46 +37,46 @@
     nLabel := arrayOfString size.
 
     valueArrayOrNil isNil ifTrue:[
-        (valueArray := arrayOfString isEmpty) ifTrue: [
-            valueArray := #()
-        ] ifFalse:[
-            valueArray := (1 to:nLabel)
-        ]
+	(valueArray := arrayOfString isEmpty) ifTrue: [
+	    valueArray := #()
+	] ifFalse:[
+	    valueArray := (1 to:nLabel)
+	]
     ] ifFalse:[
-        valueArray := valueArrayOrNil
+	valueArray := valueArrayOrNil
     ].
 
     nLabel ~~ valueArray size ifTrue: [
-        ^ self error: 'illegal menu combination'
+	^ self error: 'illegal menu combination'
     ].
 
     menuItems := Array new:nLabel.
     1 to:nLabel do:[:i |
-        |mi v|
+	|mi v|
 
-        mi := MenuItem labeled: (arrayOfString at:i) asString.
-        v := valueArray at: i.
-        (v isKindOf: Menu) ifTrue: [mi submenu: v].
-        menuItems at: i put: mi
+	mi := MenuItem labeled: (arrayOfString at:i) asString.
+	v := valueArray at: i.
+	(v isKindOf: Menu) ifTrue: [mi submenu: v].
+	menuItems at: i put: mi
     ].
 
     (linesArray == nil or:[linesArray isEmpty]) ifTrue:[
-        groupLengths := (menuItems isEmpty)
-                            ifTrue: [Array new: 0]
-                            ifFalse: [Array with: menuItems size]
+	groupLengths := (menuItems isEmpty)
+			    ifTrue: [Array new: 0]
+			    ifFalse: [Array with: menuItems size]
     ] ifFalse:[
-        groupLengths := Array new: linesArray size + 1.
-        groupLengths at: 1 put: linesArray first.
-        2 to: linesArray size do: [:i | 
-                groupLengths at: i put: (linesArray at: i) - (linesArray at: i - 1)
-        ].
-        groupLengths at: groupLengths size put: menuItems size - linesArray last
+	groupLengths := Array new: linesArray size + 1.
+	groupLengths at: 1 put: linesArray first.
+	2 to: linesArray size do: [:i | 
+		groupLengths at: i put: (linesArray at: i) - (linesArray at: i - 1)
+	].
+	groupLengths at: groupLengths size put: menuItems size - linesArray last
     ].
 
     ^ self new 
-        menuItems: menuItems 
-        menuItemGroups: groupLengths 
-        values: valueArray
+	menuItems: menuItems 
+	menuItemGroups: groupLengths 
+	values: valueArray
 
     "Modified: / 31.10.1997 / 03:19:14 / cg"
 !
@@ -95,9 +95,9 @@
 
 labels:aString lines:linesArray values:valueArrayOrNil
     ^ self 
-        labelArray:(aString asCollectionOfLines)
-        lines:linesArray
-        values:valueArrayOrNil
+	labelArray:(aString asCollectionOfLines)
+	lines:linesArray
+	values:valueArrayOrNil
 
     "Created: / 31.10.1997 / 03:12:20 / cg"
     "Modified: / 31.10.1997 / 03:23:42 / cg"
@@ -125,7 +125,7 @@
 
 addItem:aMenuItem
     items isNil ifTrue:[
-        items := OrderedCollection new
+	items := OrderedCollection new
     ].
     items add:aMenuItem.
 !
@@ -137,12 +137,12 @@
 
 addItemGroup:aCollectionOfItems
     groupSizes isNil ifTrue:[
-        groupSizes := OrderedCollection new
+	groupSizes := OrderedCollection new
     ].
     groupSizes add:aCollectionOfItems size.
 
     aCollectionOfItems do:[:item |
-        self addItem:item
+	self addItem:item
     ].
 
     "Created: / 27.10.1997 / 15:02:15 / cg"
@@ -150,12 +150,12 @@
 
 addItemGroup:aGroup values:values
     groupSizes isNil ifTrue:[
-        groupSizes := OrderedCollection new
+	groupSizes := OrderedCollection new
     ].
     groupSizes add:items size.
 
     aGroup with:values do:[:item :value |
-        self addItem:item value:value
+	self addItem:item value:value
     ].
 !
 
@@ -163,13 +163,13 @@
     |items|
 
     items := labels with:values
-                collect:[:label :value |
-                            |item|
+		collect:[:label :value |
+			    |item|
 
-                            item := MenuItem new.
-                            item label:label.
-                            item value:value.
-                        ].
+			    item := MenuItem new.
+			    item label:label.
+			    item value:value.
+			].
     self addItemGroup:items
 
     "Created: / 27.10.1997 / 19:49:27 / cg"
@@ -191,7 +191,7 @@
      Searches in allItems (i.e. also in subMenus)"
 
     self allItemsDo:[:anItem|
-        anItem nameKey == aNameKey ifTrue:[^ anItem]
+	anItem nameKey == aNameKey ifTrue:[^ anItem]
     ].
     ^ nil
 
@@ -214,7 +214,7 @@
     |item|
 
     (item := self menuItemAt:anIndex) notNil ifTrue:[
-        ^ item label
+	^ item label
     ].
   ^ nil
 
@@ -228,7 +228,7 @@
     item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue ].
 
     item notNil ifTrue:[
-        ^ item label
+	^ item label
     ].
   ^ nil
 
@@ -251,8 +251,8 @@
     lines := Array new: groupSizes size - 1.
     lines at: 1 put: groupSizes first.
     2 to: groupSizes size -1 do: 
-            [:i |
-            lines at: i put: (lines at: i - 1) + (groupSizes at: i)].
+	    [:i |
+	    lines at: i put: (lines at: i - 1) + (groupSizes at: i)].
     ^lines
 
     "Modified: / 31.10.1997 / 03:19:51 / cg"
@@ -263,7 +263,7 @@
      nil is returned
     "
     (index > 0 and:[index <= items size]) ifTrue:[
-        ^ items at:index
+	^ items at:index
     ].
   ^ nil
 !
@@ -273,17 +273,17 @@
      Searches all items (i.e. also submenu items)"
 
     self allItemsDo:[:anItem|
-                |l|
+		|l|
 
-                ((l := anItem label) sameAs: anItemLabel) ifTrue:[
-                    ^ anItem
-                ].
-                (l includes:$&) ifTrue:[
-                    ((l copyWithout:$&) sameAs: anItemLabel) ifTrue:[
-                        ^ anItem
-                    ]
-                ]
-             ].
+		((l := anItem label) sameAs: anItemLabel) ifTrue:[
+		    ^ anItem
+		].
+		(l includes:$&) ifTrue:[
+		    ((l copyWithout:$&) sameAs: anItemLabel) ifTrue:[
+			^ anItem
+		    ]
+		]
+	     ].
     ^ nil
 
     "Created: / 13.9.1997 / 10:25:16 / cg"
@@ -299,7 +299,7 @@
     groupSizes := sizes.
 
     values notNil ifTrue:[
-        items with:values do:[:anItem :aValue |anItem value:aValue]
+	items with:values do:[:anItem :aValue |anItem value:aValue]
     ].
 
     "Modified: 20.6.1997 / 10:45:30 / cg"
@@ -324,10 +324,10 @@
 removeItem:aMenuItem
     |idx|
     items notNil ifTrue:[
-        idx := items identityIndexOf:aMenuItem.
-        idx ~~ 0 ifTrue:[
-            items removeAtIndex:idx
-        ]
+	idx := items identityIndexOf:aMenuItem.
+	idx ~~ 0 ifTrue:[
+	    items removeAtIndex:idx
+	]
     ].
 
     "Created: 13.9.1997 / 10:27:31 / cg"
@@ -364,10 +364,10 @@
 
     s := aCollectionOfValues readStream.
     self itemsDo:[:item |
-        |val|
+	|val|
 
-        val := s next.
-        item value:val
+	val := s next.
+	item value:val
     ].
     s atEnd ifFalse:[self halt]
 
@@ -375,24 +375,24 @@
 !
 
 visibleMenuItemGroups
-        | itemGroups visibleItemGroups nextItem |
+	| itemGroups visibleItemGroups nextItem |
 
-        itemGroups := OrderedCollection new.
-        nextItem := 1.
-        groupSizes do: [:groupSize |
-                itemGroups addLast: (items copyFrom: nextItem to: nextItem + groupSize - 1).
-                nextItem := nextItem + groupSize].
-        self hasHiddenItems ifFalse: [^itemGroups].
+	itemGroups := OrderedCollection new.
+	nextItem := 1.
+	groupSizes do: [:groupSize |
+		itemGroups addLast: (items copyFrom: nextItem to: nextItem + groupSize - 1).
+		nextItem := nextItem + groupSize].
+	self hasHiddenItems ifFalse: [^itemGroups].
 
-        "Remove the hidden items."
-        visibleItemGroups := OrderedCollection new.
-        itemGroups do: [:eachItemGroup |
-                | visibleItemGroup |
-                visibleItemGroup := eachItemGroup reject:
-                                        [:eachMenuItem | eachMenuItem hidden].
-                visibleItemGroup isEmpty ifFalse: [
-                        visibleItemGroups addLast: visibleItemGroup]].
-        ^visibleItemGroups
+	"Remove the hidden items."
+	visibleItemGroups := OrderedCollection new.
+	itemGroups do: [:eachItemGroup |
+		| visibleItemGroup |
+		visibleItemGroup := eachItemGroup reject:
+					[:eachMenuItem | eachMenuItem hidden].
+		visibleItemGroup isEmpty ifFalse: [
+			visibleItemGroups addLast: visibleItemGroup]].
+	^visibleItemGroups
 
     "Created: / 27.10.1997 / 15:07:50 / cg"
 ! !
@@ -403,9 +403,9 @@
     "setup a resource owner
     "
     aResourceContainerOrApplication notNil ifTrue:[
-        items notNil ifTrue:[
-            items do:[:anItem| anItem findGuiResourcesIn:aResourceContainerOrApplication ]
-        ]
+	items notNil ifTrue:[
+	    items do:[:anItem| anItem findGuiResourcesIn:aResourceContainerOrApplication ]
+	]
     ]
 
 ! !
@@ -424,100 +424,100 @@
 
     "extract from PD folder.st:
      #(#Menu #(
-                #(#MenuItem 
-                        #rawLabel: 'left' 
-                        #value: #left ) 
-                #(#MenuItem 
-                        #rawLabel: 'center' 
-                        #value: #center ) 
-                #(#MenuItem 
-                        #rawLabel: 'right' 
-                        #value: #right ) 
-              ) 
-             #(3 ) 
-             nil 
+		#(#MenuItem 
+			#rawLabel: 'left' 
+			#value: #left ) 
+		#(#MenuItem 
+			#rawLabel: 'center' 
+			#value: #center ) 
+		#(#MenuItem 
+			#rawLabel: 'right' 
+			#value: #right ) 
+	      ) 
+	     #(3 ) 
+	     nil 
        ) decodeAsLiteralArray
     "
     "
      #(#Menu #(
-                #(#MenuItem 
-                        #label: 'Straighten Up' ) 
-                #(#MenuItem 
-                        #label: 'Inspect' ) 
-                #(#MenuItem 
-                        #label: 'Coredump' ) 
-              ) 
-             #(3 ) 
-            #(#straightenUp #inspect #halt ) 
+		#(#MenuItem 
+			#label: 'Straighten Up' ) 
+		#(#MenuItem 
+			#label: 'Inspect' ) 
+		#(#MenuItem 
+			#label: 'Coredump' ) 
+	      ) 
+	     #(3 ) 
+	    #(#straightenUp #inspect #halt ) 
        ) decodeAsLiteralArray startUp  
     "
 
     "extract from iconicBrowser.st:
      #(#Menu #(
-                #(#MenuItem 
-                        #label: 'Straighten Up' ) 
-                #(#MenuItem 
-                        #label: 'Inspect' ) 
-                #(#MenuItem 
-                        #label: 'Coredump' ) 
-              ) 
-             #(3 ) 
-             #(1 2 3 )
+		#(#MenuItem 
+			#label: 'Straighten Up' ) 
+		#(#MenuItem 
+			#label: 'Inspect' ) 
+		#(#MenuItem 
+			#label: 'Coredump' ) 
+	      ) 
+	     #(3 ) 
+	     #(1 2 3 )
        ) decodeAsLiteralArray startUp  
     "
 
     "extract from refactory213.st:
      #(#Menu #(
-                #(#MenuItem 
-                    #label: 'File List' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'File Editor...' 
-                    #accessCharacterPosition: 6 ) 
-                #(#MenuItem #label: 'Refactoring Tool...' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'Workspace' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'New Canvas' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'Palette' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'Canvas Tool' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'Image Editor' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'Menu Editor' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'Advanced' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'DLL and C Connect' 
-                    #accessCharacterPosition: 1 ) 
-                #(#MenuItem #label: 'System Transcript' 
-                    #accessCharacterPosition: 8 ) 
-              ) 
-              #(4 5 2 1 ) 
-              #(#openFileList #openFileEditor #openRefactoringTool #toolsNewWorkspace #toolsNewCanvas #toolsPalette #toolsCanvasTool #toolsMaskEditor #toolsMenuEditor nil #openExternalFinder #toggleSystemTranscript ) 
-        ) decodeAsLiteralArray startUp
+		#(#MenuItem 
+		    #label: 'File List' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'File Editor...' 
+		    #accessCharacterPosition: 6 ) 
+		#(#MenuItem #label: 'Refactoring Tool...' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'Workspace' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'New Canvas' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'Palette' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'Canvas Tool' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'Image Editor' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'Menu Editor' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'Advanced' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'DLL and C Connect' 
+		    #accessCharacterPosition: 1 ) 
+		#(#MenuItem #label: 'System Transcript' 
+		    #accessCharacterPosition: 8 ) 
+	      ) 
+	      #(4 5 2 1 ) 
+	      #(#openFileList #openFileEditor #openRefactoringTool #toolsNewWorkspace #toolsNewCanvas #toolsPalette #toolsCanvasTool #toolsMaskEditor #toolsMenuEditor nil #openExternalFinder #toggleSystemTranscript ) 
+	) decodeAsLiteralArray startUp
     "
 
     "submenus:
      #(#Menu #(
-                #(#MenuItem 
-                        #label: 'Foo' 
-                        #submenu: #(#Menu #(
-                                            #(#MenuItem #label: 'foo 1')     
-                                            #(#MenuItem #label: 'foo 2')     
-                                          )
-                                          nil
-                                          #(11 22)
-                                   )     
-                 ) 
-                #(#MenuItem 
-                        #label: 'Inspect' ) 
-                #(#MenuItem 
-                        #label: 'Coredump' ) 
-              ) 
-             #(3 ) 
-             #(1 2 3 )
+		#(#MenuItem 
+			#label: 'Foo' 
+			#submenu: #(#Menu #(
+					    #(#MenuItem #label: 'foo 1')     
+					    #(#MenuItem #label: 'foo 2')     
+					  )
+					  nil
+					  #(11 22)
+				   )     
+		 ) 
+		#(#MenuItem 
+			#label: 'Inspect' ) 
+		#(#MenuItem 
+			#label: 'Coredump' ) 
+	      ) 
+	     #(3 ) 
+	     #(1 2 3 )
        ) decodeAsLiteralArray startUp  
     "
 
@@ -543,12 +543,12 @@
     "evaluate block on each item and submenu items
     "
     self itemsDo:[:anItem|
-        |sub|
+	|sub|
 
-        aOneArgBlock value:anItem.
-        (sub := anItem submenu value) notNil ifTrue:[
-            sub allItemsDo:aOneArgBlock
-        ]
+	aOneArgBlock value:anItem.
+	(sub := anItem submenu value) notNil ifTrue:[
+	    sub allItemsDo:aOneArgBlock
+	]
     ]
 
     "Modified: / 27.10.1997 / 15:09:08 / cg"
@@ -568,19 +568,19 @@
     |item|
 
     items notNil ifTrue:[
-        items do:[:anItem|
-            |sub|
+	items do:[:anItem|
+	    |sub|
 
-            (aOneArgBlock value:anItem) ifTrue:[
-                ^ anItem
-            ].
-            (sub := anItem submenu value) notNil ifTrue:[
-                item := sub menuAndSubmenusDetectItem:aOneArgBlock.
-                item notNil ifTrue:[
-                    ^ item
-                ]
-            ]
-        ]
+	    (aOneArgBlock value:anItem) ifTrue:[
+		^ anItem
+	    ].
+	    (sub := anItem submenu value) notNil ifTrue:[
+		item := sub menuAndSubmenusDetectItem:aOneArgBlock.
+		item notNil ifTrue:[
+		    ^ item
+		]
+	    ]
+	]
     ].
     ^ nil
 
@@ -596,6 +596,31 @@
 
 !Menu methodsFor:'menu items'!
 
+someMenuItemLabeled:aLabel
+    "get the menu item with that label; in case that the label
+     is not found, nil is returned
+    "
+    ^ self someMenuItemLabeled:aLabel ifNone:nil
+
+    "Created: / 14.11.1997 / 20:55:17 / cg"
+!
+
+someMenuItemLabeled:aLabel ifNone:exceptionBlock
+    "get the menu item labeled aLabel; in case that the value
+     is not found, the given exceptionBlock is executed and its value returned
+    "
+    |item|
+
+    item := self menuAndSubmenusDetectItem:[:anItem| anItem label = aLabel].
+
+    item notNil ifTrue:[
+	^ item
+    ].
+    ^ exceptionBlock value
+
+    "Created: / 14.11.1997 / 20:56:13 / cg"
+!
+
 someMenuItemWithValue:aValue
     "get the menu item assigned with the value; in case that the value
      is not found nil is returned
@@ -612,7 +637,7 @@
     item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue].
 
     item notNil ifTrue:[
-        ^ item
+	^ item
     ].
   ^ exceptionBlock value
 ! !
@@ -623,7 +648,7 @@
     "test whether any item is hidden"
 
     self allItemsDo:[:anItem|
-        anItem isHidden ifTrue:[^ true]
+	anItem isHidden ifTrue:[^ true]
     ].
     ^ false
 
@@ -686,21 +711,21 @@
     ^ (MenuPanel menu:self) startUp ? 0
 
 "   
-        |m|
+	|m|
 
-        m := #(#Menu #(
-                        #(#MenuItem 
-                                #rawLabel: 'left' 
-                                #value: #left ) 
-                        #(#MenuItem 
-                                #rawLabel: 'center' 
-                                #value: #center ) 
-                        #(#MenuItem 
-                                #rawLabel: 'right' 
-                                #value: #right ) ) 
-                 #(2) 
-                nil 
-        ) decodeAsLiteralArray.
+	m := #(#Menu #(
+			#(#MenuItem 
+				#rawLabel: 'left' 
+				#value: #left ) 
+			#(#MenuItem 
+				#rawLabel: 'center' 
+				#value: #center ) 
+			#(#MenuItem 
+				#rawLabel: 'right' 
+				#value: #right ) ) 
+		 #(2) 
+		nil 
+	) decodeAsLiteralArray.
 
       Transcript showCR:(m startUp)        
 "
@@ -709,5 +734,5 @@
 !Menu class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.23 1997-11-12 21:26:53 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.24 1997-11-15 14:22:24 cg Exp $'
 ! !