ProjectView.st
changeset 110 570a38362ae1
parent 106 f4eb10b3b463
child 111 b4ef3e799345
--- 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