Tools_InheritanceClassList.st
author Claus Gittinger <cg@exept.de>
Thu, 26 Feb 2004 19:57:02 +0100
changeset 5591 273637686948
child 6179 182d948dcf05
permissions -rw-r--r--
initial checkin

"{ 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 $'
! !