Tools__ClassSorter.st
changeset 9995 febbd7fc31a0
child 12123 4bde08cebd48
child 17602 36908309a12c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__ClassSorter.st	Fri Jul 01 15:28:45 2011 +0200
@@ -0,0 +1,103 @@
+"
+ COPYRIGHT (c) 2006 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 }"
+
+Object subclass:#ClassSorter
+	instanceVariableNames:'indents order'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Interface-Browsers-New'
+!
+
+!ClassSorter class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 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.
+"
+! !
+
+!ClassSorter class methodsFor:'sorting'!
+
+sort: classes
+
+    ^self new sort: classes
+
+    "Created: / 21-01-2008 / 19:40:19 / janfrog"
+! !
+
+!ClassSorter methodsFor:'filtering'!
+
+sort: classes
+        "Sort nodes according to their position in the class hierarchy"
+
+        | supersChain |
+        self initializeResults.
+        classes do: 
+                [:class | 
+                supersChain := class  withAllSuperclasses reversed.
+                supersChain removeAllSuchThat: [:cl | (classes includes: cl) not].
+                order add: supersChain "contents" -> class].
+        self buildIndentIndex.
+        ^self collectSortedClasses
+
+    "Modified: / 21-01-2008 / 19:43:24 / janfrog"
+! !
+
+!ClassSorter methodsFor:'private'!
+
+buildIndentIndex
+	indents := IdentityDictionary new.
+	order do: [:assoc | indents at: assoc value put: assoc key size - 1].
+!
+
+collectSortedClasses
+        ^order asArray collect: [:assoc | assoc value]
+
+    "Created: / 21-01-2008 / 19:41:54 / janfrog"
+!
+
+initializeResults
+	| i chain2 chain1 result max |
+	order := SortedCollection sortBlock: 
+					[:assoc1 :assoc2 | 
+					result := nil.
+					chain1 := assoc1 key.
+					chain2 := assoc2 key.
+					max := chain1 size min: chain2 size.
+					i := 1.
+					[result isNil and: [i <= max]] whileTrue: 
+							[(chain1 at: i) = (chain2 at: i) 
+								ifTrue: [i := i + 1]
+								ifFalse: [result := (chain1 at: i) name < (chain2 at: i) name]].
+					result isNil ifTrue: [chain1 size < chain2 size] ifFalse: [result]]
+! !
+
+!ClassSorter class methodsFor:'documentation'!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__ClassSorter.st,v 1.1 2011-07-01 13:28:45 cg Exp $'
+!
+
+version_SVN
+    ^ '§Id: Tools__ClassSorter.st 7486 2009-10-26 22:06:24Z vranyj1 §'
+! !