--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_InheritanceClassList.st	Thu Feb 26 19:57:02 2004 +0100
@@ -0,0 +1,160 @@
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+HierarchicalClassList subclass:#InheritanceClassList
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Interface-Browsers-New'
+!
+
+!InheritanceClassList class methodsFor:'documentation'!
+
+documentation
+"
+    Like a HierarchicalClassList, but shows class inheritance.
+    For non-meta classes, this is the same as would be shown in
+    the hierarchy list;
+    For metaclasses, the tree is extented through the class-behavior
+    hierarchy.
+
+    embeddable application displaying the classes as listed by
+    the inputGenerator.
+    Provides an outputGenerator, which enumerates the classes and
+    their protocols (method-categories) in the selected classes.
+
+    [author:]
+	Claus Gittinger (cg@exept.de)
+"
+
+
+! !
+
+!InheritanceClassList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+    |top oldSelection newSelection showMeta|
+
+    self inSlaveModeOrInvisible ifTrue:[^ self].
+"/    (self slaveMode value == true) ifTrue:[^ self].
+
+    changedObject == slaveMode ifTrue:[
+	listValid ~~ true ifTrue:[
+	    self enqueueDelayedUpdateList
+	].
+	"/ self invalidateList.
+	^  self
+    ].
+
+    changedObject == meta ifTrue:[
+	oldSelection := self selectedClasses value ? #().
+	showMeta := meta value.
+
+	newSelection := oldSelection collect:[:cls | showMeta ifTrue:[cls theMetaclass] ifFalse:[cls theNonMetaclass]].
+	newSelection := newSelection asOrderedCollection.
+
+	top := self topClassHolder value.
+	top notNil ifTrue:[
+	    top := showMeta ifTrue:[top theMetaclass] ifFalse:[top theNonMetaclass].
+	    self topClassHolder value:top.
+	].
+	self invalidateList.
+
+(newSelection includes:nil) ifTrue:[self halt:'should not happen'].
+
+	self selectedClasses value:newSelection.
+	^ self.
+    ].
+    super delayedUpdate:something with:aParameter from:changedObject
+
+    "Modified: / 24.2.2000 / 15:29:21 / cg"
+!
+
+getSelectedClassIndicesFromClasses
+    |classes selectedClasses selectedIndices|
+
+    selectedClasses := self selectedClasses value.
+    selectedClasses size == 0 ifTrue:[^ #() ].
+
+    classes := self classList value.
+    selectedIndices := selectedClasses 
+		    collect:[:aSelectedClass |
+			classes identityIndexOf:aSelectedClass.
+		    ].
+    selectedIndices := selectedIndices select:[:idx | idx ~~ 0].
+    selectedIndices size == 0 ifTrue:[
+"/        meta value == true ifTrue:[
+"/self halt.
+"/        ] ifFalse:[
+"/self halt.
+"/        ]
+    ].
+
+    ^ selectedIndices
+
+    "Created: / 24.2.2000 / 19:48:05 / cg"
+    "Modified: / 24.2.2000 / 23:30:22 / cg"
+!
+
+getSelectedClassesFromIndices
+    |selected classes allSelected|
+
+    allSelected := false.
+
+    classes := classList value.
+    selected := self selectedClassNameIndices value collect:[:idx |
+	|cls|
+
+	cls := classes at:idx.
+"/        cls == AllEntry ifTrue:[
+"/            allSelected := true.
+"/            cls.
+"/        ] ifFalse:[
+"/            cls notNil ifTrue:[
+"/                meta value ifTrue:[
+"/                    cls := cls theMetaclass
+"/                ] ifFalse:[
+"/                    cls := cls theNonMetaclass
+"/                ].
+"/            ].
+"/            cls
+"/        ]
+    ].
+
+"/    allSelected ifTrue:[
+"/        selected := classList value select:[:cls | cls ~~ AllEntry].
+"/    ].
+
+    selected := selected select:[:cls | cls notNil].
+    ^selected.
+
+    "Created: / 24.2.2000 / 19:45:04 / cg"
+! !
+
+!InheritanceClassList methodsFor:'private'!
+
+defaultSlaveModeValue
+    self organizerMode value == #category ifTrue:[^ true].
+    ^ false
+!
+
+listOfClasses
+    |top classes|
+
+    (top := self topClassHolder value) isNil ifTrue:[
+	^ super listOfClasses
+    ].
+
+    classes := top withAllSuperclasses copy reverse.
+"/    classes addFirst:InheritedEntry.
+    ^ classes
+
+    "Modified: / 26.2.2000 / 00:38:48 / cg"
+! !
+
+!InheritanceClassList class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_InheritanceClassList.st,v 1.1 2004-02-26 18:55:29 cg Exp $'
+! !