[squeak-dev] The Trunk: 45Deprecated-fbs.3.mcz

commits at source.squeak.org commits at source.squeak.org
Fri May 3 12:35:34 UTC 2013


Frank Shearar uploaded a new version of 45Deprecated to project The Trunk:
http://source.squeak.org/trunk/45Deprecated-fbs.3.mcz

==================== Summary ====================

Name: 45Deprecated-fbs.3
Author: fbs
Time: 3 May 2013, 1:30:48.116 pm
UUID: 52f8573f-fba9-4ab9-b573-400412a8f945
Ancestors: 45Deprecated-fbs.2

Move ScriptLoader to 45Deprecated.

=============== Diff against 45Deprecated-fbs.2 ===============

Item was added:
+ Object subclass: #ScriptLoader
+ 	instanceVariableNames: 'repository'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: '45Deprecated'!
+ 
+ !ScriptLoader commentStamp: 'stephaneducasse 9/29/2005 18:48' prior: 0!
+ I'm a dummy class that is used to load packages to create release.
+ I should be merged into ReleaseBuilder in the future and ReleaseBuilder should be moved
+ out of system-support so that we do not create a new version of it each time!

Item was added:
+ ----- Method: ScriptLoader>>addRepositoryToPackageNamed: (in category 'private helpers') -----
+ addRepositoryToPackageNamed: aString
+ 	
+ 	|pa|
+ 	pa := MCPackage named: aString.
+ 	pa workingCopy repositoryGroup addRepository: self repository.
+ 	!

Item was added:
+ ----- Method: ScriptLoader>>bertLoadOneAfterTheOther:merge: (in category 'from bert') -----
+ bertLoadOneAfterTheOther: aCollection merge: aBoolean
+  
+ 	^ (self configurationFrom: aCollection) upgrade!

Item was added:
+ ----- Method: ScriptLoader>>cleanOldRepositories (in category 'cleaning') -----
+ cleanOldRepositories
+ 	"self new cleanOldRepositories"
+ 	"does not work since the interface of the repository group is not made for removing a repository only based on name"
+ 	
+ 	MCWorkingCopy allManagers do: [:each | 
+ 		each  repositoryGroup
+ 			removeRepository: (MCHttpRepository new location: 'http://kilana.unibe.ch:8888/Monticello');
+ 			removeRepository: (MCHttpRepository new location: 'http://modules.squeakfoundation.org/People/gk/')].
+ 	!

Item was added:
+ ----- Method: ScriptLoader>>cleanUpChanges (in category 'cleaning') -----
+ cleanUpChanges
+ 	"Clean up the change sets"
+ 	"self new cleanUpChanges"
+ 	
+ 	| projectChangeSetNames |
+ 	"Delete all changesets except those currently used by existing projects."
+ 	projectChangeSetNames := Project allSubInstances collect: [:proj | proj changeSet name].
+ 	ChangeSet removeChangeSetsNamedSuchThat:
+ 		[:cs | (projectChangeSetNames includes: cs) not].
+ !

Item was added:
+ ----- Method: ScriptLoader>>cleanUpEtoys (in category 'cleaning') -----
+ cleanUpEtoys
+ 	"self new cleanUpEtoys"
+ 
+ 	StandardScriptingSystem removeUnreferencedPlayers.
+ 
+ 	(self confirm: 'Remove all projects and players?')
+ 		ifFalse: [^self].
+ 	Project removeAllButCurrent.
+ 
+ 	#('Morphic-UserObjects' 'EToy-UserObjects' 'Morphic-Imported' )
+ 		do: [:each | SystemOrganization removeSystemCategory: each].
+ 		
+ 	Smalltalk
+ 		at: #Player
+ 		ifPresent: [:superCls | superCls
+ 				allSubclassesDo: [:cls | 
+ 					cls isSystemDefined
+ 						ifFalse: [cls removeFromSystem].
+ 					]].!

