handle (& warn about) class redefinitions.
--- a/BrowserView.st Wed Jun 17 11:27:32 1998 +0200
+++ b/BrowserView.st Wed Jun 17 11:43:19 1998 +0200
@@ -2362,43 +2362,45 @@
codeView modified:false.
codeModified := false.
- currentClass isNamespace ifTrue:[
- codeView acceptAction:nil.
- ] ifFalse:[
- codeView acceptAction:[:theCode |
- |ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
-
- codeView cursor:Cursor execute.
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- Object abortSignal catch:[
-
- Class nameSpaceQuerySignal answer:Smalltalk
- do:[
- (Compiler evaluate:theCode asString notifying:codeView compile:false)
- isBehavior ifTrue:[
- codeView modified:false.
- codeModified := false.
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- ]
- ]
- ].
- ].
- codeView cursor:Cursor normal.
- ].
- ].
+ self setAcceptActionForClass.
+
+"/ currentClass isNamespace ifTrue:[
+"/ codeView acceptAction:nil.
+"/ ] ifFalse:[
+"/ codeView acceptAction:[:theCode |
+"/ |ns|
+"/
+"/ currentClass notNil ifTrue:[
+"/ ns := currentClass nameSpace
+"/ ] ifFalse:[
+"/ ns := nil
+"/ ].
+"/
+"/ codeView cursor:Cursor execute.
+"/
+"/ Class nameSpaceQuerySignal handle:[:ex |
+"/ ns isNil ifTrue:[
+"/ ex reject
+"/ ].
+"/ ex proceedWith:ns
+"/ ] do:[
+"/ Object abortSignal catch:[
+"/
+"/ Class nameSpaceQuerySignal answer:Smalltalk
+"/ do:[
+"/ (Compiler evaluate:theCode asString notifying:codeView compile:false)
+"/ isBehavior ifTrue:[
+"/ codeView modified:false.
+"/ codeModified := false.
+"/ self classCategoryUpdate.
+"/ self updateClassListWithScroll:false.
+"/ ]
+"/ ]
+"/ ].
+"/ ].
+"/ codeView cursor:Cursor normal.
+"/ ].
+"/ ].
codeView explainAction:nil.
methodListView notNil ifTrue:[
@@ -2408,7 +2410,7 @@
self normalLabel
]
- "Modified: / 27.4.1998 / 15:35:33 / cg"
+ "Modified: / 17.6.1998 / 11:28:57 / cg"
!
classDocumentation
@@ -4737,47 +4739,7 @@
] ifFalse:[
"/ self classDefinition.
self classListUpdate.
-
- currentClass isNamespace ifTrue:[
- codeView acceptAction:nil
- ] ifFalse:[
- codeView acceptAction:[:theCode |
- |ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
-
- codeView cursor:Cursor execute.
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- Object abortSignal catch:[
- UndefinedObject createMinimumProtocolInNewSubclassQuery
- answer:true
- do:[
- (Compiler
- evaluate:theCode asString
- notifying:codeView
- compile:false)
- isBehavior ifTrue:[
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- codeView modified:false.
- codeModified := false.
- ].
- ]
- ].
- ].
- codeView cursor:Cursor normal.
- ].
- ]
+ self setAcceptActionForClass.
].
codeView explainAction:nil.
@@ -4796,7 +4758,7 @@
]
"Created: / 23.11.1995 / 11:32:03 / cg"
- "Modified: / 19.4.1998 / 21:04:07 / cg"
+ "Modified: / 17.6.1998 / 11:05:06 / cg"
!
classTemplateFor:aSuperClass in:categoryString namespace:isNameSpace private:isPrivate
@@ -9169,7 +9131,7 @@
Notice, that it is possible to add new methods - even with missing sources.
"'.
- codeView acceptAction:[:text | nil].
+ codeView acceptAction:nil.
] ifFalse:[
UserPreferences current syntaxColoring ifTrue:[
highlighter := actualClass syntaxHighlighterClass.
@@ -9218,7 +9180,7 @@
self normalLabel.
"Created: / 23.11.1995 / 14:16:43 / cg"
- "Modified: / 27.4.1998 / 15:37:10 / cg"
+ "Modified: / 17.6.1998 / 10:42:02 / cg"
! !
!BrowserView methodsFor:'namespace menu'!
@@ -10364,6 +10326,87 @@
"Modified: 30.7.1997 / 15:30:10 / cg"
!
+setAcceptActionForClass
+ "tell the codeView what to do on accept and explain"
+
+ currentClass isNamespace ifTrue:[
+ codeView acceptAction:nil
+ ] ifFalse:[
+ codeView acceptAction:[:theCode |
+ |ns|
+
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
+
+ codeView cursor:Cursor execute.
+
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ Object abortSignal catch:[
+ UndefinedObject createMinimumProtocolInNewSubclassQuery
+ answer:true
+ do:[
+ (Class classRedefinitionSignal)handle:[:ex |
+ |answer oldVsNew oldPkg newPkg|
+
+ oldVsNew := ex parameter.
+ oldPkg := oldVsNew key package.
+ newPkg := oldVsNew value package.
+ answer := OptionBox
+ request:
+('You are about to define a class from another (system-) package.
+The classes original packageID was ''%1''.
+If you proceed, the new class will be marked as belonging
+to the ''%2'' package (and this warning will not be shown again).
+If you proceed with ''keep'', the class will be installed
+but the old packageID will be preserved.
+Otherwise, hit ''cancel'' to leave the class unchanged.
+
+PS: you can disable these checks in the launchers settings-compilation dialog.'
+ bindWith:(oldPkg asText allBold)
+ with:(newPkg asText allBold))
+
+ label:'Class redefinition'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('cancel' 'keep' 'continue')
+ values:#(#cancel #keep #continue)
+ default:#continue.
+
+ (answer ~~ #cancel) ifTrue:[
+ ex proceedWith:answer
+ ]
+ ] do:[
+ |rslt|
+
+ rslt := Compiler
+ evaluate:theCode asString
+ notifying:codeView
+ compile:false.
+
+ rslt isBehavior ifTrue:[
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ codeView modified:false.
+ codeModified := false.
+ ].
+ ]
+ ]
+ ].
+ ].
+ codeView cursor:Cursor normal.
+ ].
+ ]
+
+ "Modified: / 17.6.1998 / 11:39:02 / cg"
+!
+
setAcceptAndExplainActionsForMethod
"tell the codeView what to do on accept and explain"
@@ -10393,7 +10436,7 @@
Object abortSignal catch:[
lockUpdates := true.
- Class methodRedefinitionSignal handle:[:ex |
+ (Class methodRedefinitionSignal) handle:[:ex |
|answer oldVsNew oldPkg newPkg|
oldVsNew := ex parameter.
@@ -10401,14 +10444,17 @@
newPkg := oldVsNew value package.
answer := OptionBox
request:
-('You are about to change code from another (system-) package.
+('You are about to change a method from another (system-) package.
The methods original packageID was ''%1''.
-If you proceed, the new code will be marked as belonging
+If you proceed, the new method will be marked as belonging
to the ''%2'' package (and this warning will not be shown again).
-If you proceed with ''keep'', the old packageID will be preserved.
+If you proceed with ''keep'', the new method will be installed
+but the old packageID will be preserved.
Otherwise, hit ''cancel'' to leave the code unchanged.
-PS: you can disable these checks in the launchers settings-compilation dialog.' bindWith:oldPkg with:newPkg)
+PS: you can disable these checks in the launchers settings-compilation dialog.'
+ bindWith:(oldPkg asText allBold)
+ with:(newPkg asText allBold))
label:'Method redefinition'
form:(WarningBox iconBitmap)
@@ -10446,7 +10492,7 @@
forClass:actualClass)
].
- "Modified: / 31.3.1998 / 23:40:23 / cg"
+ "Modified: / 17.6.1998 / 11:38:35 / cg"
!
setDoitActionForClass
@@ -10456,37 +10502,37 @@
as self, and access to the class variables by name.
"
codeView doItAction:[:theCode |
- |compiler ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- currentClass isNil ifTrue:[
- compiler := Compiler
- ] ifFalse:[
- compiler := currentClass evaluatorClass
- ].
-
- compiler
- evaluate:theCode
- in:nil
- receiver:currentClass
- notifying:codeView
- logged:false
- ifFail:nil
- ]
- ].
-
- "Modified: 10.2.1997 / 14:17:15 / cg"
+ |compiler ns|
+
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
+
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ currentClass isNil ifTrue:[
+ compiler := Compiler
+ ] ifFalse:[
+ compiler := currentClass evaluatorClass
+ ].
+
+ compiler
+ evaluate:theCode
+ in:nil
+ receiver:currentClass
+ notifying:codeView
+ logged:false
+ ifFail:nil
+ ]
+ ].
+
+ "Modified: / 17.6.1998 / 11:35:44 / cg"
!
setSearchPattern:aString
@@ -11536,6 +11582,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.416 1998-06-16 08:56:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.417 1998-06-17 09:43:19 cg Exp $'
! !
BrowserView initialize!
--- a/BrwsrView.st Wed Jun 17 11:27:32 1998 +0200
+++ b/BrwsrView.st Wed Jun 17 11:43:19 1998 +0200
@@ -2362,43 +2362,45 @@
codeView modified:false.
codeModified := false.
- currentClass isNamespace ifTrue:[
- codeView acceptAction:nil.
- ] ifFalse:[
- codeView acceptAction:[:theCode |
- |ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
-
- codeView cursor:Cursor execute.
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- Object abortSignal catch:[
-
- Class nameSpaceQuerySignal answer:Smalltalk
- do:[
- (Compiler evaluate:theCode asString notifying:codeView compile:false)
- isBehavior ifTrue:[
- codeView modified:false.
- codeModified := false.
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- ]
- ]
- ].
- ].
- codeView cursor:Cursor normal.
- ].
- ].
+ self setAcceptActionForClass.
+
+"/ currentClass isNamespace ifTrue:[
+"/ codeView acceptAction:nil.
+"/ ] ifFalse:[
+"/ codeView acceptAction:[:theCode |
+"/ |ns|
+"/
+"/ currentClass notNil ifTrue:[
+"/ ns := currentClass nameSpace
+"/ ] ifFalse:[
+"/ ns := nil
+"/ ].
+"/
+"/ codeView cursor:Cursor execute.
+"/
+"/ Class nameSpaceQuerySignal handle:[:ex |
+"/ ns isNil ifTrue:[
+"/ ex reject
+"/ ].
+"/ ex proceedWith:ns
+"/ ] do:[
+"/ Object abortSignal catch:[
+"/
+"/ Class nameSpaceQuerySignal answer:Smalltalk
+"/ do:[
+"/ (Compiler evaluate:theCode asString notifying:codeView compile:false)
+"/ isBehavior ifTrue:[
+"/ codeView modified:false.
+"/ codeModified := false.
+"/ self classCategoryUpdate.
+"/ self updateClassListWithScroll:false.
+"/ ]
+"/ ]
+"/ ].
+"/ ].
+"/ codeView cursor:Cursor normal.
+"/ ].
+"/ ].
codeView explainAction:nil.
methodListView notNil ifTrue:[
@@ -2408,7 +2410,7 @@
self normalLabel
]
- "Modified: / 27.4.1998 / 15:35:33 / cg"
+ "Modified: / 17.6.1998 / 11:28:57 / cg"
!
classDocumentation
@@ -4737,47 +4739,7 @@
] ifFalse:[
"/ self classDefinition.
self classListUpdate.
-
- currentClass isNamespace ifTrue:[
- codeView acceptAction:nil
- ] ifFalse:[
- codeView acceptAction:[:theCode |
- |ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
-
- codeView cursor:Cursor execute.
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- Object abortSignal catch:[
- UndefinedObject createMinimumProtocolInNewSubclassQuery
- answer:true
- do:[
- (Compiler
- evaluate:theCode asString
- notifying:codeView
- compile:false)
- isBehavior ifTrue:[
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- codeView modified:false.
- codeModified := false.
- ].
- ]
- ].
- ].
- codeView cursor:Cursor normal.
- ].
- ]
+ self setAcceptActionForClass.
].
codeView explainAction:nil.
@@ -4796,7 +4758,7 @@
]
"Created: / 23.11.1995 / 11:32:03 / cg"
- "Modified: / 19.4.1998 / 21:04:07 / cg"
+ "Modified: / 17.6.1998 / 11:05:06 / cg"
!
classTemplateFor:aSuperClass in:categoryString namespace:isNameSpace private:isPrivate
@@ -9169,7 +9131,7 @@
Notice, that it is possible to add new methods - even with missing sources.
"'.
- codeView acceptAction:[:text | nil].
+ codeView acceptAction:nil.
] ifFalse:[
UserPreferences current syntaxColoring ifTrue:[
highlighter := actualClass syntaxHighlighterClass.
@@ -9218,7 +9180,7 @@
self normalLabel.
"Created: / 23.11.1995 / 14:16:43 / cg"
- "Modified: / 27.4.1998 / 15:37:10 / cg"
+ "Modified: / 17.6.1998 / 10:42:02 / cg"
! !
!BrowserView methodsFor:'namespace menu'!
@@ -10364,6 +10326,87 @@
"Modified: 30.7.1997 / 15:30:10 / cg"
!
+setAcceptActionForClass
+ "tell the codeView what to do on accept and explain"
+
+ currentClass isNamespace ifTrue:[
+ codeView acceptAction:nil
+ ] ifFalse:[
+ codeView acceptAction:[:theCode |
+ |ns|
+
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
+
+ codeView cursor:Cursor execute.
+
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ Object abortSignal catch:[
+ UndefinedObject createMinimumProtocolInNewSubclassQuery
+ answer:true
+ do:[
+ (Class classRedefinitionSignal)handle:[:ex |
+ |answer oldVsNew oldPkg newPkg|
+
+ oldVsNew := ex parameter.
+ oldPkg := oldVsNew key package.
+ newPkg := oldVsNew value package.
+ answer := OptionBox
+ request:
+('You are about to define a class from another (system-) package.
+The classes original packageID was ''%1''.
+If you proceed, the new class will be marked as belonging
+to the ''%2'' package (and this warning will not be shown again).
+If you proceed with ''keep'', the class will be installed
+but the old packageID will be preserved.
+Otherwise, hit ''cancel'' to leave the class unchanged.
+
+PS: you can disable these checks in the launchers settings-compilation dialog.'
+ bindWith:(oldPkg asText allBold)
+ with:(newPkg asText allBold))
+
+ label:'Class redefinition'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('cancel' 'keep' 'continue')
+ values:#(#cancel #keep #continue)
+ default:#continue.
+
+ (answer ~~ #cancel) ifTrue:[
+ ex proceedWith:answer
+ ]
+ ] do:[
+ |rslt|
+
+ rslt := Compiler
+ evaluate:theCode asString
+ notifying:codeView
+ compile:false.
+
+ rslt isBehavior ifTrue:[
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ codeView modified:false.
+ codeModified := false.
+ ].
+ ]
+ ]
+ ].
+ ].
+ codeView cursor:Cursor normal.
+ ].
+ ]
+
+ "Modified: / 17.6.1998 / 11:39:02 / cg"
+!
+
setAcceptAndExplainActionsForMethod
"tell the codeView what to do on accept and explain"
@@ -10393,7 +10436,7 @@
Object abortSignal catch:[
lockUpdates := true.
- Class methodRedefinitionSignal handle:[:ex |
+ (Class methodRedefinitionSignal) handle:[:ex |
|answer oldVsNew oldPkg newPkg|
oldVsNew := ex parameter.
@@ -10401,14 +10444,17 @@
newPkg := oldVsNew value package.
answer := OptionBox
request:
-('You are about to change code from another (system-) package.
+('You are about to change a method from another (system-) package.
The methods original packageID was ''%1''.
-If you proceed, the new code will be marked as belonging
+If you proceed, the new method will be marked as belonging
to the ''%2'' package (and this warning will not be shown again).
-If you proceed with ''keep'', the old packageID will be preserved.
+If you proceed with ''keep'', the new method will be installed
+but the old packageID will be preserved.
Otherwise, hit ''cancel'' to leave the code unchanged.
-PS: you can disable these checks in the launchers settings-compilation dialog.' bindWith:oldPkg with:newPkg)
+PS: you can disable these checks in the launchers settings-compilation dialog.'
+ bindWith:(oldPkg asText allBold)
+ with:(newPkg asText allBold))
label:'Method redefinition'
form:(WarningBox iconBitmap)
@@ -10446,7 +10492,7 @@
forClass:actualClass)
].
- "Modified: / 31.3.1998 / 23:40:23 / cg"
+ "Modified: / 17.6.1998 / 11:38:35 / cg"
!
setDoitActionForClass
@@ -10456,37 +10502,37 @@
as self, and access to the class variables by name.
"
codeView doItAction:[:theCode |
- |compiler ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- currentClass isNil ifTrue:[
- compiler := Compiler
- ] ifFalse:[
- compiler := currentClass evaluatorClass
- ].
-
- compiler
- evaluate:theCode
- in:nil
- receiver:currentClass
- notifying:codeView
- logged:false
- ifFail:nil
- ]
- ].
-
- "Modified: 10.2.1997 / 14:17:15 / cg"
+ |compiler ns|
+
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
+
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ currentClass isNil ifTrue:[
+ compiler := Compiler
+ ] ifFalse:[
+ compiler := currentClass evaluatorClass
+ ].
+
+ compiler
+ evaluate:theCode
+ in:nil
+ receiver:currentClass
+ notifying:codeView
+ logged:false
+ ifFail:nil
+ ]
+ ].
+
+ "Modified: / 17.6.1998 / 11:35:44 / cg"
!
setSearchPattern:aString
@@ -11536,6 +11582,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.416 1998-06-16 08:56:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.417 1998-06-17 09:43:19 cg Exp $'
! !
BrowserView initialize!