--- a/MenuEditor.st Thu Jul 17 12:02:57 1997 +0200
+++ b/MenuEditor.st Thu Jul 17 12:05:00 1997 +0200
@@ -13,25 +13,25 @@
ApplicationModel subclass:#MenuEditor
- instanceVariableNames:'specClass tabSelection aspects slices'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-UIPainter'
+ instanceVariableNames:'specClass tabSelection aspects slices activeHelpTool'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-UIPainter'
!
Object subclass:#Item
- instanceVariableNames:'activeHelpKey enabled label value nameKey indication shortcutKey
- accessCharaterPos retriever icon iconAndLabel'
- classVariableNames:''
- poolDictionaries:''
- privateIn:MenuEditor
+ instanceVariableNames:'activeHelpKey enabled label value nameKey indication shortcutKey
+ accessCharaterPos retriever icon iconAndLabel submenuChannel'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:MenuEditor
!
SelectionInTreeView subclass:#Painter
- instanceVariableNames:''
- classVariableNames:'CopyBuffer'
- poolDictionaries:''
- privateIn:MenuEditor
+ instanceVariableNames:'imageDirSelect'
+ classVariableNames:'CopyBuffer'
+ poolDictionaries:''
+ privateIn:MenuEditor
!
!MenuEditor class methodsFor:'documentation'!
@@ -73,6 +73,24 @@
! !
+!MenuEditor class methodsFor:'icons'!
+
+iconStepDown
+ ^ ((Image fromFile:'stepOver.xpm') rotated:90) flipHorizontal
+!
+
+iconStepIn
+ ^ ((Image fromFile:'stepIn.xpm') rotated:90) flipHorizontal
+!
+
+iconStepOut
+ ^ ((Image fromFile:'stepOut.xpm') rotated:90) flipHorizontal
+!
+
+iconStepUp
+ ^ ((Image fromFile:'stepOver.xpm') rotated:90) flipHorizontal flipVertical
+! !
+
!MenuEditor class methodsFor:'interface specs'!
classAndMethodSpec
@@ -250,6 +268,32 @@
)
!
+menuDefaultLink
+ "this window spec was automatically generated by the ST/X MenuEditor"
+
+ "do not manually edit this - the builder may not be able to
+ handle the specification if its corrupted."
+
+ "
+ MenuEditor new openOnClass:MenuEditor andSelector:#menuDefaultLink
+ (Menu new fromLiteralArrayEncoding:(MenuEditor menuDefaultLink)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' '!! derives from application !!'
+ )
+ ) nil
+ nil
+ )
+!
+
menuPullDown
"this window spec was automatically generated by the ST/X MenuEditor"
@@ -282,10 +326,12 @@
#(#MenuItem
#'label:' 'from class ...'
#'value:' #doFromClass
+ #'enabled:' #isOwnerOfHelpTool
)
#(#MenuItem
#'label:' 'pick a menu'
#'value:' #doPickAMenu
+ #'enabled:' #isOwnerOfHelpTool
)
#(#MenuItem
#'label:' '='
@@ -308,6 +354,7 @@
#(#MenuItem
#'label:' 'class'
#'value:' #doDefineClass
+ #'enabled:' #isOwnerOfHelpTool
)
#(#MenuItem
#'label:' '-'
@@ -319,6 +366,7 @@
#(#MenuItem
#'label:' 'install help spec.'
#'value:' #doInstallHelp
+ #'enabled:' #isOwnerOfHelpTool
)
#(#MenuItem
#'label:' '='
@@ -333,7 +381,67 @@
)
#(#MenuItem
#'label:' 'test'
- #'value:' #doTest
+ #'submenuChannel:' #submenuTest
+ )
+ #(#MenuItem
+ #'label:' ''
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepUp'
+ #'value:' #doStepUp
+ #'enabled:' #enabledStepOver
+ #'labelImage:'
+ #(#ResourceRetriever
+ #MenuEditor #iconStepUp
+ )
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepDown'
+ #'value:' #doStepDown
+ #'enabled:' #enabledStepOver
+ #'labelImage:'
+ #(#ResourceRetriever
+ #MenuEditor #iconStepDown
+ )
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' ''
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepIn'
+ #'value:' #doStepIn
+ #'enabled:' #enabledStepIn
+ #'labelImage:'
+ #(#ResourceRetriever
+ #MenuEditor #iconStepIn
+ )
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepOut'
+ #'value:' #doStepOut
+ #'enabled:' #enabledStepOut
+ #'labelImage:'
+ #(#ResourceRetriever
+ #MenuEditor #iconStepOut
+ )
+ )
+ #(#MenuItem
+ #'label:' '-'
)
) nil
nil
@@ -437,6 +545,16 @@
!
+slicesLink
+ ^#(
+ (Basics basicsLinkSpec)
+ (Details detailsEditSpec)
+ (Misc miscEditSpec)
+ (Help help)
+ )
+
+!
+
slicesMenu
^#(
(Basics basicsMenuSpec)
@@ -454,9 +572,9 @@
!
-slicesSeperatorMenu
+slicesSeparatorMenu
^#(
- (Basics basicsSeperatorMenu)
+ (Basics basicsSeparatorSpec)
)
! !
@@ -546,6 +664,76 @@
)
!
+basicsLinkSpec
+ "this window spec was automatically generated by the ST/X UIPainter"
+
+ "do not manually edit this - the painter/builder may not be able to
+ handle the specification if its corrupted."
+
+ "
+ UIPainter new openOnClass:MenuEditor andSelector:#basicsLinkSpec
+ MenuEditor new openInterface:#basicsLinkSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+
+ #(#FullSpec
+ #'window:'
+ #(#WindowSpec
+ #'name:' 'uIPainterView'
+ #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #'label:' 'unnamed canvas'
+ #'bounds:' #(#Rectangle 0 0 267 319)
+ )
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#LabelSpec
+ #'name:' 'nameKeyLabel'
+ #'layout:' #(#AlignmentOrigin 87 0 26 0 1 0.5)
+ #'label:' 'NameKey:'
+ #'resizeForLabel:' true
+ )
+ #(#InputFieldSpec
+ #'name:' 'itemNameKey'
+ #'layout:' #(#LayoutFrame 91 0 15 0 -5 1.0 37 0)
+ #'tabable:' true
+ #'model:' #nameKey
+ #'type:' #symbolOrNil
+ )
+ #(#LabelSpec
+ #'name:' 'labelLabel'
+ #'layout:' #(#AlignmentOrigin 87 0 53 0 1 0.5)
+ #'label:' 'Label'
+ #'resizeForLabel:' true
+ )
+ #(#InputFieldSpec
+ #'name:' 'itemLabel'
+ #'layout:' #(#LayoutFrame 91 0 42 0 -5 1.0 64 0)
+ #'tabable:' true
+ #'model:' #label
+ )
+ #(#InputFieldSpec
+ #'name:' 'submenuChannel'
+ #'layout:' #(#LayoutFrame 91 0 69 0 -5 1.0 91 0)
+ #'tabable:' true
+ #'model:' #submenuChannel
+ #'type:' #symbolOrNil
+ )
+ #(#LabelSpec
+ #'name:' 'menuLabel'
+ #'layout:' #(#AlignmentOrigin 87 0 80 0 1 0.5)
+ #'label:' 'Menu:'
+ #'resizeForLabel:' true
+ )
+ )
+ )
+ )
+!
+
basicsMenuSpec
"this window spec was automatically generated by the ST/X UIPainter"
@@ -647,15 +835,15 @@
)
!
-basicsSeperatorMenu
+basicsSeparatorSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
- UIPainter new openOnClass:MenuEditor andSelector:#basicsSeperatorMenu
- MenuEditor new openInterface:#basicsSeperatorMenu
+ UIPainter new openOnClass:MenuEditor andSelector:#basicsSeparatorSpec
+ MenuEditor new openInterface:#basicsSeparatorSpec
"
<resource: #canvas>
@@ -674,12 +862,17 @@
#(#SpecCollection
#'collection:'
#(
- #(#CheckBoxSpec
- #'name:' 'seperator'
- #'layout:' #(#AlignmentOrigin 19 0 48 0 0 0)
- #'tabable:' true
- #'model:' #doubleSeperator
- #'label:' 'Double Seperator'
+ #(#LabelSpec
+ #'name:' 'separatorLabel'
+ #'layout:' #(#AlignmentOrigin 127 0 22 0 1 0.5)
+ #'label:' 'Separator Type:'
+ #'resizeForLabel:' true
+ )
+ #(#ComboListSpec
+ #'name:' 'comboList1'
+ #'layout:' #(#LayoutFrame 132 0 11 0 -6 1.0 33 0)
+ #'model:' #seperatorSelection
+ #'useIndex:' false
)
)
)
@@ -820,45 +1013,6 @@
)
)
)
-!
-
-seperatorSpec
- "this window spec was automatically generated by the ST/X UIPainter"
-
- "do not manually edit this - the painter/builder may not be able to
- handle the specification if its corrupted."
-
- "
- UIPainter new openOnClass:MenuEditor andSelector:#seperatorSpec
- MenuEditor new openInterface:#seperatorSpec
- "
-
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'window:'
- #(#WindowSpec
- #'name:' 'uIPainterView'
- #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #'label:' 'unnamed canvas'
- #'bounds:' #(#Rectangle 0 0 267 319)
- )
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#CheckBoxSpec
- #'name:' 'seperator'
- #'layout:' #(#AlignmentOrigin 19 0 48 0 0 0)
- #'tabable:' true
- #'model:' #doubleSeperator
- #'label:' 'Double Seperator'
- )
- )
- )
- )
! !
!MenuEditor class methodsFor:'startup'!
@@ -877,6 +1031,10 @@
!MenuEditor methodsFor:'accessing'!
+menuDefaultLink
+ ^ self class menuDefaultLink
+!
+
specClass
^ specClass
!
@@ -884,6 +1042,20 @@
specClass:aClass
aClass isBehavior ifTrue:[specClass := aClass name]
ifFalse:[specClass := aClass].
+!
+
+submenuTest
+ "returns submenu assigned to item test
+ "
+ |menu|
+
+ menu := self painter asMenu.
+
+ menu allItemsDo:[:anItem|
+ anItem value:nil.
+ anItem enabled:true.
+ ].
+ ^ menu
! !
!MenuEditor methodsFor:'actions'!
@@ -897,7 +1069,7 @@
node notNil ifTrue:[
self isHelpToolSelected ifTrue:[
- self helpTool accept
+ self activeHelpTool accept
].
cont := node contents buildFromAspects:aspects.
self painter selectedNodeChanged
@@ -916,6 +1088,33 @@
! !
+!MenuEditor methodsFor:'active help'!
+
+activeHelpTool
+ "access current active help editor
+ "
+ activeHelpTool isNil ifTrue:[
+ self activeHelpTool:(UIHelpTool new)
+ ].
+ ^ activeHelpTool
+!
+
+activeHelpTool:anApplication
+ "change current active help editor
+ "
+ activeHelpTool := anApplication.
+
+ activeHelpTool masterApplication isNil ifTrue:[
+ activeHelpTool masterApplication:self.
+ ].
+!
+
+isOwnerOfHelpTool
+ "returns true in case of owner of the helptool
+ "
+ ^ self activeHelpTool masterApplication == self
+! !
+
!MenuEditor methodsFor:'aspects'!
aspectFor:aKey
@@ -926,6 +1125,35 @@
!
+enabledStepIn
+ |holder|
+
+ (holder := builder bindingAt:#enabledStepIn) isNil ifTrue:[
+ builder aspectAt:#enabledStepIn put:(holder := false asValue).
+ ].
+ ^ holder
+
+!
+
+enabledStepOut
+ |holder|
+
+ (holder := builder bindingAt:#enabledStepOut) isNil ifTrue:[
+ builder aspectAt:#enabledStepOut put:(holder := false asValue).
+ ].
+ ^ holder
+
+!
+
+enabledStepOver
+ |holder|
+
+ (holder := builder bindingAt:#enabledStepOver) isNil ifTrue:[
+ builder aspectAt:#enabledStepOver put:(holder := false asValue).
+ ].
+ ^ holder
+!
+
menuPullDown
|menu|
@@ -989,6 +1217,25 @@
"one of my models changed its value
"
self modifiedChannel value:true
+!
+
+updateEnabledChannels
+ "update enabled channels
+ "
+ |node parent next|
+
+ node := self painter selectedNode.
+
+ (node notNil and:[(parent := node parent) notNil]) ifTrue:[
+ next := parent childAt:((parent indexOfChild:node) + 1).
+ self enabledStepIn value:(next notNil and:[next hasChildren]).
+ self enabledStepOver value:(parent children size > 1).
+ self enabledStepOut value:(parent parent notNil).
+ ] ifFalse:[
+ self enabledStepOver value:false.
+ self enabledStepIn value:false.
+ self enabledStepOut value:false.
+ ]
! !
!MenuEditor methodsFor:'queries'!
@@ -1012,15 +1259,19 @@
item := node contents.
item toAspects:aspects.
- item isSeperator ifFalse:[
+ item isSeparator ifFalse:[
node parent isNil ifFalse:[
- node hasChildren ifTrue:[slc := #slicesMenu]
- ifFalse:[slc := #slicesItem].
+ node hasChildren ifTrue:[
+ slc := #slicesMenu
+ ] ifFalse:[
+ item submenuChannel isNil ifTrue:[slc := #slicesItem]
+ ifFalse:[slc := #slicesLink]
+ ].
] ifTrue:[
slc := #slicesRootMenu
]
] ifTrue:[
- slc := #slicesSeperatorMenu
+ slc := #slicesSeparatorMenu
].
slc := self class perform:slc.
].
@@ -1039,6 +1290,7 @@
self tabSelection:nil.
]
].
+ self updateEnabledChannels
!
tabSelection
@@ -1056,7 +1308,7 @@
^ self tabCanvas client:nil
].
self isHelpToolSelected ifTrue:[
- self tabCanvas client:(tool := self helpTool).
+ self tabCanvas client:(tool := self activeHelpTool).
tool model:(self aspectFor:#activeHelpKey)
] ifFalse:[
sel := (slices at:tabSelection) last.
@@ -1067,14 +1319,14 @@
!MenuEditor methodsFor:'startup / release'!
buildFrom:aClass andSelector:aSelector
- |oldClass newClass|
+ |oldClass newClass helpTool|
oldClass := self specClass.
self specClass:aClass.
newClass := self specClass.
- oldClass ~= newClass ifTrue:[
- self helpTool helpSpecFrom:newClass
+ (self isOwnerOfHelpTool and:[oldClass ~= newClass]) ifTrue:[
+ self activeHelpTool helpSpecFrom:newClass
].
self painter buildFrom:newClass andSelector:aSelector.
!
@@ -1082,29 +1334,33 @@
initialize
"initialize channels
"
+ |holder|
+
super initialize.
aspects := IdentityDictionary new.
#(
label
accessCharaterPos
+ submenuChannel
activeHelpKey
enabled
value
nameKey
indication
shortcutKey
- doubleSeperator
retriever
iconAndLabel
icon
- ) do:[:aKey||holder|
- holder := ValueHolder new.
+ ) do:[:aKey|
+ aspects at:aKey put:(holder := ValueHolder new).
holder addDependent:self.
- aspects at:aKey put:holder.
].
+ aspects at:#seperatorSelection put:(holder := SelectionInList new).
+ holder list:(Item separatorList).
+ holder addDependent:self.
!
@@ -1177,7 +1433,7 @@
doInstallHelp
"install help text
"
- self helpTool installHelpSpecInto:(self specClass)
+ self activeHelpTool installHelpSpecInto:(self specClass)
!
doInstallSpec
@@ -1238,6 +1494,26 @@
code := code withCRs.
(ReadStream on:code) fileIn.
+ (cls compiledMethodAt:selector) isNil ifTrue:[
+ category := 'accessing menu'.
+ code := Character excla asString
+ , cls name , ' methodsFor:' , category storeString
+ , Character excla asString , '\\'
+
+ , selector , '\'
+ , ' "this window spec was automatically generated by the ST/X MenuEditor"\\'
+ , ' ^ self class ', selector, '\\'
+ , '\'
+ , Character excla asString
+ , ' '
+ , Character excla asString
+ , '\\'.
+
+ code := code withCRs.
+ (ReadStream on:code) fileIn.
+ ].
+
+
!
doNew
@@ -1246,47 +1522,64 @@
doPickAMenu
- |menu|
+ |view menu|
- menu := Screen current viewFromUser.
+ view := Screen current viewFromUser.
- (menu isNil or:[menu == Screen current rootView]) ifTrue:[
+ (view isNil or:[view == Screen current rootView]) ifTrue:[
^ self
].
- (menu isKindOf:MenuPanel) ifTrue:[
- ^ self painter buildFromMenu:(menu asMenu)
+ (view isKindOf:MenuPanel) ifTrue:[
+ ^ self painter buildFromMenu:(view asMenu)
+ ].
+ (view isKindOf:PullDownMenu) ifTrue:[
+ ^ self painter buildFromMenu:(self doPickPopupMenu:view)
].
!
-doTest
- "open current editing menu
+doPickPopupMenu:aMenu
+ "pick a popup menu
"
- |menu value|
+ |menu label values item subM|
+
+ menu := Menu new.
+ values := aMenu selectors.
- menu := self painter asMenu.
+ aMenu labels keysAndValuesDo:[:anIndex :aLabel|
+ item := MenuItem labeled:(aLabel printString).
+ subM := aMenu subMenuAt:anIndex.
+
+ subM notNil ifTrue:[
+ item submenu:(self doPickPopupMenu:subM)
+ ].
+ menu addItem:item value:(values at:anIndex).
+ ].
+ ^ menu
+!
- menu notNil ifTrue:[
- menu receiver:nil.
- value := menu startUp.
- Transcript showCR:'result from test: ', value printString
- ]
+doStepDown
+ "move selected child after next child
+ "
+ self painter doStepOver:1
+!
+
+doStepIn
+ self painter doStepIn
+!
+doStepOut
+ self painter doStepOut
+!
+
+doStepUp
+ "move selected child after next child
+ "
+ self painter doStepOver:-1
! !
!MenuEditor methodsFor:'values'!
-helpTool
- |tool|
-
- (tool := builder bindingAt:#helpTool) isNil ifTrue:[
- tool := UIHelpTool new.
- tool masterApplication:self.
- builder aspectAt:#helpTool put:tool
- ].
- ^ tool
-!
-
painter
"automatically generated by UIPainter ..."
@@ -1300,6 +1593,20 @@
^ painter
! !
+!MenuEditor::Item class methodsFor:'constants'!
+
+separatorList
+ ^ #( 'blank' 'single line' 'double line' )
+!
+
+separatorSlices
+ ^ #(
+ ( #blank '' )
+ ( #single '-' )
+ ( #double '=' )
+ )
+! !
+
!MenuEditor::Item class methodsFor:'documentation'!
documentation
@@ -1328,7 +1635,37 @@
label:something
"set the value of the instance variable 'label' (automatically generated)"
- label := something.! !
+ label := something ? '-'.
+!
+
+separatorType
+ "returns separator type assigned to item or nil
+ "
+ |c|
+
+ label size > 1 ifFalse:[
+ label size == 0 ifTrue:[
+ ^ #blank
+ ].
+ c := label first.
+ c == $- ifTrue:[^ #single].
+ c == $= ifTrue:[^ #double].
+ ].
+ ^ nil
+
+!
+
+submenuChannel
+ "return the value of the instance variable 'submenuChannel' (automatically generated)"
+
+ ^ submenuChannel
+!
+
+submenuChannel:aChannel
+ "return the value of the instance variable 'submenuChannel' (automatically generated)"
+
+ submenuChannel := aChannel
+! !
!MenuEditor::Item methodsFor:'conversion'!
@@ -1337,12 +1674,13 @@
"
|item rcv|
- item := MenuItem labeled:(label ? '-').
+ item := MenuItem labeled:label.
- self isSeperator ifFalse:[
+ self isSeparator ifFalse:[
item activeHelpKey:activeHelpKey.
item enabled:enabled.
item accessCharacterPosition:accessCharaterPos.
+ item submenuChannel:submenuChannel.
item nameKey:nameKey.
item shortcutKeyCharacter:shortcutKey.
item value:value.
@@ -1362,13 +1700,13 @@
!
buildFromAspects:aspects
- |name|
+ |name slice|
- self isSeperator ifFalse:[
+ self isSeparator ifFalse:[
name := label.
label := (aspects at:#label) value.
- self isSeperator ifTrue:[
+ (label isNil or:[self isSeparator]) ifTrue:[
(aspects at:#label) value:(label := name)
].
@@ -1379,20 +1717,21 @@
indication := (aspects at:#indication) value.
shortcutKey := (aspects at:#shortcutKey) value.
accessCharaterPos := (aspects at:#accessCharaterPos) value.
+ submenuChannel := (aspects at:#submenuChannel) value.
retriever := (aspects at:#retriever) value.
icon := (aspects at:#icon) value.
iconAndLabel := (aspects at:#iconAndLabel) value.
] ifTrue:[
- (aspects at:#doubleSeperator) value ifTrue:[label := '=']
- ifFalse:[label := nil].
+ name := (aspects at:#seperatorSelection) selectionIndex.
+ label := (self class separatorSlices at:name) last.
]
!
buildFromMenuItem:anItem
|rtv|
- label := anItem label.
- activeHelpKey := anItem activeHelpKey.
+ self label:(anItem label).
+ activeHelpKey := anItem activeHelpKey.
(enabled := anItem enabled) isSymbol ifFalse:[
enabled := nil
@@ -1409,6 +1748,7 @@
nameKey := anItem nameKey.
shortcutKey := anItem shortcutKeyCharacter.
accessCharaterPos := anItem accessCharacterPosition.
+ submenuChannel := anItem submenuChannel.
( ((rtv := anItem adornment) notNil)
and:[(rtv := rtv labelImage) isKindOf:ResourceRetriever]
@@ -1423,9 +1763,11 @@
!
toAspects:aspects
+ |type idx slice|
- self isSeperator ifTrue:[
- (aspects at:#doubleSeperator) value:(label notNil).
+ (type := self separatorType) notNil ifTrue:[
+ type := self class separatorSlices findFirst:[:el| el first == type ].
+ (aspects at:#seperatorSelection) selectionIndex:type.
] ifFalse:[
(aspects at:#label) value:label.
(aspects at:#activeHelpKey) value:activeHelpKey.
@@ -1435,6 +1777,7 @@
(aspects at:#indication) value:indication.
(aspects at:#shortcutKey) value:shortcutKey.
(aspects at:#accessCharaterPos) value:accessCharaterPos.
+ (aspects at:#submenuChannel) value:submenuChannel.
(aspects at:#retriever) value:retriever.
(aspects at:#icon) value:icon.
(aspects at:#iconAndLabel) value:iconAndLabel.
@@ -1443,25 +1786,10 @@
!MenuEditor::Item methodsFor:'queries'!
-isSeperator
- |c|
-
- label size > 1 ifTrue:[^ false].
- label size == 1 ifTrue:[
- (c := label first) == $= ifTrue:[
- ^ true
- ].
- c == $- ifFalse:[
- ^ false
- ].
- ].
- label := nil.
- ^ true
-
-!
-
-isSimpleSeperator
- ^ label isNil
+isSeparator
+ "returns true if item is a seperator
+ "
+ ^ self separatorType notNil
! !
!MenuEditor::Painter class methodsFor:'defaults'!
@@ -1614,19 +1942,35 @@
drawLabelIndex:anIndex atX:x y:yCenter
"draw text label assigned to a node at x y( center)
"
- |y w item|
+ |y type item|
item := (listOfNodes at:anIndex) contents.
+ type := item separatorType.
- item isSeperator ifFalse:[
- ^ super drawLabelIndex:anIndex atX:x y:yCenter
+ type isNil ifTrue:[
+ super drawLabelIndex:anIndex atX:x y:yCenter
+ ] ifFalse:[
+ type == #blank ifFalse:[
+ self displayLineFromX:x y:yCenter toX:(x + 80) y:yCenter.
+
+ type == #double ifTrue:[
+ self displayLineFromX:x y:(yCenter + 2) toX:(x + 80) y:(yCenter + 2).
+ ]
+ ]
+ ]
+!
+
+figureFor:aNode
+ "access figure for a node
+ "
+ (aNode hasChildren or:[aNode contents submenuChannel isNil]) ifTrue:[
+ ^ super figureFor:aNode
].
- self displayLineFromX:x y:yCenter toX:(x + 80) y:yCenter.
-
- item isSimpleSeperator ifFalse:[
- self displayLineFromX:x y:(yCenter + 2) toX:(x + 80) y:(yCenter + 2).
- ]
-
+ imageDirSelect isNil ifTrue:[
+ imageDirSelect := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_link.xpm').
+ imageDirSelect := imageDirSelect onDevice:device.
+ ].
+ ^ imageDirSelect
! !
!MenuEditor::Painter methodsFor:'initialization'!
@@ -1635,7 +1979,6 @@
super initialize.
self multipleSelectOk:true.
self model:(SelectionInTree new).
-
! !
!MenuEditor::Painter methodsFor:'menus'!
@@ -1651,6 +1994,18 @@
self addElement:(self nodeLabel:'undefined')
!
+doCreateLink
+ |node item|
+
+ node := self nodeLabel:'undefined'.
+ item := node contents.
+ item submenuChannel:#menuDefaultLink.
+ self addElement:node
+
+
+
+!
+
doCreateMenu
|node|
@@ -1680,6 +2035,79 @@
]
!
+doStepIn
+ |idx node cprt nprt|
+
+ ( (node := self selectedNode) isNil
+ or:[(cprt := node parent) isNil]
+ ) ifTrue:[
+ ^ self
+ ].
+
+ idx := cprt indexOfChild:node.
+
+ idx == cprt children size ifTrue:[
+ ^ self
+ ].
+ nprt := cprt childAt:(idx + 1).
+
+ (nprt notNil and:[nprt hasChildren]) ifFalse:[
+ ^ self
+ ].
+
+ model removeDependent:self.
+ model removeSelection.
+ selection := nil.
+ model expand:nprt.
+ model addDependent:self.
+
+ model add:node beforeIndex:1 below:nprt.
+ self selectNode:node.
+!
+
+doStepOut
+ |node cprt nprt|
+
+ ( (node := self selectedNode) isNil
+ or:[(cprt := node parent) isNil
+ or:[(nprt := cprt parent) isNil]]
+ ) ifFalse:[
+ model removeDependent:self.
+ model removeSelection.
+ selection := nil.
+ model addDependent:self.
+
+ model add:node afterIndex:(nprt indexOfChild:cprt) below:nprt.
+ self selectNode:node.
+ ]
+!
+
+doStepOver:anOffset
+ "move child 'anOffset' forward or backward in list of children
+ "
+ |idx node size parent|
+
+ ( (node := self selectedNode) notNil
+ and:[(parent := node parent) notNil
+ and:[(size := parent children size) > 1]]
+ ) ifTrue:[
+ idx := parent indexOfChild:node.
+
+ model removeDependent:self.
+ model removeSelection.
+ selection := nil.
+ model addDependent:self.
+
+ (idx := idx + anOffset) < 1 ifTrue:[
+ idx := size
+ ] ifFalse:[
+ idx > size ifTrue:[idx := 1]
+ ].
+ model add:node beforeIndex:idx below:parent.
+ self selectNode:node.
+ ]
+!
+
menu
|menu subm sz inclRoot|
@@ -1705,8 +2133,8 @@
menu disable:#doCopy.
menu disable:#doCut.
].
- subm := PopUpMenu labels:#( 'menu' 'item' 'seperator' )
- selectors:#( #doCreateMenu #doCreateItem #doCreateSep )
+ subm := PopUpMenu labels:#( 'menu static' 'menu dynamic' '-' 'item' '-' 'separator' )
+ selectors:#( #doCreateMenu #doCreateLink nil #doCreateItem nil #doCreateSep )
receiver:self.
menu subMenuAt:#create put:subm.
@@ -1741,6 +2169,12 @@
!MenuEditor::Painter methodsFor:'selection'!
+selectNode:aNode
+ "change selection to a node
+ "
+ self selection:(listOfNodes findFirst:[:el| el == aNode])
+!
+
selectedNodeChanged
|node name index|