diff -r ccbc84af922c -r 8121a4d4ab79 BrowserView.st --- 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!