"

 COPYRIGHT (c) 2004 by eXept Software AG

              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.

"

"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

ClassList subclass:#HierarchicalClassList

	instanceVariableNames:'topClassHolder'

	classVariableNames:'InheritedEntry'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

!HierarchicalClassList class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2004 by eXept Software AG

              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.

"

!

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 := Object asValue.

        topClassHolder addDependent:self

    ].

    ^ topClassHolder

!

topClassHolder:aValueHolder

    |oldTopClass newTopClass|

    oldTopClass := topClassHolder value.

    topClassHolder notNil ifTrue:[

        topClassHolder removeDependent:self

    ].

    topClassHolder := aValueHolder.

    topClassHolder notNil ifTrue:[

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

        topClassHolder addDependent:self.

    ].

    newTopClass := topClassHolder value.

    newTopClass ~~ oldTopClass ifTrue:[

        self enqueueDelayedUpdateList.

    ].

! !

!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

    |mode|

    mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.

    mode == OrganizerCanvas organizerModeClassHierarchy ifTrue:[^ false].

    mode isNil ifTrue:[^ false].

    self organizerMode value == OrganizerCanvas organizerModeCategory 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.

    nm isNil ifTrue:[^ '???'].

    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.7 2007-03-14 14:51:26 cg Exp $'

! !

HierarchicalClassList initialize!