--- a/BrowserView.st Sun Jan 05 14:43:00 1997 +0100
+++ b/BrowserView.st Sun Jan 05 19:04:16 1997 +0100
@@ -1160,42 +1160,6 @@
!BrowserView methodsFor:'class category stuff'!
-changeNameSpaceTo:nsName
- |n selectedClass str|
-
- nsName = '* all *' ifTrue:[
- currentNamespace := nsName.
- ] ifFalse:[
- n := Smalltalk at:nsName asSymbol.
- n isNamespace ifTrue:[
- currentNamespace := n.
- ] ifFalse:[
- ^ self
- ]
- ].
-
- selectedClass := actualClass.
- currentClass := actualClass := nil.
- self classCategoryUpdate.
-
- selectedClass notNil ifTrue:[
- (currentNamespace = '* all *'
- or:[currentNamespace ~= selectedClass nameSpace]) ifTrue:[
- str := selectedClass name
- ] ifFalse:[
- str := selectedClass nameWithoutPrefix
- ].
-
- self switchToClassNamed:str.
- classListView hasSelection ifFalse:[
- self classCategorySelectionChanged.
- ]
- ]
-
- "Created: 3.1.1997 / 11:11:13 / cg"
- "Modified: 3.1.1997 / 17:27:54 / cg"
-!
-
checkClassCategorySelected
currentClassCategory isNil ifTrue:[
self warn:'select a class category first'.
@@ -1268,17 +1232,25 @@
listOfAllClassCategories
"return a list of all class categories"
- |newList cat|
+ |nameSpaceList newList cat allNameSpaces|
newList := Set new.
- (self listOfNamespaces) do:[:aNamespace |
+ currentNamespace = '* all *' ifTrue:[
+ nameSpaceList := Array with:Smalltalk.
+ allNameSpaces := true.
+ ] ifFalse:[
+ nameSpaceList := self listOfNamespaces.
+ allNameSpaces := false.
+ ].
+
+ nameSpaceList do:[:aNamespace |
aNamespace allBehaviorsDo:[:aClass |
aClass isMeta ifFalse:[
(aClass isNamespace not
or:[aClass == Namespace
or:[aClass == Smalltalk]]) ifTrue:[
- aClass nameSpace == aNamespace ifTrue:[
+ (allNameSpaces or:[aClass nameSpace == aNamespace]) ifTrue:[
cat := aClass category.
cat isNil ifTrue:[
cat := '* no category *'
@@ -1298,36 +1270,7 @@
^ newList asOrderedCollection sort.
- "Modified: 5.1.1997 / 00:15:08 / cg"
-!
-
-listOfAllNamespaces
- "return a list of all namespaces"
-
- allNamespaces isNil ifTrue:[
- allNamespaces := Namespace allNamespaces.
- ].
- ^ allNamespaces
-
- "Created: 20.12.1996 / 19:18:03 / cg"
- "Modified: 2.1.1997 / 20:18:43 / cg"
-!
-
-listOfNamespaces
- "return a list of considered namespaces"
-
- currentNamespace isNil ifTrue:[
- ^ Array with:Smalltalk
- ].
-
- currentNamespace = '* all *' ifTrue:[
- ^ self listOfAllNamespaces
- ].
-
- ^ Array with:currentNamespace
-
- "Created: 26.10.1996 / 11:25:39 / cg"
- "Modified: 20.12.1996 / 19:18:18 / cg"
+ "Modified: 5.1.1997 / 17:12:01 / cg"
!
renameCurrentClassCategoryTo:aString
@@ -3747,56 +3690,43 @@
listOfAllClassesInCategory:aCategory
"return a list of all classes in a given category"
- |nameSpaces newList classNames searchCategory
- match anyCategory nm owner|
+ |nameSpaces listOfClassNames listOfClasses classesPresent namesPresent searchCategory
+ match anyCategory nm owner allNameSpaces|
+
+ allNameSpaces := (currentNamespace = '* all *').
"/ keep track of added names (care for obsolete classes)
- classNames := Set new.
+ namesPresent := Set new.
(aCategory = '* hierarchy *') ifTrue:[
- newList := OrderedCollection new.
+ listOfClassNames := OrderedCollection new.
+
self classHierarchyOf:Object withAutoloaded:true do:[:aClass :lvl|
+ |indent|
+
(aClass isNamespace not
or:[aClass == Smalltalk]) ifTrue:[
nm := self displayedClassNameOf:aClass.
-"/ (newList includes:aClass) ifFalse:[
- (classNames includes:nm) ifFalse:[
+
+ (namesPresent includes:nm) ifFalse:[
+ indent := String new:lvl*2.
+
"/ show classes from other nameSpaces in italic
- (currentNamespace ~= '* all *'
- and:[(self findClassNamedInNameSpace:nm) isNil]) ifTrue:[
- nm := (String new:lvl*2) , (nm asText emphasizeAllWith:#italic).
- ] ifFalse:[
- nm := (String new:lvl*2) , nm.
+
+ (allNameSpaces not
+ and:[(self findClassNamedInNameSpace:nm) isNil]) ifTrue:[
+ nm := nm asText emphasizeAllWith:#italic.
].
- classNames add:nm.
- newList add:nm
+ nm := indent , nm.
+ namesPresent add:nm.
+ listOfClassNames add:nm
]
-
-"/ nm := aClass nameWithoutPrefix.
-"/
-"/ "/ is it in one of the selected namespaces ?
-"/
-"/ (self findClassNamed:aClass name) isNil ifTrue:[
-"/ classNames add:(aClass name).
-"/ newList add:(((String new:lvl) , nm) asText emphasizeAllWith:#italic)
-"/ ] ifFalse:[
-"/ currentNamespace = aClass nameSpace ifFalse:[
-"/ nm := aClass nameSpace name , '::' , aClass nameWithoutPrefix
-"/ ].
-"/
-"/ (classNames includes:nm) ifFalse:[
-"/ classNames add:nm.
-"/ newList add:(String new:lvl) , nm
-"/ ]
-"/ ]
]
].
- ^ newList
- ].
-
- newList := IdentitySet new.
- nameSpaces := self listOfNamespaces.
+ ^ listOfClassNames
+ ].
+
(aCategory = '* all *') ifTrue:[
anyCategory := true
@@ -3809,6 +3739,16 @@
].
].
+ allNameSpaces ifTrue:[
+ nameSpaces := Array with:Smalltalk.
+ ] ifFalse:[
+ nameSpaces := self listOfNamespaces.
+ ].
+
+ listOfClasses := OrderedCollection new.
+ listOfClassNames := OrderedCollection new.
+ classesPresent := IdentitySet new.
+
nameSpaces do:[:aNamespace |
aNamespace allBehaviorsDo:[:aClass |
|thisCategory actualNamespace nm owner|
@@ -3816,34 +3756,42 @@
aClass isMeta ifFalse:[
(aClass isNamespace not
or:[aClass == Smalltalk]) ifTrue:[
- match := anyCategory.
- match ifFalse:[
- thisCategory := aClass category.
- match := ((thisCategory = searchCategory)
- or:[thisCategory = aCategory]).
- ].
-
- match ifTrue:[
- fullClass ifTrue:[
- aClass owningClass notNil ifTrue:[
- match := false
- ]
+ (classesPresent includes:aClass) ifFalse:[
+
+ match := anyCategory.
+ match ifFalse:[
+ thisCategory := aClass category.
+ match := ((thisCategory = searchCategory)
+ or:[thisCategory = aCategory]).
+ ].
+
+ match ifTrue:[
+ fullClass ifTrue:[
+ aClass owningClass notNil ifTrue:[
+ match := false
+ ]
+ ].
].
- ].
-
- match ifTrue:[
- nm := self displayedClassNameOf:aClass.
-"/ (newList includes:aClass) ifFalse:[
- (classNames includes:nm) ifFalse:[
- (owner := aClass topOwningClass) notNil ifTrue:[
- actualNamespace := owner nameSpace
- ] ifFalse:[
- actualNamespace := aClass nameSpace.
- ].
- (actualNamespace isNamespace not "/ a private class
- or:[actualNamespace == aNamespace]) ifTrue:[
- classNames add:nm.
- newList add:aClass
+
+ match ifTrue:[
+ nm := self displayedClassNameOf:aClass.
+ (namesPresent includes:nm) ifFalse:[
+
+ allNameSpaces ifFalse:[
+ (owner := aClass topOwningClass) notNil ifTrue:[
+ actualNamespace := owner nameSpace
+ ] ifFalse:[
+ actualNamespace := aClass nameSpace.
+ ].
+ match := actualNamespace isNamespace not "/ a private class
+ or:[actualNamespace == aNamespace].
+ ].
+ match ifTrue:[
+ namesPresent add:nm.
+ classesPresent add:aClass.
+ listOfClasses add:aClass.
+ listOfClassNames add:nm.
+ ]
]
]
]
@@ -3855,19 +3803,22 @@
fullClass ifFalse:[
"/
"/ mhm - must search through private classes of those
- "/ in smalltalk (they are not visible in the nameSpace
+ "/ in smalltalk (they are not visible in the nameSpace,
+ "/ but should also be displayed)
"/
Smalltalk allBehaviorsDo:[:aClass |
|actualNamespace owner|
aClass isMeta ifFalse:[
- (owner := aClass topOwningClass) notNil ifTrue:[
- (newList includes:owner) ifTrue:[
- nm := self displayedClassNameOf:aClass.
- "/ (newList includes:aClass) ifFalse:[
- (classNames includes:nm) ifFalse:[
- classNames add:nm.
- newList add:aClass
+ (classesPresent includes:aClass) ifFalse:[
+ (owner := aClass topOwningClass) notNil ifTrue:[
+ (classesPresent includes:owner) ifTrue:[
+ nm := self displayedClassNameOf:aClass.
+ (namesPresent includes:nm) ifFalse:[
+ namesPresent add:nm.
+ listOfClasses add:aClass.
+ listOfClassNames add:nm.
+ ]
]
]
]
@@ -3875,26 +3826,31 @@
].
].
- (newList size == 0) ifTrue:[^ nil].
- newList := newList asOrderedCollection sort:[:a :b | (self displayedClassNameOf:a) < (self displayedClassNameOf:b)].
-
- "/ collect names & indent after sorting
-
- newList := newList collect:[:cls |
- | nm owner s |
-
- nm := self displayedClassNameOf:cls.
- s := nm.
+ (listOfClasses size == 0) ifTrue:[^ nil].
+
+ "/ sort by name
+ listOfClassNames sortWith:listOfClasses.
+
+ "/ indent after sorting
+ 1 to:listOfClassNames size do:[:index |
+ |nm cls owner s|
+
+ cls := listOfClasses at:index.
owner := cls.
- [ (owner := owner owningClass) notNil ] whileTrue:[
- s := ' ' , s
- ].
- s
- ].
-
- ^ newList
-
- "Modified: 4.1.1997 / 15:07:47 / cg"
+ (owner := owner owningClass) notNil ifTrue:[
+ nm := listOfClassNames at:index.
+ s := nm.
+ [owner notNil] whileTrue:[
+ s := ' ' , s.
+ owner := owner owningClass
+ ].
+ listOfClassNames at:index put:s.
+ ].
+ ].
+
+ ^ listOfClassNames
+
+ "Modified: 5.1.1997 / 18:45:22 / cg"
!
listOfClassHierarchyOf:aClass
@@ -7403,6 +7359,129 @@
"Modified: 5.1.1997 / 00:10:05 / cg"
! !
+!BrowserView methodsFor:'namespace stuff'!
+
+changeNameSpaceTo:nsName
+ |n selectedClass str selectedCategory|
+
+ nsName = '* all *' ifTrue:[
+ currentNamespace := nsName.
+ ] ifFalse:[
+ n := Smalltalk at:nsName asSymbol.
+ n isNamespace ifTrue:[
+ currentNamespace := n.
+ ] ifFalse:[
+ ^ self
+ ]
+ ].
+
+ selectedClass := actualClass.
+ currentClass := actualClass := nil.
+ selectedCategory := currentClassCategory.
+"/ currentClassCategory := nil.
+
+ self updateClassCategoryListWithScroll:true.
+ selectedCategory notNil ifTrue:[
+ self classCategorySelectionChanged.
+ ].
+
+"/ self classCategoryUpdate.
+
+ selectedClass notNil ifTrue:[
+ str := self displayedClassNameOf:selectedClass.
+
+"/ (currentNamespace = '* all *'
+"/ or:[currentNamespace ~= selectedClass nameSpace]) ifTrue:[
+"/ str := selectedClass name
+"/ ] ifFalse:[
+"/ str := selectedClass nameWithoutPrefix
+"/ ].
+
+ self switchToClassNamed:str.
+"/ classListView hasSelection ifFalse:[
+"/ self classCategorySelectionChanged.
+"/ ]
+ ]
+
+ "Created: 3.1.1997 / 11:11:13 / cg"
+ "Modified: 5.1.1997 / 19:00:34 / cg"
+!
+
+displayedClassNameOf:aClass
+ "depending on the current nameSpace, either show a classes
+ fullname or its name without the namespace prefix (if its in the current)"
+
+ |owner nm ns|
+
+ "/ in which nameSpace is that class (or its owner) ?
+
+ owner := aClass topOwningClass.
+ owner notNil ifTrue:[
+ ns := owner nameSpace.
+ ] ifFalse:[
+ ns := aClass nameSpace.
+ ].
+
+ "/ this 'cannot' happen (should always be Smalltalk)
+ ns isNil ifTrue:[
+ ^ aClass name
+ ].
+
+ currentNamespace = '* all *' ifTrue:[
+ (ns == Smalltalk) ifTrue:[
+ nm := aClass nameWithoutNameSpacePrefix.
+ ^ nm
+ ].
+ nm := aClass nameWithoutNameSpacePrefix.
+ ^ ns name , '::' , nm "/ full name
+"/ ^ aClass name "/ full name
+ ].
+
+ nm := aClass nameWithoutNameSpacePrefix.
+
+ "/ is it in one of the selected namespaces ?
+
+ (self findClassNamedInNameSpace:nm) isNil ifTrue:[
+ ^ ns name , '::' , nm "/ full name
+ ].
+ currentNamespace = ns ifFalse:[
+ ^ ns name , '::' , nm "/ full name
+ ].
+ ^ nm.
+
+ "Created: 20.12.1996 / 17:46:41 / cg"
+ "Modified: 5.1.1997 / 18:30:29 / cg"
+!
+
+listOfAllNamespaces
+ "return a list of all namespaces"
+
+ allNamespaces isNil ifTrue:[
+ allNamespaces := Namespace allNamespaces.
+ ].
+ ^ allNamespaces
+
+ "Created: 20.12.1996 / 19:18:03 / cg"
+ "Modified: 2.1.1997 / 20:18:43 / cg"
+!
+
+listOfNamespaces
+ "return a list of considered namespaces"
+
+ currentNamespace isNil ifTrue:[
+ ^ Array with:Smalltalk
+ ].
+
+ currentNamespace = '* all *' ifTrue:[
+ ^ self listOfAllNamespaces
+ ].
+
+ ^ Array with:currentNamespace
+
+ "Created: 26.10.1996 / 11:25:39 / cg"
+ "Modified: 20.12.1996 / 19:18:18 / cg"
+! !
+
!BrowserView methodsFor:'private'!
askAndBrowseMethodCategory:title action:aBlock
@@ -7650,15 +7729,17 @@
"Modified: 20.2.1996 / 20:47:51 / cg"
!
-classHierarchyOf:aClass level:level do:aBlock using:aDictionary removeFrom:remainSet
+classHierarchyOf:aClass level:level do:aBlock using:subclassDictionary removeFrom:remainSet
"evaluate the 2-arg block for every subclass of aClass,
passing class and nesting level to the block."
|names subclasses|
remainSet remove:aClass ifAbsent:[].
+
aBlock value:aClass value:level.
- subclasses := aDictionary at:aClass ifAbsent:[nil].
+
+ subclasses := subclassDictionary at:aClass ifAbsent:[nil].
(subclasses size == 0) ifFalse:[
names := subclasses collect:[:class | class name].
names sortWith:subclasses.
@@ -7666,47 +7747,81 @@
self classHierarchyOf:aSubClass
level:(level + 1)
do:aBlock
- using:aDictionary
+ using:subclassDictionary
removeFrom:remainSet
]
]
"Created: 20.12.1996 / 17:05:06 / cg"
- "Modified: 20.12.1996 / 17:53:47 / cg"
+ "Modified: 5.1.1997 / 18:45:41 / cg"
!
classHierarchyOf:topClass withAutoloaded:withAutoloaded do:aBlock
- "eavluate the 2-arg block for every class,
+ "evaluate the 2-arg block for every class,
starting at Object; passing class and nesting level to the block."
- |classes s classDict l remaining|
+ |classes s subclassDict l remaining allNameSpaces nameSpaceList|
classes := IdentitySet new.
- self listOfNamespaces do:[:aNamespace |
- aNamespace allClasses do:[:aClass |
- aClass isMeta ifFalse:[
- classes addAll:(aClass withAllSuperclasses).
+
+ "/ first, collect the list of classes to consider
+ "/ thats all classes which are in the selected NameSpaces,
+ "/ or private ones, owned by a class which is
+ "/ also all of its superclasses are added.
+
+ allNameSpaces := (currentNamespace = '* all *').
+ nameSpaceList := self listOfNamespaces.
+
+ Smalltalk allBehaviorsDo:[:aClass |
+ |actualNamespace match owner|
+
+ aClass isMeta ifFalse:[
+ (aClass isNamespace not
+ or:[aClass == Smalltalk]) ifTrue:[
+ match := allNameSpaces.
+ match ifFalse:[
+ (owner := aClass topOwningClass) notNil ifTrue:[
+ actualNamespace := owner nameSpace
+ ] ifFalse:[
+ actualNamespace := aClass nameSpace.
+ ].
+ match := nameSpaceList includesIdentical:actualNamespace.
+ ].
+ match ifTrue:[
+ classes addAll:(aClass withAllSuperclasses).
+ ]
]
]
].
- classDict := IdentityDictionary new:classes size.
+
+ "/ now, generate a dictionary, which associates a set of subclasses
+ "/ to each ...
+
+ subclassDict := IdentityDictionary new:classes size.
classes do:[:aClass |
s := aClass superclass.
s notNil ifTrue:[
- l := classDict at:s ifAbsent:[nil].
+ l := subclassDict at:s ifAbsent:[nil].
l isNil ifTrue:[
l := OrderedCollection new:5.
- classDict at:s put:l
+ subclassDict at:s put:l
].
l add:aClass
]
].
+
+ "/
+ "/ walk this ..
+ "/
remaining := classes.
- self classHierarchyOf:topClass level:0 do:aBlock using:classDict removeFrom:remaining.
-
+ self classHierarchyOf:topClass level:0 do:aBlock using:subclassDict removeFrom:remaining.
+
+ "/
+ "/ if autoloaded classes are wanted ...
+ "/
withAutoloaded ifTrue:[
(remaining includes:Autoload) ifTrue:[
- self classHierarchyOf:Autoload level:0 do:aBlock using:classDict removeFrom:remaining.
+ self classHierarchyOf:Autoload level:0 do:aBlock using:subclassDict removeFrom:remaining.
].
(remaining asSortedCollection:[:a :b | a name < b name]) do:[:aNilSubclass |
aBlock value:aNilSubclass value:0
@@ -7714,7 +7829,7 @@
].
"Created: 28.5.1996 / 13:46:23 / cg"
- "Modified: 4.1.1997 / 13:37:03 / cg"
+ "Modified: 5.1.1997 / 18:44:50 / cg"
!
classesInFullProtocolHierarchy:aClass do:aBlock
@@ -7750,41 +7865,6 @@
(ReadStream on:someCode) fileIn
!
-displayedClassNameOf:aClass
- |owner nm ns|
-
- nm := aClass nameWithoutNameSpacePrefix.
- owner := aClass topOwningClass.
- owner notNil ifTrue:[
- ns := owner nameSpace.
- ] ifFalse:[
- ns := aClass nameSpace.
- ].
- ns isNil ifTrue:[
- ^ nm
- ].
-
- currentNamespace = '* all *' ifTrue:[
- (ns == Smalltalk) ifTrue:[
- ^ nm
- ].
- ^ ns name , '::' , nm "/ full name
- ].
-
- "/ is it in one of the selected namespaces ?
-
- (self findClassNamedInNameSpace:nm) isNil ifTrue:[
- ^ ns name , '::' , nm "/ full name
- ].
- currentNamespace = ns ifFalse:[
- ^ ns name , '::' , nm "/ full name
- ].
- ^ nm.
-
- "Created: 20.12.1996 / 17:46:41 / cg"
- "Modified: 3.1.1997 / 19:28:07 / cg"
-!
-
enterBoxForBrowseTitle:title action:aBlock
"convenient method: setup enterBox with text from codeView or selected
method for method browsing based on className/variable"
@@ -9059,6 +9139,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.245 1997-01-05 13:43:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.246 1997-01-05 18:04:16 cg Exp $'
! !
BrowserView initialize!