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

-------------- next part --------------
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.

! !