--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/HierarchicalListEditor.st Tue Sep 02 14:49:58 1997 +0200
@@ -0,0 +1,1299 @@
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+
+
+ApplicationModel subclass:#HierarchicalListEditor
+ instanceVariableNames:'didInstall treeView specClass specSelector'
+ classVariableNames:'CopyBuffer IconCreateChild IconCreateSister'
+ poolDictionaries:''
+ category:'Interface-UIPainter'
+!
+
+!HierarchicalListEditor class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+
+!
+
+documentation
+"
+ HierarchicalListEditor is used by the UIPainter to
+ create or maintain a hierarchical list.
+
+ [start with:]
+ HierarchicalListEditor open
+
+ [see also:]
+ UIPainter
+
+ [author:]
+ Claus Atzkern
+"
+
+
+
+! !
+
+!HierarchicalListEditor class methodsFor:'icons'!
+
+iconCreateChild
+
+ IconCreateChild isNil ifTrue:[
+ IconCreateChild := Image fromFile:'/home/ca/st/images/ui_hierListChild.xpm'.
+
+ IconCreateChild isNil ifTrue:[
+ IconCreateChild := MenuEditor iconCreateMenu
+ ].
+ ].
+ ^ IconCreateChild.
+
+"
+IconCreateChild := nil
+"
+!
+
+iconCreateSister
+
+ IconCreateSister isNil ifTrue:[
+ IconCreateSister := Image fromFile:'/home/ca/st/images/ui_hierListSister.xpm'.
+
+ IconCreateSister isNil ifTrue:[
+ IconCreateSister := MenuEditor iconCreateItem
+ ]
+ ].
+ ^ IconCreateSister.
+
+"
+IconCreateSister := nil
+"
+! !
+
+!HierarchicalListEditor class methodsFor:'interface specs'!
+
+classAndMethodSpec
+ "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:HierarchicalListEditor andSelector:#classAndMethodSpec
+ HierarchicalListEditor new openInterface:#classAndMethodSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+
+ #(#FullSpec
+ #'window:'
+ #(#WindowSpec
+ #'name:' 'Painter'
+ #'layout:' #(#LayoutFrame 199 0 167 0 589 0 336 0)
+ #'label:' 'Painter'
+ #'min:' #(#Point 10 10)
+ #'max:' #(#Point 1160 870)
+ #'bounds:' #(#Rectangle 199 167 590 337)
+ )
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#LabelSpec
+ #'name:' 'boxLabel'
+ #'layout:' #(#Point 5 10)
+ #'label:' 'class & method for code:'
+ #'adjust:' #left
+ #'resizeForLabel:' true
+ )
+ #(#LabelSpec
+ #'name:' 'classLabel'
+ #'layout:' #(#AlignmentOrigin 45 0.11 51 0 1 0.5)
+ #'label:' 'class:'
+ #'adjust:' #right
+ #'resizeForLabel:' true
+ )
+ #(#InputFieldSpec
+ #'name:' 'classField'
+ #'layout:' #(#LayoutFrame 47 0.11 39 0 -2 1.0 61 0)
+ #'tabable:' true
+ #'model:' #specClassChannel
+ )
+ #(#LabelSpec
+ #'name:' 'methodLabel'
+ #'layout:' #(#AlignmentOrigin 45 0.11 74 0 1 0.5)
+ #'label:' 'method:'
+ #'adjust:' #right
+ #'resizeForLabel:' true
+ )
+ #(#InputFieldSpec
+ #'name:' 'methodField'
+ #'layout:' #(#LayoutFrame 47 0.11 64 0 -2 1.0 86 0)
+ #'tabable:' true
+ #'model:' #specSelectorChannel
+ #'type:' #string
+ )
+ #(#HorizontalPanelViewSpec
+ #'name:' 'commitPanel'
+ #'layout:' #(#LayoutFrame 0 0.0 -24 1.0 0 1.0 0 1.0)
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#ActionButtonSpec
+ #'name:' 'cancel'
+ #'label:' 'cancel'
+ #'tabable:' true
+ #'model:' #cancel
+ #'extent:' #(#Point 191 24)
+ )
+ #(#ActionButtonSpec
+ #'name:' 'accept'
+ #'label:' 'ok'
+ #'tabable:' true
+ #'isDefault:' true
+ #'model:' #accept
+ #'extent:' #(#Point 191 24)
+ )
+ )
+ )
+ #'horizontalLayout:' #fitSpace
+ #'verticalLayout:' #fit
+ #'horizontalSpace:' 3
+ #'verticalSpace:' 3
+ )
+ )
+ )
+ )
+!
+
+menuButtons
+ "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:HierarchicalListEditor andSelector:#menuButtons
+ (Menu new fromLiteralArrayEncoding:(HierarchicalListEditor menuButtons)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'createChild'
+ #'value:' #doCreateChild
+ #'enabled:' #canCreateChildChannel
+ #'labelImage:' #(#ResourceRetriever #HierarchicalListEditor #iconCreateChild)
+ )
+ #(#MenuItem
+ #'label:' 'createSister'
+ #'value:' #doCreateSister
+ #'enabled:' #canCreateSisterChannel
+ #'labelImage:' #(#ResourceRetriever #HierarchicalListEditor #iconCreateSister)
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' ''
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepUp'
+ #'value:' #doStepUp
+ #'enabled:' #canStepOverChannel
+ #'labelImage:' #(#ResourceRetriever #UIPainter #iconStepUp)
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepDown'
+ #'value:' #doStepDown
+ #'enabled:' #canStepOverChannel
+ #'labelImage:' #(#ResourceRetriever #UIPainter #iconStepDown)
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepIn'
+ #'value:' #doStepIn
+ #'enabled:' #canStepInChannel
+ #'labelImage:' #(#ResourceRetriever #UIPainter #iconStepIn)
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'stepOut'
+ #'value:' #doStepOut
+ #'enabled:' #canStepOutChannel
+ #'labelImage:' #(#ResourceRetriever #UIPainter #iconStepOut)
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ ) nil
+ nil
+ )
+!
+
+menuMain
+ "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:HierarchicalListEditor andSelector:#menuMain
+ (Menu new fromLiteralArrayEncoding:(HierarchicalListEditor menuMain)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'file'
+ #'submenu:'
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'new'
+ #'value:' #doNew
+ )
+ #(#MenuItem
+ #'label:' 'reload'
+ #'value:' #doReload
+ )
+ #(#MenuItem
+ #'label:' '='
+ )
+ #(#MenuItem
+ #'label:' 'quit'
+ #'value:' #closeRequest
+ )
+ ) nil
+ nil
+ )
+ )
+ #(#MenuItem
+ #'label:' 'code'
+ #'submenu:'
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'class && method'
+ #'value:' #doDefineClass
+ #'enabled:' #canChangeClassName
+ )
+ #(#MenuItem
+ #'label:' 'method'
+ #'value:' #doDefineSelector
+ #'enabled:' #hasValidClass
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'install spec.'
+ #'value:' #doInstall
+ #'enabled:' #hasValidClass
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'browse'
+ #'enabled:' #hasValidClass
+ #'submenu:'
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'class'
+ #'value:' #'doBrowse:'
+ #'argument:' #class
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'specification'
+ #'value:' #'doBrowse:'
+ #'enabled:' #hasValidSpecSelector
+ #'argument:' #spec
+ )
+ #(#MenuItem
+ #'label:' 'method'
+ #'value:' #'doBrowse:'
+ #'enabled:' #hasValidMethodSelector
+ #'argument:' #method
+ )
+ ) nil
+ nil
+ )
+ )
+ ) nil
+ nil
+ )
+ )
+ ) nil
+ nil
+ )
+!
+
+menuTree
+ "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:HierarchicalListEditor andSelector:#menuTree
+ (Menu new fromLiteralArrayEncoding:(HierarchicalListEditor menuTree)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'copy'
+ #'value:' #doCopy
+ #'enabled:' #canCopy
+ )
+ #(#MenuItem
+ #'label:' 'cut'
+ #'value:' #doCut
+ #'enabled:' #canCut
+ )
+ #(#MenuItem
+ #'label:' 'paste'
+ #'value:' #doPaste
+ #'enabled:' #canPaste
+ )
+ ) nil
+ nil
+ )
+!
+
+methodSpec
+ "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:HierarchicalListEditor andSelector:#methodSpec
+ HierarchicalListEditor new openInterface:#methodSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+
+ #(#FullSpec
+ #'window:'
+ #(#WindowSpec
+ #'name:' 'Painter'
+ #'layout:' #(#LayoutFrame 275 0 381 0 665 0 550 0)
+ #'label:' 'Painter'
+ #'min:' #(#Point 10 10)
+ #'max:' #(#Point 1160 870)
+ #'bounds:' #(#Rectangle 275 381 666 551)
+ )
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#LabelSpec
+ #'name:' 'boxLabel'
+ #'layout:' #(#Point 5 10)
+ #'label:' 'class & method for code:'
+ #'adjust:' #left
+ #'resizeForLabel:' true
+ )
+ #(#LabelSpec
+ #'name:' 'methodLabel'
+ #'layout:' #(#AlignmentOrigin 45 0.11 74 0 1 0.5)
+ #'label:' 'method:'
+ #'adjust:' #right
+ #'resizeForLabel:' true
+ )
+ #(#InputFieldSpec
+ #'name:' 'methodField'
+ #'layout:' #(#LayoutFrame 47 0.11 64 0 -2 1.0 86 0)
+ #'tabable:' true
+ #'model:' #specSelectorChannel
+ #'type:' #string
+ )
+ #(#HorizontalPanelViewSpec
+ #'name:' 'commitPanel'
+ #'layout:' #(#LayoutFrame 0 0.0 -24 1.0 0 1.0 0 1.0)
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#ActionButtonSpec
+ #'name:' 'cancel'
+ #'label:' 'cancel'
+ #'tabable:' true
+ #'model:' #cancel
+ #'extent:' #(#Point 191 24)
+ )
+ #(#ActionButtonSpec
+ #'name:' 'accept'
+ #'label:' 'ok'
+ #'tabable:' true
+ #'isDefault:' true
+ #'model:' #accept
+ #'extent:' #(#Point 191 24)
+ )
+ )
+ )
+ #'horizontalLayout:' #fitSpace
+ #'verticalLayout:' #fit
+ #'horizontalSpace:' 3
+ #'verticalSpace:' 3
+ )
+ )
+ )
+ )
+!
+
+windowSpec
+ "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:HierarchicalListEditor andSelector:#windowSpec
+ HierarchicalListEditor new openInterface:#windowSpec
+ "
+ "HierarchicalListEditor open"
+
+ <resource: #canvas>
+
+ ^
+
+ #(#FullSpec
+ #'window:'
+ #(#WindowSpec
+ #'name:' 'HierarchicalListEditor'
+ #'layout:' #(#LayoutFrame 437 0 260 0 1004 0 554 0)
+ #'label:' 'Hierarchical List Editor'
+ #'min:' #(#Point 10 10)
+ #'max:' #(#Point 1160 870)
+ #'bounds:' #(#Rectangle 437 260 1005 555)
+ )
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#MenuPanelSpec
+ #'name:' 'menuMain'
+ #'layout:' #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #'menu:' #menuMain
+ )
+ #(#VariableHorizontalPanelSpec
+ #'name:' 'variableHorizontalPanel1'
+ #'layout:' #(#LayoutFrame 0 0.0 26 0.0 0 1.0 0 1.0)
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#ViewSpec
+ #'name:' 'view1'
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#MenuPanelSpec
+ #'name:' 'menuButtons'
+ #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 28 0)
+ #'menu:' #menuButtons
+ )
+ #(#ArbitraryComponentSpec
+ #'name:' 'treeView'
+ #'layout:' #(#LayoutFrame 0 0.0 28 0.0 0 1.0 0 1.0)
+ #'menu:' #menuTree
+ #'hasHorizontalScrollBar:' true
+ #'hasVerticalScrollBar:' true
+ #'miniScrollerHorizontal:' true
+ #'miniScrollerVertical:' true
+ #'component:' #treeView
+ #'hasBorder:' false
+ )
+ )
+ )
+ )
+ #(#ViewSpec
+ #'name:' 'view2'
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#ViewSpec
+ #'name:' 'viewSpec'
+ #'layout:' #(#LayoutFrame 0 0 0 0 0 0 0 0)
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#LabelSpec
+ #'name:' 'nameLabel'
+ #'layout:' #(#AlignmentOrigin 75 0 36 0 1 0.5)
+ #'label:' 'Name:'
+ #'resizeForLabel:' true
+ )
+ #(#InputFieldSpec
+ #'name:' 'nameFiled'
+ #'layout:' #(#LayoutFrame 81 0 26 0 -5 1.0 48 0)
+ #'model:' #itemName
+ )
+ #(#LabelSpec
+ #'name:' 'valueLabel'
+ #'layout:' #(#AlignmentOrigin 75 0 71 0 1 0.5)
+ #'label:' 'Value:'
+ #'resizeForLabel:' true
+ )
+ #(#InputFieldSpec
+ #'name:' 'valueField'
+ #'layout:' #(#LayoutFrame 81 0 61 0 -5 1.0 83 0)
+ #'model:' #itemValue
+ #'type:' #symbolOrNil
+ )
+ #(#HorizontalPanelViewSpec
+ #'name:' 'commitPanel'
+ #'layout:' #(#LayoutFrame 0 0.0 -30 1.0 0 1.0 0 1.0)
+ #'component:'
+ #(#SpecCollection
+ #'collection:'
+ #(
+ #(#ActionButtonSpec
+ #'name:' 'cancelButton'
+ #'label:' 'cancel'
+ #'model:' #cancel
+ #'enableChannel:' #modifiedChannel
+ #'extent:' #(#Point 1 22)
+ )
+ #(#ActionButtonSpec
+ #'name:' 'acceptButton'
+ #'label:' 'ok'
+ #'model:' #accept
+ #'enableChannel:' #modifiedChannel
+ #'extent:' #(#Point 1 22)
+ )
+ )
+ )
+ #'horizontalLayout:' #fitSpace
+ #'verticalLayout:' #center
+ #'horizontalSpace:' 3
+ #'verticalSpace:' 3
+ )
+ )
+ )
+ )
+ )
+ )
+ #'borderWidth:' 1
+ )
+ )
+ )
+ #'handles:' #(#Any 0.5 1.0)
+ )
+ )
+ )
+ )
+! !
+
+!HierarchicalListEditor class methodsFor:'printing'!
+
+prettyPrintArray:anArray on:aStream indent:anIndent
+ "print a literal array in a nice format
+ "
+ |arg sol|
+
+ sol := aStream position.
+ aStream spaces:anIndent.
+ aStream nextPutAll:'#('.
+
+ anArray first isSymbol ifTrue:[
+ arg := anArray first.
+ aStream nextPut:$#.
+ aStream nextPutAll:anArray first.
+ aStream cr.
+ anArray size == 2 ifTrue:[
+ self prettyPrintArray:(anArray last)
+ on:aStream
+ indent:(anIndent + 4).
+ ].
+ aStream spaces:anIndent.
+ aStream nextPut:$).
+ ^ self
+ ].
+
+ aStream nextPut:$'.
+ aStream nextPutAll:(anArray at:1).
+ aStream nextPut:$'.
+ arg := anArray at:2 ifAbsent:nil.
+
+ arg isString ifTrue:[
+ aStream spaces:((50 - (aStream position - sol)) max:4).
+
+ arg isSymbol ifTrue:[
+ aStream nextPut:$#.
+ ].
+ aStream nextPut:$'.
+ aStream nextPutAll:arg.
+ aStream nextPut:$'.
+ arg := anArray at:3 ifAbsent:nil.
+ ].
+ arg isArray ifTrue:[
+ aStream nextPutAll:' #('.
+ aStream cr.
+ arg do:[:e|self prettyPrintArray:e on:aStream indent:(anIndent + 4)].
+ aStream spaces:anIndent.
+ aStream nextPut:$).
+ ].
+ aStream nextPut:$).
+ aStream cr.
+! !
+
+!HierarchicalListEditor methodsFor:'accessing'!
+
+didInstall
+ "returns true if spec was installed by operator
+ "
+ ^ didInstall ? false
+!
+
+selectorName
+ "returns current spec. selector
+ "
+ ^ specSelector
+! !
+
+!HierarchicalListEditor methodsFor:'actions'!
+
+accept
+ "accept changes"
+
+ |node index|
+
+ (index := treeView selectedIndex) ~~ 0 ifTrue:[
+ node := treeView nodeAtIndex:index.
+ node name:(self itemName value).
+ node contents:(self itemValue value).
+ treeView redrawLine:index.
+ ].
+ self modifiedChannel value:false.
+
+!
+
+cancel
+ "reload selected item and update channels
+ "
+ |node|
+
+ (node := treeView selectedNode) notNil ifTrue:[
+ self itemName value:node name.
+ self itemValue value:node contents.
+ (builder componentAt:#viewSpec) extent:1.0@1.0.
+ ] ifFalse:[
+ (builder componentAt:#viewSpec) extent:0@0.
+ self itemName value:''.
+ self itemValue value:nil.
+ ].
+ self modifiedChannel value:false.
+! !
+
+!HierarchicalListEditor methodsFor:'aspects'!
+
+canCreateChildChannel
+ "automatically generated by UIPainter ..."
+
+ ^ builder booleanValueAspectFor:#canCreateChildChannel
+
+!
+
+canCreateSisterChannel
+ "automatically generated by UIPainter ..."
+
+ ^ builder booleanValueAspectFor:#canCreateSisterChannel
+
+!
+
+canStepInChannel
+ "automatically generated by UIPainter ..."
+
+ ^ builder booleanValueAspectFor:#canStepInChannel
+
+!
+
+canStepOutChannel
+ "automatically generated by UIPainter ..."
+
+ ^ builder booleanValueAspectFor:#canStepOutChannel
+
+!
+
+canStepOverChannel
+ "automatically generated by UIPainter ..."
+
+ ^ builder booleanValueAspectFor:#canStepOverChannel
+
+!
+
+itemName
+ "automatically generated by UIPainter ..."
+
+ |holder|
+
+ (holder := builder bindingAt:#itemName) isNil ifTrue:[
+ builder aspectAt:#itemName put:(holder := ValueHolder new).
+ holder addDependent:self.
+ ].
+ ^ holder
+!
+
+itemValue
+ "automatically generated by UIPainter ..."
+
+ |holder|
+
+ (holder := builder bindingAt:#itemValue) isNil ifTrue:[
+ builder aspectAt:#itemValue put:(holder := ValueHolder new).
+ holder addDependent:self.
+ ].
+ ^ holder
+!
+
+modifiedChannel
+ "automatically generated by UIPainter ..."
+
+ ^ builder booleanValueAspectFor:#modifiedChannel
+
+!
+
+treeView
+ "automatically generated by UIPainter ..."
+
+ ^ treeView
+! !
+
+!HierarchicalListEditor methodsFor:'change & update'!
+
+update:something with:aParameter from:someObject
+ "one of my models changed
+ "
+ self modifiedChannel value:true
+! !
+
+!HierarchicalListEditor methodsFor:'menu buttons'!
+
+doCreateChild
+ "create a child within selected parent
+ "
+ |node|
+
+ (node := treeView selectedNode) notNil ifTrue:[
+ treeView model add:(self newItem) beforeIndex:1 below:node.
+ treeView selectedNodeExpand:true.
+ self updateChannels.
+ ].
+!
+
+doCreateSister
+ "create a sister next to selected item
+ "
+ |node|
+
+ (node := treeView selectedNode) notNil ifTrue:[
+ node parent notNil ifTrue:[
+ treeView model add:(self newItem) after:node
+ ] ifFalse:[
+ treeView model add:(self newItem) beforeIndex:1 below:node
+ ].
+ self updateChannels
+ ].
+!
+
+doStepDown
+ "move selected item after next item
+ "
+ treeView selectedNodeChangeSequenceOrder:1.
+ self updateChannels.
+!
+
+doStepIn
+ "lets become the selected item a child of its next sister
+ "
+ treeView selectedNodeBecomeChildOfNext.
+ self updateChannels.
+!
+
+doStepOut
+ "let selected node become a sister of its current parent
+ "
+ treeView selectedNodeBecomeSisterOfParent.
+ self updateChannels.
+!
+
+doStepUp
+ "move selected item before previous item
+ "
+ treeView selectedNodeChangeSequenceOrder:-1.
+ self updateChannels.
+!
+
+menuButtons
+ "this window spec was automatically generated by the ST/X MenuEditor"
+
+ ^ self class menuButtons
+
+
+! !
+
+!HierarchicalListEditor methodsFor:'menu main'!
+
+doBrowse:what
+ "open a system browser
+ "
+ |cls sel|
+
+ (cls := specClass) notNil ifTrue:[
+ what == #class ifFalse:[
+ (sel := specSelector) isNil ifTrue:[
+ ^ self
+ ].
+ what == #spec ifTrue:[cls := cls class]
+ ].
+
+ SystemBrowser openInClass:cls selector:sel
+ ]
+!
+
+doDefineClass
+ "define class and selector
+ "
+ |sel cls bindings accepted|
+
+ masterApplication notNil ifTrue:[
+ ^ self information:'only selector could be changed.'
+ ].
+ accepted := true.
+ bindings := IdentityDictionary new.
+
+ specClass notNil ifTrue:[cls := specClass name asString]
+ ifFalse:[cls := ''].
+
+ specSelector notNil ifTrue:[sel := specSelector asString]
+ ifFalse:[sel := ''].
+
+ bindings at:#specSelectorChannel put:(sel asValue).
+ bindings at:#specClassChannel put:(cls asValue).
+
+ [accepted] whileTrue:[
+ accepted := self openDialogInterface:#classAndMethodSpec withBindings:bindings.
+
+ accepted ifTrue:[
+ cls := Smalltalk at:(bindings at:#specClassChannel) value asSymbol.
+
+ cls notNil ifTrue:[
+ sel := (bindings at:#specSelectorChannel) value withoutSeparators.
+
+ sel size ~~ 0 ifTrue:[
+ specClass := cls.
+ specSelector := sel asSymbol.
+ ^ self
+ ]
+ ]
+ ]
+ ]
+
+!
+
+doDefineSelector
+ "define selector only
+ "
+ |sel cls bindings accepted|
+
+ accepted := true.
+ bindings := IdentityDictionary new.
+
+ specSelector notNil ifTrue:[sel := specSelector asString]
+ ifFalse:[sel := ''].
+
+ bindings at:#specSelectorChannel put:(sel asValue).
+
+ [accepted] whileTrue:[
+ accepted := self openDialogInterface:#methodSpec withBindings:bindings.
+
+ accepted ifTrue:[
+ sel := (bindings at:#specSelectorChannel) value withoutSeparators.
+
+ sel size ~~ 0 ifTrue:[
+ specSelector := sel asSymbol.
+ ^ self
+ ]
+ ]
+ ]
+
+!
+
+doInstall
+ "install code
+ "
+ |code spec category mthd stream|
+
+ (specClass notNil and:[specSelector notNil]) ifFalse:[
+ ^ self information:'no valid class & method defined'.
+ ].
+
+ spec := (treeView nodeAtIndex:1) literalArrayEncoding.
+ stream := WriteStream on:String new.
+ self class prettyPrintArray:spec on:stream indent:4.
+ spec := stream contents.
+ category := 'interface specs'.
+ didInstall := true.
+
+ (mthd := specClass class compiledMethodAt:specSelector) notNil ifTrue:[
+ category := mthd category.
+ ].
+
+ code := Character excla asString
+ , specClass name , ' class methodsFor:' , category storeString
+ , Character excla asString , '\\'
+
+ , specSelector , '\'
+ , ' "this window spec was automatically generated by the ST/X HierarchicalListEditor"\\'
+ , ' "do not manually edit this - the builder may not be able to\'
+ , ' handle the specification if its corrupted."\\'
+ , ' "\'
+ , ' HierarchicalListEditor new openOnClass:' , specClass name , ' andSelector:#' , specSelector , '\'
+ , ' "\'.
+
+ code := code
+ , '\'
+ , ' <resource: #hierarchicalList>\\'
+ , ' ^\'
+ , spec
+ , ' decodeAsLiteralArray\'
+ , Character excla asString
+ , ' '
+ , Character excla asString
+ , '\\'.
+
+ code := code withCRs.
+ (ReadStream on:code) fileIn.
+
+ (specClass compiledMethodAt:specSelector) isNil ifTrue:[
+ category := 'aspects'.
+
+ code := Character excla asString
+ , specClass name , ' methodsFor:' , category storeString
+ , Character excla asString , '\\'
+
+ , specSelector , '\'
+ , ' "this window spec was automatically generated by the ST/X HierarchicalListEditor"\\'
+ , ' |holder root|\\'
+ , ' (holder := builder bindingAt:#', specSelector, ') isNil ifTrue:[\'
+ , ' holder := SelectionInTree new.\'
+ , ' root := self class ', specSelector, '.\'
+ , ' root expand.\'
+ , ' holder root:root.\'
+ , ' ].\'
+ , ' ^ holder'
+ , '\'
+ , Character excla asString
+ , ' '
+ , Character excla asString
+ , '\\'.
+
+ code := code withCRs.
+ (ReadStream on:code) fileIn.
+ ].
+
+
+!
+
+doNew
+ "remove all items; restart
+ "
+ |anchor|
+
+ anchor := TreeItem name:'Anchor' contents:#anchor.
+ anchor expand.
+ treeView model:(SelectionInTree new root:anchor).
+ treeView selection:0.
+
+!
+
+doReload
+ "reload spec from current class and selector
+ "
+ self buildFrom:specClass andSelector:specSelector
+
+!
+
+menuMain
+ "this window spec was automatically generated by the ST/X MenuEditor"
+
+ ^ self class menuMain
+
+
+! !
+
+!HierarchicalListEditor methodsFor:'menu tree'!
+
+doCopy
+ "copy current selected nodes into copy buffer
+ "
+ CopyBuffer := OrderedCollection new.
+ treeView selectedNodesDo:[:aNode| CopyBuffer add:(aNode copy)].
+
+!
+
+doCut
+ "cut current selected nodes
+ "
+ treeView hasSelection ifTrue:[
+ self doCopy.
+ treeView selectedNodesRemove.
+ self updateChannels.
+ ]
+!
+
+doPaste
+ "paste after current selected item
+ "
+ treeView selectedNodeAdd:CopyBuffer.
+ self updateChannels.
+!
+
+menuTree
+ "this window spec was automatically generated by the ST/X MenuEditor"
+
+ ^ self class menuTree
+
+
+! !
+
+!HierarchicalListEditor methodsFor:'private'!
+
+newItem
+ "creates and returns a new default item
+ "
+ ^ TreeItem name:'undefined' contents:nil
+!
+
+updateChannels
+ "update channels
+ "
+ |node parent chnStepIn chnStepOut chnStepOvr chnChild chnSister|
+
+ chnStepIn := chnStepOut := chnStepOvr := chnChild := chnSister := false.
+
+ (node := treeView selectedNode) notNil ifTrue:[
+ chnChild := true.
+
+ (parent := node parent) notNil ifTrue:[
+ chnSister := true.
+ chnStepOvr := parent numberOfChildren > 1.
+ chnStepOut := parent parent notNil.
+ chnStepIn := node ~~ parent lastChild.
+ ]
+ ].
+ self canCreateChildChannel value:chnChild.
+ self canCreateSisterChannel value:chnSister.
+ self canStepOverChannel value:chnStepOvr.
+ self canStepOutChannel value:chnStepOut.
+ self canStepInChannel value:chnStepIn.
+! !
+
+!HierarchicalListEditor methodsFor:'queries'!
+
+canChangeClassName
+ "returns true if current class could be changed which is dependent on
+ the mode: standalone or started by UIPainter
+ "
+ ^ masterApplication isNil
+!
+
+canCopy
+ "returns true if any selection exists
+ "
+ ^ treeView selection notNil
+!
+
+canCut
+ "returns true if any selection exists and not includes
+ the anchor (first element into list).
+ "
+ treeView selection notNil ifTrue:[
+ ^ (treeView isInSelection:1) not
+ ].
+ ^ false
+!
+
+canPaste
+ "returns true if something to be paste exists and a
+ single selection exists
+ "
+ ^ (CopyBuffer notNil and:[treeView selectedNode notNil])
+!
+
+hasValidClass
+ "returns true if the class defined allready exists
+ "
+ ^ specClass isBehavior
+!
+
+hasValidMethodSelector
+ "returns true if the class and the instance selector defined
+ allready exists.
+ "
+ (specSelector notNil and:[self hasValidClass]) ifTrue:[
+ ^ (specClass compiledMethodAt:specSelector) notNil
+ ].
+ ^ false
+!
+
+hasValidSpecSelector
+ "returns true if the class and the class selector defined
+ allready exists.
+ "
+ (specSelector notNil and:[self hasValidClass]) ifTrue:[
+ ^ (specClass class compiledMethodAt:specSelector) notNil
+ ].
+! !
+
+!HierarchicalListEditor methodsFor:'startup/release'!
+
+buildFrom:aClass andSelector:aSelector
+ "rebuild window from a class and selector
+ "
+ |sel anchor stream|
+
+ (specClass := aClass) isBehavior ifFalse:[
+ specClass notNil ifTrue:[
+ specClass := Smalltalk at:aClass asSymbol
+ ]
+ ].
+ specSelector := nil.
+
+ aSelector size ~~ 0 ifTrue:[
+ sel := aSelector asString withoutSeparators.
+ sel size ~~ 0 ifTrue:[
+ specSelector := sel asSymbol
+ ]
+ ].
+ treeView selection:nil.
+
+ (specSelector notNil and:[specClass notNil]) ifTrue:[
+ (specClass respondsTo:specSelector) ifTrue:[
+ anchor := specClass perform:specSelector.
+
+ anchor isArray ifTrue:[
+ anchor := anchor decodeAsLiteralArray.
+ ]
+ ]
+ ].
+ anchor notNil ifTrue:[
+ anchor expand.
+ treeView model root:anchor.
+ ] ifFalse:[
+ self doNew
+ ].
+!
+
+initialize
+ "setup default values
+ "
+ super initialize.
+
+ treeView := SelectionInTreeView new.
+ treeView multipleSelectOk:true.
+ treeView action:[:aNr| self updateChannels. self cancel ].
+ self doNew.
+!
+
+openModalOnClass:aClass andSelector:aSelector
+ "open modal on class and selector
+ "
+ specClass := Association key:aClass value:aSelector.
+ super openInterfaceModal.
+
+
+!
+
+openOnClass:aClass andSelector:aSelector
+ "open on class and selector
+ "
+ specClass := Association key:aClass value:aSelector.
+ super openInterface.
+
+!
+
+postBuildWith:builder
+ "setup view
+ "
+ |cls sel|
+
+ specClass isAssociation ifTrue:[
+ cls := specClass key.
+ sel := specClass value.
+ ].
+ self buildFrom:cls andSelector:sel.
+
+! !
+
+!HierarchicalListEditor class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !