--- a/Smalltalk.st	Wed May 08 16:30:05 2002 +0200
+++ b/Smalltalk.st	Mon May 13 11:16:35 2002 +0200
@@ -1837,6 +1837,54 @@
 
 !
 
+classCategoryCompletion:aPartialCategory
+    "given a partial class category name, return an array consisting of
+     2 entries: 1st: collection consisting of matching categories
+                2nd: the longest match"
+
+    |matches best lcName|
+
+    matches := IdentitySet new.
+
+    "/ search for exact match
+    self allClassesDo:[:aClass |
+        |category|
+
+        category := aClass category.
+        (category notNil and:[category startsWith:aPartialCategory]) ifTrue:[
+            matches add:category
+        ]
+    ].
+    matches isEmpty ifTrue:[
+        "/ search for case-ignoring match
+        lcName := aPartialCategory asLowercase.
+        self allClassesDo:[:aClass |
+            |category|
+
+            category := aClass category.
+            (category asLowercase startsWith:lcName) ifTrue:[
+                matches add:category
+            ].
+        ].
+    ].
+
+    matches isEmpty ifTrue:[
+        ^ Array with:aPartialCategory with:(Array with:aPartialCategory)
+    ].
+    matches size == 1 ifTrue:[
+        ^ Array with:matches first with:(matches asArray)
+    ].
+    matches := matches asSortedCollection.
+    best := matches longestCommonPrefix.
+    ^ Array with:best with:matches asArray
+
+    "
+     Smalltalk classCategoryCompletion:'Sys'    
+     Smalltalk classCategoryCompletion:'System'              
+     Smalltalk classCategoryCompletion:'System-BinaryStorage' 
+    "
+!
+
 classNamed:aString
     "return the class with name aString, or nil if absent.
      To get to the metaClass, append ' class' to the string."
@@ -6171,5 +6219,5 @@
 !Smalltalk class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.526 2002-05-03 13:05:24 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.527 2002-05-13 09:16:35 cg Exp $'
 ! !