"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

ClassList subclass:#HierarchicalClassList

	instanceVariableNames:'topClassHolder'

	classVariableNames:'InheritedEntry'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

!HierarchicalClassList class methodsFor:'documentation'!

documentation

"

    Like a ClassList, but shows classes hierarchical.

    If topClassHolders value is non-nil, only that classes hierarchy

    is shown.

    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)

"

! !

!HierarchicalClassList class methodsFor:'initialization'!

initialize

    InheritedEntry := '* inheritance *'

    "Created: / 24.2.2000 / 20:19:19 / cg"

! !

!HierarchicalClassList class methodsFor:'queries-plugin'!

aspectSelectors

    ^ super aspectSelectors ,

       #(  

	  topClassHolder

	)

! !

!HierarchicalClassList methodsFor:'aspects'!

topClassHolder

    topClassHolder isNil ifTrue:[

	topClassHolder := ValueHolder new.

	topClassHolder addDependent:self

    ].

    ^ topClassHolder

!

topClassHolder:aTriggerValue

    topClassHolder notNil ifTrue:[

	topClassHolder removeDependent:self

    ].

    topClassHolder := aTriggerValue.

    topClassHolder notNil ifTrue:[

	topClassHolder isBehavior ifTrue:[self halt:'should not happen'].

	topClassHolder addDependent:self

    ].

! !

!HierarchicalClassList methodsFor:'change & update'!

classDefinitionChanged:aClass

    |prevTop prevSelection newSelection selectedClassesHolder|

    listValid ifFalse:[^ self].

    slaveMode value == true ifTrue:[

	self invalidateList.

	^ self.

    ].

    selectedClassesHolder := self selectedClasses.

    prevSelection := selectedClassesHolder value copy.

    prevTop := self topClassHolder value.

    prevTop notNil ifTrue:[

	(prevTop name = aClass name) ifTrue:[

	    "/ forced update

	    topClassHolder value:aClass.

	] ifFalse:[

	    (prevTop name = aClass class name) ifTrue:[

		"/ forced update

		topClassHolder value:aClass class.

	    ]   

	]

    ].

    "/ must update the list (notice, that the hierarchy might have changed..)

    self updateList.

    selectedClassesHolder value ~= prevSelection ifTrue:[

	newSelection := prevSelection collect:[:eachOldClass | Smalltalk classNamed:(eachOldClass name)].

	selectedClassesHolder value:newSelection.

    ]

    "Modified: / 26.2.2000 / 01:17:01 / cg"

!

classRemoved:aClass

    |prevTop newTop prevSel nPrevSelected selectedClassesHolder newSelection wasMeta|

    prevTop := self topClassHolder value.

    prevTop notNil ifTrue:[

	wasMeta := prevTop isMeta.

	newTop := prevTop theNonMetaclass.

	[newTop notNil and:[(Smalltalk at:newTop name) ~= newTop]] whileTrue:[

	    newTop := newTop superclass.

	].

	wasMeta ifTrue:[

	    newTop := newTop theMetaclass

	].

	newTop ~~ prevTop ifTrue:[

	    self topClassHolder value:newTop.

	].

    ].

    selectedClassesHolder := self selectedClasses.

    "/ if there is a single selection,

    "/ which is the old top, replace it.

    prevSel := selectedClassesHolder value.

    nPrevSelected := prevSel size.

    nPrevSelected > 0 ifTrue:[

	nPrevSelected == 1 ifTrue:[

	    prevSel first == aClass ifTrue:[

		newTop notNil ifTrue:[

		    newSelection := Array with:newTop.

		] ifFalse:[

		    newSelection := #().

		]

	    ].

	] ifFalse:[

	    nPrevSelected ~~ 0 ifTrue:[

		"/ clear the selection

		newSelection := #().

	    ]

	].

	newSelection notNil ifTrue:[

	    selectedClassesHolder value:newSelection

	].

    ].

    super classRemoved:aClass.

! !

!HierarchicalClassList methodsFor:'private'!

addTo:aList whereSuperclassIs:aSuperclass

    |theClasses|

    aSuperclass isNil ifTrue:[

	theClasses := Smalltalk allClasses select:[:cls | cls superclass isNil]

    ] ifFalse:[

	theClasses := aSuperclass subclasses.

    ].

    (self hideUnloadedClasses value) ifTrue:[

	theClasses := theClasses select:[:cls | cls isLoaded].

    ].

    theClasses := theClasses asOrderedCollection sort:[:a :b | (a name ? '??') < (b name ? '??')].

    theClasses do:[:aClass |

	aList add:aClass.

	self addTo:aList whereSuperclassIs:aClass

    ].        

!

defaultSlaveModeValue

    self organizerMode value == #category ifTrue:[^ true].

    ^ false

!

listOfClasses

    |classes top|

    classes := OrderedCollection new.

    (top := self topClassHolder value) notNil ifTrue:[

	top := top theNonMetaclass.

	classes addAll:(top withAllSuperclasses copy reverse).

    ].

    self addTo:classes whereSuperclassIs:top.

    ^ classes

    "Modified: / 24.2.2000 / 13:27:43 / cg"

!

nameListEntryFor:aClass withNameSpace:useFullName

    |indent superClass nm|

    aClass == (self class nameListEntryForALL) ifTrue:[ ^ aClass ].

    aClass == InheritedEntry ifTrue:[ ^ aClass ].

    nm := aClass name.

    indent := 0.

    superClass := aClass superclass.

    [superClass notNil] whileTrue:[

	indent := indent + 1.

	superClass := superClass superclass.

    ].

    indent == 0 ifTrue:[

	^ nm

    ].

    indent <= 5 ifTrue:[

	indent := #(

		     ''

		     '    '

		     '        '

		     '            '

		     '                '

		     '                    '

		   ) at:indent+1.

    ] ifFalse:[

	indent := String new:indent*4 withAll:Character space.

    ].

    ^ indent , nm

    "Modified: / 24.2.2000 / 20:19:47 / cg"

!

release

    super release.

    topClassHolder removeDependent:self.

! !

!HierarchicalClassList class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassList.st,v 1.2 2004-02-26 19:03:55 cg Exp $'

! !

HierarchicalClassList initialize!