--- a/BrowserView.st Wed Feb 07 15:17:41 1996 +0100
+++ b/BrowserView.st Thu Feb 08 20:23:16 1996 +0100
@@ -105,6 +105,23 @@
!BrowserView methodsFor:'change & update'!
+refetchClass
+ "after a class definition change in another browser,
+ this is sent to update (otherwise, we'd still refer to the obsolete class)"
+
+"/ currentClass := Smalltalk at:(currentClass name asSymbol).
+ self switchToClass:(Smalltalk at:(currentClass name asSymbol)).
+
+"/ showInstance ifTrue:[
+"/ actualClass := currentClass
+"/ ] ifFalse:[
+"/ actualClass := currentClass class
+"/ ].
+
+ "Created: 8.2.1996 / 13:22:27 / cg"
+ "Modified: 8.2.1996 / 13:40:18 / cg"
+!
+
update:something with:someArgument from:changedObject
|list selector oldMethod|
@@ -113,7 +130,7 @@
"
lockUpdates == true ifTrue:[
"/ 'ignored my change' printNL.
- ^ self
+ ^ self
].
"/ changedObject print. ' ' print. someArgument print. ' ' print.
@@ -121,178 +138,206 @@
(changedObject == Smalltalk) ifTrue:[
- something == #newClass ifTrue:[
- (currentClass notNil
- and:[someArgument name = currentClass name]) ifTrue:[
- "
- the current class was autoloaded
- "
- self warnLabel:'the selected class has changed'.
- self updateClassListWithScroll:false.
- ].
-
- ((someArgument category = currentClassCategory)
- or:[currentClassCategory notNil
- and:[currentClassCategory startsWith:'*']]) ifTrue:[
- self updateClassListWithScroll:false.
- ].
-
- someArgument category ~= currentClassCategory ifTrue:[
- "
- category new ?
- "
- (classCategoryListView notNil
- and:[(list := classCategoryListView list) notNil
- and:[(list includes:someArgument category) not]])
- ifTrue:[
- self updateClassCategoryListWithScroll:false.
- ]
- ].
- ^ self
- ].
-
- something == #classRemove ifTrue:[
- someArgument == currentClass ifTrue:[
- self warnLabel:'the selected class was removed'.
- ^ self
- ].
- " fall into general update "
- ].
-
- "
- any other (unknown) change
- with the Smalltalk dictionary ...
- "
- self updateClassCategoryListWithScroll:false.
- self updateClassListWithScroll:false.
- ^ self
+ something == #newClass ifTrue:[
+ (currentClass notNil
+ and:[someArgument name = currentClass name]) ifTrue:[
+ "
+ the current class was autoloaded
+ "
+ self warnLabel:'the selected class has changed'.
+ self updateClassListWithScroll:false.
+ ].
+
+ ((someArgument category = currentClassCategory)
+ or:[currentClassCategory notNil
+ and:[currentClassCategory startsWith:'*']]) ifTrue:[
+ self updateClassListWithScroll:false.
+ ].
+
+ someArgument category ~= currentClassCategory ifTrue:[
+ "
+ category new ?
+ "
+ (classCategoryListView notNil
+ and:[(list := classCategoryListView list) notNil
+ and:[(list includes:someArgument category) not]])
+ ifTrue:[
+ self updateClassCategoryListWithScroll:false.
+ ]
+ ].
+ ^ self
+ ].
+
+ something == #classRemove ifTrue:[
+ someArgument == currentClass ifTrue:[
+ self warnLabel:'the selected class was removed'.
+ ^ self
+ ].
+ " fall into general update "
+ ].
+
+ "
+ any other (unknown) change
+ with the Smalltalk dictionary ...
+ "
+ self updateClassCategoryListWithScroll:false.
+ self updateClassListWithScroll:false.
+ ^ self
].
changedObject isBehavior ifTrue:[
- "/
- "/ its a class, that has changed
- "/
- fullClass ifTrue:[
- "/
- "/ full-class browser ...
- "/ (must check for moth class and metaclass changes)
- "/
- (currentClass == changedObject
- or:[currentClass class == changedObject]) ifTrue:[
- self warnLabel:'class was changed - the code shown may be obsolete'.
- ].
- ^ self
- ].
-
- (currentClass notNil
- and:[changedObject name = currentClass name]) ifTrue:[
- "/
- "/ its the current class that has changed
- "/
- something == #methodDictionary ifTrue:[
-
- "/ new feature: changeArg may be an array consisting of
- "/ the selector and the oldMethod
- someArgument isArray ifTrue:[
- oldMethod := someArgument at:2.
- selector := someArgument at:1.
- ] ifFalse:[
- selector := someArgument
- ].
-
- (selector isSymbol) ifTrue:[
- |changedMethod|
-
- "
- the method with selector was changed or removed
- "
- self updateMethodCategoryListWithScroll:false.
- self updateMethodListWithScroll:false.
-
- selector == currentSelector ifTrue:[
- "
- special care here: the currently shown method has been
- changed somehow in another browser (or via fileIn)
- "
- changedMethod := currentClass compiledMethodAt:currentSelector.
- changedMethod isNil ifTrue:[
- self warnLabel:'the method shown was removed'.
- ^ self
- ].
- "compare the source codes"
- currentMethod notNil ifTrue:[
- changedMethod source = codeView contents ifFalse:[
- self warnLabel:'method has changed - the code shown may be obsolete'.
- ]
- ].
- ^ self
- ].
- ]
- ].
-
- something == #comment ifTrue:[
- "
- the class has changed its comment; we dont care, except if
- currently showing the comment
- "
- aspect == #comment ifTrue:[
- self warnLabel:'the comment shown may not up to date'.
- ].
- ^ self
- ].
- something == #definition ifTrue:[
- "
- the class has changed its definition.
- Warn, except if showing a method.
- "
- aspect notNil ifTrue:[
- self warnLabel:'the classes definition has changed'.
- ].
-"/ ^ self
- ].
-
- "
- get the class again - in case of a changed class definition,
- we are otherwise refering to the obsolete old class
- "
- currentClass := Smalltalk at:(currentClass name asSymbol).
- showInstance ifTrue:[
- actualClass := currentClass
- ] ifFalse:[
- actualClass := currentClass class
- ].
-
- self updateMethodCategoryListWithScroll:false.
-
- "dont update codeView ...."
- "self update"
- ^ self
- ].
-
- "
- any other class has changed (but not its organization, since
- that is cought in the above case).
- We are not interested in it - except, if showing fullProtocol
- or hierarchy ...
- "
- currentClassHierarchy notNil ifTrue:[
- fullProtocol ifTrue:[
- (currentClass isSubclassOf:changedObject) ifTrue:[
- ]
- ] ifFalse:[
- ((currentClass isSubclassOf:changedObject)
- or:[changedObject isSubclassOf:currentClass]) ifTrue:[
- ]
- ]
- ].
-
- ^ self
+ "/
+ "/ its a class, that has changed
+ "/
+ fullClass ifTrue:[
+ "/
+ "/ full-class browser ...
+ "/ (must check for both class and metaclass changes)
+ "/
+ (currentClass == changedObject
+ or:[currentClass class == changedObject]) ifTrue:[
+ self warnLabel:'class was changed - the code shown may be obsolete'.
+ ].
+ ^ self
+ ].
+
+ (currentClass notNil
+ and:[changedObject name = currentClass name]) ifTrue:[
+something printNL.
+aspect printNL.
+ "/
+ "/ its the current class that has changed
+ "/
+ something == #methodDictionary ifTrue:[
+
+ "/ new feature: changeArg may be an array consisting of
+ "/ the selector and the oldMethod
+
+ someArgument isArray ifTrue:[
+ oldMethod := someArgument at:2.
+ selector := someArgument at:1.
+ ] ifFalse:[
+ selector := someArgument
+ ].
+
+ (selector isSymbol) ifTrue:[
+ |changedMethod|
+
+ "
+ the method with selector was changed or removed
+ "
+ self updateMethodCategoryListWithScroll:false.
+ self updateMethodListWithScroll:false.
+
+ selector == currentSelector ifTrue:[
+ "
+ special care here: the currently shown method has been
+ changed somehow in another browser (or via fileIn)
+ "
+ changedMethod := currentClass compiledMethodAt:currentSelector.
+ changedMethod isNil ifTrue:[
+ self warnLabel:'the method shown was removed'.
+ ^ self
+ ].
+ "compare the source codes"
+ currentMethod notNil ifTrue:[
+ changedMethod source = codeView contents ifFalse:[
+ self warnLabel:'method has changed - the code shown may be obsolete'.
+ ]
+ ].
+ ^ self
+ ].
+ ]
+ ].
+
+ something == #comment ifTrue:[
+ "
+ the class has changed its comment; we dont care, except if
+ currently showing the comment
+ "
+ aspect == #comment ifTrue:[
+ codeView modified ifFalse:[
+ self refetchClass.
+ self updateCodeView
+ ] ifTrue:[
+ self warnLabel:'the comment has changed - reselect to update'.
+ ]
+ ].
+ self refetchClass.
+ ^ self
+ ].
+
+ something == #definition ifTrue:[
+ "
+ the class has changed its definition.
+ Warn, except if showing a method.
+ "
+ aspect notNil ifTrue:[
+ codeView modified ifFalse:[
+ self refetchClass.
+ self updateCodeView
+ ] ifTrue:[
+ self warnLabel:'the classes definition has changed - reselect to update'.
+ ].
+ ^ self
+ ].
+ ].
+
+ "/
+ "/ if I am not showing code update if unmodified,
+ "/ warn if modified
+ "/
+ aspect notNil ifTrue:[
+ codeView modified ifFalse:[
+ self refetchClass.
+ self updateCodeView
+ ] ifTrue:[
+ self warnLabel:'the classes has changed - reselect to update'.
+ ].
+ ^ self
+ ].
+
+ "
+ get the class again - in case of a changed class definition,
+ we are otherwise refering to the obsolete old class
+ "
+ self refetchClass.
+
+ self updateMethodCategoryListWithScroll:false.
+
+ "dont update codeView ...."
+ "self update"
+
+ self warnLabel:'the class has changed'.
+ ^ self
+ ].
+
+ "
+ any other class has changed (but not its organization, since
+ that is cought in the above case).
+ We are not interested in it - except, if showing fullProtocol
+ or hierarchy ...
+ "
+ currentClassHierarchy notNil ifTrue:[
+ fullProtocol ifTrue:[
+ (currentClass isSubclassOf:changedObject) ifTrue:[
+ self warnLabel:'some superclass has changed - reselect to update'.
+ ]
+ ] ifFalse:[
+ ((currentClass isSubclassOf:changedObject)
+ or:[changedObject isSubclassOf:currentClass]) ifTrue:[
+ self warnLabel:'some superclass has changed - reselect to update'.
+ ]
+ ]
+ ].
+
+ ^ self
].
(changedObject isMethod) ifTrue:[
]
- "Modified: 13.12.1995 / 15:28:47 / cg"
+ "Modified: 8.2.1996 / 18:19:25 / cg"
! !
!BrowserView methodsFor:'class category list menu'!
@@ -854,19 +899,23 @@
"class category has changed - update dependent views"
self withWaitCursorDo:[
- self switchToClass:nil.
- actualClass := acceptClass := nil.
- currentMethodCategory := nil.
- currentMethod := currentSelector := nil.
-
- self updateClassList.
- self updateMethodCategoryList.
- self updateMethodList.
- self updateCodeView.
-
- codeView explainAction:nil.
- codeView acceptAction:nil
+ self switchToClass:nil.
+ aspect := nil.
+
+ actualClass := acceptClass := nil.
+ currentMethodCategory := nil.
+ currentMethod := currentSelector := nil.
+
+ self updateClassList.
+ self updateMethodCategoryList.
+ self updateMethodList.
+ self updateCodeView.
+
+ codeView explainAction:nil.
+ codeView acceptAction:nil
]
+
+ "Modified: 8.2.1996 / 13:35:18 / cg"
!
listOfAllClassCategories
@@ -1032,28 +1081,31 @@
for a class-instvar-definition change"
self doClassMenu:[:currentClass |
- |s|
-
- s := WriteStream on:(String new).
- currentClass fileOutClassInstVarDefinitionOn:s.
- codeView contents:(s contents).
- codeView modified:false.
- codeView acceptAction:[:theCode |
- codeView cursor:Cursor execute.
- Object abortSignal catch:[
- Compiler evaluate:theCode asString notifying:codeView compile:false.
- codeView modified:false.
- self updateClassList.
- ].
- codeView cursor:Cursor normal.
- ].
- codeView explainAction:nil.
- methodListView notNil ifTrue:[
- methodListView deselect
- ].
- aspect := #classInstVars.
- self normalLabel
+ |s|
+
+ s := WriteStream on:(String new).
+ currentClass fileOutClassInstVarDefinitionOn:s.
+ codeView contents:(s contents).
+ codeView modified:false.
+ codeView acceptAction:[:theCode |
+ codeView cursor:Cursor execute.
+ Object abortSignal catch:[
+ Compiler evaluate:theCode asString notifying:codeView compile:false.
+ codeView modified:false.
+ self normalLabel.
+ self updateClassList.
+ ].
+ codeView cursor:Cursor normal.
+ ].
+ codeView explainAction:nil.
+ methodListView notNil ifTrue:[
+ methodListView deselect
+ ].
+ aspect := #classInstVars.
+ self normalLabel
]
+
+ "Modified: 8.2.1996 / 13:34:03 / cg"
!
classComment
@@ -2324,30 +2376,32 @@
classListView deselect.
fullClass ifFalse:[
- methodCategoryListView contents:nil.
- methodListView contents:nil
- ].
-
- codeView contents:(self templateFor:name in:cat).
+ methodCategoryListView contents:nil.
+ methodListView contents:nil
+ ].
+
+ codeView contents:(self classTemplateFor:name in:cat).
codeView modified:false.
codeView acceptAction:[:theCode |
- codeView cursor:Cursor execute.
- Object abortSignal catch:[
- |cls|
-
- cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
- cls isBehavior ifTrue:[
- codeView modified:false.
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- self switchToClassNamed:(cls name).
- ]
- ].
- codeView cursor:(Cursor normal).
+ codeView cursor:Cursor execute.
+ Object abortSignal catch:[
+ |cls|
+
+ cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
+ cls isBehavior ifTrue:[
+ codeView modified:false.
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ self switchToClassNamed:(cls name).
+ ]
+ ].
+ codeView cursor:(Cursor normal).
].
codeView explainAction:nil.
self switchToClass:nil
+
+ "Modified: 8.2.1996 / 18:22:29 / cg"
!
classListUpdate
@@ -2472,6 +2526,50 @@
"Created: 23.11.1995 / 11:32:03 / cg"
!
+classTemplateFor:className in:cat
+ "return a class definition template - be smart in what is offered initially"
+
+ |aString name i|
+
+ name := 'NewClass'.
+ i := 1.
+ [name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
+ i := i + 1.
+ name := 'NewClass' , i printString
+ ].
+
+ aString := className , ' subclass:#' , name , '
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: '''.
+
+ cat notNil ifTrue:[
+ aString := aString , cat
+ ].
+ aString := aString , '''
+
+
+
+
+
+"
+ Replace ''' , className , ''', ''', name , ''' and
+ the empty string arguments by true values.
+
+ Install (or change) the class by ''accepting'',
+ either via the menu or the keyboard (usually CMD-A).
+
+ To be nice to others (and yourself later), do not forget to
+ add some documentation; either under the classes documentation
+ protocol, or as a class comment.
+"
+'.
+ ^ aString
+
+ "Created: 8.2.1996 / 18:22:34 / cg"
+!
+
doClassMenu:aBlock
"a helper - check if class is selected and evaluate aBlock
while showing waitCursor"
@@ -2702,48 +2800,6 @@
"Modified: 1.9.1995 / 01:41:35 / claus"
!
-templateFor:className in:cat
- "return a class definition template - be smart in what is offered initially"
-
- |aString name i|
-
- name := 'NewClass'.
- i := 1.
- [name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
- i := i + 1.
- name := 'NewClass' , i printString
- ].
-
- aString := className , ' subclass:#' , name , '
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: '''.
-
- cat notNil ifTrue:[
- aString := aString , cat
- ].
- aString := aString , '''
-
-
-
-
-
-"
- Replace ''' , className , ''', ''', name , ''' and
- the empty string arguments by true values.
-
- Install (or change) the class by ''accepting'',
- either via the menu or the keyboard (usually CMD-A).
-
- To be nice to others (and yourself later), do not forget to
- add some documentation; either under the classes documentation
- protocol, or as a class comment.
-"
-'.
- ^ aString
-!
-
updateClassList
self updateClassListWithScroll:true
!
@@ -4801,19 +4857,21 @@
code view and define accept-action to compile it"
currentClass isNil ifTrue:[
- ^ self warn:'select/create a class first'.
+ ^ self warn:'select/create a class first'.
].
currentMethodCategory isNil ifTrue:[
- ^ self warn:'select/create a method category first'.
+ ^ self warn:'select/create a method category first'.
].
currentMethod := currentSelector := nil.
methodListView deselect.
- codeView contents:(self template).
+ codeView contents:(self methodTemplate).
codeView modified:false.
self setAcceptAndExplainActionsForMethod.
+
+ "Modified: 8.2.1996 / 18:21:48 / cg"
!
methodPrintOut
@@ -5219,6 +5277,41 @@
"Modified: 15.12.1995 / 17:06:36 / cg"
!
+methodTemplate
+ "return a method definition template"
+
+ ^
+'message selector and argument names
+ "comment stating purpose of this message"
+
+ |temporaries|
+
+ statement.
+ statement.
+
+
+ "
+ optional: comment giving example use
+ "
+
+"
+ change above template into real code.
+ Then `accept'' either via the menu
+ or via the keyboard (usually CMD-A).
+
+ You do not need this template; you can also
+ select any existing methods code, change it,
+ and finally `accept''.
+
+ Or clear this text, type in the method from scratch
+ and install it with `accept''.
+"
+'
+
+ "Modified: 8.2.1996 / 13:45:58 / cg"
+ "Created: 8.2.1996 / 18:21:53 / cg"
+!
+
switchToAnyMethodNamed:matchString
"switch (in the current classes hierarhy) to a method named matchString.
If there are more than one matches, switch to the first."
@@ -5309,30 +5402,6 @@
"Modified: 4.2.1996 / 18:42:37 / cg"
!
-template
- "return a method definition template"
-
- ^
-'message selector and argument names
- "comment stating purpose of message"
-
-
- |temporaries|
- statements
-
-
-"
- change above template into real code.
- Then ''accept'' either via the menu
- or via the keyboard (usually CMD-A).
-
- You do not need this template; you can also
- select any existing methods code, change it,
- and finally ''accept''.
-"
-'
-!
-
updateMethodList
self updateMethodListWithScroll:true keepSelection:false
!
@@ -5457,21 +5526,46 @@
updateCodeView
|code|
+ aspect == #hierarchy ifTrue:[
+ ^ self classHierarchy
+ ].
+ aspect == #classInstVars ifTrue:[
+ ^ self classClassInstVars
+ ].
+ aspect == #comment ifTrue:[
+ ^ self classComment
+ ].
+ aspect == #primitiveDefinitions ifTrue:[
+ ^ self classPrimitiveDefinitions
+ ].
+ aspect == #primitiveFunctions ifTrue:[
+ ^ self classPrimitiveFunctions
+ ].
+ aspect == #primitiveVariables ifTrue:[
+ ^ self classPrimitiveVariables
+ ].
+ aspect == #revisionInfo ifTrue:[
+ ^ self classRevisionInfo
+ ].
+ aspect == #definition ifTrue:[
+ ^ self classDefinition
+ ].
+
fullClass ifTrue:[
- currentClass notNil ifTrue:[
- code := currentClass source.
- ]
+ currentClass notNil ifTrue:[
+ code := currentClass source.
+ ]
] ifFalse:[
- currentMethod notNil ifTrue:[
- (codeView acceptAction isNil
- and:[actualClass notNil
- and:[currentMethodCategory notNil]]) ifTrue:[
- self setAcceptAndExplainActionsForMethod.
- ].
-
- code := currentMethod source.
-
- ]
+ currentMethod notNil ifTrue:[
+ (codeView acceptAction isNil
+ and:[actualClass notNil
+ and:[currentMethodCategory notNil]]) ifTrue:[
+ self setAcceptAndExplainActionsForMethod.
+ ].
+
+ code := currentMethod source.
+
+ ]
].
codeView contents:code.
codeView modified:false.
@@ -5479,7 +5573,7 @@
self normalLabel.
"Created: 23.11.1995 / 14:16:43 / cg"
- "Modified: 23.11.1995 / 14:19:25 / cg"
+ "Modified: 8.2.1996 / 13:42:53 / cg"
! !
!BrowserView methodsFor:'private'!
@@ -5946,48 +6040,51 @@
"tell the codeView what to do on accept and explain"
codeView acceptAction:[:theCode |
- |cat cls|
-
- codeView cursor:Cursor execute.
-
- (cat := currentMethodCategory) = '* all *' ifTrue:[
- "must check from which category this code came from ...
- ... thanks to Arno for pointing this out"
-
- cat := self askForMethodCategory.
- ].
- (cat notNil and:[cat notEmpty]) ifTrue:[
- fullProtocol ifTrue:[
- cls := acceptClass "/actualClass whichClassIncludesSelector:currentSelector.
- ].
- cls isNil ifTrue:[
- cls := actualClass
- ].
-
- Object abortSignal catch:[
- lockUpdates := true.
-
- actualClass compilerClass
- compile:theCode asString
- forClass:cls
- inCategory:cat
- notifying:codeView.
-
- codeView modified:false.
- self updateMethodListWithScroll:false.
- currentMethod := actualClass compiledMethodAt:currentSelector.
- ].
- lockUpdates := false.
- ].
- codeView cursor:Cursor normal.
+ |cat cls|
+
+ codeView cursor:Cursor execute.
+
+ (cat := currentMethodCategory) = '* all *' ifTrue:[
+ "must check from which category this code came from ...
+ ... thanks to Arno for pointing this out"
+
+ cat := self askForMethodCategory.
+ ].
+ (cat notNil and:[cat notEmpty]) ifTrue:[
+ fullProtocol ifTrue:[
+ cls := acceptClass "/actualClass whichClassIncludesSelector:currentSelector.
+ ].
+ cls isNil ifTrue:[
+ cls := actualClass
+ ].
+
+ Object abortSignal catch:[
+ lockUpdates := true.
+
+ actualClass compilerClass
+ compile:theCode asString
+ forClass:cls
+ inCategory:cat
+ notifying:codeView.
+
+ codeView modified:false.
+ self updateMethodListWithScroll:false.
+ currentMethod := actualClass compiledMethodAt:currentSelector.
+ self normalLabel.
+ ].
+ lockUpdates := false.
+ ].
+ codeView cursor:Cursor normal.
].
codeView explainAction:[:theCode :theSelection |
- self showExplanation:(Explainer
- explain:theSelection
- in:theCode
- forClass:actualClass)
- ].
+ self showExplanation:(Explainer
+ explain:theSelection
+ in:theCode
+ forClass:actualClass)
+ ].
+
+ "Modified: 8.2.1996 / 18:19:47 / cg"
!
setDoitActionForClass
@@ -6664,6 +6761,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.92 1996-02-06 20:30:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.93 1996-02-08 19:23:16 cg Exp $'
! !
BrowserView initialize!
--- a/BrwsrView.st Wed Feb 07 15:17:41 1996 +0100
+++ b/BrwsrView.st Thu Feb 08 20:23:16 1996 +0100
@@ -105,6 +105,23 @@
!BrowserView methodsFor:'change & update'!
+refetchClass
+ "after a class definition change in another browser,
+ this is sent to update (otherwise, we'd still refer to the obsolete class)"
+
+"/ currentClass := Smalltalk at:(currentClass name asSymbol).
+ self switchToClass:(Smalltalk at:(currentClass name asSymbol)).
+
+"/ showInstance ifTrue:[
+"/ actualClass := currentClass
+"/ ] ifFalse:[
+"/ actualClass := currentClass class
+"/ ].
+
+ "Created: 8.2.1996 / 13:22:27 / cg"
+ "Modified: 8.2.1996 / 13:40:18 / cg"
+!
+
update:something with:someArgument from:changedObject
|list selector oldMethod|
@@ -113,7 +130,7 @@
"
lockUpdates == true ifTrue:[
"/ 'ignored my change' printNL.
- ^ self
+ ^ self
].
"/ changedObject print. ' ' print. someArgument print. ' ' print.
@@ -121,178 +138,206 @@
(changedObject == Smalltalk) ifTrue:[
- something == #newClass ifTrue:[
- (currentClass notNil
- and:[someArgument name = currentClass name]) ifTrue:[
- "
- the current class was autoloaded
- "
- self warnLabel:'the selected class has changed'.
- self updateClassListWithScroll:false.
- ].
-
- ((someArgument category = currentClassCategory)
- or:[currentClassCategory notNil
- and:[currentClassCategory startsWith:'*']]) ifTrue:[
- self updateClassListWithScroll:false.
- ].
-
- someArgument category ~= currentClassCategory ifTrue:[
- "
- category new ?
- "
- (classCategoryListView notNil
- and:[(list := classCategoryListView list) notNil
- and:[(list includes:someArgument category) not]])
- ifTrue:[
- self updateClassCategoryListWithScroll:false.
- ]
- ].
- ^ self
- ].
-
- something == #classRemove ifTrue:[
- someArgument == currentClass ifTrue:[
- self warnLabel:'the selected class was removed'.
- ^ self
- ].
- " fall into general update "
- ].
-
- "
- any other (unknown) change
- with the Smalltalk dictionary ...
- "
- self updateClassCategoryListWithScroll:false.
- self updateClassListWithScroll:false.
- ^ self
+ something == #newClass ifTrue:[
+ (currentClass notNil
+ and:[someArgument name = currentClass name]) ifTrue:[
+ "
+ the current class was autoloaded
+ "
+ self warnLabel:'the selected class has changed'.
+ self updateClassListWithScroll:false.
+ ].
+
+ ((someArgument category = currentClassCategory)
+ or:[currentClassCategory notNil
+ and:[currentClassCategory startsWith:'*']]) ifTrue:[
+ self updateClassListWithScroll:false.
+ ].
+
+ someArgument category ~= currentClassCategory ifTrue:[
+ "
+ category new ?
+ "
+ (classCategoryListView notNil
+ and:[(list := classCategoryListView list) notNil
+ and:[(list includes:someArgument category) not]])
+ ifTrue:[
+ self updateClassCategoryListWithScroll:false.
+ ]
+ ].
+ ^ self
+ ].
+
+ something == #classRemove ifTrue:[
+ someArgument == currentClass ifTrue:[
+ self warnLabel:'the selected class was removed'.
+ ^ self
+ ].
+ " fall into general update "
+ ].
+
+ "
+ any other (unknown) change
+ with the Smalltalk dictionary ...
+ "
+ self updateClassCategoryListWithScroll:false.
+ self updateClassListWithScroll:false.
+ ^ self
].
changedObject isBehavior ifTrue:[
- "/
- "/ its a class, that has changed
- "/
- fullClass ifTrue:[
- "/
- "/ full-class browser ...
- "/ (must check for moth class and metaclass changes)
- "/
- (currentClass == changedObject
- or:[currentClass class == changedObject]) ifTrue:[
- self warnLabel:'class was changed - the code shown may be obsolete'.
- ].
- ^ self
- ].
-
- (currentClass notNil
- and:[changedObject name = currentClass name]) ifTrue:[
- "/
- "/ its the current class that has changed
- "/
- something == #methodDictionary ifTrue:[
-
- "/ new feature: changeArg may be an array consisting of
- "/ the selector and the oldMethod
- someArgument isArray ifTrue:[
- oldMethod := someArgument at:2.
- selector := someArgument at:1.
- ] ifFalse:[
- selector := someArgument
- ].
-
- (selector isSymbol) ifTrue:[
- |changedMethod|
-
- "
- the method with selector was changed or removed
- "
- self updateMethodCategoryListWithScroll:false.
- self updateMethodListWithScroll:false.
-
- selector == currentSelector ifTrue:[
- "
- special care here: the currently shown method has been
- changed somehow in another browser (or via fileIn)
- "
- changedMethod := currentClass compiledMethodAt:currentSelector.
- changedMethod isNil ifTrue:[
- self warnLabel:'the method shown was removed'.
- ^ self
- ].
- "compare the source codes"
- currentMethod notNil ifTrue:[
- changedMethod source = codeView contents ifFalse:[
- self warnLabel:'method has changed - the code shown may be obsolete'.
- ]
- ].
- ^ self
- ].
- ]
- ].
-
- something == #comment ifTrue:[
- "
- the class has changed its comment; we dont care, except if
- currently showing the comment
- "
- aspect == #comment ifTrue:[
- self warnLabel:'the comment shown may not up to date'.
- ].
- ^ self
- ].
- something == #definition ifTrue:[
- "
- the class has changed its definition.
- Warn, except if showing a method.
- "
- aspect notNil ifTrue:[
- self warnLabel:'the classes definition has changed'.
- ].
-"/ ^ self
- ].
-
- "
- get the class again - in case of a changed class definition,
- we are otherwise refering to the obsolete old class
- "
- currentClass := Smalltalk at:(currentClass name asSymbol).
- showInstance ifTrue:[
- actualClass := currentClass
- ] ifFalse:[
- actualClass := currentClass class
- ].
-
- self updateMethodCategoryListWithScroll:false.
-
- "dont update codeView ...."
- "self update"
- ^ self
- ].
-
- "
- any other class has changed (but not its organization, since
- that is cought in the above case).
- We are not interested in it - except, if showing fullProtocol
- or hierarchy ...
- "
- currentClassHierarchy notNil ifTrue:[
- fullProtocol ifTrue:[
- (currentClass isSubclassOf:changedObject) ifTrue:[
- ]
- ] ifFalse:[
- ((currentClass isSubclassOf:changedObject)
- or:[changedObject isSubclassOf:currentClass]) ifTrue:[
- ]
- ]
- ].
-
- ^ self
+ "/
+ "/ its a class, that has changed
+ "/
+ fullClass ifTrue:[
+ "/
+ "/ full-class browser ...
+ "/ (must check for both class and metaclass changes)
+ "/
+ (currentClass == changedObject
+ or:[currentClass class == changedObject]) ifTrue:[
+ self warnLabel:'class was changed - the code shown may be obsolete'.
+ ].
+ ^ self
+ ].
+
+ (currentClass notNil
+ and:[changedObject name = currentClass name]) ifTrue:[
+something printNL.
+aspect printNL.
+ "/
+ "/ its the current class that has changed
+ "/
+ something == #methodDictionary ifTrue:[
+
+ "/ new feature: changeArg may be an array consisting of
+ "/ the selector and the oldMethod
+
+ someArgument isArray ifTrue:[
+ oldMethod := someArgument at:2.
+ selector := someArgument at:1.
+ ] ifFalse:[
+ selector := someArgument
+ ].
+
+ (selector isSymbol) ifTrue:[
+ |changedMethod|
+
+ "
+ the method with selector was changed or removed
+ "
+ self updateMethodCategoryListWithScroll:false.
+ self updateMethodListWithScroll:false.
+
+ selector == currentSelector ifTrue:[
+ "
+ special care here: the currently shown method has been
+ changed somehow in another browser (or via fileIn)
+ "
+ changedMethod := currentClass compiledMethodAt:currentSelector.
+ changedMethod isNil ifTrue:[
+ self warnLabel:'the method shown was removed'.
+ ^ self
+ ].
+ "compare the source codes"
+ currentMethod notNil ifTrue:[
+ changedMethod source = codeView contents ifFalse:[
+ self warnLabel:'method has changed - the code shown may be obsolete'.
+ ]
+ ].
+ ^ self
+ ].
+ ]
+ ].
+
+ something == #comment ifTrue:[
+ "
+ the class has changed its comment; we dont care, except if
+ currently showing the comment
+ "
+ aspect == #comment ifTrue:[
+ codeView modified ifFalse:[
+ self refetchClass.
+ self updateCodeView
+ ] ifTrue:[
+ self warnLabel:'the comment has changed - reselect to update'.
+ ]
+ ].
+ self refetchClass.
+ ^ self
+ ].
+
+ something == #definition ifTrue:[
+ "
+ the class has changed its definition.
+ Warn, except if showing a method.
+ "
+ aspect notNil ifTrue:[
+ codeView modified ifFalse:[
+ self refetchClass.
+ self updateCodeView
+ ] ifTrue:[
+ self warnLabel:'the classes definition has changed - reselect to update'.
+ ].
+ ^ self
+ ].
+ ].
+
+ "/
+ "/ if I am not showing code update if unmodified,
+ "/ warn if modified
+ "/
+ aspect notNil ifTrue:[
+ codeView modified ifFalse:[
+ self refetchClass.
+ self updateCodeView
+ ] ifTrue:[
+ self warnLabel:'the classes has changed - reselect to update'.
+ ].
+ ^ self
+ ].
+
+ "
+ get the class again - in case of a changed class definition,
+ we are otherwise refering to the obsolete old class
+ "
+ self refetchClass.
+
+ self updateMethodCategoryListWithScroll:false.
+
+ "dont update codeView ...."
+ "self update"
+
+ self warnLabel:'the class has changed'.
+ ^ self
+ ].
+
+ "
+ any other class has changed (but not its organization, since
+ that is cought in the above case).
+ We are not interested in it - except, if showing fullProtocol
+ or hierarchy ...
+ "
+ currentClassHierarchy notNil ifTrue:[
+ fullProtocol ifTrue:[
+ (currentClass isSubclassOf:changedObject) ifTrue:[
+ self warnLabel:'some superclass has changed - reselect to update'.
+ ]
+ ] ifFalse:[
+ ((currentClass isSubclassOf:changedObject)
+ or:[changedObject isSubclassOf:currentClass]) ifTrue:[
+ self warnLabel:'some superclass has changed - reselect to update'.
+ ]
+ ]
+ ].
+
+ ^ self
].
(changedObject isMethod) ifTrue:[
]
- "Modified: 13.12.1995 / 15:28:47 / cg"
+ "Modified: 8.2.1996 / 18:19:25 / cg"
! !
!BrowserView methodsFor:'class category list menu'!
@@ -854,19 +899,23 @@
"class category has changed - update dependent views"
self withWaitCursorDo:[
- self switchToClass:nil.
- actualClass := acceptClass := nil.
- currentMethodCategory := nil.
- currentMethod := currentSelector := nil.
-
- self updateClassList.
- self updateMethodCategoryList.
- self updateMethodList.
- self updateCodeView.
-
- codeView explainAction:nil.
- codeView acceptAction:nil
+ self switchToClass:nil.
+ aspect := nil.
+
+ actualClass := acceptClass := nil.
+ currentMethodCategory := nil.
+ currentMethod := currentSelector := nil.
+
+ self updateClassList.
+ self updateMethodCategoryList.
+ self updateMethodList.
+ self updateCodeView.
+
+ codeView explainAction:nil.
+ codeView acceptAction:nil
]
+
+ "Modified: 8.2.1996 / 13:35:18 / cg"
!
listOfAllClassCategories
@@ -1032,28 +1081,31 @@
for a class-instvar-definition change"
self doClassMenu:[:currentClass |
- |s|
-
- s := WriteStream on:(String new).
- currentClass fileOutClassInstVarDefinitionOn:s.
- codeView contents:(s contents).
- codeView modified:false.
- codeView acceptAction:[:theCode |
- codeView cursor:Cursor execute.
- Object abortSignal catch:[
- Compiler evaluate:theCode asString notifying:codeView compile:false.
- codeView modified:false.
- self updateClassList.
- ].
- codeView cursor:Cursor normal.
- ].
- codeView explainAction:nil.
- methodListView notNil ifTrue:[
- methodListView deselect
- ].
- aspect := #classInstVars.
- self normalLabel
+ |s|
+
+ s := WriteStream on:(String new).
+ currentClass fileOutClassInstVarDefinitionOn:s.
+ codeView contents:(s contents).
+ codeView modified:false.
+ codeView acceptAction:[:theCode |
+ codeView cursor:Cursor execute.
+ Object abortSignal catch:[
+ Compiler evaluate:theCode asString notifying:codeView compile:false.
+ codeView modified:false.
+ self normalLabel.
+ self updateClassList.
+ ].
+ codeView cursor:Cursor normal.
+ ].
+ codeView explainAction:nil.
+ methodListView notNil ifTrue:[
+ methodListView deselect
+ ].
+ aspect := #classInstVars.
+ self normalLabel
]
+
+ "Modified: 8.2.1996 / 13:34:03 / cg"
!
classComment
@@ -2324,30 +2376,32 @@
classListView deselect.
fullClass ifFalse:[
- methodCategoryListView contents:nil.
- methodListView contents:nil
- ].
-
- codeView contents:(self templateFor:name in:cat).
+ methodCategoryListView contents:nil.
+ methodListView contents:nil
+ ].
+
+ codeView contents:(self classTemplateFor:name in:cat).
codeView modified:false.
codeView acceptAction:[:theCode |
- codeView cursor:Cursor execute.
- Object abortSignal catch:[
- |cls|
-
- cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
- cls isBehavior ifTrue:[
- codeView modified:false.
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- self switchToClassNamed:(cls name).
- ]
- ].
- codeView cursor:(Cursor normal).
+ codeView cursor:Cursor execute.
+ Object abortSignal catch:[
+ |cls|
+
+ cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
+ cls isBehavior ifTrue:[
+ codeView modified:false.
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ self switchToClassNamed:(cls name).
+ ]
+ ].
+ codeView cursor:(Cursor normal).
].
codeView explainAction:nil.
self switchToClass:nil
+
+ "Modified: 8.2.1996 / 18:22:29 / cg"
!
classListUpdate
@@ -2472,6 +2526,50 @@
"Created: 23.11.1995 / 11:32:03 / cg"
!
+classTemplateFor:className in:cat
+ "return a class definition template - be smart in what is offered initially"
+
+ |aString name i|
+
+ name := 'NewClass'.
+ i := 1.
+ [name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
+ i := i + 1.
+ name := 'NewClass' , i printString
+ ].
+
+ aString := className , ' subclass:#' , name , '
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: '''.
+
+ cat notNil ifTrue:[
+ aString := aString , cat
+ ].
+ aString := aString , '''
+
+
+
+
+
+"
+ Replace ''' , className , ''', ''', name , ''' and
+ the empty string arguments by true values.
+
+ Install (or change) the class by ''accepting'',
+ either via the menu or the keyboard (usually CMD-A).
+
+ To be nice to others (and yourself later), do not forget to
+ add some documentation; either under the classes documentation
+ protocol, or as a class comment.
+"
+'.
+ ^ aString
+
+ "Created: 8.2.1996 / 18:22:34 / cg"
+!
+
doClassMenu:aBlock
"a helper - check if class is selected and evaluate aBlock
while showing waitCursor"
@@ -2702,48 +2800,6 @@
"Modified: 1.9.1995 / 01:41:35 / claus"
!
-templateFor:className in:cat
- "return a class definition template - be smart in what is offered initially"
-
- |aString name i|
-
- name := 'NewClass'.
- i := 1.
- [name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
- i := i + 1.
- name := 'NewClass' , i printString
- ].
-
- aString := className , ' subclass:#' , name , '
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: '''.
-
- cat notNil ifTrue:[
- aString := aString , cat
- ].
- aString := aString , '''
-
-
-
-
-
-"
- Replace ''' , className , ''', ''', name , ''' and
- the empty string arguments by true values.
-
- Install (or change) the class by ''accepting'',
- either via the menu or the keyboard (usually CMD-A).
-
- To be nice to others (and yourself later), do not forget to
- add some documentation; either under the classes documentation
- protocol, or as a class comment.
-"
-'.
- ^ aString
-!
-
updateClassList
self updateClassListWithScroll:true
!
@@ -4801,19 +4857,21 @@
code view and define accept-action to compile it"
currentClass isNil ifTrue:[
- ^ self warn:'select/create a class first'.
+ ^ self warn:'select/create a class first'.
].
currentMethodCategory isNil ifTrue:[
- ^ self warn:'select/create a method category first'.
+ ^ self warn:'select/create a method category first'.
].
currentMethod := currentSelector := nil.
methodListView deselect.
- codeView contents:(self template).
+ codeView contents:(self methodTemplate).
codeView modified:false.
self setAcceptAndExplainActionsForMethod.
+
+ "Modified: 8.2.1996 / 18:21:48 / cg"
!
methodPrintOut
@@ -5219,6 +5277,41 @@
"Modified: 15.12.1995 / 17:06:36 / cg"
!
+methodTemplate
+ "return a method definition template"
+
+ ^
+'message selector and argument names
+ "comment stating purpose of this message"
+
+ |temporaries|
+
+ statement.
+ statement.
+
+
+ "
+ optional: comment giving example use
+ "
+
+"
+ change above template into real code.
+ Then `accept'' either via the menu
+ or via the keyboard (usually CMD-A).
+
+ You do not need this template; you can also
+ select any existing methods code, change it,
+ and finally `accept''.
+
+ Or clear this text, type in the method from scratch
+ and install it with `accept''.
+"
+'
+
+ "Modified: 8.2.1996 / 13:45:58 / cg"
+ "Created: 8.2.1996 / 18:21:53 / cg"
+!
+
switchToAnyMethodNamed:matchString
"switch (in the current classes hierarhy) to a method named matchString.
If there are more than one matches, switch to the first."
@@ -5309,30 +5402,6 @@
"Modified: 4.2.1996 / 18:42:37 / cg"
!
-template
- "return a method definition template"
-
- ^
-'message selector and argument names
- "comment stating purpose of message"
-
-
- |temporaries|
- statements
-
-
-"
- change above template into real code.
- Then ''accept'' either via the menu
- or via the keyboard (usually CMD-A).
-
- You do not need this template; you can also
- select any existing methods code, change it,
- and finally ''accept''.
-"
-'
-!
-
updateMethodList
self updateMethodListWithScroll:true keepSelection:false
!
@@ -5457,21 +5526,46 @@
updateCodeView
|code|
+ aspect == #hierarchy ifTrue:[
+ ^ self classHierarchy
+ ].
+ aspect == #classInstVars ifTrue:[
+ ^ self classClassInstVars
+ ].
+ aspect == #comment ifTrue:[
+ ^ self classComment
+ ].
+ aspect == #primitiveDefinitions ifTrue:[
+ ^ self classPrimitiveDefinitions
+ ].
+ aspect == #primitiveFunctions ifTrue:[
+ ^ self classPrimitiveFunctions
+ ].
+ aspect == #primitiveVariables ifTrue:[
+ ^ self classPrimitiveVariables
+ ].
+ aspect == #revisionInfo ifTrue:[
+ ^ self classRevisionInfo
+ ].
+ aspect == #definition ifTrue:[
+ ^ self classDefinition
+ ].
+
fullClass ifTrue:[
- currentClass notNil ifTrue:[
- code := currentClass source.
- ]
+ currentClass notNil ifTrue:[
+ code := currentClass source.
+ ]
] ifFalse:[
- currentMethod notNil ifTrue:[
- (codeView acceptAction isNil
- and:[actualClass notNil
- and:[currentMethodCategory notNil]]) ifTrue:[
- self setAcceptAndExplainActionsForMethod.
- ].
-
- code := currentMethod source.
-
- ]
+ currentMethod notNil ifTrue:[
+ (codeView acceptAction isNil
+ and:[actualClass notNil
+ and:[currentMethodCategory notNil]]) ifTrue:[
+ self setAcceptAndExplainActionsForMethod.
+ ].
+
+ code := currentMethod source.
+
+ ]
].
codeView contents:code.
codeView modified:false.
@@ -5479,7 +5573,7 @@
self normalLabel.
"Created: 23.11.1995 / 14:16:43 / cg"
- "Modified: 23.11.1995 / 14:19:25 / cg"
+ "Modified: 8.2.1996 / 13:42:53 / cg"
! !
!BrowserView methodsFor:'private'!
@@ -5946,48 +6040,51 @@
"tell the codeView what to do on accept and explain"
codeView acceptAction:[:theCode |
- |cat cls|
-
- codeView cursor:Cursor execute.
-
- (cat := currentMethodCategory) = '* all *' ifTrue:[
- "must check from which category this code came from ...
- ... thanks to Arno for pointing this out"
-
- cat := self askForMethodCategory.
- ].
- (cat notNil and:[cat notEmpty]) ifTrue:[
- fullProtocol ifTrue:[
- cls := acceptClass "/actualClass whichClassIncludesSelector:currentSelector.
- ].
- cls isNil ifTrue:[
- cls := actualClass
- ].
-
- Object abortSignal catch:[
- lockUpdates := true.
-
- actualClass compilerClass
- compile:theCode asString
- forClass:cls
- inCategory:cat
- notifying:codeView.
-
- codeView modified:false.
- self updateMethodListWithScroll:false.
- currentMethod := actualClass compiledMethodAt:currentSelector.
- ].
- lockUpdates := false.
- ].
- codeView cursor:Cursor normal.
+ |cat cls|
+
+ codeView cursor:Cursor execute.
+
+ (cat := currentMethodCategory) = '* all *' ifTrue:[
+ "must check from which category this code came from ...
+ ... thanks to Arno for pointing this out"
+
+ cat := self askForMethodCategory.
+ ].
+ (cat notNil and:[cat notEmpty]) ifTrue:[
+ fullProtocol ifTrue:[
+ cls := acceptClass "/actualClass whichClassIncludesSelector:currentSelector.
+ ].
+ cls isNil ifTrue:[
+ cls := actualClass
+ ].
+
+ Object abortSignal catch:[
+ lockUpdates := true.
+
+ actualClass compilerClass
+ compile:theCode asString
+ forClass:cls
+ inCategory:cat
+ notifying:codeView.
+
+ codeView modified:false.
+ self updateMethodListWithScroll:false.
+ currentMethod := actualClass compiledMethodAt:currentSelector.
+ self normalLabel.
+ ].
+ lockUpdates := false.
+ ].
+ codeView cursor:Cursor normal.
].
codeView explainAction:[:theCode :theSelection |
- self showExplanation:(Explainer
- explain:theSelection
- in:theCode
- forClass:actualClass)
- ].
+ self showExplanation:(Explainer
+ explain:theSelection
+ in:theCode
+ forClass:actualClass)
+ ].
+
+ "Modified: 8.2.1996 / 18:19:47 / cg"
!
setDoitActionForClass
@@ -6664,6 +6761,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.92 1996-02-06 20:30:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.93 1996-02-08 19:23:16 cg Exp $'
! !
BrowserView initialize!