--- a/ProjectView.st Thu Aug 03 03:38:05 1995 +0200
+++ b/ProjectView.st Thu Aug 10 15:14:54 1995 +0200
@@ -37,7 +37,8 @@
version
"
-$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.15 1995-06-27 02:30:00 claus Exp $
+$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.16 1995-08-10 13:14:50 claus Exp $
+$Revision: 1.16 $
"
! !
@@ -136,14 +137,17 @@
(p := aClass package) notNil ifTrue:[
existingPackages add:(p asString)
- ]
- ].
- Method allInstancesDo:[:aClass |
- |p|
-
- (p := aClass package) notNil ifTrue:[
- existingPackages add:(p asString)
- ]
+ ].
+ aClass methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
+ aClass class methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
].
box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
@@ -156,8 +160,84 @@
].
box showAtPointer
]
+!
+removePackage
+ "remove all classes and individual methods from the system.
+ Currently, this cannot fully restore the state to before
+ the time the package was loaded (redefined methods are lost).
+ In the future, we may keep a backref of overwritten methods
+ and restore them from their source ..."
+ |classesToRemove methodsToRemove theProject|
+
+ (myProject isNil
+ or:[(theProject := myProject packageName) isNil]) ifTrue:[
+ self warn:'No current package'.
+ ^ self
+ ].
+
+ classesToRemove := IdentitySet new.
+ methodsToRemove := IdentitySet new.
+
+ Smalltalk allClassesDo:[:aClass |
+ |p|
+
+ (p := aClass package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ classesToRemove add:aClass
+ ]
+ ].
+ ].
+ Smalltalk allClassesDo:[:aClass |
+ |p|
+
+ (classesToRemove includes:aClass) ifFalse:[
+ aClass methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ aClass class methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ ].
+ ].
+
+ (classesToRemove isEmpty
+ and:[methodsToRemove isEmpty]) ifTrue:[
+ self warn:('Nothing found in ' , theProject).
+ ^ self
+ ].
+
+ (self confirm:('About to remove '
+ , classesToRemove size printString
+ , ' classes and '
+ , methodsToRemove size printString
+ , ' additional methods.\\Are you certain you want this ?') withCRs)
+ ifTrue:[
+ classesToRemove do:[:aClass |
+ ('PROJECT: removing ' , aClass name) infoPrintNL.
+ Smalltalk removeClass:aClass.
+ ].
+ methodsToRemove do:[:aMethod |
+ |where|
+
+ ('PROJECT: removing ' , aMethod displayString) infoPrintNL.
+ where := aMethod who.
+ where isNil ifTrue:[
+ 'PROJECT: oops, some method is gone' infoPrintNL.
+ ] ifFalse:[
+ (where at:1) removeSelector:(where at:2)
+ ]
+ ]
+ ].
!
showProject
@@ -263,10 +343,19 @@
initialize
super initialize.
+
+ "/
+ "/ create the toggle ...
+ "/
toggle := Toggle in:self.
toggle borderWidth:0.
toggle pressAction:[self showProject].
toggle releaseAction:[self hideProject].
+
+ "/
+ "/ and give it a menu
+ "/
+
toggle middleButtonMenu:(
PopUpMenu
labels:(resources array:
@@ -285,6 +374,7 @@
'show'
'hide'
'-'
+ 'remove package'
'destroy'
)
)
@@ -303,6 +393,7 @@
showProject
hideProject
nil
+ removePackage
destroy
)
receiver:self