--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__HierarchicalClassList.st Fri Jul 01 15:34:16 2011 +0200
@@ -0,0 +1,318 @@
+"
+ 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:'accessing'!
+
+showMethodComplexity:aValueHolder
+
+ "Created: / 05-11-2007 / 17:15:35 / cg"
+!
+
+showMethodInheritance:aValueHolder
+
+ "Created: / 05-11-2007 / 17:15:23 / cg"
+!
+
+showMethodTypeIcon:aValueHolder
+
+ "Created: / 05-11-2007 / 17:15:42 / cg"
+! !
+
+!HierarchicalClassList methodsFor:'aspects'!
+
+methodVisibilityHolder:aValueHolder
+
+ "Created: / 05-11-2007 / 17:15:48 / cg"
+!
+
+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_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__HierarchicalClassList.st,v 1.1 2011-07-01 13:34:16 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: Tools__HierarchicalClassList.st 7796 2011-06-23 16:01:32Z vranyj1 §'
+! !
+
+HierarchicalClassList initialize!