Tools_HierarchicalClassList.st
author Claus Gittinger <cg@exept.de>
Wed, 02 Feb 2005 12:03:33 +0100
changeset 6179 182d948dcf05
parent 5592 d9730a8d7c52
child 6737 2a8e0031c83e
permissions -rw-r--r--
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.
"

"{ 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 := 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.3 2005-02-02 11:01:35 cg Exp $'
! !

HierarchicalClassList initialize!