--- a/Tools_ClassList.st Mon Jul 04 19:07:42 2011 +0200
+++ b/Tools_ClassList.st Mon Jul 04 19:07:47 2011 +0200
@@ -17,7 +17,7 @@
instanceVariableNames:'classList classNameList meta lastSelectedClasses
selectedClassNameIndices currentNamespace hidePrivateClasses
unloadedClassesColor markApplicationsHolder classFilterBlock
- showCoverageInformation'
+ showCoverageInformation sortByNameAndInheritance'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-New'
@@ -177,6 +177,7 @@
#forceGeneratorTrigger
#hidePrivateClasses
#hideUnloadedClasses
+ #sortByNameAndInheritance
#immediateUpdate
#inGeneratorHolder
#menuHolder
@@ -194,7 +195,7 @@
#showCoverageInformation
).
- "Modified: / 27-04-2010 / 16:14:16 / cg"
+ "Modified: / 04-07-2011 / 18:34:44 / cg"
! !
!ClassList methodsFor:'accessing'!
@@ -400,6 +401,28 @@
].
"Created: / 27-04-2010 / 16:13:20 / cg"
+!
+
+sortByNameAndInheritance
+ sortByNameAndInheritance isNil ifTrue:[
+ sortByNameAndInheritance := false asValue.
+ sortByNameAndInheritance addDependent:self.
+ ].
+ ^ sortByNameAndInheritance.
+
+ "Created: / 04-07-2011 / 18:28:15 / cg"
+!
+
+sortByNameAndInheritance:aValueHolder
+ sortByNameAndInheritance notNil ifTrue:[
+ sortByNameAndInheritance removeDependent:self
+ ].
+ sortByNameAndInheritance := aValueHolder.
+ sortByNameAndInheritance notNil ifTrue:[
+ sortByNameAndInheritance addDependent:self
+ ].
+
+ "Created: / 04-07-2011 / 18:33:43 / cg"
! !
!ClassList methodsFor:'change & update'!
@@ -902,9 +925,14 @@
].
].
+ changedObject == sortByNameAndInheritance ifTrue:[
+ self invalidateList.
+ ^ self.
+ ].
+
super update:something with:aParameter from:changedObject
- "Modified: / 06-08-2006 / 11:13:59 / cg"
+ "Modified: / 04-07-2011 / 19:06:47 / cg"
! !
!ClassList methodsFor:'drag & drop'!
@@ -1050,6 +1078,10 @@
|classesAlready classesOrdered generator nameSpaceFilter packageFilter allName hidePrivate
privateClassesPerClass nameFilterIncludesMatchCharacters lcNameFilter|
+ self sortByNameAndInheritance value ifTrue:[
+ ^ self listOfClassesByInheritance
+ ].
+
allName := self class nameListEntryForALL.
(self showAllClassesInNameSpaceOrganisation value) ifFalse:[
nameSpaceFilter := self nameSpaceFilter value.
@@ -1164,7 +1196,115 @@
"/ classes addFirst:AllEntry.
^ classesOrdered
- "Modified: / 10-02-2011 / 22:58:00 / cg"
+ "Modified: / 04-07-2011 / 18:33:56 / cg"
+!
+
+listOfClassesByInheritance
+ "TODO: needs refatoring and common code extract with listOfClasses,
+ but I have no time at the moment..."
+
+ |classesAlready classes classesOrdered generator nameSpaceFilter packageFilter allName hidePrivate
+ privateClassesPerClass nameFilterIncludesMatchCharacters lcNameFilter|
+
+ allName := self class nameListEntryForALL.
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ ].
+ packageFilter := self packageFilter value.
+ packageFilter notNil ifTrue:[
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ ].
+
+ inGeneratorHolder isNil ifTrue:[
+ "/ for standAlone testing
+ generator := Smalltalk allClasses.
+ (self hideUnloadedClasses value) ifTrue:[
+ generator := generator select:[:cls | cls isLoaded]
+ ].
+ ] ifFalse:[
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ ].
+
+ classesAlready := IdentitySet new.
+ classes := Set new.
+ classesOrdered := OrderedCollection new.
+ hidePrivate := self hidePrivateClasses value.
+
+ privateClassesPerClass := IdentityDictionary new.
+ nameFilterIncludesMatchCharacters := nameFilter notNil and:[nameFilter includesMatchCharacters].
+ nameFilter notNil ifTrue:[ lcNameFilter := nameFilter asLowercase].
+
+ generator do:[:cls |
+ |owner bucket|
+
+ (hidePrivate not or:[cls isPrivate not])
+ ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ (classesAlready includes:cls) ifFalse:[
+ classesAlready add:cls.
+ (owner := cls owningClass) notNil ifTrue:[
+ bucket := privateClassesPerClass at:owner ifAbsentPut:[SortedCollection new sortBlock:[:a :b | a name < b name] ].
+ bucket add:cls.
+ ] ifFalse:[
+ classes add:cls.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ privateClassesPerClass keysAndValuesDo:
+ [:owner :privateClasses|
+ (owner isPrivate not and:[(classes includes: owner) not])
+ ifTrue:[classes addAll: privateClasses]].
+
+
+ classes size == 1 ifTrue:[
+ classesOrdered := classes asArray.
+ self classLabelHolder value:(classes first name)
+ ] ifFalse:[
+"/ self classLabelHolder value:(classes size printString , ' classes').
+" sortBy value ~~ #doNotSort ifTrue:[
+ classesOrdered sort:[:a :b | a name < b name].
+ ]"
+ classesOrdered := ClassSorter sort: classes.
+ ].
+
+ privateClassesPerClass notEmpty ifTrue:[
+ |stream action|
+
+ stream := WriteStream on:(Array new).
+
+ action := [:eachClass |
+ |bucket|
+
+ stream nextPut:eachClass.
+
+ bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
+ bucket notNil ifTrue:[
+ bucket do:action.
+ ]
+ ].
+
+ classesOrdered do:action.
+ classesOrdered := stream contents.
+ ].
+
+"/
+"/ does not work (yet)
+"/ classes addFirst:AllEntry.
+ ^ classesOrdered
+
+ "Modified: / 18-08-2000 / 20:34:10 / cg"
+ "Modified: / 21-01-2008 / 19:43:04 / janfrog"
+ "Modified: / 24-08-2010 / 20:17:07 / Jan Vrany <enter your email here>"
+ "Created: / 04-07-2011 / 18:27:34 / cg"
!
makeDependent
@@ -1316,6 +1456,39 @@
"Modified: / 28-04-2010 / 14:05:38 / cg"
!
+nameListIndentStringFor:aClass withNameSpace:useFullName
+ | indent indentString cls |
+
+ indent := 0.
+ indentString := ''.
+ cls := aClass superclass.
+ [self classList value includesIdentical:cls]
+ whileTrue:
+ [indent := indent + 1.
+ cls := cls superclass].
+
+ indent == 0 ifFalse:[
+ indent <= 5 ifTrue:[
+ indentString := #(
+ ''
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ ) at:indent+1.
+ ] ifFalse:[
+ indentString := String new:indent*2 withAll:Character space.
+ ].
+
+ ].
+ ^indentString
+
+ "Modified: / 24-02-2000 / 17:52:28 / cg"
+ "Created: / 21-01-2008 / 19:02:07 / janfrog"
+ "Modified (format): / 04-07-2011 / 18:30:20 / cg"
+!
+
reconstructNameList
"only reconstruct the names - class list & selection remains unschanged.
Invoked when the organizerMode mode changes"
@@ -1373,13 +1546,14 @@
super release.
currentNamespace removeDependent:self.
+ sortByNameAndInheritance removeDependent:self.
hidePrivateClasses removeDependent:self.
markApplicationsHolder removeDependent:self.
meta removeDependent:self.
selectedClassNameIndices removeDependent:self.
showClassPackages removeDependent:self.
- "Created: / 5.2.2000 / 13:42:18 / cg"
+ "Created: / 05-02-2000 / 13:42:18 / cg"
!
updateClassesIn:aCollection
@@ -1637,11 +1811,17 @@
!
nameListEntryFor:aClass withNameSpace:useFullName
- |nm indent owner orgMode indentString javaPackage|
+ |sortByNameAndInheritance nm indent owner orgMode indentString javaPackage|
aClass == (self class nameListEntryForALL) ifTrue:[ ^ aClass ].
- nm := aClass nameInBrowser.
+ sortByNameAndInheritance := self sortByNameAndInheritance value.
+
+ sortByNameAndInheritance ifTrue:[
+ nm := (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameInBrowser.
+ ] ifFalse:[
+ nm := aClass nameInBrowser.
+ ].
aClass isLoaded ifFalse:[
unloadedClassesColor notNil ifTrue:[
@@ -1670,6 +1850,9 @@
useFullName ifFalse:[
aClass isPrivate ifFalse:[
+ sortByNameAndInheritance ifTrue:[
+ ^ (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameWithoutNameSpacePrefix
+ ].
^ aClass nameWithoutNameSpacePrefix
]
].
@@ -1686,11 +1869,16 @@
indent > 0 ifTrue:[
indent := indent * self indentPerPrivacyLevel.
indentString := String new:indent withAll:Character space.
- nm := indentString , '::' , aClass nameWithoutPrefix
+ sortByNameAndInheritance ifTrue:[
+ nm := (self nameListIndentStringFor:owner withNameSpace:useFullName)
+ , indentString , '::' , aClass nameWithoutPrefix.
+ ] ifFalse:[
+ nm := indentString , '::' , aClass nameWithoutPrefix
+ ]
].
^ nm
- "Modified: / 24.2.2000 / 17:52:28 / cg"
+ "Modified: / 04-07-2011 / 19:00:45 / cg"
! !
!ClassList methodsFor:'setup'!
@@ -1732,10 +1920,6 @@
!ClassList class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.51 2011-02-10 21:58:10 cg Exp $'
-!
-
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.51 2011-02-10 21:58:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.52 2011-07-04 17:07:47 cg Exp $'
! !