diff -r c23841df3616 -r 570a38362ae1 ProjectView.st --- 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