Item was added:
+ ----- Method: ScriptLoader>>cleanUpMethods (in category 'cleaning') -----
+ cleanUpMethods
+ 	"Make sure that all methods in use are restarted"
+ 
+ 	WeakArray restartFinalizationProcess.
+ 	MethodChangeRecord allInstancesDo:[:x| x noteNewMethod: nil].
+ 	Delay startTimerEventLoop.
+ 	WorldState allInstancesDo:[:ws| ws convertAlarms; convertStepList].
+ 	ExternalDropHandler initialize.
+ 	ScrollBar initializeImagesCache.
+ 	Vocabulary initialize.
+ 	GradientFillStyle initPixelRampCache.
+ 	ProcessBrowser initialize.
+ 	DebuggerMethodMap voidMapCache.
+ 	Smalltalk garbageCollect.
+ 
+ 	self assert: (CompiledMethod allInstances
+ 	reject:[:cm| cm hasNewPropertyFormat]) isEmpty.!

Item was added:
+ ----- Method: ScriptLoader>>cleaningCS (in category 'private helpers') -----
+ cleaningCS
+ 	"self new cleaningCS" 
+ 	 
+ 	ChangesOrganizer removeChangeSetsNamedSuchThat: [:each | true].
+ 	ChangeSet resetCurrentToNewUnnamedChangeSet !

Item was added:
+ ----- Method: ScriptLoader>>compileNewUpdateMethod (in category 'public helpers') -----
+ compileNewUpdateMethod
+ 
+ 	self class compile: 
+ 		(self generateNewUpdateMethod)
+ 		classified: 'updates'!

Item was added:
+ ----- Method: ScriptLoader>>compileScriptMethodWithCurrentPackages: (in category 'public helpers') -----
+ compileScriptMethodWithCurrentPackages: aNumber 
+ 	"ScriptLoader new compileScriptMethodWithCurrentPackages: 9999"
+ 	
+ 	self class compile: 
+ 		(self generateScriptTemplateWithCurrentPackages: aNumber)
+ 		classified: 'scripts'!

Item was added:
+ ----- Method: ScriptLoader>>compileScriptMethodXXXWithCurrentPackages (in category 'public helpers') -----
+ compileScriptMethodXXXWithCurrentPackages
+ 	"ScriptLoader new compileScriptMethodXXXWithCurrentPackages"
+ 	
+ 	self class compile: self generateScriptTemplateWithCurrentPackages classified: 'scripts'!

