--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/HierNode.st Wed Nov 01 14:43:34 1995 +0100
@@ -0,0 +1,448 @@
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+
+Object subclass:#HierarchyNode
+ instanceVariableNames:'name id parent children contents disabled hide level'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+!HierarchyNode class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg2/Attic/HierNode.st,v 1.1 1995-11-01 13:43:28 cg Exp $
+"
+!
+
+documentation
+"
+ class to build up tree like structures to represent
+ file-trees, class tress etc.
+ Especially suited for use with SelectionInHierarchy and
+ SelectionInHierarchyView.
+ See examples in SelectionInHierarchyView.
+"
+!
+
+!HierarchyNode class methodsFor:'instance creation'!
+
+newAsTreeFromSmalltalkClass: aClass
+
+ "create a tree of nodes with aClass and all its
+ subclasses as contents."
+
+ |newInst|
+ newInst := super new initialize.
+ newInst name: aClass name.
+ newInst contents: aClass.
+ newInst level: aClass allSuperclasses size.
+ aClass subclasses do: [ :aSubClass |
+ newInst addChild: (self newAsTreeFromSmalltalkClass: aSubClass).
+ ].
+ ^newInst
+!
+
+newWithName: aString
+
+ |newInst|
+ newInst := super new initialize.
+ newInst name: aString.
+ ^newInst
+!
+
+new
+
+ ^super new initialize
+!
+
+newWithName: aString andId: anId
+
+ |newInst|
+ newInst := super new initialize.
+ newInst name: aString.
+ newInst id: anId.
+ ^newInst
+! !
+
+!HierarchyNode methodsFor:'accessing'!
+
+contents
+ "Answer the contents of me (e.g. a set of items)"
+
+ ^contents
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+name
+ "return name"
+
+ ^ name
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+level
+ "answer the level in hierarchy (0=root)"
+
+ ^level
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+contents: anObject
+ "Set the contents of me to any object (e.g. a set of items)"
+
+ ^contents:= anObject
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+hide: aBoolean
+
+ "Set hide to aBoolean"
+
+ hide:= aBoolean
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+level: anInteger
+ "set the level in hierarchy (0=root)"
+
+ level := anInteger.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+hideToFalseForPath
+ "set the hide-flag to false"
+
+ hide:= false.
+ parent isNil ifTrue: [^self].
+ parent hideToFalseForPath
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+parent:something
+ "set parent"
+
+ parent := something.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+name: aString
+ "set the name that identifys me within my parent's context."
+
+ name := aString.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+id
+ "return id"
+
+ ^ id
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+id:something
+ "set id"
+
+ id := something.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+children: aCollectionWithElementsOfMyKind
+ "set my children"
+
+ aCollectionWithElementsOfMyKind do: [:child |
+ child parent: self.
+ child level: level +1.
+ ].
+ children := aCollectionWithElementsOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+disabled
+ "return disabled"
+
+ ^ disabled
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+disabled: aBool
+ "set disabled"
+
+ disabled := aBool.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+pathName
+ "return a full path name to me"
+
+ parent isNil ifTrue: [^ (self delimiterString), name].
+ ^parent pathName, (self delimiterString), name.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'queries'!
+
+hasChildren
+
+ ^children size > 0.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+isExpandable
+ "Answer true if I have hidden children"
+
+ self hasChildren ifTrue: [ ^hide == true ].
+ ^false.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+isCollapsable
+ "Answer true if I have shown children"
+
+ self hasChildren ifTrue: [ ^hide == false ].
+ ^false.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+childrenHidden
+ "Answer true if my children shall be hidden
+ in hierachical printouts etc."
+
+ ^hide.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+childrenShown
+ "Answer true if my children shall be shown
+ in hierachical printouts etc."
+
+ ^hide not.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'hierarchy operations'!
+
+withAllShownChildren
+ "Answer me, my immediate children and all my grandchildren which are
+ currently not hidden.
+ -- in hierachical order and alphabeticaly sorted by name within one level."
+
+ | kids |
+ kids := OrderedCollection with: self .
+ self addAllShownChildrenTo: kids.
+ ^kids.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+allChildren
+ "Answer my immediate children plus all my grandchildren
+ -- in hierachical order and alphabeticaly sorted by name within one level."
+
+ | kids |
+ kids := OrderedCollection new.
+ self addAllChildrenTo: kids.
+ ^kids.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+addChild: anObjectOfMyKind
+ "add anObjectOfMyKind to my children"
+
+ anObjectOfMyKind parent: self.
+ anObjectOfMyKind level: level +1.
+ children add: anObjectOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+expand
+ "Show my immediate children in hierachical printouts."
+
+ hide := false.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+collapse
+ "Hide my children in hierachical printouts."
+
+ hide := true
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+removeChild: anObjectOfMyKind
+ "remove anObjectOfMyKind from my children"
+
+ anObjectOfMyKind parent: nil.
+ children rehash.
+ children remove: anObjectOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"
+!
+
+removeYourself
+ "remove me and all my children"
+
+ parent isNil ifTrue: [^nil].
+ parent removeChild: self.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+withAllChildren
+ "Answer me, my immediate children and all my grandchildren
+ -- in hierachical order and alphabeticaly sorted by name within one level."
+
+ | kids |
+ kids := OrderedCollection with: self .
+ self addAllChildrenTo: kids.
+ ^kids.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+parent
+ "return parent"
+
+ ^ parent
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+children
+ "Answer my immediate children."
+
+ ^ children
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+addChildren: aCollectionWithElementsOfMyKind
+ "add aCollectionWithElementsOfMyKind to my children"
+
+ aCollectionWithElementsOfMyKind do: [:child |
+ child parent: self.
+ child level: level +1.
+ ].
+ children addAll: aCollectionWithElementsOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+allParents
+ "return all my parents (next first - root last)"
+
+ parent isNil ifTrue: [ ^OrderedCollection new: 0 ]
+ ifFalse: [ ^parent, parent allParents ].
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+expandAll
+ "Show my children and all grand children in hierachical printouts."
+
+ hide := false.
+ children do: [ :kid | kid expandAll ].
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+collapseAll
+ "Hide my children and all my grandchildren in hierachical printouts."
+
+ hide := true.
+ children do: [ :kid | kid collapseAll ].
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+removeAllChildren
+ "Remove all children of me from the tree, i.e. let them
+ forget myself as parent."
+
+ | kids |
+ kids := self allChildren.
+ kids do: [:kid | kid parent: nil ].
+ children := Set new.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'private'!
+
+addAllShownChildrenTo: aCollection
+ "Add all my children in hierachical and alphabetical order
+ if they are not hidden."
+
+ |myChildren|
+ hide ifTrue: [^self].
+ myChildren := children asSortedCollection:
+ [:x :y | x name < y name ].
+ myChildren do: [:aChild |
+ aCollection addLast: aChild.
+ aChild addAllShownChildrenTo: aCollection.
+ ].
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"!
+
+addAllChildrenTo: aCollection
+ "Add all my children in hierachical and alphabetical order."
+
+ |myChildren|
+ myChildren := children asSortedCollection:
+ [:x :y | x name < y name ].
+ myChildren do: [:aChild |
+ aCollection addLast: aChild.
+ aChild addAllChildrenTo: aCollection.
+ ].
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'initialize-release'!
+
+initialize
+ "init some defaults"
+
+ " name
+ id
+ parent --"
+ children := Set new.
+ " contents := Set new."
+ disabled := false.
+ hide := false.
+ level := 0. "=root"
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'constants'!
+
+delimiter
+ "Answer the delimiter character"
+
+ ^$/
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"!
+
+delimiterString
+ "Answer the delimiter character asString"
+
+ ^self delimiter asString
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"! !
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/HierarchyNode.st Wed Nov 01 14:43:34 1995 +0100
@@ -0,0 +1,448 @@
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+
+Object subclass:#HierarchyNode
+ instanceVariableNames:'name id parent children contents disabled hide level'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+!HierarchyNode class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg2/HierarchyNode.st,v 1.1 1995-11-01 13:43:28 cg Exp $
+"
+!
+
+documentation
+"
+ class to build up tree like structures to represent
+ file-trees, class tress etc.
+ Especially suited for use with SelectionInHierarchy and
+ SelectionInHierarchyView.
+ See examples in SelectionInHierarchyView.
+"
+!
+
+!HierarchyNode class methodsFor:'instance creation'!
+
+newAsTreeFromSmalltalkClass: aClass
+
+ "create a tree of nodes with aClass and all its
+ subclasses as contents."
+
+ |newInst|
+ newInst := super new initialize.
+ newInst name: aClass name.
+ newInst contents: aClass.
+ newInst level: aClass allSuperclasses size.
+ aClass subclasses do: [ :aSubClass |
+ newInst addChild: (self newAsTreeFromSmalltalkClass: aSubClass).
+ ].
+ ^newInst
+!
+
+newWithName: aString
+
+ |newInst|
+ newInst := super new initialize.
+ newInst name: aString.
+ ^newInst
+!
+
+new
+
+ ^super new initialize
+!
+
+newWithName: aString andId: anId
+
+ |newInst|
+ newInst := super new initialize.
+ newInst name: aString.
+ newInst id: anId.
+ ^newInst
+! !
+
+!HierarchyNode methodsFor:'accessing'!
+
+contents
+ "Answer the contents of me (e.g. a set of items)"
+
+ ^contents
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+name
+ "return name"
+
+ ^ name
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+level
+ "answer the level in hierarchy (0=root)"
+
+ ^level
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+contents: anObject
+ "Set the contents of me to any object (e.g. a set of items)"
+
+ ^contents:= anObject
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+hide: aBoolean
+
+ "Set hide to aBoolean"
+
+ hide:= aBoolean
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+level: anInteger
+ "set the level in hierarchy (0=root)"
+
+ level := anInteger.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+hideToFalseForPath
+ "set the hide-flag to false"
+
+ hide:= false.
+ parent isNil ifTrue: [^self].
+ parent hideToFalseForPath
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+parent:something
+ "set parent"
+
+ parent := something.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+name: aString
+ "set the name that identifys me within my parent's context."
+
+ name := aString.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+id
+ "return id"
+
+ ^ id
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+id:something
+ "set id"
+
+ id := something.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+children: aCollectionWithElementsOfMyKind
+ "set my children"
+
+ aCollectionWithElementsOfMyKind do: [:child |
+ child parent: self.
+ child level: level +1.
+ ].
+ children := aCollectionWithElementsOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+disabled
+ "return disabled"
+
+ ^ disabled
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+disabled: aBool
+ "set disabled"
+
+ disabled := aBool.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+pathName
+ "return a full path name to me"
+
+ parent isNil ifTrue: [^ (self delimiterString), name].
+ ^parent pathName, (self delimiterString), name.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'queries'!
+
+hasChildren
+
+ ^children size > 0.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+isExpandable
+ "Answer true if I have hidden children"
+
+ self hasChildren ifTrue: [ ^hide == true ].
+ ^false.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+isCollapsable
+ "Answer true if I have shown children"
+
+ self hasChildren ifTrue: [ ^hide == false ].
+ ^false.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+childrenHidden
+ "Answer true if my children shall be hidden
+ in hierachical printouts etc."
+
+ ^hide.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"!
+
+childrenShown
+ "Answer true if my children shall be shown
+ in hierachical printouts etc."
+
+ ^hide not.
+
+ "Modified: 10.10.94 / 16:13:33 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'hierarchy operations'!
+
+withAllShownChildren
+ "Answer me, my immediate children and all my grandchildren which are
+ currently not hidden.
+ -- in hierachical order and alphabeticaly sorted by name within one level."
+
+ | kids |
+ kids := OrderedCollection with: self .
+ self addAllShownChildrenTo: kids.
+ ^kids.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+allChildren
+ "Answer my immediate children plus all my grandchildren
+ -- in hierachical order and alphabeticaly sorted by name within one level."
+
+ | kids |
+ kids := OrderedCollection new.
+ self addAllChildrenTo: kids.
+ ^kids.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+addChild: anObjectOfMyKind
+ "add anObjectOfMyKind to my children"
+
+ anObjectOfMyKind parent: self.
+ anObjectOfMyKind level: level +1.
+ children add: anObjectOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+expand
+ "Show my immediate children in hierachical printouts."
+
+ hide := false.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+collapse
+ "Hide my children in hierachical printouts."
+
+ hide := true
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+removeChild: anObjectOfMyKind
+ "remove anObjectOfMyKind from my children"
+
+ anObjectOfMyKind parent: nil.
+ children rehash.
+ children remove: anObjectOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"
+!
+
+removeYourself
+ "remove me and all my children"
+
+ parent isNil ifTrue: [^nil].
+ parent removeChild: self.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+withAllChildren
+ "Answer me, my immediate children and all my grandchildren
+ -- in hierachical order and alphabeticaly sorted by name within one level."
+
+ | kids |
+ kids := OrderedCollection with: self .
+ self addAllChildrenTo: kids.
+ ^kids.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+parent
+ "return parent"
+
+ ^ parent
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+children
+ "Answer my immediate children."
+
+ ^ children
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+addChildren: aCollectionWithElementsOfMyKind
+ "add aCollectionWithElementsOfMyKind to my children"
+
+ aCollectionWithElementsOfMyKind do: [:child |
+ child parent: self.
+ child level: level +1.
+ ].
+ children addAll: aCollectionWithElementsOfMyKind.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+allParents
+ "return all my parents (next first - root last)"
+
+ parent isNil ifTrue: [ ^OrderedCollection new: 0 ]
+ ifFalse: [ ^parent, parent allParents ].
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+expandAll
+ "Show my children and all grand children in hierachical printouts."
+
+ hide := false.
+ children do: [ :kid | kid expandAll ].
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+collapseAll
+ "Hide my children and all my grandchildren in hierachical printouts."
+
+ hide := true.
+ children do: [ :kid | kid collapseAll ].
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"!
+
+removeAllChildren
+ "Remove all children of me from the tree, i.e. let them
+ forget myself as parent."
+
+ | kids |
+ kids := self allChildren.
+ kids do: [:kid | kid parent: nil ].
+ children := Set new.
+
+ "Modified: 10.10.94 / 16:13:34 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'private'!
+
+addAllShownChildrenTo: aCollection
+ "Add all my children in hierachical and alphabetical order
+ if they are not hidden."
+
+ |myChildren|
+ hide ifTrue: [^self].
+ myChildren := children asSortedCollection:
+ [:x :y | x name < y name ].
+ myChildren do: [:aChild |
+ aCollection addLast: aChild.
+ aChild addAllShownChildrenTo: aCollection.
+ ].
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"!
+
+addAllChildrenTo: aCollection
+ "Add all my children in hierachical and alphabetical order."
+
+ |myChildren|
+ myChildren := children asSortedCollection:
+ [:x :y | x name < y name ].
+ myChildren do: [:aChild |
+ aCollection addLast: aChild.
+ aChild addAllChildrenTo: aCollection.
+ ].
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'initialize-release'!
+
+initialize
+ "init some defaults"
+
+ " name
+ id
+ parent --"
+ children := Set new.
+ " contents := Set new."
+ disabled := false.
+ hide := false.
+ level := 0. "=root"
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"! !
+
+!HierarchyNode methodsFor:'constants'!
+
+delimiter
+ "Answer the delimiter character"
+
+ ^$/
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"!
+
+delimiterString
+ "Answer the delimiter character asString"
+
+ ^self delimiter asString
+
+ "Modified: 10.10.94 / 16:13:35 / W.Olberding"! !
+
+
--- a/Make.proto Sun Oct 29 20:36:28 1995 +0100
+++ b/Make.proto Wed Nov 01 14:43:34 1995 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libwidg2/Make.proto,v 1.27 1995-10-27 18:00:06 cg Exp $
+# $Header: /cvs/stx/stx/libwidg2/Make.proto,v 1.28 1995-11-01 13:43:31 cg Exp $
#
# -------------- no need to change anything below ----------
@@ -36,7 +36,10 @@
HStepSLider.$(O) \
TextRuler.$(O) \
ClrListEntry.$(O) \
- ParSpec.$(O)
+ ParSpec.$(O) \
+ HierNode.$(O) \
+ SelHier.$(O) \
+ SelHierV.$(O)
# obsolete: \
# RetButton.$(O) \
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SelHier.st Wed Nov 01 14:43:34 1995 +0100
@@ -0,0 +1,296 @@
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+
+Model subclass:#SelectionInHierarchy
+ instanceVariableNames:'root list selection'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support-Models'
+!
+
+!SelectionInHierarchy class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg2/Attic/SelHier.st,v 1.1 1995-11-01 13:43:33 cg Exp $
+"
+!
+
+documentation
+"
+ model for a selection in a hierarchical list.
+ See examples in SelectionInHierarchyView.
+"
+! !
+
+!SelectionInHierarchy methodsFor:'accessing'!
+
+list
+ "Answer a collection of nodes representing the
+ list of currently viewed objects."
+
+ ^list
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+getHierarchyNodeForContents: something
+
+ "return the hierarchyNode wich contents is something"
+
+ |allNodes|
+
+ allNodes:= root allChildren.
+ allNodes do: [:each|
+ (each contents = something) ifTrue:[^each].
+ ].
+ ^nil
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+showCompleteHierarchyStartingAtNode: aHierarchyNode
+ "Set the hide-Flag to false for the hierarchy starting at aHierarchyNode"
+
+ | |
+ aHierarchyNode isNil ifTrue: [^self].
+ aHierarchyNode hideToFalseForPath.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+setHideToChildren: aBoolean startingAt: aHierarchyNode
+
+ "set the hide-Falg to aBoolean starting at aHierarchyNode down"
+
+ |allNodes|
+
+ allNodes:= root allChildren.
+ allNodes do: [:each|
+ each hide: aBoolean
+ ].
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+root: aHierarchyNode
+ "Set the root object - this means initialization."
+
+ root := aHierarchyNode.
+ self initialize.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+remove: aHierarchyNode
+ "Remove aHierarchyNode and all its children. "
+
+ aHierarchyNode removeYourself.
+ self setNewList.
+ ^aHierarchyNode
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+add: aHierarchyNode below: existingHierarchyNode
+ "Add a new HierarchyNode to the tree."
+
+
+ existingHierarchyNode addChild: aHierarchyNode.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+selectedPath
+ "Answer the pathName to the currently selected node."
+
+ | selectedNode |
+ selection isNil ifTrue: [^String new].
+ selectedNode := list at: selection ifAbsent: [^String new].
+ ^selectedNode pathName.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+add: aHierarchyNode belowIndex: anIndex
+ "Add a new HierarchyNode to the tree below the node
+ which is found in the list at anIndex."
+
+ | existingHierarchyNode |
+ existingHierarchyNode := list at: anIndex ifAbsent: [^nil].
+ self add: aHierarchyNode below: existingHierarchyNode
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+removeIndex: anIndex
+ "Remove the HierarchyNode and all its children
+ which is found in the list at anIndex."
+
+ | existingHierarchyNode |
+ existingHierarchyNode := list at: anIndex ifAbsent: [^nil].
+ ^self remove: existingHierarchyNode.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+removeBelow: existingHierarchyNode
+ "Remove all children below an existingHierarchyNode ."
+
+
+ existingHierarchyNode removeAllChildren.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+removeBelowIndex: anIndex
+ "Remove all the children of aHierarchyNode
+ which is found in the list at anIndex."
+
+ | existingHierarchyNode |
+ existingHierarchyNode := list at: anIndex ifAbsent: [^nil].
+ ^self removeBelow: existingHierarchyNode.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'selection'!
+
+selection
+ "Answer the current selection as
+ anIndex of the selection list."
+
+ ^selection
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+selection: anIndex
+ "Set the current selected object to be the element
+ at anIndex of the selection list."
+
+ anIndex isNil
+ ifTrue: [ selection := 0]
+ ifFalse: [
+ (selection = anIndex)
+ ifTrue: [^nil]
+ ifFalse: [selection := anIndex ].
+ ].
+ self changed: #selection.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+doubleClickSelection: anIndex
+ "Set the current selected object to be the element
+ at anIndex of the selection list.
+ Also expand or collapse the tree at that point."
+
+ self selection: anIndex.
+ self hideShow.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'private'!
+
+setNewList
+ "Travers the tree and build a new list."
+
+ list := root withAllShownChildren.
+ self changed: #list.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'hierarchy manipulation'!
+
+hideShow
+ "If possible, expand or collaps the tree
+ at the currently selected node."
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isExpandable ifTrue: [ selectedNode expand.
+ ^self setNewList. ].
+ selectedNode isCollapsable ifTrue: [ selectedNode collapse.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+expand
+ "If possible, expand the tree
+ at the currently selected node."
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isExpandable ifTrue: [ selectedNode expand.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+collapse
+ "If possible, collapse the tree at the currently selected node.
+ The tree structure can be restored again with #expand. "
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isCollapsable ifTrue: [ selectedNode collapse.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+expandAll
+ "If possible, expand the tree compleately to all leaves
+ at the currently selected node."
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode expandAll.
+ ^self setNewList.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+collapseAll
+ "If possible, collapse the tree at the currently selected node.
+ A latter #expand will show the next hierarchy level"
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isCollapsable ifTrue: [ selectedNode collapseAll.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'testing & debugging'!
+
+root
+
+ ^root
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'initialization'!
+
+initialize
+
+ " nodes := Set new. ***"
+ selection := nil.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SelHierV.st Wed Nov 01 14:43:34 1995 +0100
@@ -0,0 +1,316 @@
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+
+SelectionInListView subclass:#SelectionInHierarchyView
+ instanceVariableNames:'itemList showConnectingLines'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Text'
+!
+
+!SelectionInHierarchyView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg2/Attic/SelHierV.st,v 1.1 1995-11-01 13:43:34 cg Exp $
+"
+!
+
+documentation
+"
+ somewhat like a SelectionInListView; but specialized for hierarchical (i.e. tree-like)
+ lists and adds the functions to show/hide subtrees.
+ Requires SelectionInHierarchy as model and HierarchyNode (or compatible) list entries.
+ See examples.
+"
+!
+
+examples
+"
+ shows the tree of smalltalk classes:
+
+ |top hierarchy hierarchyV scroller|
+
+ hierarchy := SelectionInHierarchy new.
+ hierarchy root:(HierarchyNode newAsTreeFromSmalltalkClass:Object).
+ hierarchy setHideToChildren:true startingAt:hierarchy root.
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ hierarchyV := SelectionInHierarchyView new.
+ hierarchyV model: hierarchy.
+ hierarchyV action:[:nr | Transcript show:'selected:'; showCr:nr].
+
+ top add:(ScrollableView forView:hierarchyV)
+ in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
+ top open.
+
+
+ same, with nice connecting links:
+
+ |top hierarchy hierarchyV scroller|
+
+ hierarchy := SelectionInHierarchy new.
+ hierarchy root:(HierarchyNode newAsTreeFromSmalltalkClass:Object).
+ hierarchy setHideToChildren:true startingAt:hierarchy root.
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ hierarchyV := SelectionInHierarchyView new.
+ hierarchyV showConnectingLines:true.
+ hierarchyV model: hierarchy.
+ hierarchyV action:[:nr | Transcript show:'selected:'; showCr:nr].
+
+ top add:(ScrollableView forView:hierarchyV)
+ in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
+ top open.
+"
+! !
+
+!SelectionInHierarchyView methodsFor:'event handling'!
+
+buttonPress:button x:x y:y
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ enabled ifTrue:[
+ oldSelection := selection.
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ (selectConditionBlock isNil or:[selectConditionBlock value:listLineNr]) ifTrue:[
+ listLineNr notNil ifTrue: [
+ self selectWithoutScroll:listLineNr
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ "actionBlock notNil ifTrue:[actionBlock value:selection]."
+ "the ST-80 way of doing things"
+ model notNil ifTrue:[
+ model perform:#selection: with:(selection)
+ ]
+ ].
+ clickLine := listLineNr
+ ]
+ ]
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+
+ "Modified: 10.10.94 / 17:13:38 / W.Olberding"
+ "Modified: 08.11.94 / 15:38:43 / R.Sailer"!
+
+selection: anIndex
+ "Pass the selection along to the model."
+
+ super selection: anIndex.
+ model selection: anIndex.
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"!
+
+keyPress:key x:x y:y
+ "a key was pressed - handle [-][+][*] here"
+
+ (key == $-) ifTrue: [^ model collapse].
+ (key == $+) ifTrue: [^ model expand].
+ (key == $*) ifTrue: [^ model expandAll].
+ (key == $.) ifTrue: [^ model collapseAll].
+
+ super keyPress:key x:x y:y
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"! !
+
+!SelectionInHierarchyView methodsFor:'model access'!
+
+model:aModel
+ super model:aModel.
+ self setNewList
+!
+
+getSelectionFromModel
+ "Get the current list selection from model. "
+
+ ^ model selection
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"!
+
+getListFromModel
+ "Get list entries from model.
+ Answer them as idented Text."
+
+ | listOfNodes textList textLine treeLevels isLastOnLevel oldLevel |
+
+ listOfNodes := model list.
+ listOfNodes isNil ifTrue:[^ #()].
+
+ showConnectingLines ifFalse:[
+ textList := listOfNodes collect: [ :aNode |
+ textLine := ReadWriteStream on: String new.
+ aNode level timesRepeat: [
+ textLine space; space.
+ ].
+ textLine nextPutAll: aNode name.
+ aNode isExpandable ifTrue: [
+ textLine nextPutAll: ' ...'.
+ ].
+ textLine contents.
+ ].
+ ] ifTrue:[
+ isLastOnLevel:=Set new.
+ treeLevels:=Set new.
+ oldLevel:=0.
+
+ listOfNodes reverseDo: [ :aNode |
+ (treeLevels includes:(aNode level)) ifFalse:[
+ isLastOnLevel add:aNode.
+ treeLevels add:(aNode level).
+ ].
+ aNode level < oldLevel ifTrue:[
+ treeLevels remove:oldLevel.
+ ].
+ oldLevel:=aNode level.
+ ].
+
+ treeLevels:=Set new.
+ oldLevel:=0.
+ textList := listOfNodes collect: [ :aNode |
+ textLine := ReadWriteStream on: String new.
+
+ 1 to:((aNode level)-1) do: [ :l |
+ (treeLevels includes:l) ifTrue:[
+ textLine space; nextPutAll:((Character value:25)printString); space.
+ ]ifFalse:[
+ textLine space; space; space.
+ ]
+ ].
+ treeLevels add:(aNode level).
+ oldLevel:=aNode level.
+
+ (aNode = (listOfNodes first)) ifFalse:[
+ textLine space.
+ (isLastOnLevel includes:aNode)ifTrue:[
+ textLine nextPutAll:((Character value:14)printString).
+ treeLevels remove:(aNode level).
+ ]ifFalse:[
+ textLine nextPutAll:((Character value:21)printString).
+ ].
+ textLine nextPutAll:((Character value:18)printString).
+ ].
+ aNode isExpandable ifTrue: [
+ textLine nextPutAll: '[+]'.
+ ]ifFalse:[
+ aNode isCollapsable ifTrue: [
+ textLine nextPutAll: '[-]'.
+ ]ifFalse:[textLine nextPutAll:((Character value:18)printString).].
+ ].
+
+ textLine nextPutAll:' ', aNode name.
+ textLine contents.
+ ].
+ ].
+
+ ^textList
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"
+!
+
+getListAttributes
+ "get list attributes (selectable, disabled ...) from model)"
+
+ ^Array new: 0.
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"! !
+
+!SelectionInHierarchyView methodsFor:'updating'!
+
+update: aSymbol with:aParameter from:changedObject
+ "Change my apperance according to the occurred change."
+
+ aSymbol==#list
+ ifTrue: [^self setNewList].
+ aSymbol==#selection
+ ifTrue: [^self selection: self getSelectionFromModel].
+ aSymbol==#attributes
+ ifTrue: [].
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"! !
+
+!SelectionInHierarchyView methodsFor:'private'!
+
+setNewList
+ "Build a completely new hierarchy list."
+
+
+ self setList: (self getListFromModel).
+"/ self attributes: (self getListAttributes).
+ self selection: (self getSelectionFromModel).
+
+ "Modified: 10.10.94 / 17:13:38 / W.Olberding"
+ "Modified: 08.11.94 / 15:28:03 / R.Sailer"! !
+
+!SelectionInHierarchyView methodsFor:'initialization'!
+
+initialize
+
+ super initialize.
+ showConnectingLines := true.
+
+ self doubleClickAction:
+ [:selection | model doubleClickSelection: selection ].
+ "this will usualy initiate a hide/show operation"
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"
+!
+
+showConnectingLines:aBoolean
+ showConnectingLines := aBoolean
+! !
+
+!SelectionInHierarchyView methodsFor:'accessing'!
+
+
+selectElement:anObject
+ "select the element with same printString as the argument, anObject"
+
+ |index|
+
+ index:= 1.
+
+ list notNil ifTrue:[
+
+ list do:[:each|
+ ((each withoutSpaces) = (anObject printString)) ifTrue:[
+ self selection: index.
+ ^index
+ ].
+ index:= index + 1.
+ ].
+ ].
+ ^index
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SelectionInHierarchy.st Wed Nov 01 14:43:34 1995 +0100
@@ -0,0 +1,296 @@
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+
+Model subclass:#SelectionInHierarchy
+ instanceVariableNames:'root list selection'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support-Models'
+!
+
+!SelectionInHierarchy class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg2/SelectionInHierarchy.st,v 1.1 1995-11-01 13:43:33 cg Exp $
+"
+!
+
+documentation
+"
+ model for a selection in a hierarchical list.
+ See examples in SelectionInHierarchyView.
+"
+! !
+
+!SelectionInHierarchy methodsFor:'accessing'!
+
+list
+ "Answer a collection of nodes representing the
+ list of currently viewed objects."
+
+ ^list
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+getHierarchyNodeForContents: something
+
+ "return the hierarchyNode wich contents is something"
+
+ |allNodes|
+
+ allNodes:= root allChildren.
+ allNodes do: [:each|
+ (each contents = something) ifTrue:[^each].
+ ].
+ ^nil
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+showCompleteHierarchyStartingAtNode: aHierarchyNode
+ "Set the hide-Flag to false for the hierarchy starting at aHierarchyNode"
+
+ | |
+ aHierarchyNode isNil ifTrue: [^self].
+ aHierarchyNode hideToFalseForPath.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+setHideToChildren: aBoolean startingAt: aHierarchyNode
+
+ "set the hide-Falg to aBoolean starting at aHierarchyNode down"
+
+ |allNodes|
+
+ allNodes:= root allChildren.
+ allNodes do: [:each|
+ each hide: aBoolean
+ ].
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+root: aHierarchyNode
+ "Set the root object - this means initialization."
+
+ root := aHierarchyNode.
+ self initialize.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+remove: aHierarchyNode
+ "Remove aHierarchyNode and all its children. "
+
+ aHierarchyNode removeYourself.
+ self setNewList.
+ ^aHierarchyNode
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+add: aHierarchyNode below: existingHierarchyNode
+ "Add a new HierarchyNode to the tree."
+
+
+ existingHierarchyNode addChild: aHierarchyNode.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+selectedPath
+ "Answer the pathName to the currently selected node."
+
+ | selectedNode |
+ selection isNil ifTrue: [^String new].
+ selectedNode := list at: selection ifAbsent: [^String new].
+ ^selectedNode pathName.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+add: aHierarchyNode belowIndex: anIndex
+ "Add a new HierarchyNode to the tree below the node
+ which is found in the list at anIndex."
+
+ | existingHierarchyNode |
+ existingHierarchyNode := list at: anIndex ifAbsent: [^nil].
+ self add: aHierarchyNode below: existingHierarchyNode
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+removeIndex: anIndex
+ "Remove the HierarchyNode and all its children
+ which is found in the list at anIndex."
+
+ | existingHierarchyNode |
+ existingHierarchyNode := list at: anIndex ifAbsent: [^nil].
+ ^self remove: existingHierarchyNode.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+removeBelow: existingHierarchyNode
+ "Remove all children below an existingHierarchyNode ."
+
+
+ existingHierarchyNode removeAllChildren.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+removeBelowIndex: anIndex
+ "Remove all the children of aHierarchyNode
+ which is found in the list at anIndex."
+
+ | existingHierarchyNode |
+ existingHierarchyNode := list at: anIndex ifAbsent: [^nil].
+ ^self removeBelow: existingHierarchyNode.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'selection'!
+
+selection
+ "Answer the current selection as
+ anIndex of the selection list."
+
+ ^selection
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+selection: anIndex
+ "Set the current selected object to be the element
+ at anIndex of the selection list."
+
+ anIndex isNil
+ ifTrue: [ selection := 0]
+ ifFalse: [
+ (selection = anIndex)
+ ifTrue: [^nil]
+ ifFalse: [selection := anIndex ].
+ ].
+ self changed: #selection.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"!
+
+doubleClickSelection: anIndex
+ "Set the current selected object to be the element
+ at anIndex of the selection list.
+ Also expand or collapse the tree at that point."
+
+ self selection: anIndex.
+ self hideShow.
+
+ "Modified: 10.10.94 / 16:13:36 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'private'!
+
+setNewList
+ "Travers the tree and build a new list."
+
+ list := root withAllShownChildren.
+ self changed: #list.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'hierarchy manipulation'!
+
+hideShow
+ "If possible, expand or collaps the tree
+ at the currently selected node."
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isExpandable ifTrue: [ selectedNode expand.
+ ^self setNewList. ].
+ selectedNode isCollapsable ifTrue: [ selectedNode collapse.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+expand
+ "If possible, expand the tree
+ at the currently selected node."
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isExpandable ifTrue: [ selectedNode expand.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+collapse
+ "If possible, collapse the tree at the currently selected node.
+ The tree structure can be restored again with #expand. "
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isCollapsable ifTrue: [ selectedNode collapse.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+expandAll
+ "If possible, expand the tree compleately to all leaves
+ at the currently selected node."
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode expandAll.
+ ^self setNewList.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"!
+
+collapseAll
+ "If possible, collapse the tree at the currently selected node.
+ A latter #expand will show the next hierarchy level"
+
+ | selectedNode |
+ selectedNode := list at: selection.
+ selectedNode isCollapsable ifTrue: [ selectedNode collapseAll.
+ ^self setNewList. ].
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'testing & debugging'!
+
+root
+
+ ^root
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+!SelectionInHierarchy methodsFor:'initialization'!
+
+initialize
+
+ " nodes := Set new. ***"
+ selection := nil.
+ self setNewList.
+
+ "Modified: 10.10.94 / 16:13:37 / W.Olberding"! !
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SelectionInHierarchyView.st Wed Nov 01 14:43:34 1995 +0100
@@ -0,0 +1,316 @@
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+
+SelectionInListView subclass:#SelectionInHierarchyView
+ instanceVariableNames:'itemList showConnectingLines'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Text'
+!
+
+!SelectionInHierarchyView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by AEG Industry Automation
+ COPYRIGHT (c) 1994 by 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg2/SelectionInHierarchyView.st,v 1.1 1995-11-01 13:43:34 cg Exp $
+"
+!
+
+documentation
+"
+ somewhat like a SelectionInListView; but specialized for hierarchical (i.e. tree-like)
+ lists and adds the functions to show/hide subtrees.
+ Requires SelectionInHierarchy as model and HierarchyNode (or compatible) list entries.
+ See examples.
+"
+!
+
+examples
+"
+ shows the tree of smalltalk classes:
+
+ |top hierarchy hierarchyV scroller|
+
+ hierarchy := SelectionInHierarchy new.
+ hierarchy root:(HierarchyNode newAsTreeFromSmalltalkClass:Object).
+ hierarchy setHideToChildren:true startingAt:hierarchy root.
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ hierarchyV := SelectionInHierarchyView new.
+ hierarchyV model: hierarchy.
+ hierarchyV action:[:nr | Transcript show:'selected:'; showCr:nr].
+
+ top add:(ScrollableView forView:hierarchyV)
+ in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
+ top open.
+
+
+ same, with nice connecting links:
+
+ |top hierarchy hierarchyV scroller|
+
+ hierarchy := SelectionInHierarchy new.
+ hierarchy root:(HierarchyNode newAsTreeFromSmalltalkClass:Object).
+ hierarchy setHideToChildren:true startingAt:hierarchy root.
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ hierarchyV := SelectionInHierarchyView new.
+ hierarchyV showConnectingLines:true.
+ hierarchyV model: hierarchy.
+ hierarchyV action:[:nr | Transcript show:'selected:'; showCr:nr].
+
+ top add:(ScrollableView forView:hierarchyV)
+ in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
+ top open.
+"
+! !
+
+!SelectionInHierarchyView methodsFor:'event handling'!
+
+buttonPress:button x:x y:y
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ enabled ifTrue:[
+ oldSelection := selection.
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ (selectConditionBlock isNil or:[selectConditionBlock value:listLineNr]) ifTrue:[
+ listLineNr notNil ifTrue: [
+ self selectWithoutScroll:listLineNr
+ ].
+ ((ignoreReselect not and:[selection notNil])
+ or:[selection ~= oldSelection]) ifTrue:[
+ "actionBlock notNil ifTrue:[actionBlock value:selection]."
+ "the ST-80 way of doing things"
+ model notNil ifTrue:[
+ model perform:#selection: with:(selection)
+ ]
+ ].
+ clickLine := listLineNr
+ ]
+ ]
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+
+ "Modified: 10.10.94 / 17:13:38 / W.Olberding"
+ "Modified: 08.11.94 / 15:38:43 / R.Sailer"!
+
+selection: anIndex
+ "Pass the selection along to the model."
+
+ super selection: anIndex.
+ model selection: anIndex.
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"!
+
+keyPress:key x:x y:y
+ "a key was pressed - handle [-][+][*] here"
+
+ (key == $-) ifTrue: [^ model collapse].
+ (key == $+) ifTrue: [^ model expand].
+ (key == $*) ifTrue: [^ model expandAll].
+ (key == $.) ifTrue: [^ model collapseAll].
+
+ super keyPress:key x:x y:y
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"! !
+
+!SelectionInHierarchyView methodsFor:'model access'!
+
+model:aModel
+ super model:aModel.
+ self setNewList
+!
+
+getSelectionFromModel
+ "Get the current list selection from model. "
+
+ ^ model selection
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"!
+
+getListFromModel
+ "Get list entries from model.
+ Answer them as idented Text."
+
+ | listOfNodes textList textLine treeLevels isLastOnLevel oldLevel |
+
+ listOfNodes := model list.
+ listOfNodes isNil ifTrue:[^ #()].
+
+ showConnectingLines ifFalse:[
+ textList := listOfNodes collect: [ :aNode |
+ textLine := ReadWriteStream on: String new.
+ aNode level timesRepeat: [
+ textLine space; space.
+ ].
+ textLine nextPutAll: aNode name.
+ aNode isExpandable ifTrue: [
+ textLine nextPutAll: ' ...'.
+ ].
+ textLine contents.
+ ].
+ ] ifTrue:[
+ isLastOnLevel:=Set new.
+ treeLevels:=Set new.
+ oldLevel:=0.
+
+ listOfNodes reverseDo: [ :aNode |
+ (treeLevels includes:(aNode level)) ifFalse:[
+ isLastOnLevel add:aNode.
+ treeLevels add:(aNode level).
+ ].
+ aNode level < oldLevel ifTrue:[
+ treeLevels remove:oldLevel.
+ ].
+ oldLevel:=aNode level.
+ ].
+
+ treeLevels:=Set new.
+ oldLevel:=0.
+ textList := listOfNodes collect: [ :aNode |
+ textLine := ReadWriteStream on: String new.
+
+ 1 to:((aNode level)-1) do: [ :l |
+ (treeLevels includes:l) ifTrue:[
+ textLine space; nextPutAll:((Character value:25)printString); space.
+ ]ifFalse:[
+ textLine space; space; space.
+ ]
+ ].
+ treeLevels add:(aNode level).
+ oldLevel:=aNode level.
+
+ (aNode = (listOfNodes first)) ifFalse:[
+ textLine space.
+ (isLastOnLevel includes:aNode)ifTrue:[
+ textLine nextPutAll:((Character value:14)printString).
+ treeLevels remove:(aNode level).
+ ]ifFalse:[
+ textLine nextPutAll:((Character value:21)printString).
+ ].
+ textLine nextPutAll:((Character value:18)printString).
+ ].
+ aNode isExpandable ifTrue: [
+ textLine nextPutAll: '[+]'.
+ ]ifFalse:[
+ aNode isCollapsable ifTrue: [
+ textLine nextPutAll: '[-]'.
+ ]ifFalse:[textLine nextPutAll:((Character value:18)printString).].
+ ].
+
+ textLine nextPutAll:' ', aNode name.
+ textLine contents.
+ ].
+ ].
+
+ ^textList
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"
+!
+
+getListAttributes
+ "get list attributes (selectable, disabled ...) from model)"
+
+ ^Array new: 0.
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"! !
+
+!SelectionInHierarchyView methodsFor:'updating'!
+
+update: aSymbol with:aParameter from:changedObject
+ "Change my apperance according to the occurred change."
+
+ aSymbol==#list
+ ifTrue: [^self setNewList].
+ aSymbol==#selection
+ ifTrue: [^self selection: self getSelectionFromModel].
+ aSymbol==#attributes
+ ifTrue: [].
+
+ "Modified: 10.10.94 / 16:13:38 / W.Olberding"! !
+
+!SelectionInHierarchyView methodsFor:'private'!
+
+setNewList
+ "Build a completely new hierarchy list."
+
+
+ self setList: (self getListFromModel).
+"/ self attributes: (self getListAttributes).
+ self selection: (self getSelectionFromModel).
+
+ "Modified: 10.10.94 / 17:13:38 / W.Olberding"
+ "Modified: 08.11.94 / 15:28:03 / R.Sailer"! !
+
+!SelectionInHierarchyView methodsFor:'initialization'!
+
+initialize
+
+ super initialize.
+ showConnectingLines := true.
+
+ self doubleClickAction:
+ [:selection | model doubleClickSelection: selection ].
+ "this will usualy initiate a hide/show operation"
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"
+!
+
+showConnectingLines:aBoolean
+ showConnectingLines := aBoolean
+! !
+
+!SelectionInHierarchyView methodsFor:'accessing'!
+
+
+selectElement:anObject
+ "select the element with same printString as the argument, anObject"
+
+ |index|
+
+ index:= 1.
+
+ list notNil ifTrue:[
+
+ list do:[:each|
+ ((each withoutSpaces) = (anObject printString)) ifTrue:[
+ self selection: index.
+ ^index
+ ].
+ index:= index + 1.
+ ].
+ ].
+ ^index
+
+ "Modified: 10.10.94 / 16:13:39 / W.Olberding"! !