[etoys-dev] Etoys Inbox: ReleaseBuilderSqueakland-tfel.1.mcz

[commits at source.squeak.org]

Tim Felgentreff uploaded a new version of ReleaseBuilderSqueakland to project Etoys Inbox:
http://source.squeak.org/etoysinbox/ReleaseBuilderSqueakland-tfel.1.mcz

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

Name: ReleaseBuilderSqueakland-tfel.1
Author: tfel
Time: 28 July 2016, 12:08:50.303881 pm
UUID: 2c13a249-9c09-9842-af04-e658875dc74a
Ancestors: 

move release builder for squeakland into its own package

==================== Snapshot ====================

SystemOrganization addCategory: #ReleaseBuilderSqueakland!

ReleaseBuilder subclass: #ReleaseBuilderSqueakland
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ReleaseBuilderSqueakland'!

!ReleaseBuilderSqueakland commentStamp: '<historical>' prior: 0!
Note: as of this writing, the only reliable way to get rid of all but the current project is to execute the following, one line at a time...

Smalltalk zapAllOtherProjects.	"close inspector if it popped up"
ProjectHistory currentHistory initialize.
Smalltalk garbageCollect.
Project rebuildAllProjects.

ReleaseBuilderSqueakland new prepareReleaseImage.!

----- Method: ReleaseBuilderSqueakland>>buildInitialScreen (in category 'squeakland') -----
buildInitialScreen
	"ReleaseBuilderSqueakland new buildInitialScreen"

	QuickGuideMorph preloadIndexPage.

	World
		submorphsDo: [:m | m delete].
	Flaps disableGlobalFlaps: false.
	Flaps enableEToyFlaps.

	ProjectLoading loadFromImagePath: 'Tutorials'.
	ProjectLoading loadFromImagePath: 'Gallery'.
	ProjectLoading loadFromImagePath: 'Home'.

	(World submorphs select: [:e | e isMemberOf: ProjectViewMorph]) do: [:e | e delete].
	Project current
		setThumbnail: (Project home ifNotNilDo: [:p | p thumbnail]).!

----- Method: ReleaseBuilderSqueakland>>checkCopyright (in category 'utilities') -----
checkCopyright
	| inNotice inImage inFile dir |
	dir := FileDirectory on: Smalltalk imagePath.
	[inFile := (dir readOnlyFileNamed: 'NOTICE') wantsLineEndConversion: true; contentsOfEntireFile]
		on: FileDoesNotExistException do: [:ex |	
			dir = FileDirectory default
				ifTrue: [dir := dir containingDirectory. ex retry]
				ifFalse: [self error: 'NOTICE file not found']].
	inFile = Utilities copyrightNotice ifFalse: [self error: 'NOTICE file does not match image'].
	inNotice := ((Utilities copyrightNotice findTokens: Character cr)
		select: [:s | s includesSubString: '(c)'])
		collect: [:s | s withBlanksTrimmed].
	inNotice := inNotice atAll: #(1 4 5).
	inImage := Smalltalk copyright findTokens: Character cr.
	inNotice = inImage ifFalse: [self error: 'Copyright declarations do not match'].!

----- Method: ReleaseBuilderSqueakland>>cleanUpChanges (in category 'utilities') -----
cleanUpChanges
	"Clean up the change sets"

	"ReleaseBuilder new cleanUpChanges"
	
	| projectChangeSetNames |

	"Delete all changesets except those currently used by existing projects."
	projectChangeSetNames _ Project allSubInstances collect: [:proj | proj changeSet name].
	ChangeSorter removeChangeSetsNamedSuchThat:
		[:cs | (projectChangeSetNames includes: cs) not].
!

----- Method: ReleaseBuilderSqueakland>>cleanUpEtoys (in category 'utilities') -----
cleanUpEtoys
	"ReleaseBuilder new cleanUpEtoys"


	StandardScriptingSystem removeUnreferencedPlayers.
	Project removeAllButCurrent.

	#('Morphic-UserObjects' 'EToy-UserObjects' 'Morphic-Imported' )
		do: [:each | SystemOrganization removeSystemCategory: each]!