Item was added:
+ ----- Method: ScriptLoader>>configurationFrom: (in category 'from bert') -----
+ configurationFrom: aCollection
+ 
+ 	| spec | 
+ 	spec := Array streamContents: [:s |
+          s nextPut: #repository; nextPut: {self repository description}.
+          aCollection do: [:ea | | pkg ver id |
+              pkg := ea copyUpToLast: $- .
+              ver := ea copyUpToLast: $. .
+              id := UUID nilUUID asString.
+              s nextPut: #dependency; nextPut: {pkg . ver . id}]].
+     ^MCConfiguration fromArray: spec.!

Item was added:
+ ----- Method: ScriptLoader>>currentPackages (in category 'private helpers') -----
+ currentPackages
+ 	"ScriptLoader new currentPackages" 
+ 	
+ 	
+ 	| copies |
+ 	copies := MCWorkingCopy allManagers asSortedCollection:
+ 		[ :a :b | a package name <= b package name ].
+ 	^ copies select: [:each | '*Plus*' match: each package name ].!

Item was added:
+ ----- Method: ScriptLoader>>currentVersions (in category 'private helpers') -----
+ currentVersions
+ 	"ScriptLoader new currentVersions"
+ 	
+ 	| copies |
+ 	copies := MCWorkingCopy allManagers asSortedCollection:
+ 		[ :a :b | a package name <= b package name ].
+ 	^ copies collect:
+ 		[:ea |  ea ancestry ancestorString ]!

Item was added:
+ ----- Method: ScriptLoader>>finalCleanup (in category 'cleaning') -----
+ finalCleanup
+ 	"self new finalCleanup"
+ 
+ 	DataStream initialize.
+ 	Behavior flushObsoleteSubclasses.
+ 	"The pointer to currentMethod is not realy needed (anybody care to fix this) and often holds on to obsolete bindings"
+ 	MethodChangeRecord allInstancesDo: [:each | each noteNewMethod: nil].
+ 	self cleanUpEtoys.
+ 	SmalltalkImage current fixObsoleteReferences.
+ 	Smalltalk flushClassNameCache.
+ 	SystemOrganization removeEmptyCategories.
+ 	Symbol compactSymbolTable.
+ 	
+ !

Item was added:
+ ----- Method: ScriptLoader>>finalStripping (in category 'cleaning') -----
+ finalStripping
+ 	"self new finalStripping"
+ !

Item was added:
+ ----- Method: ScriptLoader>>fixObsoleteReferences (in category 'cleaning') -----
+ fixObsoleteReferences
+ 	"self new fixObsoleteReferences"
+ 
+ 	
+ 	Preference allInstances do: [:each | | informee | 
+ 		informee := each instVarNamed: #changeInformee.
+ 		((informee isKindOf: Behavior)
+ 			and: [informee isObsolete])
+ 			ifTrue: [
+ 				Transcript show: each name; cr.
+ 				each instVarNamed: #changeInformee put: (Smalltalk at: (informee name copyReplaceAll: 'AnObsolete' with: '') asSymbol)]].
+  
+ 	CompiledMethod allInstances do: [:method |
+ 		| obsoleteBindings |
+ 		obsoleteBindings := method literals select: [:literal |
+ 			literal isVariableBinding
+ 				and: [literal value isBehavior
+ 				and: [literal value isObsolete]]].
+ 		obsoleteBindings do: [:binding |
+ 			| obsName realName realClass |
+ 			obsName := binding value name.
+ 			Transcript show: obsName; cr.
+ 			realName := obsName copyReplaceAll: 'AnObsolete' with: ''.
+ 			realClass := Smalltalk at: realName asSymbol ifAbsent: [UndefinedObject].
+ 			binding isSpecialWriteBinding
+ 				ifTrue: [binding privateSetKey: binding key value: realClass]
+ 				ifFalse: [binding key: binding key value: realClass]]].
+ 
+ 
+ 	Behavior flushObsoleteSubclasses.
+ 	Smalltalk garbageCollect; garbageCollect.
+ 	SystemNavigation default obsoleteBehaviors size > 0
+ 		ifTrue: [SystemNavigation default obsoleteBehaviors inspect]!

Item was added:
+ ----- Method: ScriptLoader>>flushCaches (in category 'cleaning') -----
+ flushCaches
+ 
+ 	MCFileBasedRepository flushAllCaches.
+ 	MCDefinition clearInstances.
+ 	Smalltalk garbageCollect.
+ 	
+ 	"Initialization required for tests: strange why this is not a teardwon method"
+ 	Smalltalk at: #SendCaches ifPresent:[:aClass| aClass initializeAllInstances].!

Item was added:
+ ----- Method: ScriptLoader>>generateCS:fromUpdate:on: (in category 'private helpers') -----
+ generateCS: extensionAndNumber fromUpdate: updateNumber on: st
+ 	
+ 	st nextPutAll:
+ '"Postscript:
+ Leave the line above, and replace the rest of this comment by a useful one.
+ Executable statements should follow this comment, and should
+ be separated by periods, with no exclamation points (!!!!).
+ Be sure to put any further comments in double-quotes, like this one."
+ 
+ |repository|
+ repository := MCHttpRepository
+                 location: ''http://source.squeakfoundation.org/39a''
+                 user: ''''
+                 password: ''''.
+ (repository loadVersionFromFileNamed:' .
+ 	st nextPut: $' ; nextPutAll: 'ScriptLoader', extensionAndNumber, '.mcz'') load.'; cr.
+ 	st nextPutAll: 'ScriptLoader new updateFrom', (updateNumber-1) asString; nextPutAll: '.' ; cr.
+ 	st nextPutAll: '!!'.
+ 	^ st contents
+ !

Item was added:
+ ----- Method: ScriptLoader>>generateNewUpdateMethod (in category 'private helpers') -----
+ generateNewUpdateMethod
+ 	"ScriptLoader new compileNewUpdateMethod"
+ 	
+ 	| str mthName |
+ 	str := ReadWriteStream on: (String new: 1000).
+ 	mthName := 'updateFrom', (self getLatestUpdateNumber + 1) asString.
+ 	str nextPutAll: mthName ; cr ; cr ; tab.
+ 	str nextPutAll: '"self new ', mthName, '"' ; cr.
+ 	
+ 	str nextPutAll: '	self script' , self getLatestScriptNumber asString, '.'.
+ 	str nextPutAll: '
+ 	self flushCaches.
+ 	'.
+ 	
+ 	^ str contents!

Item was added:
+ ----- Method: ScriptLoader>>generateScriptTemplateWithAllCurrentPackages (in category 'private helpers') -----
+ generateScriptTemplateWithAllCurrentPackages
+ 	"ScriptLoader new generateScriptTemplateWithAllCurrentPackages"
+ 	
+ 	| str |
+ 	str := ReadWriteStream on: (String new: 1000).
+ 	str nextPutAll: 'scriptXXX' ; cr ; cr ; tab.
+ 	str nextPutAll: '| names|'; cr.
+ 	str nextPutAll: 'names := '.
+ 	str nextPut: $'.
+ 	self currentVersions do: 
+ 		[:each |
+ 			str nextPutAll: each ; nextPutAll: '.mcz']
+ 		separatedBy: [str nextPut: Character cr].
+ 	str nextPut: $'; nextPut: Character cr.
+ 	str nextPutAll: 'findTokens: '' '', String cr.
+ 
+ 	self loadTogether: names merge: false.'.
+ 	^ str contents!

Item was added:
+ ----- Method: ScriptLoader>>generateScriptTemplateWithCurrentPackages (in category 'private helpers') -----
+ generateScriptTemplateWithCurrentPackages
+ 	"ScriptLoader new generateScriptTemplateWithCurrentPackages"
+ 	
+ 	| str withoutScriptLoader |
+ 	str := ReadWriteStream on: (String new: 1000).
+ 	str nextPutAll: 'scriptXXX' ; cr ; cr ; tab.
+ 	str nextPutAll: '| names|'; cr.
+ 	str nextPutAll: 'names := '.
+ 	str nextPut: $'.
+ 	withoutScriptLoader := self currentVersions reject: [:each| ('*ScriptLoader*' match: each)].
+ 	withoutScriptLoader 
+ 		do: [ :each |
+ 			str nextPutAll: each ; nextPutAll: '.mcz']
+ 		separatedBy: [str nextPut: Character cr].
+ 	str nextPut: $'; nextPut: Character cr.
+ 	str nextPutAll: 'findTokens: '' '', String cr.
+ 
+ 	self loadTogether: names merge: false.'.
+ 	^ str contents!

Item was added:
+ ----- Method: ScriptLoader>>generateScriptTemplateWithCurrentPackages: (in category 'private helpers') -----
+ generateScriptTemplateWithCurrentPackages: aNumber
+ 	"ScriptLoader new generateScriptTemplateWithCurrentPackages"
+ 	
+ 	| str withoutScriptLoader |
+ 	str := ReadWriteStream on: (String new: 1000).
+ 	str nextPutAll: 'script', aNumber asString ; cr ; cr ; tab.
+ 	str nextPutAll: '| names|'; cr.
+ 	str nextPutAll: 'names := '.
+ 	str nextPut: $'.
+ 	withoutScriptLoader := self currentVersions reject: [:each| ('*ScriptLoader*' match: each)].
+ 	withoutScriptLoader 
+ 		do: [ :each |
+ 			str nextPutAll: each ; nextPutAll: '.mcz']
+ 		separatedBy: [str nextPut: Character cr].
+ 	str nextPut: $'; nextPut: Character cr.
+ 	str nextPutAll: 'findTokens: '' '', String cr.
+ 
+ 	self loadTogether: names merge: false.'.
+ 	^ str contents!

Item was added:
+ ----- Method: ScriptLoader>>getLatestScriptNumber (in category 'private helpers') -----
+ getLatestScriptNumber
+ 
+ 	| upfroms |
+ 	upfroms := self class selectors select: [:each | 'script*' match: each ].
+ 	upfroms := upfroms collect: [:each | (each asString allButFirst: 6)].
+ 	upfroms := upfroms reject: [:each | '*Log*' match: each ].
+ 	upfroms := upfroms reject: [:each | '*XXX*' match: each ].
+ 	upfroms := upfroms collect: [:each | each asNumber].
+ 	^ upfroms asSortedCollection last
+ 	!

Item was added:
+ ----- Method: ScriptLoader>>getLatestUpdateNumber (in category 'private helpers') -----
+ getLatestUpdateNumber
+ 
+ 	| upfroms |
+ 	upfroms := self class selectors select: [:each | 'updateFrom*' match: each ].
+ 	upfroms := upfroms collect: [:each | (each asString last: 4) asNumber].
+ 	^ upfroms asSortedCollection last!

Item was added:
+ ----- Method: ScriptLoader>>inboxRepository (in category 'accessing') -----
+ inboxRepository
+ 	repository isNil 
+ 		ifTrue: [ repository := 
+ 					MCHttpRepository
+ 						location: 'http://source.squeakfoundation.org/inbox'
+ 						user: ''
+ 						password: ''].
+ 	^ repository!

Item was added:
+ ----- Method: ScriptLoader>>initialCleanup (in category 'cleaning') -----
+ initialCleanup
+ 	"Perform various image cleanups in preparation for making a Squeak gamma release candidate image."
+ 	"self new initialCleanup"
+ 	
+ 	Undeclared removeUnreferencedKeys.
+ 	StandardScriptingSystem initialize.
+ 	self resetToolSet.
+ 	AppRegistry removeObsolete.
+ 	FileServices removeObsolete. 
+ 
+ 	(Object classPool at: #DependentsFields) size > 1 ifTrue: [self error:'Still have dependents'].
+ 	Undeclared isEmpty ifFalse: [self error:'Please clean out Undeclared'].
+ 
+ 	Smalltalk at: #Browser ifPresent:[:br| br initialize].
+ 	ScriptingSystem deletePrivateGraphics.  "?"
+ 	 
+ 	self cleanUpChanges.
+ 	ChangeSet current clear.
+ 	ChangeSet current name: 'Unnamed'. 
+ 	Smalltalk garbageCollect.
+  
+ 	"Reinitialize DataStream; it may hold on to some zapped entitities"
+ 	DataStream initialize. 
+ 
+ 	Smalltalk garbageCollect.
+ 	ScheduledControllers := nil.
+ 	Smalltalk garbageCollect.
+ 	
+ 	"SMSqueakMap default purge.  does not work"
+ 	
+ !

Item was added:
+ ----- Method: ScriptLoader>>installInBoxAnd39 (in category 'cleaning') -----
+ installInBoxAnd39
+ 	"self new installInBoxAnd39"
+ 	
+ 	MCWorkingCopy allManagers do: [:each | 
+ 		each  repositoryGroup
+ 			addRepository: (MCHttpRepository new location: 'http://source.squeakfoundation.org/39a' ; user: ''; password: '');
+ 			addRepository: (MCHttpRepository new location: 'http://source.squeakfoundation.org/inbox' ; user: '' ; password: '')].
+ 	
+ 	!

Item was added:
+ ----- Method: ScriptLoader>>installPreferences (in category 'cleaning') -----
+ installPreferences
+ 
+ 	Preferences initialize.
+ 	"Preferences chooseInitialSettings."
+ !

Item was added:
+ ----- Method: ScriptLoader>>installRepository:for: (in category 'cleaning') -----
+ installRepository: aString for: packageName
+ 
+ 	(MCWorkingCopy allManagers select: [:each | each package name = packageName])
+ 		first repositoryGroup
+ 		addRepository: (MCHttpRepository new location: aString ; user: 'squeak' ; password: 'squeak')
+ 		!

Item was added:
+ ----- Method: ScriptLoader>>installVersionInfo (in category 'cleaning') -----
+ installVersionInfo
+ 	"self new installVersionInfo"
+ 
+ 	| highestUpdate newVersion |
+ 	highestUpdate := SystemVersion current highestUpdate.
+ 	(self confirm: 'Reset highest update (' , highestUpdate printString , ')?')
+ 		ifTrue: [SystemVersion current highestUpdate: 0].
+ 
+ 	newVersion := UIManager default request: 'New version designation:' initialAnswer: '3.9' , highestUpdate printString. 
+ 	SystemVersion newVersion: newVersion.
+ 	
+ !

Item was added:
+ ----- Method: ScriptLoader>>installingDefaultRepositoriesToPackages (in category 'cleaning') -----
+ installingDefaultRepositoriesToPackages
+ 	"self new installingDefaultRepositoriesToPackages"
+ 	
+ 	self installInBoxAnd39.
+ 	self packagesAndHome do: [:each | 
+ 								self installRepository: each second for: each first].!

Item was added:
+ ----- Method: ScriptLoader>>loadOneAfterTheOther:merge: (in category 'private helpers') -----
+ loadOneAfterTheOther: aCollection merge: aBoolean
+ 	
+ 	(self newerVersionsIn: aCollection)
+ 		do: [:fn | | loader |
+ 			loader := aBoolean
+ 				ifTrue: [ MCVersionMerger new ]
+ 				ifFalse: [ MCVersionLoader new].
+ 			loader addVersion: (self repository loadVersionFromFileNamed: fn).
+ 			aBoolean
+ 				ifTrue: [[loader merge] on: MCMergeResolutionRequest do: [:request |
+ 							request merger conflicts isEmpty
+ 								ifTrue: [request resume: true]
+ 								ifFalse: [request pass]]]
+ 				ifFalse: [loader load]]
+   	  	displayingProgress: 'Loading versions...'.
+ 	
+ 
+ !

Item was added:
+ ----- Method: ScriptLoader>>loadTogether:merge: (in category 'private helpers') -----
+ loadTogether: aCollection merge: aBoolean
+ 	| loader |
+ 	loader := aBoolean
+ 		ifTrue: [ MCVersionMerger new ]
+ 		ifFalse: [ MCVersionLoader new].
+ 	(self newerVersionsIn: aCollection)
+ 		do: [:fn | loader addVersion: (self repository loadVersionFromFileNamed: fn)]
+   	  	displayingProgress: 'Adding versions...'.
+ 	aBoolean
+ 		ifTrue: [[loader merge] on: MCMergeResolutionRequest do: [:request |
+ 					request merger conflicts isEmpty
+ 						ifTrue: [request resume: true]
+ 						ifFalse: [request pass]]]
+ 		ifFalse: [loader load]
+ 
+ !

Item was added:
+ ----- Method: ScriptLoader>>mergePackagesNamed: (in category 'private helpers') -----
+ mergePackagesNamed: names
+ 	| vm  |
+ 	repository := MCHttpRepository
+                 location: 'http://source.squeakfoundation.org/39a'
+                 user: ''
+                 password: ''.
+ 
+ 	vm := MCVersionMerger new.
+ 	names
+ 		do: [:fn | vm addVersion: (repository loadVersionFromFileNamed: fn)]
+ 		displayingProgress: 'Adding versions...'.
+ 
+ 	[vm merge]
+ 		on: MCMergeResolutionRequest do: [:request |
+ 			request merger conflicts isEmpty
+ 				ifTrue: [request resume: true]
+ 				ifFalse: [request pass]]!

Item was added:
+ ----- Method: ScriptLoader>>methodsForNewVersion (in category 'public helpers') -----
+ methodsForNewVersion
+ 	"self new methodsForNewVersion"
+ 	
+ 	self compileScriptMethodWithCurrentPackages: (self getLatestScriptNumber + 1).
+ 	self compileNewUpdateMethod.!

Item was added:
+ ----- Method: ScriptLoader>>newerVersionsIn: (in category 'private helpers') -----
+ newerVersionsIn: aCollection
+ 	^aCollection reject: [:each |
+ 		MCWorkingCopy allManagers anySatisfy: [:workingcopy |
+ 			workingcopy ancestry ancestorString , '.mcz' = each]].!

Item was added:
+ ----- Method: ScriptLoader>>packagesAndHome (in category 'cleaning') -----
+ packagesAndHome
+ 
+ ^ #(
+ ('MonticelloConfigurations' 
+ 'http://source.impara.de/mc')
+ ('Balloon' 
+ 'http://source.squeakfoundation.org/Balloon')
+ ('Compression'
+ 'http://source.squeakfoundation.org/Compression')
+ ('Flash'
+ 'http://source.squeakfoundation.org/Balloon')
+ ('Graphics'
+ 'http://source.squeakfoundation.org/Graphics')
+ ('GraphicsTests' 
+ 'http://source.squeakfoundation.org/Graphics')
+ ('ToolBuilder-Kernel'
+ 'http://squeaksource.com/ToolBuilder')
+ ('ToolBuilder-MVC'
+ 'http://squeaksource.com/ToolBuilder')
+ ('ToolBuilder-Morphic'
+ 'http://squeaksource.com/ToolBuilder')
+ ('ToolBuilder-SUnit'
+ 'http://squeaksource.com/ToolBuilder')
+ ('TrueType'
+ 'http://source.squeakfoundation.org/Balloon')
+ ('PackageInfo'
+ 'http://www.squeaksource.com/PackageInfo')
+ ('SMBase'
+ 'http://source.squeakfoundation.org/SqueakMap')
+ ('SMLoader'
+ 'http://source.squeakfoundation.org/SqueakMap')
+ ('Network'
+ 'http://source.squeakfoundation.org/network')
+ ('NetworkTests'
+ 'http://source.squeakfoundation.org/network')
+ ('VersionNumber'
+ 'http://source.squeakfoundation.org/SqueakMap')
+ ('OB-Standard'
+ 'http://source.wiresong.ca/ob/')
+ ('OmniBrowser'
+ 'http://source.wiresong.ca/ob/')
+ ('Monticello'
+ 'http://source.wiresong.ca/mc/')
+ )
+ !

Item was added:
+ ----- Method: ScriptLoader>>packagesToUnload (in category 'log') -----
+ packagesToUnload
+ 
+ 	^ #('*PlusTools*' '*FixInvisible*')!

Item was added:
+ ----- Method: ScriptLoader>>packagesWithProblemsForAssignments (in category 'log') -----
+ packagesWithProblemsForAssignments
+ 	"FixUnderscores fixPackages: #()"
+ 	"when I tried to reload with the package fixed with underscores
+ 	I got problems so I just rollbacked for now."
+ 	
+ 	^#('PackageInfo')!

Item was added:
+ ----- Method: ScriptLoader>>prepareReleaseImage (in category 'cleaning') -----
+ prepareReleaseImage
+ 	"Perform various image cleanups in preparation for making a Squeak gamma release candidate image."
+ 	"self new prepareReleaseImage"
+ 	
+ 	(self confirm: 'Are you sure you want to prepare a release image?
+ This will perform several irreversible cleanups on this image.')
+ 		ifFalse: [^ self].
+ 
+ 	self
+ 		"unloadPackages;"
+ 		initialCleanup;
+ 		installPreferences;
+ 		finalStripping;
+ 		finalCleanup
+ 		"installVersionInfo"
+ !

Item was added:
+ ----- Method: ScriptLoader>>repository (in category 'accessing') -----
+ repository
+ 	repository isNil  
+ 		ifTrue: [ repository := 
+ 					MCHttpRepository
+ 						location:  'http://source.squeakfoundation.org/39a'
+ 						user: ''
+ 						password: ''].
+ 	^ repository!

Item was added:
+ ----- Method: ScriptLoader>>resetToolSet (in category 'private helpers') -----
+ resetToolSet
+ 
+ 	ToolSet default: nil!

Item was added:
+ ----- Method: ScriptLoader>>test (in category 'private helpers') -----
+ test
+ 	"self new test"
+ 	
+ 	|pa|
+ 	pa := MCPackage named: 'FlexibleVocabularies'.
+ 	pa workingCopy repositoryGroup addRepository: self repository.
+ 	!

Item was added:
+ ----- Method: ScriptLoader>>treatedPackagesForAssignments (in category 'log') -----
+ treatedPackagesForAssignments
+ 	"FixUnderscores fixPackages: #()"
+ 	
+ 	^#('38Deprecated' 'Tests' 'SUnit' 'SUnitGUI' '39Deprecated' 'CollectionsTests' 'Compression' 'Files' 'FlexibleVocabularies' 'Monticello' 'MonticelloConfigurations' 'Movies' 'Nebraska' 'PackageInfo' 'PreferenceBrowser'  'Protocols' 'ToolBuilder-Kernel' 'StarSqueak' 'Sound' 'VersionNumber' 'Tools' 'ToolBuilder-SUnit' 'ToolBuilder-MVC' 'Services-Base' 'SmaCC' 'SMLoader' 'SMBase' 'ToolBuilder-Morphic' 'Speech' 'ReleaseBuilder')!

Item was added:
+ ----- Method: ScriptLoader>>unloadFFI (in category 'private helpers') -----
+ unloadFFI
+ 	"ScriptLoader new unloadFFI"
+ 	
+ 	| copies namesOfpackagesToUnload |
+ 	namesOfpackagesToUnload := #('*FFI*'). 
+ 	copies := MCWorkingCopy allManagers asSortedCollection:
+ 		[ :a :b | a package name <= b package name ].
+ 	(copies select: [:each | namesOfpackagesToUnload anySatisfy: [:ea | ea match: each package name ]])
+ 		do: [:z | z unload].
+ 	Smalltalk recreateSpecialObjectsArray!

Item was added:
+ ----- Method: ScriptLoader>>unloadPackages (in category 'private helpers') -----
+ unloadPackages
+ 	"ScriptLoader new unloadPackages"
+ 	
+ 	| copies namesOfpackagesToUnload |
+ 	namesOfpackagesToUnload := self packagesToUnload. 
+ 	copies := MCWorkingCopy allManagers asSortedCollection:
+ 		[ :a :b | a package name <= b package name ].
+ 	(copies select: [:each | namesOfpackagesToUnload anySatisfy: [:ea | ea match: each package name ]])
+ 		do: [:z | z unload].!

Item was added:
+ ----- Method: ScriptLoader>>unloadableFailedPackages (in category 'log') -----
+ unloadableFailedPackages
+ 	"list of the packages that I succeeded to remove pressing unload"
+ 	
+ 	^ #('Nebraska' 'TrueType')!

Item was added:
+ ----- Method: ScriptLoader>>unloadablePackages (in category 'log') -----
+ unloadablePackages
+ 	"list of the packages that I succeeded to remove pressing unload"
+ 	"Note that this does not mean that the system is working after, just that it
+ 	was possible to unload the package without crashing Squeak"
+ 	
+ 	^ #('OmniBrowser' 'PlusTools' 'Flash' 'FFI' 'StarSqueak' 'Speech' 'Movie' 'FlexibleVocabularies' '39Deprecated' '39Deprecated' 'PreferenceBrowser' 'ReleaseBuilder' 
+ 	'SUnitUI' 'Protocols' 'Sounds')!

Item was added:
+ ----- Method: ScriptLoader>>writeCS:forUpdate: (in category 'private helpers') -----
+ writeCS: extensionAndNumber forUpdate: updateNumber
+ 	"ScriptLoader new writeCS: '-sd.210' forUpdate: 7037"
+ 	
+ 	self writeCS: extensionAndNumber forUpdate: updateNumber withName: 'changeMe'!

Item was added:
+ ----- Method: ScriptLoader>>writeCS:forUpdate:withName: (in category 'public helpers') -----
+ writeCS: extensionAndNumber forUpdate: updateNumber withName: aSt
+ 	"ScriptLoader new writeCS: '-md.2929' forUpdate: 7049 withName: 'cleanUpMethods'"
+ 	
+ 	| str |
+ 	str := FileDirectory default forceNewFileNamed:  updateNumber asString, 'update', aSt, '.cs'.
+ 	self generateCS: extensionAndNumber fromUpdate: updateNumber on: str.
+ 	str close.!



More information about the Squeak-dev mailing list