--- a/BrowserView.st Thu Jul 13 17:50:51 2000 +0200
+++ b/BrowserView.st Fri Jul 14 12:22:07 2000 +0200
@@ -8874,6 +8874,89 @@
"Modified: 7.11.1996 / 18:53:55 / cg"
!
+methodCopy
+ "copy the current method into another class; typically a brother-sister class"
+
+ |newClass newClassName sup initial copiedMethod
+ supers subs list holders|
+
+ self checkMethodSelected ifFalse:[^ self].
+
+ lastMethodMoveClass ~= currentClass name ifTrue:[
+ initial := lastMethodMoveClass.
+ ].
+
+ initial isNil ifTrue:[
+ (sup := currentClass superclass) notNil ifTrue:[
+ initial := sup name
+ ] ifFalse:[
+ initial := nil.
+ ].
+ ].
+
+ supers := (currentClass allSuperclasses reverse collect:[:cls | cls name]).
+ subs := (currentClass allSubclasses collect:[:cls | cls name]).
+ list := supers.
+ (supers notEmpty and:[subs notEmpty]) ifTrue:[
+ list := list , (Array with:'---- ' , currentClass name , ' ----')
+ ].
+ list := list , subs.
+
+
+"/ preps to use windowSpecs ...
+"/
+"/ holders := IdentityDictionary new.
+"/ holders at:#className put:initial asValue.
+"/ holders at:#classList put:list.
+"/
+"/ (SystemBrowser
+"/ openDialogInterface:#methodMoveDialogSpec
+"/ withBindings:holders) ifFalse:[
+"/ ^ self
+"/ ].
+"/ newClassName := (holders at:#className) value.
+
+ newClassName := Dialog
+ request:(resources string:'copy this method to which class:')
+ initialAnswer:initial
+ okLabel:(resources string:'copy')
+ title:(resources string:'copy method')
+ onCancel:nil
+ list:list.
+ newClassName isNil ifTrue:[^ self].
+ (newClassName startsWith:'---- ') ifTrue:[^ self].
+
+ newClass := Smalltalk classNamed:newClassName.
+ newClass isNil ifTrue:[
+ self warn:'no such class'.
+ ^ self
+ ].
+
+ showInstance ifFalse:[
+ newClass isMeta ifFalse:[
+ newClass := newClass class
+ ]
+ ].
+
+ (newClass implements:currentSelector) ifTrue:[
+ (self confirm:(newClass name asText allBold , ' already implements ' , currentSelector
+ , '\\Redefine anyway ?' withCRs)) ifFalse:[
+ ^ self
+ ]
+ ].
+
+ lastMethodMoveClass := newClassName.
+
+ copiedMethod := newClass
+ compile:(currentMethod source)
+ classified:currentMethodCategory.
+
+ (copiedMethod isNil or:[copiedMethod == #Error]) ifTrue:[
+ self warn:'not copied - compilation failed due to an error'.
+ ^ self
+ ].
+!
+
methodDecompile
"decompile the current methods bytecodes.
The Decompiler is delivered as an extra, and not normally
@@ -9323,11 +9406,12 @@
mthdItems := #(
('change category...' methodChangeCategory )
- ('move...' methodMove )
- ('remove' methodRemove )
- ('-' nil )
- ('compare with previous' methodCompareWithPreviousVersion )
- ('back to previous' methodPreviousVersion )
+ ('move to...' methodMove )
+ ('copy to...' methodCopy )
+ ('remove' methodRemove )
+ ('-' nil )
+ ('compare with previous' methodCompareWithPreviousVersion )
+ ('back to previous' methodPreviousVersion )
).
] ifFalse:[
@@ -9501,7 +9585,7 @@
classified:currentMethodCategory.
(movedMethod isNil or:[movedMethod == #Error]) ifTrue:[
- self warn:'not moved - compilation failed due to a compilation error'.
+ self warn:'not moved - compilation failed due to an error'.
^ self
].
@@ -14051,6 +14135,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.623 2000-07-13 15:50:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.624 2000-07-14 10:22:07 cg Exp $'
! !
BrowserView initialize!