--- a/BrowserView.st Fri Aug 20 12:20:43 1999 +0200
+++ b/BrowserView.st Fri Aug 20 15:43:39 1999 +0200
@@ -2874,7 +2874,7 @@
].
].
aStream cr; cr; cr; cr; cr.
- aStream emphasis:(self commentEmphasis).
+ aStream emphasis:(self commentEmphasisAndColor).
s isNil ifTrue:[
aStream nextPut:$" ; cr; nextPutLine:' no comment or documentation method found'.
] ifFalse:[
@@ -3604,17 +3604,21 @@
|theClass cls|
- theClass := Object.
+ currentNamespace == JAVA ifTrue:[
+ theClass := Java at:'java.lang.Object'
+ ] ifFalse:[
+ theClass := Object.
+ ].
currentClass notNil ifTrue:[
- (cls := currentClass superclass) notNil ifTrue:[
- theClass := cls
- ]
+ (cls := currentClass superclass) notNil ifTrue:[
+ theClass := cls
+ ]
].
self
- classClassDefinitionTemplateFor:theClass
- in:currentClassCategory
- namespace:false
- private:false.
+ classClassDefinitionTemplateFor:theClass
+ in:currentClassCategory
+ namespace:false
+ private:false.
aspect := nil.
@@ -5267,47 +5271,24 @@
classListView setSelection:nil.
fullClass ifFalse:[
- methodCategoryListView contents:nil.
- methodListView contents:nil
+ methodCategoryListView contents:nil.
+ methodListView contents:nil
].
(aClass == Autoload
or:[aClass isNil or:[aClass isLoaded not]]) ifTrue:[
- theSuperClass := Object
+ currentNamespace == JAVA ifTrue:[
+ theSuperClass := Java at:'java.lang.Object'
+ ] ifFalse:[
+ theSuperClass := Object
+ ]
] ifFalse:[
- theSuperClass := aClass
+ theSuperClass := aClass
].
codeView contents:(self classTemplateFor:theSuperClass in:cat namespace:isNameSpace private:isPrivate).
codeView modified:false.
codeModified := false.
- codeView acceptAction:[:theCode |
- codeView cursor:Cursor execute.
- Object abortSignal catch:[
- |cls|
-
- Object errorSignal handle:[:ex |
- codeView error:ex errorString
- position:1 to:nil from:nil.
- ] do:[
- Class nameSpaceQuerySignal answer:Smalltalk
- do:[
-
- cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
- cls isBehavior ifTrue:[
- codeView modified:false.
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- cls isNamespace ifFalse:[
- self switchToClassNamed:(cls name).
- ]
- ]
- ]
- ]
- ].
- codeView cursor:(Cursor normal).
- ].
- self clearExplainAction.
self changeCurrentClass:nil
"Created: / 23.12.1996 / 12:45:43 / cg"
@@ -5540,92 +5521,102 @@
"return a class definition template - be smart in what is offered initially"
|cat name nameProto namePrefix i existingNames withNameSpaceDirective
- className ownerName s|
+ className ownerName s isJava|
+
+ (aSuperClass notNil and:[aSuperClass isJavaClass not]) ifFalse:[
+ (currentNamespace == JAVA
+ or:[aSuperClass notNil and:[aSuperClass isJavaClass]])
+ ifTrue:[
+ ^ self javaClassTemplateFor:aSuperClass in:categoryString private:isPrivate
+ ].
+ ].
+
+ self setAcceptActionForNewClass.
s := TextStream on:''.
isNameSpace ifTrue:[
- s nextPutAll:'Namespace name:''NewNameSpace'''.
- s cr; cr.
- s emphasis:(self commentEmphasis).
- s nextPutAll:'"
+ s nextPutAll:'Namespace name:''NewNameSpace'''.
+ s cr; cr.
+ s emphasis:(self commentEmphasisAndColor).
+ s nextPutAll:'"
Replace ''NewNameSpace'' by the desired name.
Create the namespace by ''accepting'',
either via the menu or the keyboard (usually CMD-A).
"
'.
- ^ s contents.
+ ^ s contents.
].
withNameSpaceDirective :=
- currentNamespace notNil
- and:[currentNamespace ~= '* all *'
- and:[currentNamespace ~= Smalltalk]].
+ currentNamespace notNil
+ and:[currentNamespace ~= '* all *'
+ and:[currentNamespace ~= Smalltalk]].
withNameSpaceDirective ifTrue:[
- className := aSuperClass nameWithoutNameSpacePrefix.
- s nextPutAll:('"{ Namespace: ''' , currentNamespace name , ''' }"').
- s cr; cr.
+ className := aSuperClass nameWithoutNameSpacePrefix.
+ s nextPutAll:('"{ Namespace: ''' , currentNamespace name , ''' }"').
+ s cr; cr.
] ifFalse:[
- className := aSuperClass name.
+ className := aSuperClass name.
].
cat := categoryString.
(cat isNil or:[cat startsWith:$*]) ifTrue:[
- cat := '* no category *'
+ cat := '* no category *'
].
nameProto := 'NewClass'.
i := 1.
isPrivate ifTrue:[
- namePrefix := currentClass name , '::'.
- existingNames := currentClass privateClasses.
- existingNames size > 0 ifTrue:[
- existingNames := existingNames collect:[:cls | cls name].
- ]
+ namePrefix := currentClass name , '::'.
+ existingNames := currentClass privateClasses.
+ existingNames size > 0 ifTrue:[
+ existingNames := existingNames collect:[:cls | cls name].
+ ]
] ifFalse:[
- namePrefix := ''.
- existingNames := Smalltalk keys
+ 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
- ].
+ nameProto := namePrefix , name.
+ [nameProto knownAsSymbol and:[existingNames includes:nameProto asSymbol]] whileTrue:[
+ i := i + 1.
+ name := 'NewClass' , i printString.
+ nameProto := namePrefix , name
+ ].
].
s nextPutAll:className.
isPrivate ifTrue:[
- withNameSpaceDirective ifTrue:[
- ownerName := currentClass nameWithoutNameSpacePrefix
- ] ifFalse:[
- ownerName := currentClass name
- ].
- s nextPutAll:(' subclass:#' , name , '
+ withNameSpaceDirective ifTrue:[
+ ownerName := currentClass nameWithoutNameSpacePrefix
+ ] ifFalse:[
+ ownerName := currentClass name
+ ].
+ s nextPutAll:(' subclass:#' , name , '
' , ' instanceVariableNames: ''''
' , ' classVariableNames: ''''
' , ' poolDictionaries: ''''
' , ' privateIn:' , ownerName)
] ifFalse:[
- s nextPutAll:(' subclass:#' , name , '
+ s nextPutAll:(' subclass:#' , name , '
' , ' instanceVariableNames: ''''
' , ' classVariableNames: ''''
' , ' poolDictionaries: ''''
' , ' category: ''').
- cat notNil ifTrue:[
- cat printWithQuotesDoubledOn:s
- ].
- s nextPutAll: ''''
+ cat notNil ifTrue:[
+ cat printWithQuotesDoubledOn:s
+ ].
+ s nextPutAll: ''''
].
s cr; cr.
- s emphasis:(self commentEmphasis).
+ s emphasis:(self commentEmphasisAndColor).
s nextPutAll:'
"
Replace ''' , className , ''', ''', name , ''' and
@@ -5658,6 +5649,61 @@
"Modified: 18.8.1997 / 15:43:58 / cg"
!
+javaClassTemplateFor:aSuperClass in:categoryString private:isPrivate
+ "return a java class definition template - be smart in what is offered initially"
+
+ |cat name nameProto namePrefix i existingNames withNameSpaceDirective
+ className ownerName s superPackage|
+
+ self setAcceptActionForNewJavaClass.
+
+ s := TextStream on:''.
+ s nextPutAll:('package ' , categoryString , ';').
+ s cr; cr.
+
+ s nextPutAll:('public '); cr.
+ s nextPutAll:('class ').
+
+ i := 1.
+ name := 'NewClass' , i printString.
+ [ (Java classNamed:(categoryString , '.' , name)) notNil ] whileTrue:[
+ i := i + 1.
+ name := 'NewClass' , i printString.
+ ].
+ s nextPutAll:name; space.
+
+ className := aSuperClass lastName.
+ superPackage := aSuperClass package copy replaceAll:$/ with:$..
+ superPackage = categoryString ifFalse:[
+ superPackage = 'java.lang' ifFalse:[
+ className := aSuperClass name.
+ ].
+ ].
+
+ s nextPutAll:'extends '; nextPutAll:className.
+ s nextPutAll:' {'; cr.
+ s nextPutAll:' // { private } { static } { final } type varName;'; cr.
+ s nextPutAll:' // int var1;'; cr.
+ s nextPutAll:' // int var2;'; cr.
+ s nextPutAll:'}'; cr.
+
+ s cr; cr.
+ s emphasis:(self commentEmphasisAndColor).
+ s nextPutAll:'
+
+// Replace ''' , className , ''', ''', name , ''' and
+// change the local variable declarations as required.
+//
+// Install (or change) the class by ''accepting'',
+// either via the menu or the keyboard (usually CMD-A).
+'.
+
+ ^ s contents
+
+ "Created: / 23.12.1996 / 12:46:31 / cg"
+ "Modified: / 15.6.1998 / 17:23:05 / cg"
+!
+
listOfAllClassNamesInCategory:aCategory
"return a list of the names of all classes in a given category"
@@ -10242,7 +10288,7 @@
"
'.
s cr.
- s emphasis:(self commentEmphasis).
+ s emphasis:(self commentEmphasisAndColor).
s nextPutAll:'"
change the above template into real code.
Then `accept'' either via the menu
@@ -12171,6 +12217,70 @@
"Modified: / 17.6.1998 / 11:39:02 / cg"
!
+setAcceptActionForNewClass
+ "tell the codeView what to do on accept and explain"
+
+ codeView acceptAction:[:theCode |
+ codeView cursor:Cursor execute.
+ Object abortSignal catch:[
+ |cls|
+
+ Object errorSignal handle:[:ex |
+ codeView error:ex errorString
+ position:1 to:nil from:nil.
+ ] do:[
+ Class nameSpaceQuerySignal answer:Smalltalk
+ do:[
+
+ cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
+ cls isBehavior ifTrue:[
+ codeView modified:false.
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ cls isNamespace ifFalse:[
+ self switchToClassNamed:(cls name).
+ ]
+ ]
+ ]
+ ]
+ ].
+ codeView cursor:(Cursor normal).
+ ].
+ self clearExplainAction.
+
+!
+
+setAcceptActionForNewJavaClass
+ "tell the codeView what to do on accept and explain"
+
+ codeView acceptAction:[:theCode |
+ codeView cursor:Cursor execute.
+ Object abortSignal catch:[
+ |cls|
+
+ Object errorSignal handle:[:ex |
+ ex signal == Object haltSignal ifTrue:[
+ ex reject
+ ].
+ codeView error:ex errorString position:1 to:nil from:nil.
+ ] do:[
+ cls := JavaCompiler
+ evaluateClassDefinition:theCode asString
+ notifying:codeView.
+ cls isBehavior ifTrue:[
+ codeView modified:false.
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ self switchToClassNamed:(cls name).
+ ]
+ ]
+ ].
+ codeView cursor:(Cursor normal).
+ ].
+ self clearExplainAction.
+
+!
+
setAcceptAndExplainActionsForMethod
"tell the codeView what to do on accept and explain"
@@ -12424,15 +12534,13 @@
"Modified: / 26.7.1998 / 14:04:10 / cg"
!
-commentEmphasis
+commentEmphasisAndColor
+ |prefs|
+
+ prefs := UserPreferences current.
^ Text
- addEmphasis:(UserPreferences current commentEmphasis)
- to:(#color->UserPreferences current commentColor).
-
-"/ ^ (#color -> (Color red:0 green:0 blue:25))
-
- "Created: / 1.8.1997 / 12:36:14 / cg"
- "Modified: / 31.3.1998 / 22:41:37 / cg"
+ addEmphasis:(prefs commentEmphasis) to:(#color->prefs commentColor).
+
!
fileImageIcon
@@ -12444,6 +12552,15 @@
"Created: / 29.10.1997 / 03:32:05 / cg"
!
+globalClassIdentifierEmphasisAndColor
+ |prefs|
+
+ prefs := UserPreferences current.
+ ^ Text
+ addEmphasis:(prefs globalClassIdentifierEmphasis) to:(#color->prefs globalClassIdentifierColor).
+
+!
+
helpIcon
"answer an icon to mark help spec methods"
@@ -13698,6 +13815,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.542 1999-08-20 10:20:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.543 1999-08-20 13:43:39 cg Exp $'
! !
BrowserView initialize!