Next steps for MCP?

Daniel Vainsencher danielv at netvision.net.il
Sun May 25 12:55:34 UTC 2003


>From what I've read of your snippet, it is a tool to do destructive
removal - in the sense that stuff is removed whether it is needed or
not. For example in this case, the *PropertyMorph stuff would be
removed, despite the fact that it is actually called by external methods
(which are shown to the user).

Which is a good way when you're trying to cut stuff out to get to a
specific subset that serves you. But when you want to preserve the
functionality (for example, Morphs should still be able to bring up
*PropertyMorphs), but in a form that is (un)loadable, you need to
perform manual refactorings.

SpT merely shows the paths of dependency clearly, so the human can
decide what refactorings to do. It also tests in the same way whether
the refactorings have made some components independently loadable.

Daniel

"Lic. Edgar J. De Cleene" <edgardec2001 at yahoo.com.ar> wrote:
> > This message is in MIME format. Since your mail reader does not understand
> this format, some or all of this message may not be legible.
> 
> --Boundary_(ID_nXyT5A9jfY/FbH4UTsN3uw)
> Content-type: text/plain; charset=US-ASCII
> Content-transfer-encoding: 7BIT
> 
> On 25/05/03 08:19, "Daniel Vainsencher" <danielv at netvision.net.il> wrote:
> 
> > I wonder if you find this interesting - the class category
> > Morphic-Experimental sounds to me unessential to Morphic. But looking at
> > the reference graph using SpT, I see that actually, Morphic-Kernel does
> > depend on it in a few ways. The *PropertiesMorph classes are referenced
> > by Morph. This requires some sleuthing as to whether the *PropertyMorphs
> > should actually be in the Squeak core (in which case, they should be
> > moved out of the category *Experimental), or that they should be made
> > somehow optional extensions, which would require some design solution.
> 
> Daniel:
> 
> Here is what I do for removing Morphic-Experimental from image.
> If any could say this is correct, or test, could send more of this.
> 
> Smalltalk organization addCategory: 'Morphic-AlignmentMorphBob1'.
> SystemOrganization classifyAll: #(AlignmentMorphBob1) under:
> 'Morphic-AlignmentMorphBob1'.
> InformAbout removeSuspectMethods: 'Morphic-Experimental*'.
> toRemove _ SystemOrganization categoriesMatching: 'Morphic-Experimental*'.
> toRemove do: [:each | SystemOrganization removeSystemCategory: each].
> Smalltalk garbageCollect.
> 
> Edgar
> 
> 
> --Boundary_(ID_nXyT5A9jfY/FbH4UTsN3uw)
> Content-type: text/plain; name=RemovalThings.st; x-mac-creator=522A6368;
>  x-mac-type=54455854
> Content-transfer-encoding: 7BIT
> Content-disposition: attachment; filename=RemovalThings.st
> 
> Object subclass: #InformAbout
> 	instanceVariableNames: ''
> 	classVariableNames: ''
> 	poolDictionaries: ''
> 	category: 'RemovalThings'!
> 
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
> 
> InformAbout class
> 	instanceVariableNames: ''!
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 3/29/2003 07:41'!
> classInThisCategorie: aCategory
> 
> | newBrowser catList |
> 
> 	newBrowser _ Browser new.
> 	catList _ newBrowser systemCategoryList.
> 	newBrowser systemCategoryListIndex: 
> 		(catList indexOf: aCategory asSymbol ifAbsent: [^ self inform: 'No such category']).
> ^ newBrowser classList.! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 3/30/2003 07:18'!
> informCategories: aString 
> 	| categorieList classList aStream associationList actualClass |
> 	aStream _ WriteStream on: String new.
> 	categorieList _ SystemOrganization categoriesMatching: aString.
> 	categorieList
> 		do: [:aCategorie | aStream print: aCategorie;
> 				 cr].
> 	aStream print: 'This are the categories matching ' , aString;
> 		 cr.
> 	categorieList
> 		do: [:aCategorie | 
> 			classList _ self classInThisCategorie: aCategorie.
> 	aStream tab; tab; print: '=== Class ========= Method ==='; cr.
> 			classList
> 				do: [:aClass | 
> 					aStream tab; print: aClass; cr.
> 					
> 				
> 					actualClass _ Smalltalk
> 								atOrBelow: aClass
> 								ifAbsent: [^ nil].
> 					associationList _ Smalltalk
> 								allCallsOn: (Smalltalk associationAt: actualClass theNonMetaClass name).
> 					associationList
> 						do: [:aAssociation | 
> 							aStream tab; tab; print: aAssociation classSymbol asString.
> 							aStream tab; tab; print: aAssociation methodSymbol asString; cr].
> 					aStream print: 'This are the associations in class '.
> 						aStream print: aClass asString;
> 						 cr].aStream print: 'This are the classes in ' , aCategorie asString;
> 						 cr.].
> 	StringHolder new contents: aStream contents;
> 		 openLabel: aString , ' Use in this image '! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 5/16/2003 07:12'!
> limpieza0
> 	"NOTE: This method assumes that
> 		* ALL WINDOWS HAVE BEEN CLOSED (most importantly all project windows)
> 		* ALL GLOBAL FLAPS HAVE BEEN DESTROYED (not just disabled)
> 	This method may needs to be run twice - upon the first run you will probably receive an error message saying 'still have obsolete behaviors'. Close the notifier and try again. If there are still obsolete behaviors then go looking for them.
> 	Last update: ar 8/18/2001 01:14 for Squeak 3.1"
> 	| ss |
> 	 
> 	"Delete all projects"
> 	Project allSubInstancesDo:[:p|
> 		(p == Project current) ifFalse:[Project deletingProject: p].
> 	].
> 	"Fix up for some historical problem"
> 	Smalltalk allObjectsDo:[:o|
> 		o isMorph ifTrue:[o removeProperty: #undoGrabCommand].
> 	].
> 	"Hm ... how did this come in?!!"
> 	Smalltalk keys do:[:x|
> 		(x class == String and:[(Smalltalk at: x) isBehavior]) ifTrue:[Smalltalk removeKey: x].
> 	].
> 	"Remove stuff from References"
> 	References keys do:[:k| References removeKey: k].
> 	"Reset command history"
> 	CommandHistory resetAllHistory.
> 	"Clean out Undeclared"
> 	Undeclared removeUnreferencedKeys.
> 	"Reset scripting system"
> 	StandardScriptingSystem initialize.
> 	"Reset preferences"
> 	Preferences
> 		chooseInitialSettings;
> 		installBrightWindowColors.
> 	"Do a nice fat GC"
> 	Smalltalk garbageCollect.
> 	"Dependents mean that we're holding onto stuff"
> 	(Object classPool at: #DependentsFields) size > 1 
> 		ifTrue: [self error:'Still have dependents'].
> 
> 	 	"Initialize Browser (e.g., reset recent classes etc)"
> 	Browser initialize.
> 	"Check for Undeclared"
> 	Undeclared isEmpty 
> 		ifFalse: [self error:'Please clean out Undeclared'].
> 	"Remove graphics we don't want"
> 	ScriptingSystem deletePrivateGraphics.
> 	"Remove a few text styles"
> 	#(Helvetica Palatino Courier) do:
> 		[:n | TextConstants removeKey: n ifAbsent: []].
> 	"Dump all player uniclasses"
> 	Smalltalk at: #Player ifPresent:[:player|
> 		player allSubclassesDo:[:cls|
> 			cls isSystemDefined ifFalse:[cls removeFromSystem]]].
> 	"Dump all Wonderland uniclasses"
> 	Smalltalk at: #WonderlandActor ifPresent:[:wnldActor|
> 		wnldActor allSubclassesDo:[:cls|
> 			cls isSystemDefined ifFalse:[cls removeFromSystem]]].
> 	"Attempt to get rid of them"
> 	Smalltalk garbageCollect.
> 
> 	"Dump change sets"
> 	ChangeSorter removeChangeSetsNamedSuchThat:
> 		[:cs| cs name ~= Smalltalk changes name].
> 	"Clear current change set"
> 	Smalltalk changes clear.
> 	Smalltalk changes name: 'Unnamed1'.
> 	Smalltalk garbageCollect.
> 	"Reinitialize DataStream; it may hold on to some zapped entitities"
> 	DataStream initialize.
> 	"Remove refs to old ControlManager"
> 	ScheduledControllers _ nil.
> 	"Flush obsolete subclasses"
> 	Behavior flushObsoleteSubclasses.
> 	Smalltalk garbageCollect.
> 	
> 
> 	"Clear all server entries"
> 	ServerDirectory serverNames do: [:each | ServerDirectory removeServerNamed: each].
> 	SystemVersion current resetHighestUpdate.
> 
> 	ss _ Set allSubInstances.
> 	'Rehashing all sets' displayProgressAt: Sensor cursorPoint from: 1 to: ss size during:[:bar|
> 		1 to: ss size do:[:i|
> 			bar value: i.
> 			(ss at: i) rehash.
> 		].
> 	].
> 
> 
> 	SystemDictionary removeSelector: #makeSqueaklandRelease.
> 
> ! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 5/16/2003 10:06'!
> moreSuspectMethods: aSymbol 
> 	| categorieList aStream tokens moreSuspects |
> 	aStream _ WriteStream on: String new.
> 	categorieList _ (Smalltalk allMethodsInCategory: aSymbol)
> 				collect: [:each | 
> 					tokens _ each findTokens: ' '.
> 					tokens].
> 	categorieList
> 		do: [:each | each
> 				pairsDo: [:aClass :aMethod | 
> 					aStream print: aClass;
> 						 tab.
> 					aStream print: aMethod;
> 						 cr.
> 					aStream print: 'Otros sospechosos ';
> 						 cr.
> 					moreSuspects _ Smalltalk allCallsOn: aMethod asSymbol.
> 					moreSuspects
> 						do: [:ms | aStream print: ms;
> 								 cr].
> 					aStream print: ' <======   ====>']].
> 	StringHolder new contents: aStream contents;
> 		 openLabel: 'This are the usual suspect in ' , aSymbol! !
> 
> !InformAbout class methodsFor: 'as yet unclassified'!
> removeClassCategories: t1 
> 	| t2 t3 t4 |
> 	t2 _ (Smalltalk allMethodsInCategory: t1)
> 				collect: [:t5 | 
> 					t3 _ t5 findTokens: ' '.
> 					t3 _ t3 copyWithoutIndex: 2].
> 	t2
> 		do: [:t5 | t5
> 				pairsDo: [:t6 :t7 | 
> 					t4 _ Smalltalk
> 								atOrBelow: t6 asSymbol
> 								ifAbsent: [].
> 					t4 class removeSelector: t7 asSymbol]].
> 	Smalltalk removeEmptyMessageCategories.
> 	Smalltalk garbageCollect! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 5/16/2003 09:42'!
> removeClassCategoriesContaining: aString 
> 	| listaClasesYmetodos tokens actualClass aList |
> aList _ Symbol selectorsContaining:aString.
> aList do: [ :aSymbol |
> 	listaClasesYmetodos _ (Smalltalk allMethodsInCategory: #aSymbol)
> 				collect: [:each | 
> 					tokens _ each findTokens: ' '.
> 					tokens _ tokens copyWithoutIndex: 2].
> 	listaClasesYmetodos
> 		do: [:each | each
> 				pairsDo: [:aClass :methodo | 
> 					actualClass _ Smalltalk
> 								atOrBelow: aClass asSymbol
> 								ifAbsent: [].
> 					actualClass class removeSelector: methodo asSymbol]]].
> 	Smalltalk removeEmptyMessageCategories.
>  Smalltalk garbageCollect! !
> 
> !InformAbout class methodsFor: 'as yet unclassified'!
> removeMethodsInCategory: t1 
> 	| t2 t3 t4 |
> 	t2 _ (Smalltalk allMethodsInCategory: t1)
> 				collect: [:t5 | 
> 					t3 _ t5 findTokens: ' '.
> 					t3 _ t3 copyWithoutIndex: 2].
> 	t2
> 		do: [:t5 | t5
> 				pairsDo: [:t6 :t7 | 
> 					t4 _ Smalltalk
> 								atOrBelow: t6 asSymbol
> 								ifAbsent: [].
> 					t4 removeSelector: t7 asSymbol]]! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 5/20/2003 08:47'!
> removeMoreSuspectMethods: aString
> 	| categorieList tokens actualClass |
> 	categorieList _ (Smalltalk allMethodsInCategory: aString asSymbol)
> 				collect: [:each | 
> 					tokens _ each findTokens: ' '.
> 					tokens
> 						remove: 'class'
> 						ifAbsent: [].
> 					tokens].
> 	categorieList
> 		do: [:each | each
> 				pairsDo: [:aClass :aMethod | 
> 					actualClass _ Smalltalk
> 								atOrBelow: aClass asSymbol
> 								ifAbsent: [].
> 					actualClass  removeSelector: aMethod asSymbol]].
> 	Smalltalk removeEmptyMessageCategories.
> 	Smalltalk garbageCollect! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 5/20/2003 17:05'!
> removeOtherSuspectMethods: aSymbol 
> 	| associationList actualClass |
> 	associationList _ Smalltalk allImplementorsOf: aSymbol.
> 	associationList
> 		do: [:aAssociation | aAssociation classSymbol isLiteral
> 				ifTrue: [actualClass _ Smalltalk
> 								atOrBelow: aAssociation classSymbol
> 								ifAbsent: [^ nil].
> (actualClass methodDict includesKey: aAssociation methodSymbol asSymbol) ifTrue: [
> 					actualClass removeSelector: aAssociation methodSymbol asSymbol]
> ifFalse: [
> 					actualClass class removeSelector: aAssociation methodSymbol asSymbol]
> 
> ]
> 				ifFalse: [aAssociation classSymbol removeSelector: aAssociation methodSymbol asSymbol]]! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 4/22/2003 05:40'!
> removeSuspectMethods:  aString 
> 	| categorieList classList  associationList actualClass t7   |
> 
> 
> 	categorieList _ SystemOrganization categoriesMatching: aString.
> 	categorieList
> 		do: [:aCategorie | 
> 			classList _ self classInThisCategorie: aCategorie].
> 			classList
> 				do: [:aClass | 
> 
> 					actualClass _ Smalltalk
> 								atOrBelow: aClass
> 								ifAbsent: [^ nil].
> 					associationList _ Smalltalk
> 								allCallsOn: (Smalltalk associationAt: actualClass theNonMetaClass name).
> 					associationList
> 						do: [:aAssociation | 
> 
> 							t7 _ classList
> 										detect: [:t11 | t11 = aAssociation classSymbol]
> 										ifNone:  [aAssociation classSymbol isLiteral ifTrue:[
> 
> actualClass _ Smalltalk
> 								atOrBelow: aAssociation classSymbol
> 								ifAbsent: [^ nil].
>  actualClass  removeSelector: aAssociation methodSymbol asSymbol] ifFalse: [aAssociation classSymbol   removeSelector: aAssociation methodSymbol asSymbol].
> 							].
> 					]].
> 	
> 
> 
> ! !
> 
> !InformAbout class methodsFor: 'as yet unclassified' stamp: 'edc 5/21/2003 08:54'!
> suspectMethods:  aString 
> 	| categorieList classList aStream associationList actualClass t7   |
> 	aStream _ WriteStream on: String new.
> 
> 
> 	categorieList _ SystemOrganization categoriesMatching: aString.
> 	categorieList
> 		do: [:aCategorie | 
> 			classList _ self classInThisCategorie: aCategorie].
> classList ifNil: [ ^0].
> 			classList
> 				do: [:aClass | 
> self halt.
> 					actualClass _ Smalltalk
> 								atOrBelow: aClass
> 								ifAbsent: [^ nil].
> 					associationList _ Smalltalk
> 								allCallsOn: (Smalltalk associationAt: actualClass theNonMetaClass name).
> 					associationList
> 						do: [:aAssociation | 
> 
> 							t7 _ classList
> 										detect: [:t11 | t11 = aAssociation classSymbol]
> 										ifNone: [aStream  print: aAssociation classSymbol asString.
> 							aStream tab; tab; print: aAssociation methodSymbol asString; cr].
> 							].
> 					].
> 	
> 	StringHolder new contents: aStream contents;
> 		 openLabel: 'This are the usual suspect in ', aString.
> 
> ! !
> 
> 
> --Boundary_(ID_nXyT5A9jfY/FbH4UTsN3uw)
> MIME-version: 1.0
> Content-type: text/plain; charset=us-ascii
> Content-transfer-encoding: 7BIT
> 
> 
> 
> --Boundary_(ID_nXyT5A9jfY/FbH4UTsN3uw)--



More information about the Squeak-dev mailing list