--- a/BrowserView.st Sun Oct 27 14:20:59 1996 +0100
+++ b/BrowserView.st Mon Oct 28 14:03:13 1996 +0100
@@ -3306,31 +3306,47 @@
classTemplateFor:className in:cat private:isPrivate
"return a class definition template - be smart in what is offered initially"
- |aString name i|
-
- name := 'NewClass'.
+ |aString name nameProto namePrefix i existingNames|
+
+ nameProto := 'NewClass'.
i := 1.
- [name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
- i := i + 1.
- name := 'NewClass' , i printString
+ isPrivate ifTrue:[
+ namePrefix := currentClass name , '::'.
+ existingNames := currentClass privateClasses.
+ existingNames notNil ifTrue:[
+ existingNames := existingNames collect:[:cls | cls name].
+ ]
+ ] ifFalse:[
+ namePrefix := ''.
+ existingNames := Smalltalk keys
+ ].
+
+ name := 'NewClass' , i printString.
+ existingNames notNil ifTrue:[
+ nameProto := namePrefix , name.
+ [nameProto knownAsSymbol and:[existingNames includes:nameProto asSymbol]] whileTrue:[
+ i := i + 1.
+ name := 'NewClass' , i printString.
+ nameProto := namePrefix , name
+ ].
].
isPrivate ifTrue:[
- aString := className , ' subclass:#' , name , '
+ aString := className , ' subclass:#' , name , '
' , ' instanceVariableNames: ''''
' , ' classVariableNames: ''''
' , ' poolDictionaries: ''''
' , ' privateIn:' , currentClass name printString
] ifFalse:[
- aString := className , ' subclass:#' , name , '
+ aString := className , ' subclass:#' , name , '
' , ' instanceVariableNames: ''''
' , ' classVariableNames: ''''
' , ' poolDictionaries: ''''
' , ' category: '''.
- cat notNil ifTrue:[
- aString := aString , cat
- ].
- aString := aString , ''''
+ cat notNil ifTrue:[
+ aString := aString , cat
+ ].
+ aString := aString , ''''
].
aString := aString , '
@@ -3351,7 +3367,7 @@
^ aString
"Created: 8.2.1996 / 18:22:34 / cg"
- "Modified: 11.10.1996 / 16:28:42 / cg"
+ "Modified: 27.10.1996 / 14:43:08 / cg"
!
doClassMenu:aBlock
@@ -3366,60 +3382,77 @@
listOfAllClassesInCategory:aCategory
"return a list of all classes in a given category"
- |newList classes searchCategory nm owner|
+ |newList classNames searchCategory nm owner|
+
+ "/ keep track of added names (care for obsolete classes)
+
+ classNames := Set new.
(aCategory = '* hierarchy *') ifTrue:[
- newList := OrderedCollection new.
- classes := Set new.
- self classHierarchyOf:Object do:[:aClass :lvl|
- nm := aClass name.
- (classes includes:nm) ifFalse:[
- classes add:nm.
- newList add:(String new:lvl) , nm
- ]
- ].
- ^ newList
+ newList := OrderedCollection new.
+ self classHierarchyOf:Object do:[:aClass :lvl|
+ nm := aClass name.
+ (classNames includes:nm) ifFalse:[
+ classNames add:nm.
+ newList add:(String new:lvl) , nm
+ ]
+ ].
+ ^ newList
].
newList := Set new.
(aCategory = '* all *') ifTrue:[
- Smalltalk allBehaviorsDo:[:aClass |
- newList add:aClass name
- ]
+ Smalltalk allBehaviorsDo:[:aClass |
+ nm := aClass name.
+ (classNames includes:nm) ifFalse:[
+ classNames add:nm.
+ newList add:aClass
+ ]
+ ]
] ifFalse:[
- (aCategory = '* no category *') ifTrue:[
- searchCategory := nil
- ] ifFalse:[
- searchCategory := aCategory
- ].
- Smalltalk allBehaviorsDo:[:aClass |
- |thisCategory|
-
- aClass isMeta ifFalse:[
- thisCategory := aClass category.
- ((thisCategory = searchCategory)
- or:[thisCategory = aCategory]) ifTrue:[
- newList add:aClass name
- ]
- ]
- ]
+ (aCategory = '* no category *') ifTrue:[
+ searchCategory := nil
+ ] ifFalse:[
+ searchCategory := aCategory
+ ].
+
+ Smalltalk allBehaviorsDo:[:aClass |
+ |thisCategory|
+
+ aClass isMeta ifFalse:[
+ thisCategory := aClass category.
+ ((thisCategory = searchCategory)
+ or:[thisCategory = aCategory]) ifTrue:[
+ nm := aClass name.
+ (classNames includes:nm) ifFalse:[
+ classNames add:nm.
+ newList add:aClass
+ ]
+ ]
+ ]
+ ]
].
(newList size == 0) ifTrue:[^ nil].
- newList := newList asOrderedCollection sort.
-
- "/ indent after sorting
-
- newList := newList collect:[:item |
- (item includes:$:) ifTrue:[
- ' ' , item
- ] ifFalse:[
- item
- ]
- ].
+ newList := newList asOrderedCollection sort:[:a :b | a name < b name].
+
+ "/ collect names & indent after sorting
+
+ newList := newList collect:[:cls |
+ | nm owner s |
+
+ nm := cls name.
+ s := nm.
+ owner := cls.
+ [ (owner := owner owningClass) notNil ] whileTrue:[
+ s := ' ' , s
+ ].
+ s
+ ].
+
^ newList
- "Modified: 14.10.1996 / 18:38:26 / cg"
+ "Modified: 27.10.1996 / 15:28:08 / cg"
!
listOfClassHierarchyOf:aClass
@@ -8163,62 +8196,67 @@
show classVars, if classProtocol is shown (instead of classInstance vars)
"
showInstance ifTrue:[
- nameAccessSelector := #instVarNames
+ nameAccessSelector := #instVarNames
] ifFalse:[
- nameAccessSelector := #classVarNames
+ nameAccessSelector := #classVarNames
].
"/ class := currentClass notNil ifTrue:[currentClass] ifFalse:[actualClass].
"/ class isNil ifTrue:[class := currentClassHierarchy].
class := currentClassHierarchy notNil ifTrue:[
- currentClassHierarchy
+ currentClassHierarchy
] ifFalse:[
- currentClass
- ].
-class := currentClass.
-fullProtocol ifTrue:[
- class := currentClassHierarchy
-].
+ currentClass
+ ].
+ class := currentClass.
+ fullProtocol ifTrue:[
+ class := currentClassHierarchy
+ ].
+
+ class isNil ifTrue:[
+ variableListView list:nil.
+ ^ self
+ ].
class withAllSuperclasses do:[:aClass |
- |ignore|
-
- ignore := fullProtocol
- and:[classListView valueIsInSelection:(aClass name asString)].
- ignore ifFalse:[
- subList := aClass perform:nameAccessSelector.
- subList size ~~ 0 ifTrue:[
- l := l , (subList asOrderedCollection reverse).
- l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------').
- ]
- ]
+ |ignore|
+
+ ignore := fullProtocol
+ and:[classListView valueIsInSelection:(aClass name asString)].
+ ignore ifFalse:[
+ subList := aClass perform:nameAccessSelector.
+ subList size ~~ 0 ifTrue:[
+ l := l , (subList asOrderedCollection reverse).
+ l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------').
+ ]
+ ]
].
l reverse.
variableListView setAttributes:nil.
l ~= variableListView list ifTrue:[
- variableListView list:l.
+ variableListView list:l.
].
l keysAndValuesDo:[:index :entry |
- (entry startsWith:'---') ifTrue:[
- variableListView attributeAt:index put:#disabled.
- last := index
- ]
+ (entry startsWith:'---') ifTrue:[
+ variableListView attributeAt:index put:#disabled.
+ last := index
+ ]
].
last notNil ifTrue:[variableListView scrollToLine:last].
oldSelection notNil ifTrue:[
- variableListView setSelectElement:oldSelection.
- self hilightMethodsInMethodCategoryList:true inMethodList:true.
+ variableListView setSelectElement:oldSelection.
+ self hilightMethodsInMethodCategoryList:true inMethodList:true.
]
- "Modified: 4.6.1996 / 22:00:33 / cg"
+ "Modified: 27.10.1996 / 15:48:02 / cg"
! !
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.197 1996-10-27 13:20:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.198 1996-10-28 13:03:13 cg Exp $'
! !
BrowserView initialize!
--- a/BrwsrView.st Sun Oct 27 14:20:59 1996 +0100
+++ b/BrwsrView.st Mon Oct 28 14:03:13 1996 +0100
@@ -3306,31 +3306,47 @@
classTemplateFor:className in:cat private:isPrivate
"return a class definition template - be smart in what is offered initially"
- |aString name i|
-
- name := 'NewClass'.
+ |aString name nameProto namePrefix i existingNames|
+
+ nameProto := 'NewClass'.
i := 1.
- [name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
- i := i + 1.
- name := 'NewClass' , i printString
+ isPrivate ifTrue:[
+ namePrefix := currentClass name , '::'.
+ existingNames := currentClass privateClasses.
+ existingNames notNil ifTrue:[
+ existingNames := existingNames collect:[:cls | cls name].
+ ]
+ ] ifFalse:[
+ namePrefix := ''.
+ existingNames := Smalltalk keys
+ ].
+
+ name := 'NewClass' , i printString.
+ existingNames notNil ifTrue:[
+ nameProto := namePrefix , name.
+ [nameProto knownAsSymbol and:[existingNames includes:nameProto asSymbol]] whileTrue:[
+ i := i + 1.
+ name := 'NewClass' , i printString.
+ nameProto := namePrefix , name
+ ].
].
isPrivate ifTrue:[
- aString := className , ' subclass:#' , name , '
+ aString := className , ' subclass:#' , name , '
' , ' instanceVariableNames: ''''
' , ' classVariableNames: ''''
' , ' poolDictionaries: ''''
' , ' privateIn:' , currentClass name printString
] ifFalse:[
- aString := className , ' subclass:#' , name , '
+ aString := className , ' subclass:#' , name , '
' , ' instanceVariableNames: ''''
' , ' classVariableNames: ''''
' , ' poolDictionaries: ''''
' , ' category: '''.
- cat notNil ifTrue:[
- aString := aString , cat
- ].
- aString := aString , ''''
+ cat notNil ifTrue:[
+ aString := aString , cat
+ ].
+ aString := aString , ''''
].
aString := aString , '
@@ -3351,7 +3367,7 @@
^ aString
"Created: 8.2.1996 / 18:22:34 / cg"
- "Modified: 11.10.1996 / 16:28:42 / cg"
+ "Modified: 27.10.1996 / 14:43:08 / cg"
!
doClassMenu:aBlock
@@ -3366,60 +3382,77 @@
listOfAllClassesInCategory:aCategory
"return a list of all classes in a given category"
- |newList classes searchCategory nm owner|
+ |newList classNames searchCategory nm owner|
+
+ "/ keep track of added names (care for obsolete classes)
+
+ classNames := Set new.
(aCategory = '* hierarchy *') ifTrue:[
- newList := OrderedCollection new.
- classes := Set new.
- self classHierarchyOf:Object do:[:aClass :lvl|
- nm := aClass name.
- (classes includes:nm) ifFalse:[
- classes add:nm.
- newList add:(String new:lvl) , nm
- ]
- ].
- ^ newList
+ newList := OrderedCollection new.
+ self classHierarchyOf:Object do:[:aClass :lvl|
+ nm := aClass name.
+ (classNames includes:nm) ifFalse:[
+ classNames add:nm.
+ newList add:(String new:lvl) , nm
+ ]
+ ].
+ ^ newList
].
newList := Set new.
(aCategory = '* all *') ifTrue:[
- Smalltalk allBehaviorsDo:[:aClass |
- newList add:aClass name
- ]
+ Smalltalk allBehaviorsDo:[:aClass |
+ nm := aClass name.
+ (classNames includes:nm) ifFalse:[
+ classNames add:nm.
+ newList add:aClass
+ ]
+ ]
] ifFalse:[
- (aCategory = '* no category *') ifTrue:[
- searchCategory := nil
- ] ifFalse:[
- searchCategory := aCategory
- ].
- Smalltalk allBehaviorsDo:[:aClass |
- |thisCategory|
-
- aClass isMeta ifFalse:[
- thisCategory := aClass category.
- ((thisCategory = searchCategory)
- or:[thisCategory = aCategory]) ifTrue:[
- newList add:aClass name
- ]
- ]
- ]
+ (aCategory = '* no category *') ifTrue:[
+ searchCategory := nil
+ ] ifFalse:[
+ searchCategory := aCategory
+ ].
+
+ Smalltalk allBehaviorsDo:[:aClass |
+ |thisCategory|
+
+ aClass isMeta ifFalse:[
+ thisCategory := aClass category.
+ ((thisCategory = searchCategory)
+ or:[thisCategory = aCategory]) ifTrue:[
+ nm := aClass name.
+ (classNames includes:nm) ifFalse:[
+ classNames add:nm.
+ newList add:aClass
+ ]
+ ]
+ ]
+ ]
].
(newList size == 0) ifTrue:[^ nil].
- newList := newList asOrderedCollection sort.
-
- "/ indent after sorting
-
- newList := newList collect:[:item |
- (item includes:$:) ifTrue:[
- ' ' , item
- ] ifFalse:[
- item
- ]
- ].
+ newList := newList asOrderedCollection sort:[:a :b | a name < b name].
+
+ "/ collect names & indent after sorting
+
+ newList := newList collect:[:cls |
+ | nm owner s |
+
+ nm := cls name.
+ s := nm.
+ owner := cls.
+ [ (owner := owner owningClass) notNil ] whileTrue:[
+ s := ' ' , s
+ ].
+ s
+ ].
+
^ newList
- "Modified: 14.10.1996 / 18:38:26 / cg"
+ "Modified: 27.10.1996 / 15:28:08 / cg"
!
listOfClassHierarchyOf:aClass
@@ -8163,62 +8196,67 @@
show classVars, if classProtocol is shown (instead of classInstance vars)
"
showInstance ifTrue:[
- nameAccessSelector := #instVarNames
+ nameAccessSelector := #instVarNames
] ifFalse:[
- nameAccessSelector := #classVarNames
+ nameAccessSelector := #classVarNames
].
"/ class := currentClass notNil ifTrue:[currentClass] ifFalse:[actualClass].
"/ class isNil ifTrue:[class := currentClassHierarchy].
class := currentClassHierarchy notNil ifTrue:[
- currentClassHierarchy
+ currentClassHierarchy
] ifFalse:[
- currentClass
- ].
-class := currentClass.
-fullProtocol ifTrue:[
- class := currentClassHierarchy
-].
+ currentClass
+ ].
+ class := currentClass.
+ fullProtocol ifTrue:[
+ class := currentClassHierarchy
+ ].
+
+ class isNil ifTrue:[
+ variableListView list:nil.
+ ^ self
+ ].
class withAllSuperclasses do:[:aClass |
- |ignore|
-
- ignore := fullProtocol
- and:[classListView valueIsInSelection:(aClass name asString)].
- ignore ifFalse:[
- subList := aClass perform:nameAccessSelector.
- subList size ~~ 0 ifTrue:[
- l := l , (subList asOrderedCollection reverse).
- l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------').
- ]
- ]
+ |ignore|
+
+ ignore := fullProtocol
+ and:[classListView valueIsInSelection:(aClass name asString)].
+ ignore ifFalse:[
+ subList := aClass perform:nameAccessSelector.
+ subList size ~~ 0 ifTrue:[
+ l := l , (subList asOrderedCollection reverse).
+ l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------').
+ ]
+ ]
].
l reverse.
variableListView setAttributes:nil.
l ~= variableListView list ifTrue:[
- variableListView list:l.
+ variableListView list:l.
].
l keysAndValuesDo:[:index :entry |
- (entry startsWith:'---') ifTrue:[
- variableListView attributeAt:index put:#disabled.
- last := index
- ]
+ (entry startsWith:'---') ifTrue:[
+ variableListView attributeAt:index put:#disabled.
+ last := index
+ ]
].
last notNil ifTrue:[variableListView scrollToLine:last].
oldSelection notNil ifTrue:[
- variableListView setSelectElement:oldSelection.
- self hilightMethodsInMethodCategoryList:true inMethodList:true.
+ variableListView setSelectElement:oldSelection.
+ self hilightMethodsInMethodCategoryList:true inMethodList:true.
]
- "Modified: 4.6.1996 / 22:00:33 / cg"
+ "Modified: 27.10.1996 / 15:48:02 / cg"
! !
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.197 1996-10-27 13:20:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.198 1996-10-28 13:03:13 cg Exp $'
! !
BrowserView initialize!