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