# HG changeset patch # User ca # Date 869133900 -7200 # Node ID 5c88856b360fa436b8461ff1cb82086532fbdf8f # Parent 354ba46948b47b9ebc63e0191d85de5c71f74ee3 access MenuEditor from any specification; common changes diff -r 354ba46948b4 -r 5c88856b360f MenuEditor.st --- 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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 " @@ -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 - " - - - - ^ - - #(#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|