----- Method: ReleaseBuilderSqueakland>>cleanupForSqueakland (in category 'squeakland') -----
cleanupForSqueakland
	"Perform various image cleanups in preparation for making a Squeakland OLPC image."
	"ReleaseBuilderSqueakland new cleanupForSqueakland"
	
	self
		initialCleanup;
		installPreferences;
		finalStripping;
		installReleaseSpecifics;
		finalCleanup.
	OLPCVirtualScreen virtualScreenExtent: nil.
	Display isVirtualScreen ifFalse: [
		OLPCVirtualScreen install
	].
	Display newDepth: 16.
	Project current displayDepth: 16.
	Vocabulary initialize.
	PartsBin  rebuildIconsWithProgress.
!

----- Method: ReleaseBuilderSqueakland>>finalCleanup (in category 'utilities') -----
finalCleanup
	"ReleaseBuilderSqueakland new finalCleanup"


	Smalltalk condenseChanges.
	Preferences disable: #warnIfNoChangesFile.
	Preferences disable: #warnIfChangesFileReadOnly.
	Preferences disable: #warnIfNoSourcesFile.
	Smalltalk zapAllOtherProjects.
	Smalltalk forgetDoIts.

	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.

	self cleanUpChanges.
	ChangeSet current clear.
	ChangeSet current name: 'Unnamed1'.
	
	Smalltalk flushClassNameCache.
	3 timesRepeat: [
		Smalltalk garbageCollect.
		Symbol compactSymbolTable.
	].!

----- Method: ReleaseBuilderSqueakland>>finalStripping (in category 'utilities') -----
finalStripping
	"ReleaseBuilderSqueakland new finalStripping"

	#(#Helvetica #Palatino #Courier #ComicSansMS )
		do: [:n | TextConstants
				removeKey: n
				ifAbsent: []].
	QuickGuideMorph indexPage: nil.
	Smalltalk
		at: #Player
		ifPresent: [:superCls | superCls
				allSubclassesDo: [:cls | 
					cls isSystemDefined
						ifFalse: [cls removeFromSystem].
					cls := nil]].
	Smalltalk garbageCollect.
	SystemOrganization removeEmptyCategories.
!

----- Method: ReleaseBuilderSqueakland>>fixObsoleteReferences (in category 'utilities') -----
fixObsoleteReferences
	"ReleaseBuilder new fixObsoleteReferences"

	| informee obsoleteBindings obsName realName realClass |
	Preference allInstances do: [:each | 
		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 _ method literals select: [:literal |
			literal isVariableBinding
				and: [literal value isBehavior]
				and: [literal value isObsolete]].
		obsoleteBindings do: [:binding |
			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 inspect]!

----- Method: ReleaseBuilderSqueakland>>initialCleanup (in category 'utilities') -----
initialCleanup
	"ReleaseBuilder new initialCleanup"

	Browser initialize.
	ChangeSorter removeChangeSetsNamedSuchThat:
		[:cs| cs name ~= ChangeSet current name].

	"Perform various image cleanups in preparation for making a Squeak gamma release candidate image."

	Undeclared removeUnreferencedKeys.
	StandardScriptingSystem initialize.
	Object reInitializeDependentsFields.

	(Object classPool at: #DependentsFields) size > 1 ifTrue: [self error:'Still have dependents'].
	"Undeclared isEmpty ifFalse: [self error:'Please clean out Undeclared']."

	Browser initialize.
	ObjectScanner new. "clear ObjectScanner's class pool"
	
	self cleanUpChanges.
	ChangeSet current clear.
	ChangeSet current name: 'Unnamed1'.
	Smalltalk garbageCollect.

	"Reinitialize DataStream; it may hold on to some zapped entitities"
	DataStream initialize.

	Smalltalk garbageCollect.
	ScheduledControllers _ nil.
	Smalltalk garbageCollect.
	
	SMSqueakMap default purge.!

----- Method: ReleaseBuilderSqueakland>>installPreferences (in category 'utilities') -----
installPreferences
	"Install desired preferences for the release."
	Preferences cambridge.
	Preferences allPreferenceObjects do: [:each |
		each defaultValue: each preferenceValue].
!

----- Method: ReleaseBuilderSqueakland>>installReleaseSpecifics (in category 'utilities') -----
installReleaseSpecifics
	"ReleaseBuilderSqueakland new installReleaseSpecifics"

	World color: (Color r: 0.9 g: 0.9 b: 1.0).
	Preferences restoreDefaultFontsForSqueakland.
	ExternalSettings registerClient: ServerDirectory.
!

----- Method: ReleaseBuilderSqueakland>>installVersionInfo (in category 'utilities') -----
installVersionInfo
	"ReleaseBuilderSqueakland new installVersionInfo"

	| newVersion |
"	highestUpdate := SystemVersion current highestUpdate.
	(self confirm: 'Reset highest update (' , highestUpdate printString , ')?')
		ifTrue: [SystemVersion current highestUpdate: 0].
"
	newVersion := FillInTheBlank request: 'New version designation:' initialAnswer: SystemVersion current version.
	SystemVersion newVersion: newVersion.
	self inform: 'System version is now:', String cr, SystemVersion current asString
!

----- Method: ReleaseBuilderSqueakland>>makeSqueaklandRelease (in category 'squeakland') -----
makeSqueaklandRelease
	"ReleaseBuilder new makeSqueaklandRelease"

	self 
		makeSqueaklandReleasePhasePrepare; 		makeSqueaklandReleasePhaseStripping; 		makeSqueaklandReleasePhaseFinalSettings; 		makeSqueaklandReleasePhaseCleanup!

----- Method: ReleaseBuilderSqueakland>>makeSqueaklandReleasePhaseCleanup (in category 'squeakland') -----
makeSqueaklandReleasePhaseCleanup
	"ReleaseBuilder new makeSqueaklandReleasePhaseCleanup"

	Browser initialize.
	ChangeSorter 
		removeChangeSetsNamedSuchThat: [:cs | cs name ~= ChangeSet current name].
	ChangeSet current clear.
	ChangeSet current name: 'Unnamed1'.
	Smalltalk garbageCollect.
	"Reinitialize DataStream; it may hold on to some zapped entitities"
	DataStream initialize.
	"Remove existing player references"
	References keys do: [:k | References removeKey: k].
	Smalltalk garbageCollect.
	ScheduledControllers := nil.
	Behavior flushObsoleteSubclasses.
	Smalltalk
		garbageCollect;
		garbageCollect.
	SystemNavigation default obsoleteBehaviors isEmpty 
		ifFalse: [self error: 'Still have obsolete behaviors'].

	"Reinitialize DataStream; it may hold on to some zapped entitities"
	DataStream initialize.
	Smalltalk fixObsoleteReferences.
	Smalltalk abandonTempNames.
	Smalltalk zapAllOtherProjects.
	Smalltalk forgetDoIts.
	Smalltalk flushClassNameCache.
	3 timesRepeat: 
			[Smalltalk garbageCollect.
			Symbol compactSymbolTable]!

----- Method: ReleaseBuilderSqueakland>>makeSqueaklandReleasePhaseFinalSettings (in category 'squeakland') -----
makeSqueaklandReleasePhaseFinalSettings
	"ReleaseBuilder new makeSqueaklandReleasePhaseFinalSettings"

	| serverName serverURL serverDir updateServer highestUpdate newVersion |

	ProjectLauncher splashMorph: (FileDirectory default readOnlyFileNamed: 'scripts\SqueaklandSplash.morph') fileInObjectAndCode.

	"Dump all morphs so we don't hold onto anything"
	World submorphsDo:[:m| m delete].

	#(
		(honorDesktopCmdKeys false)
		(warnIfNoChangesFile false)
		(warnIfNoSourcesFile false)
		(showDirectionForSketches true)
		(menuColorFromWorld false)
		(unlimitedPaintArea true)
		(useGlobalFlaps false)
		(mvcProjectsAllowed false)
		(projectViewsInWindows false)
		(automaticKeyGeneration true)
		(securityChecksEnabled true)
		(showSecurityStatus false)
		(startInUntrustedDirectory true)
		(warnAboutInsecureContent false)
		(promptForUpdateServer false)
		(fastDragWindowForMorphic false)

		(externalServerDefsOnly true)
		(expandedFormat false)
		(allowCelesteTell false)
		(eToyFriendly true)
		(eToyLoginEnabled true)
		(magicHalos true)
		(mouseOverHalos true)
		(biggerHandles false)
		(selectiveHalos true)
		(includeSoundControlInNavigator true)
		(readDocumentAtStartup true)
		(preserveTrash true)
		(slideDismissalsToTrash true)

	) do:[:spec|
		Preferences setPreference: spec first toValue: spec last].
	"Workaround for bug"
	Preferences enable: #readDocumentAtStartup.

	World color: (Color r: 0.9 g: 0.9 b: 1.0).

	"Clear all server entries"
	ServerDirectory serverNames do: [:each | ServerDirectory removeServerNamed: each].
	SystemVersion current resetHighestUpdate.

	"Add the squeakalpha update stream"
	serverName _ 'Squeakalpha'.
	serverURL _ 'squeakalpha.org'.
	serverDir _ serverURL , '/'.

	updateServer _ ServerDirectory new.
	updateServer
		server: serverURL;
		directory: 'updates/';
		altUrl: serverDir;
		user: 'sqland';
		password: nil.
	Utilities updateUrlLists addFirst: {serverName. {serverDir. }.}.

	"Add the squeakland update stream"
	serverName _ 'Squeakland'.
	serverURL _ 'squeakland.org'.
	serverDir _ serverURL , '/'.

	updateServer _ ServerDirectory new.
	updateServer
		server: serverURL;
		directory: 'public_html/updates/';
		altUrl: serverDir.
	Utilities updateUrlLists addFirst: {serverName. {serverDir. }.}.

	highestUpdate _ SystemVersion current highestUpdate.
	(self confirm: 'Reset highest update (' , highestUpdate printString , ')?')
		ifTrue: [SystemVersion current highestUpdate: 0].

	newVersion _ FillInTheBlank request: 'New version designation:' initialAnswer: 'Squeakland 3.8.' , highestUpdate printString. 
	SystemVersion newVersion: newVersion.
	(self confirm: self version , '
Is this the correct version designation?
If not, choose no, and fix it.') ifFalse: [^ self].
!

----- Method: ReleaseBuilderSqueakland>>makeSqueaklandReleasePhasePrepare (in category 'squeakland') -----
makeSqueaklandReleasePhasePrepare
	"ReleaseBuilder new makeSqueaklandReleasePhasePrepare"

	Undeclared removeUnreferencedKeys.
	StandardScriptingSystem initialize.
	Preferences initialize.
	"(Object classPool at: #DependentsFields) size > 1 ifTrue: [self error:'Still have dependents']."
	Undeclared isEmpty ifFalse: [self error:'Please clean out Undeclared'].

	"Dump all projects"
	Project allSubInstancesDo:[:prj| prj == Project current ifFalse:[Project deletingProject: prj]].

	"Set new look so we don't need older fonts later"
	StandardScriptingSystem applyNewEToyLook.

	Browser initialize.
	ScriptingSystem deletePrivateGraphics.
	ChangeSorter removeChangeSetsNamedSuchThat:
		[:cs| cs name ~= ChangeSet current name].
	ChangeSet current clear.
	ChangeSet current name: 'Unnamed1'.
	Smalltalk garbageCollect.
	"Reinitialize DataStream; it may hold on to some zapped entitities"
	DataStream initialize.
	"Remove existing player references"
	References keys do:[:k| References removeKey: k].

	Smalltalk garbageCollect.
	ScheduledControllers _ nil.
	Smalltalk garbageCollect.
!

----- Method: ReleaseBuilderSqueakland>>makeSqueaklandReleasePhaseStripping (in category 'squeakland') -----
makeSqueaklandReleasePhaseStripping
	"ReleaseBuilder new makeSqueaklandReleasePhaseStripping"

	#(#Helvetica #Palatino #Courier #ComicSansMS )
		do: [:n | TextConstants
				removeKey: n
				ifAbsent: []].
	Smalltalk
		at: #Player
		ifPresent: [:superCls | superCls
				allSubclassesDo: [:cls | 
					cls isSystemDefined
						ifFalse: [cls removeFromSystem].
					cls := nil]].
	Smalltalk garbageCollect.
	Smalltalk discardFFI; discardSUnit; discardSpeech; yourself.
	"discardMVC;"
	SystemOrganization removeEmptyCategories.
	Smalltalk garbageCollect.
	ScheduledControllers := nil.
	Behavior flushObsoleteSubclasses.
	Smalltalk garbageCollect; garbageCollect.
	DataStream initialize.
	Smalltalk fixObsoleteReferences!

----- Method: ReleaseBuilderSqueakland>>prepareReleaseImage (in category 'utilities') -----
prepareReleaseImage
	"Perform various image cleanups in preparation for making a Squeak gamma release candidate image."
	"ReleaseBuilder 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
		initialCleanup;
		installPreferences;
		finalStripping;
		installReleaseSpecifics;
		finalCleanup;
		installVersionInfo
!

----- Method: ReleaseBuilderSqueakland>>setupServerDirectoryForSqueakland (in category 'squeakland') -----
setupServerDirectoryForSqueakland

	| d |
"
	ReleaseBuilderSqueakland new setupServerDirectoryForSqueakland
"
	Utilities authorName: nil.

	d _ DAVMultiUserServerDirectory on: 'http://content.squeakland.org/showcase/'.
	d altUrl: 'http://content.squeakland.org/showcase/'.
	d moniker: 'My Squeakland'.
	d acceptsUploads: true.
	d useDefaultAccount: true.
	d origDirectory: '/showcase'.
	d setupSelector: #setupPersonalDirectory:.
	ServerDirectory inImageServers at: 'My Squeakland' put: d.

	d _ DAVMultiUserServerDirectory on: 'http://content.squeakland.org/showcase/'.
	d altUrl: 'http://content.squeakland.org/showcase/'.
	d moniker: 'Squeakland Showcase'.
	d user: 'etoys'.
	d useDefaultAccount: true.
	d acceptsUploads: false.
	d instVarNamed: 'passwordHolder' put: 'kaeuqs'.
	ServerDirectory inImageServers at: 'Squeakland Showcase' put: d.
	Utilities loggedIn: false.

!

----- Method: ReleaseBuilderSqueakland>>setupUpdateStreamForSqueakland (in category 'squeakland') -----
setupUpdateStreamForSqueakland

	| base url d |
	base := 'etoys.squeak.org/'.
	url := 'http://', base, 'updates'.
	d := DAVMultiUserServerDirectory on: url.
	d altUrl: url.
	d moniker: 'Etoys Updates'.
	d groupName: 'etoys'.
	Utilities classPool at: #UpdateUrlLists put: nil.
	ServerDirectory inImageServers keysDo: [:k | ServerDirectory inImageServers removeKey: k].
	ServerDirectory inImageServers at: d moniker put: d.
	Utilities updateUrlLists add: {d moniker. {base}}.

	"SystemVersion newVersion: 'etoys4.1'."
	"SystemVersion current resetHighestUpdate."
!

----- Method: ReleaseBuilderSqueakland>>testPrerequired (in category 'squeakland') -----
testPrerequired
	| directory entries projectNames |
	projectNames := #('Gallery' 'Tutorials' 'Home').
	directory := FileDirectory on: Smalltalk imagePath.
	entries := FileList2 projectOnlySelectionMethod: directory entries.
	projectNames
		do: [:projectName | (entries
					anySatisfy: [:each | (Project parseProjectFileName: each first) first = projectName])
				ifFalse: [^ self error: projectName , ' is not found']].
	self checkCopyright.
	"Test if the screen resolution is correct"
	DisplayScreen actualScreenSize = (800 @ 600)
		ifFalse: [^ self error: 'The Etoys window be 800 @ 600'].
	Display extent = (1200 @ 900)
		ifFalse: [^ self error: 'The virtual screen extent should be 1200 @ 900'].
!

----- Method: ReleaseBuilderSqueakland>>updateAll (in category 'utilities') -----
updateAll
	| logFile logWindow |
	logWindow := Transcript openLabel: self name.
	Utilities updateFromServer.
	Transcript cr; show: '-----'.
	Transcript cr; show: SmalltalkImage current systemInformationString.
	logFile := FileDirectory default forceNewFileNamed: self name , '.log'.
	[logFile nextPutAll: logWindow contents text]
		ensure: [logFile close]!

----- Method: ReleaseBuilderSqueakland>>updateGettext (in category 'squeakland') -----
updateGettext
	"ReleaseBuilderSqueakland new updateGettext"
	"Export gettext template and import all translation in po/"
	GetTextExporter exportTemplate.
	GetTextImporter importAll.!