[squeak-dev] Image Versions (Re: Trunk image size)

Edgar J. De Cleene edgardec2001 at yahoo.com.ar
Fri Dec 11 09:20:35 UTC 2009


I sent what I have.
Sure some could polish this and have some better.
But please, don't let non Squeakers excuses for they say

"You was in the same spot as two years ago"

If agree with this , or better do yours own versions, the rest is produced
automatic and go to 'updates" folder of local dir.
And all updates could be transfer to ftp , for all "old guys who was more
confortable with .cs" have a happy day.

Edgar



-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7243] on 30 September 2009 at 10:24:13 am'!
Preference subclass: #PragmaPreference
	instanceVariableNames: 'provider getter setter'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Preferences'!

!PragmaPreference commentStamp: 'ar 3/9/2009 21:27' prior: 0!
Differs from superclass by redirecting all queries to preference provider.!


!PragmaPreference methodsFor: 'initialization' stamp: 'ar 3/9/2009 21:35'!
provider: aClass getter: getterSymbol setter: setterSymbol
	provider := aClass.
	getter := getterSymbol.
	setter := setterSymbol.
! !

!PragmaPreference methodsFor: 'initialization' stamp: 'ar 3/9/2009 21:28'!
restoreDefaultValue
	"Pragma preferences preserve their current value"! !

!PragmaPreference methodsFor: 'printing' stamp: 'ar 3/9/2009 21:28'!
printOn: aStream
	"Print a string decribing the receiver to the given stream"

	super printOn: aStream.
	aStream nextPutAll: name storeString, ' ', self value storeString! !

!PragmaPreference methodsFor: 'value' stamp: 'ar 3/9/2009 21:31'!
preferenceValue
	"Answer the current value of the preference"
	^provider perform: getter! !

!PragmaPreference methodsFor: 'value' stamp: 'ar 3/9/2009 21:30'!
preferenceValue: aValue
	"set the value as indicated, and invoke the change selector if appropriate"
	self preferenceValue = aValue ifFalse:[
		self rawValue: aValue.
		self notifyInformeeOfChange].! !

!PragmaPreference methodsFor: 'value' stamp: 'ar 3/9/2009 21:29'!
rawValue: aValue
	"set the value as indicated, with no side effects"
	provider perform: setter with: aValue! !

!PragmaPreference methodsFor: 'value' stamp: 'ar 3/9/2009 21:31'!
togglePreferenceValue
	"Toggle whether the value of the preference. Self must be a boolean preference."
	self preferenceValue: self preferenceValue not.
	self notifyInformeeOfChange! !

-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7243] on 30 September 2009 at 10:27:29 am'!
Object subclass: #MCConfiguration
	instanceVariableNames: 'name dependencies repositories log '
	classVariableNames: 'DefaultLog LogToFile '
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCConfiguration methodsFor: 'accessing' stamp: 'ar 9/19/2009 11:50'!
log
	"Answer the receiver's log. If no log exist use the default log"
	log ifNil: [
		(name notNil and:[self class logToFile]) ifFalse:[^Transcript].
		self log: (FileStream fileNamed: self name, '.log').
	].
	^log! !


!MCConfiguration class methodsFor: 'preferences' stamp: 'ar 8/21/2009 21:18'!
logToFile
	"Whether to log configuration info to files by default.
	If true, logs to a file named after the configuration (config.nn.log).
	If false, logs to the transcript."
	<preference: 'Log config info to disk' 
		category: 'Monticello' 
		description: 'If true, configuration information (such as change logs) are logged to disk instead of the Transcript. The log file is named after the configuration map (config.nn.log)' 
		type: #Boolean>
	^LogToFile ifNil:[true].! !


!MCPackageLoader methodsFor: 'private' stamp: 'edc 9/30/2009 10:11'!
useChangeSetNamed: baseName during: aBlock 
	"Use the named change set, or create one with the given name."
	| changeHolder oldChanges newChanges csName |
	changeHolder := (ChangeSet respondsTo: #newChanges:)
				ifTrue: [ChangeSet]
				ifFalse: [Smalltalk].
	oldChanges := (ChangeSet respondsTo: #current)
				ifTrue: [ChangeSet current]
				ifFalse: [Smalltalk changes].
				self halt.
	self class changeHighestUpdate
		ifTrue: [csName := (SystemVersion current highestUpdate + 1) asString , baseName.
			newChanges := (ChangesOrganizer changeSetNamed: csName)
						ifNil: [ChangeSet new name: csName].
			changeHolder newChanges: newChanges.
			[aBlock value]
				ensure: [changeHolder newChanges: oldChanges].
			SystemVersion current registerUpdate: SystemVersion current highestUpdate + 1]
		ifFalse: [newChanges := (ChangesOrganizer changeSetNamed: baseName)
						ifNil: [ChangeSet new name: baseName].
			changeHolder newChanges: newChanges.
			[aBlock value]
				ensure: [changeHolder newChanges: oldChanges]].
			newChanges fileOut! !

Object subclass: #MCConfiguration
	instanceVariableNames: 'name dependencies repositories log'
	classVariableNames: 'DefaultLog LogToFile'
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!
-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7244] on 16 October 2009 at 7:19:45 am'!

!PasteUpMorph methodsFor: 'world menu' stamp: 'edc 10/16/2009 07:18'!
reportPublicIP
	"Report the public IP of this computer
	World reportPublicIP."

	| addrString m s 	stream |
	stream := HTTPSocket httpGet: 'http://checkip.dyndns.com'.
	stream upToAll: 'IP Address: '.
	stream := stream upTo: $<.
	
	Socket initializeNetwork.
	addrString := stream upTo: $<.
	m _ RectangleMorph new
		color: (Color r: 0.6 g: 0.8 b: 0.6);
		extent: 118 at 36;
		borderWidth: 1.
	s _ StringMorph contents: 'Public IP:'.
	s position: m position + (5 at 4).
	m addMorph: s.
	s _ StringMorph contents: addrString.
	s position: m position + (5 at 19).
	m addMorph: s.
	self primaryHand attachMorph: m.
! !
-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7228] on 10 July 2009 at 2:13:13 pm'!

!PackageInfo methodsFor: 'preamble/postscript' stamp: 'edc 7/10/2009 10:57'!
hasPreamble
	"Answer the value of hasPreamble"

	^ preamble notNil! !
-------------- next part --------------
'From MinimalMorphic of 8 December 2006 [latest update: #7245] on 16 October 2009 at 6:30:50 pm'!

!Utilities class methodsFor: '*MinimalMorphic-common requests' stamp: 'edc 10/16/2009 18:30'!
exportCommonRequests


	"Utilities exportCommonRequests"

	

	

	(CommonRequestStrings == nil or: [CommonRequestStrings isKindOf: Array])
		ifTrue:
			[self initializeCommonRequestStrings]ifFalse:[CommonRequestStrings saveOnFileNamed: 'CRS']
	
! !

!Utilities class methodsFor: '*MinimalMorphic-common requests' stamp: 'edc 10/16/2009 18:30'!
importCommonRequests

	"Utilities importCommonRequests"
	|  inputStream anObject |
inputStream _ FileStream oldFileNamed: 'CRS.obj'.
	anObject _ inputStream fileInObjectAndCode.
	inputStream close.
	CommonRequestStrings := anObject


	

	! !

-------------- next part --------------
'From Squeak3.11alpha of 1 October 2009 [latest update: #7174] on 1 October 2009 at 9:53:38 am'!

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'edc 10/1/2009 09:53'!
fileOut
	"File out the receiver, to a file whose name is a function of the 
	change-set name and either of the date & time or chosen to have a 
	unique numeric tag, depending on the preference 
	'changeSetVersionNumbers'"
	| slips nameToUse internalStream |
	self checkForConversionMethods.
	ChangeSet promptForDefaultChangeSetDirectoryIfNecessary.
	self name endsWithDigit ifTrue:[nameToUse := self name ,  FileDirectory dot , FileStream cs]
	ifFalse:[
	nameToUse := Preferences changeSetVersionNumbers
				ifTrue: [self defaultChangeSetDirectory nextNameFor: self name extension: FileStream cs]
				ifFalse: [self name , FileDirectory dot , Utilities dateTimeSuffix , FileDirectory dot , FileStream cs]].
	nameToUse := nameToUse asJoliet.
	
	nameToUse := self defaultChangeSetDirectory fullNameFor: nameToUse.
	Cursor write
		showWhile: [internalStream := WriteStream
						on: (String new: 10000).
			internalStream header; timeStamp.
			self fileOutPreambleOn: internalStream.
			self fileOutOn: internalStream.
			self fileOutPostscriptOn: internalStream.
			internalStream trailer.
			FileStream
				writeSourceCodeFrom: internalStream
				baseName: (nameToUse copyFrom: 1 to: nameToUse size - 3)
				isSt: false
				useHtml: false].
	Preferences checkForSlips
		ifFalse: [^ self].
	slips := self checkForSlips.
	(slips size > 0
			and: [(PopUpMenu withCaption: 'Methods in this fileOut have halts
or references to the Transcript
or other ''slips'' in them.
Would you like to browse them?' chooseFrom: 'Ignore\Browse slips')
					= 2])
		ifTrue: [self systemNavigation browseMessageList: slips name: 'Possible slips in ' , name]! !

-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7243] on 30 September 2009 at 10:24:39 am'!

!Object methodsFor: 'error handling' stamp: 'eem 12/19/2008 10:46'!
doesNotUnderstand: aMessage 
	 "Handle the fact that there was an attempt to send the given
	  message to the receiver but the receiver does not understand
	  this message (typically sent from the machine when a message
	 is sent to the receiver and no method is defined for that selector)."

	"Testing: (3 activeProcess)"

	| exception resumeValue |
	(Preferences autoAccessors
	 and: [self tryToDefineVariableAccess: aMessage]) ifTrue:
		[^aMessage sentTo: self].

	(exception := MessageNotUnderstood new)
		message: aMessage;
		receiver: self.
	resumeValue := exception signal.
	^exception reachedDefaultHandler
		ifTrue: [aMessage sentTo: self]
		ifFalse: [resumeValue]! !

-------------- next part --------------
'From Squeak3.11alpha of 2 October 2009 [latest update: #7171] on 2 October 2009 at 7:06:45 am'!
Object subclass: #MCPackageLoader
	instanceVariableNames: 'requirements unloadableDefinitions obsoletions additions removals errorDefinitions provisions methodAdditions '
	classVariableNames: 'ChangeHIghUp '
	poolDictionaries: ''
	category: 'Monticello-Loading'!

!MCPackageLoader methodsFor: 'private' stamp: 'edc 9/30/2009 10:11'!
useChangeSetNamed: baseName during: aBlock 
	"Use the named change set, or create one with the given name."
	| changeHolder oldChanges newChanges csName |
	changeHolder := (ChangeSet respondsTo: #newChanges:)
				ifTrue: [ChangeSet]
				ifFalse: [Smalltalk].
	oldChanges := (ChangeSet respondsTo: #current)
				ifTrue: [ChangeSet current]
				ifFalse: [Smalltalk changes].
	self class changeHighestUpdate
		ifTrue: [csName := (SystemVersion current highestUpdate + 1) asString , baseName.
			newChanges := (ChangesOrganizer changeSetNamed: csName)
						ifNil: [ChangeSet new name: csName].
			changeHolder newChanges: newChanges.
			[aBlock value]
				ensure: [changeHolder newChanges: oldChanges].
			SystemVersion current registerUpdate: SystemVersion current highestUpdate + 1]
		ifFalse: [newChanges := (ChangesOrganizer changeSetNamed: baseName)
						ifNil: [ChangeSet new name: baseName].
			changeHolder newChanges: newChanges.
			[aBlock value]
				ensure: [changeHolder newChanges: oldChanges]].
			newChanges fileOut! !


!MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'edc 9/29/2009 12:03'!
changeHighestUpdate
" MCPackageLoader changeHighestUpdate"
"Whether change highestUpdate by default.
	If true, logs to a file named after the configuration (config.nn.log).
	If false, logs to the transcript."
	<preference: 'Change SystemVersion current highestUpdate' 
		category: 'Monticello' 
		description: 'If true,  each monticello package loaded rises the highestUpdate)' 
		type: #Boolean>
	^ChangeHIghUp  ifNil:[ChangeHIghUp := false].! !

!MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'edc 10/1/2009 16:29'!
setHighestUpdate: aBoolean
" MCPackageLoader togleHighestUpdate"
self changeHighestUpdate.
	^ChangeHIghUp  := aBoolean! !

!MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'edc 9/30/2009 11:07'!
useChangeSetNamed: baseName during: aBlock
    "Use the named change set, or create one with the given name."
    | changeHolder oldChanges newChanges csName |

    changeHolder := (ChangeSet respondsTo: #newChanges:)
                        ifTrue: [ChangeSet]
                        ifFalse: [Smalltalk].
    oldChanges := (ChangeSet respondsTo: #current)
                        ifTrue: [ChangeSet current]
                        ifFalse: [Smalltalk changes].
(self class changeHighestUpdate) ifTrue:[
csName := (SystemVersion current highestUpdate + 1) asString,baseName.
    newChanges := (ChangesOrganizer changeSetNamed: csName) ifNil: [ ChangeSet new name: csName ].
    changeHolder newChanges: newChanges.
    [aBlock value] ensure: [changeHolder newChanges: oldChanges].
SystemVersion current registerUpdate: SystemVersion current highestUpdate + 1]
ifFalse:[	newChanges := (ChangesOrganizer changeSetNamed: baseName) ifNil: [ ChangeSet new name: baseName ].
	changeHolder newChanges: newChanges.
	[aBlock value] ensure: [changeHolder newChanges: oldChanges].
]! !


!Utilities class methodsFor: 'fetching updates' stamp: 'edc 10/1/2009 16:30'!
updateFromServer
	"Update the image by loading all pending updates from the server. Also
	save local copies of the update files if the #updateSavesFile preference
	is set to true"
	MCPackageLoader setHighestUpdate: true..
	MCMcmUpdater updateFromRepositories: #('http://source.squeak.org/trunk' ).
	MCPackageLoader  setHighestUpdate: false..! !

MCPackageLoader class removeSelector: #togleHighestUpdate!
Object subclass: #MCPackageLoader
	instanceVariableNames: 'requirements unloadableDefinitions obsoletions additions removals errorDefinitions provisions'
	classVariableNames: 'ChangeHIghUp'
	poolDictionaries: ''
	category: 'Monticello-Loading'!
-------------- next part --------------
'From Squeak3.10.2 of ''5 June 2008'' [latest update: #7179] on 30 September 2009 at 10:02:29 am'!
Object subclass: #MCMcmUpdater
	instanceVariableNames: ''
	classVariableNames: 'LastUpdateMap'
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

MCMcmUpdater class
	instanceVariableNames: ''!

!MCMcmUpdater class methodsFor: 'class initialization' stamp: 'ar 8/12/2009 22:15'!
initialize
	"MCMcmUpdater initialize"
	LastUpdateMap := Dictionary new.
! !


!MCMcmUpdater class methodsFor: 'updating' stamp: 'ar 8/12/2009 22:13'!
updateFromRepositories: repositoryUrls
	"MCMcmUpdater updateFromRepositories: #(
		'http://squeaksource.com/MCUpdateTest'
	)"

	| repos updateList parts base author version type config minVersion |
	Preferences enable: #upgradeIsMerge.
	LastUpdateMap ifNil:[LastUpdateMap := Dictionary new].
	"The list of repositories to consult in order"
	repos := repositoryUrls collect:[:url| 
		MCRepositoryGroup default repositories 
			detect:[:r| r description = url]
			ifNone:[ | r |
				r := MCHttpRepository location: url user: '' password: ''.
				MCRepositoryGroup default addRepository: r.
				r]].

	"The list of updates-author.version.mcm sorted by version"
	repos do:[:r|
		updateList := SortedCollection new.
		minVersion := LastUpdateMap at: r description ifAbsent:[0].
		"Find all the updates-author.version.mcm files"
		r allFileNames do:[:versionedName|
			parts := versionedName findTokens: '.-'.
			parts size = 4 ifTrue:[
				base := parts at: 1.
				author := parts at: 2.
				version := [(parts at: 3) asNumber] on: Error do:[:ex| ex return: 0].
				type := parts at: 4.
			].
			(base = 'update' and:[version >= minVersion and:[type = 'mcm']]) 
				ifTrue:[updateList add: version -> versionedName]].
		
		"Proceed only if there are updates available at all."
		updateList ifNotEmpty: [
			"Now process each update file. Check if we have all dependencies and if not,
			load the entire configuration (this is mostly to skip older updates quickly)"
			updateList do:[:assoc|
				ProgressNotification signal: '' extra: 'Processing ', assoc value.
				config := r versionFromFileNamed: assoc value.
				(config dependencies allSatisfy:[:dep| dep isFulfilled]) 
					ifFalse:[config upgrade].
				LastUpdateMap at: r description put: assoc key.
			] displayingProgress: 'Processing configurations'.
			"We've loaded all the provided update configurations.
			Use the latest configuration to update all the remaining packages."
			config updateFromRepositories.
			config upgrade.
		].
	].! !


MCMcmUpdater initialize!
-------------- next part --------------
'From MinimalMorphic of 8 December 2006 [latest update: #7239] on 8 October 2009 at 9:48:28 am'!
FileList2 class
	instanceVariableNames: 'lastSelDir '!

!FileList2 class methodsFor: 'modal dialogs' stamp: 'edc 10/3/2009 08:18'!
modalFolderSelector
self lastSelDir  ifNil: [^self modalFolderSelector: FileDirectory default]
ifNotNil:[^self modalFolderSelector: self lastSelDir ]
	! !

!FileList2 class methodsFor: 'modal dialogs' stamp: 'edc 10/3/2009 08:19'!
modalFolderSelector: aDir

	| window fileModel |
	window _ self morphicViewFolderSelector: aDir.
	fileModel _ window model.
	window openInWorld: self currentWorld extent: 300 at 400.
	self modalLoopOn: window.
	^self lastSelDir: fileModel getSelectedDirectory withoutListWrapper! !

!FileList2 class methodsFor: 'morphic ui' stamp: 'edc 10/8/2009 09:46'!
morphicViewFileSelectorForSuffixes: aList 
	"Answer a morphic file-selector tool for the given suffix list."
	^ self morphicViewFileSelectorForSuffixes: aList directory: self modalFolderSelector! !

!FileList2 class methodsFor: 'accessing' stamp: 'edc 10/3/2009 08:14'!
lastSelDir
^ lastSelDir! !

!FileList2 class methodsFor: 'accessing' stamp: 'edc 10/3/2009 08:14'!
lastSelDir: aDir
^ lastSelDir := aDir! !

FileList2 class
	instanceVariableNames: 'lastSelDir'!

!FileList2 reorganize!
('as yet unclassified' specsForImageViewer)
('drag''n''drop' dropDestinationDirectory:event: isDirectoryList:)
('initialization' dirSelectionBlock: directory: directoryChangeBlock: fileSelectionBlock: initialDirectoryList labelString limitedSuperSwikiDirectoryList limitedSuperSwikiPublishDirectoryList optionalButtonSpecs optionalButtonSpecs: publishingServers universalButtonServices updateDirectory)
('initialize-release' initialize)
('own services' addNewDirectory deleteDirectory importImage okayAndCancelServices openImageInWindow openProjectFromFile removeLinefeeds serviceCancel serviceOkay serviceOpenProjectFromFile servicesForFolderSelector servicesForProjectLoader)
('user interface' blueButtonForService:textColor:inWindow: morphicDirectoryTreePane morphicDirectoryTreePaneFiltered: morphicFileContentsPane morphicFileListPane morphicPatternPane)
('volume list and pattern' changeDirectoryTo: directory listForPattern: listForPatterns:)
('private' cancelHit currentDirectorySelected directoryNamesFor: getSelectedDirectory getSelectedFile modalView: okHit okHitForProjectLoader postOpen saveLocalOnlyHit setSelectedDirectoryTo:)
!

-------------- next part --------------
'From MinimalMorphic of 8 December 2006 [latest update: #7239] on 8 October 2009 at 9:48:28 am'!
FileList2 class
	instanceVariableNames: 'lastSelDir '!

!FileList2 class methodsFor: 'modal dialogs' stamp: 'edc 10/3/2009 08:18'!
modalFolderSelector
self lastSelDir  ifNil: [^self modalFolderSelector: FileDirectory default]
ifNotNil:[^self modalFolderSelector: self lastSelDir ]
	! !

!FileList2 class methodsFor: 'modal dialogs' stamp: 'edc 10/3/2009 08:19'!
modalFolderSelector: aDir

	| window fileModel |
	window _ self morphicViewFolderSelector: aDir.
	fileModel _ window model.
	window openInWorld: self currentWorld extent: 300 at 400.
	self modalLoopOn: window.
	^self lastSelDir: fileModel getSelectedDirectory withoutListWrapper! !

!FileList2 class methodsFor: 'morphic ui' stamp: 'edc 10/8/2009 09:46'!
morphicViewFileSelectorForSuffixes: aList 
	"Answer a morphic file-selector tool for the given suffix list."
	^ self morphicViewFileSelectorForSuffixes: aList directory: self modalFolderSelector! !

!FileList2 class methodsFor: 'accessing' stamp: 'edc 10/3/2009 08:14'!
lastSelDir
^ lastSelDir! !

!FileList2 class methodsFor: 'accessing' stamp: 'edc 10/3/2009 08:14'!
lastSelDir: aDir
^ lastSelDir := aDir! !

FileList2 class
	instanceVariableNames: 'lastSelDir'!

!FileList2 reorganize!
('as yet unclassified' specsForImageViewer)
('drag''n''drop' dropDestinationDirectory:event: isDirectoryList:)
('initialization' dirSelectionBlock: directory: directoryChangeBlock: fileSelectionBlock: initialDirectoryList labelString limitedSuperSwikiDirectoryList limitedSuperSwikiPublishDirectoryList optionalButtonSpecs optionalButtonSpecs: publishingServers universalButtonServices updateDirectory)
('initialize-release' initialize)
('own services' addNewDirectory deleteDirectory importImage okayAndCancelServices openImageInWindow openProjectFromFile removeLinefeeds serviceCancel serviceOkay serviceOpenProjectFromFile servicesForFolderSelector servicesForProjectLoader)
('user interface' blueButtonForService:textColor:inWindow: morphicDirectoryTreePane morphicDirectoryTreePaneFiltered: morphicFileContentsPane morphicFileListPane morphicPatternPane)
('volume list and pattern' changeDirectoryTo: directory listForPattern: listForPatterns:)
('private' cancelHit currentDirectorySelected directoryNamesFor: getSelectedDirectory getSelectedFile modalView: okHit okHitForProjectLoader postOpen saveLocalOnlyHit setSelectedDirectoryTo:)
!

-------------- next part --------------
'From Squeak3.10beta of 22 July 2007 [latest update: #7173] on 8 December 2009 at 5:46:54 pm'!
StringMorph subclass: #BorderedStringMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MorphicExtras-Widgets'!

!BorderedStringMorph methodsFor: 'drawing' stamp: 'ar 12/31/2001 02:34'!
drawOn: aCanvas
	| nameForm |
	font _ self fontToUse.
	nameForm _ Form extent: bounds extent depth: 8.
	nameForm getCanvas drawString: contents at: 0 at 0 font: self fontToUse color: Color black.
	(bounds origin + 1) eightNeighbors do: [ :pt |
		aCanvas
			stencil: nameForm 
			at: pt
			color: self borderColor.
	].
	aCanvas
		stencil: nameForm 
		at: bounds origin + 1 
		color: color.


	
! !

!BorderedStringMorph methodsFor: 'initialization' stamp: 'ar 12/14/2001 20:02'!
initWithContents: aString font: aFont emphasis: emphasisCode
	super initWithContents: aString font: aFont emphasis: emphasisCode.
	self borderStyle: (SimpleBorder width: 1 color: Color white).! !

!BorderedStringMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 20:42'!
initialize
"initialize the state of the receiver"
	super initialize.
""
	self
		borderStyle: (SimpleBorder width: 1 color: Color white)! !

!BorderedStringMorph methodsFor: 'accessing' stamp: 'ar 12/12/2001 03:03'!
measureContents
	^super measureContents +2.! !


!ByteString methodsFor: 'converting' stamp: 'edc 11/19/2007 10:49'!
asJoliet
|badChars |
badChars := #( $: $< $> $| $/ $\ $? $* $") asSet.
^ self copyWithoutAll: badChars! !


!ChangeSet methodsFor: 'fileIn/Out' stamp: 'edc 5/15/2005 12:11'!
fileOutCompressed
	"File out the receiver, to a file whose name is a function of the  
	change-set name and either of the date & time or chosen to have a  
	unique numeric tag, depending on the preference  
	'changeSetVersionNumbers'"
	| slips nameToUse internalStream shortnameToUse |
	self checkForConversionMethods.
	ChangeSet promptForDefaultChangeSetDirectoryIfNecessary.
	nameToUse := Preferences changeSetVersionNumbers
				ifTrue: [self defaultChangeSetDirectory nextNameFor: self name extension: FileStream cs]
				ifFalse: [self name , FileDirectory dot , Utilities dateTimeSuffix, FileDirectory dot , FileStream cs].
	(Preferences warningForMacOSFileNameLength
			and: [nameToUse size > 30])
		ifTrue: [nameToUse := FillInTheBlank
						request: (nameToUse , '\has ' , nameToUse size asString , ' letters - too long for Mac OS.\Suggested replacement is:') withCRs
						initialAnswer: (nameToUse contractTo: 30).
			nameToUse = ''
				ifTrue: [^ self]].
shortnameToUse _ nameToUse.
	nameToUse := self defaultChangeSetDirectory fullNameFor: nameToUse.
	Cursor write showWhile: [
			internalStream := WriteStream on: (String new: 10000).
			internalStream header; timeStamp.
			self fileOutPreambleOn: internalStream.
			self fileOutOn: internalStream.
			self fileOutPostscriptOn: internalStream.
			internalStream trailer.

			FileStream writeSourceCodeFrom: internalStream baseName: (nameToUse copyFrom: 1 to: nameToUse size - 3) isSt: false useHtml: false.
	].
	Preferences checkForSlips
		ifFalse: [^ self].
	slips := self checkForSlips.
	(slips size > 0
			and: [(PopUpMenu withCaption: 'Methods in this fileOut have halts
or references to the Transcript
or other ''slips'' in them.
Would you like to browse them?' chooseFrom: 'Ignore\Browse slips')
					= 2])
		ifTrue: [self systemNavigation browseMessageList: slips name: 'Possible slips in ' , name].
CodeLoader compressFileNamed: shortnameToUse in: self defaultChangeSetDirectory

! !


!DualChangeSorter methodsFor: 'initialization' stamp: 'edc 7/16/2005 10:46'!
morphicWindow
	
	| window |
	
	leftCngSorter _ ChangeSorter new myChangeSet: ChangeSet current.
	leftCngSorter parent: self.
	rightCngSorter _ ChangeSorter new myChangeSet: 
			ChangeSorter secondaryChangeSet.
	rightCngSorter parent: self.

	window _ (SystemWindow labelled: leftCngSorter label) model: self.
	"topView minimumSize: 300 @ 200."
	leftCngSorter openAsMorphIn: window rect: (0 at 0 extent: 0.5 at 1).
	rightCngSorter openAsMorphIn: window rect: (0.5 at 0 extent: 0.5 at 1).
	^ window
! !


!MailComposition methodsFor: 'interface' stamp: 'edc 11/19/2007 10:53'!
saveContentsInFile
	"Save the receiver's contents string to a file, prompting the user for a file-name.  Suggest a reasonable file-name."

	| fileName stringToSave suggestedName |
	stringToSave := (RWBinaryOrTextStream with: messageText  string) reset.

	suggestedName := stringToSave  upToAll: 'Subject: ';nextLine.
	
	
		suggestedName := (suggestedName, '.text' ) asJoliet.
		
			
	fileName := UIManager default request: 'File name?' translated
			initialAnswer: suggestedName.
	fileName isEmptyOrNil ifFalse:
		[(FileStream newFileNamed: fileName) nextPutAll: stringToSave reset; close]! !


!MethodReference methodsFor: 'string version' stamp: 'edc 5/23/2007 09:32'!
stringVersion
stringVersion ifNil: [ stringVersion := self actualClass name, ' >> ', methodSymbol].
	^stringVersion! !


!Object class methodsFor: 'objects from disk' stamp: 'edc 6/11/2008 07:37'!
readAndInspect: inputStream

inputStream setConverterForCode.
(inputStream fileInObjectAndCode ) inspect! !

!Object class methodsFor: '*services-extras' stamp: 'edc 2/14/2008 08:24'!
fileReaderServicesForFile: fullName suffix: suffix
	| services |
	services _ OrderedCollection new.
	
	(fullName asLowercase endsWith: '.obj')
		ifTrue: [ services add: self serviceLoadObject ].
	^services! !

!Object class methodsFor: '*services-extras' stamp: 'edc 10/25/2006 17:45'!
registeredServices
	^ { 
	Service new
		label: 'Open saved objects';
		shortLabel: 'object'; 
		description: 'load back saved object ';
		action: [:stream | self readAndInspect: (FileStream oldFileOrNoneNamed:stream name)];
		shortcut: nil;
		categories: Service worldServiceCat.} ! !

!Object class methodsFor: '*services-extras' stamp: 'edc 2/14/2008 08:26'!
serviceLoadObject
"Answer a service for opening a saved Object"

	^ (SimpleServiceEntry 
		provider: self 
		label: 'saved Object'
		selector: #readAndInspect:
		description: 'open a Object'
		buttonLabel: 'object')
		argumentGetter: [:fileList | fileList readOnlyStream]! !


!ObjectsTool methodsFor: 'categories' stamp: 'edc 12/4/2007 15:34'!
showCategory: aCategoryName fromButton: aButton 
	"Project items from the given category into my lower pane"
	| quads |
	"self partsBin removeAllMorphs. IMHO is redundant, "
	
	Cursor wait
		showWhile: [quads := OrderedCollection new.
			Morph withAllSubclasses
				do: [:aClass | aClass theNonMetaClass
						addPartsDescriptorQuadsTo: quads
						if: [:aDescription | aDescription translatedCategories includes: aCategoryName]].
			quads := quads
						asSortedCollection: [:q1 :q2 | q1 third <= q2 third].
			self installQuads: quads fromButton: aButton]! !


!PasteUpMorph methodsFor: 'world menu' stamp: 'edc 4/21/2005 09:55'!
collapseAll
	"Collapse all windows"
	self collapseAllWindows.
	self collapseNonWindows! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'edc 4/21/2005 09:43'!
collapseAllWindows
	"World  collapseAllWindows  "
| tl |
tl _ (30 at 40) asPoint.
 self submorphsDo:  [:each | (each isKindOf: SystemWindow  )ifTrue: [ each collapse.
 each topLeft: tl .
tl _ tl +( 0 at 30) asPoint]]
! !


!StringHolder methodsFor: '*Tools' stamp: 'edc 7/31/2007 07:30'!
copySelector
	"Copy the selected selector to the clipboard"

	|  class selector  |
	class := self selectedClassOrMetaClass printString.
	selector := self selectedMessageName printString.
	(selector := self selectedMessageName) ifNotNil:
		[Clipboard clipboardText: class, ' ', selector asString]! !

!StringHolder methodsFor: 'message list menu' stamp: 'edc 7/16/2005 10:54'!
offerDurableMenuFrom: menuRetriever shifted: aBoolean
	"Pop up (morphic only) a menu whose target is the receiver and whose contents are provided by sending the menuRetriever to the receiver.  The menuRetriever takes two arguments: a menu, and a boolean representing the shift state; put a stay-up item at the top of the menu."

	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addStayUpItem.
	
	self perform: menuRetriever with: aMenu with: aBoolean.
		aMenu popUpInWorld! !


!CodeHolder methodsFor: 'controls' stamp: 'edc 4/6/2005 10:53'!
addOptionalButtonsTo: window at: fractions plus: verticalOffset
	"If the receiver wishes it, add a button pane to the window, and answer the verticalOffset plus the height added"

	| delta buttons divider width |
width _ 10.
	self wantsOptionalButtons ifFalse: [^verticalOffset].
	delta _ self defaultButtonPaneHeight.
	buttons _ self optionalButtonRow 
		color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]);
		borderWidth: 0.
	Preferences alternativeWindowLook ifTrue:[
		buttons color: Color transparent.
		buttons submorphsDo:[:m| m borderWidth: 2; borderColor: #raised.
width _ width + m width



].
	].
	divider _ BorderedSubpaneDividerMorph forBottomEdge.
	Preferences alternativeWindowLook ifTrue:[
		divider extent: 4 at 4; color: Color transparent; borderColor: #raised; borderWidth: 2.
	].
window width: width.
	window 
		addMorph: buttons
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0 at verticalOffset corner: 0@(verticalOffset + delta - 1))).
	window 
		addMorph: divider
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0@(verticalOffset + delta - 1) corner: 0@(verticalOffset + delta))).
	^ verticalOffset + delta! !

!CodeHolder methodsFor: 'controls' stamp: 'edc 4/6/2005 10:48'!
optionalButtonPairs
	"Answer a tuple (formerly pairs) defining buttons, in the format:
			button label
			selector to send
			help message"

	| aList |

	aList _ #(
	('browse'			browseMethodFull			'view this method in a browser')
	('local senders' browseLocalSendersOfMessages 'browse local senders of...')
	('senders' 			browseSendersOfMessages	'browse senders of...')
	('implementors'		browseMessages				'browse implementors of...')
	('versions'			browseVersions				'browse versions')), 

	(Preferences decorateBrowserButtons
		ifTrue:
			[{#('inheritance'		methodHierarchy 'browse method inheritance
green: sends to super
tan: has override(s)
mauve: both of the above
pink: is an override but doesn''t call super
pinkish tan: has override(s), also is an override but doesn''t call super' )}]
		ifFalse:
			[{#('inheritance'		methodHierarchy			'browse method inheritance')}]),

	#(
	('hierarchy'		classHierarchy				'browse class hierarchy')
	('inst vars'			browseInstVarRefs			'inst var refs...')
	('class vars'			browseClassVarRefs			'class var refs...')).

	^ aList
! !


!Browser methodsFor: 'message functions' stamp: 'edc 7/31/2007 07:16'!
messageListMenu: aMenu shifted: shifted 
	"Answer the message-list menu"
	ServiceGui browser: self messageListMenu: aMenu.
	ServiceGui onlyServices ifTrue: [^ aMenu].
	shifted
		ifTrue: [^ self shiftedMessageListMenu: aMenu].
	aMenu addList: #(
			('what to show...'			offerWhatToShowMenu)
			('toggle break on entry'		toggleBreakOnEntry)
			-
			('browse full (b)' 			browseMethodFull)
			('browse hierarchy (h)'			classHierarchy)
			('browse method (O)'			openSingleMessageBrowser)
			('browse protocol (p)'			browseFullProtocol)
			-
			('fileOut'				fileOutMessage)
			('printOut'				printOutMessage)
							('copy Selector'				copySelector)
			-
			('senders of... (n)'			browseSendersOfMessages)
			('implementors of... (m)'		browseMessages)
			('inheritance (i)'			methodHierarchy)
			('tile scriptor'			openSyntaxView)
			('versions (v)'				browseVersions)
			-
			('inst var refs...'			browseInstVarRefs)
			('inst var defs...'			browseInstVarDefs)
			('class var refs...'			browseClassVarRefs)
			('class variables'			browseClassVariables)
			('class refs (N)'			browseClassRefs)
			-
			('remove method (x)'			removeMessage)
			-
			('more...'				shiftedYellowButtonActivity)).
	^ aMenu! !


!ChangeSorter methodsFor: 'changeSet menu' stamp: 'edc 9/23/2005 09:11'!
changeSetMenu: aMenu shifted: isShifted 
	"Set up aMenu to hold commands for the change-set-list pane. 
	This could be for a single or double changeSorter"
	isShifted
		ifTrue: [^ self shiftedChangeSetMenu: aMenu].
	Smalltalk isMorphic
		ifTrue: [aMenu title: 'Change Set'.
			aMenu addStayUpItemSpecial]
		ifFalse: [aMenu title: 'Change Set:
' , myChangeSet name].
	aMenu add: 'make changes go to me (m)' action: #newCurrent.
	aMenu addLine.
	aMenu add: 'new change set... (n)' action: #newSet.
	aMenu add: 'find...(f)' action: #findCngSet.
	aMenu add: 'show category... (s)' action: #chooseChangeSetCategory.
	aMenu balloonTextForLastItem: 'Lets you choose which change sets should be listed in this change sorter'.
	aMenu add: 'select change set...' action: #chooseCngSet.
	aMenu addLine.
	aMenu add: 'rename change set (r)' action: #rename.
	aMenu add: 'file out (o)' action: #fileOut.
	aMenu add: 'file out Compressed' action: #fileOutCompressed.
	aMenu add: 'browse methods (b)' action: #browseChangeSet.
	aMenu add: 'browse change set (B)' action: #openChangeSetBrowser.
	aMenu addLine.
	parent
		ifNotNil: [aMenu add: 'copy all to other side (c)' action: #copyAllToOther.
			aMenu add: 'submerge into other side' action: #submergeIntoOtherSide.
			aMenu add: 'subtract other side (-)' action: #subtractOtherSide.
			aMenu addLine].
	myChangeSet hasPreamble
		ifTrue: [aMenu add: 'edit preamble (p)' action: #addPreamble.
			aMenu add: 'remove preamble' action: #removePreamble]
		ifFalse: [aMenu add: 'add preamble (p)' action: #addPreamble].
	myChangeSet hasPostscript
		ifTrue: [aMenu add: 'edit postscript...' action: #editPostscript.
			aMenu add: 'remove postscript' action: #removePostscript]
		ifFalse: [aMenu add: 'add postscript...' action: #editPostscript].
	aMenu addLine.
	aMenu add: 'category functions...' action: #offerCategorySubmenu.
	aMenu balloonTextForLastItem: 'Various commands relating to change-set-categories'.
	aMenu addLine.
	aMenu add: 'destroy change set (x)' action: #remove.
	aMenu addLine.
	aMenu add: 'more...' action: #offerShiftedChangeSetMenu.
	^ aMenu! !

!ChangeSorter methodsFor: 'changeSet menu' stamp: 'edc 11/18/2007 08:26'!
fileOut
	"File out the current change set."

	myChangeSet fileOut.
	parent modelWakeUp.	"notice object conversion methods created"
! !

!ChangeSorter methodsFor: 'changeSet menu' stamp: 'edc 7/16/2005 11:02'!
fileOutCompressed
	"File out the current change set."
	myChangeSet fileOutCompressed.
	parent modelWakeUp.	"notice object conversion methods created"
! !

!ChangeSorter methodsFor: 'message list' stamp: 'sw 3/5/2001 18:26'!
messageMenu: aMenu shifted: shifted
	"Fill aMenu with items appropriate for the message list; could be for a single or double changeSorter"

	shifted ifTrue: [^ self shiftedMessageMenu: aMenu].

	aMenu title: 'message list'.
	Smalltalk isMorphic ifTrue: [aMenu addStayUpItemSpecial].

	parent ifNotNil:
		[aMenu addList: #(
			('copy method to other side'			copyMethodToOther)
			('move method to other side'			moveMethodToOther))].

	aMenu addList: #(
			('delete method from changeSet (d)'	forget)
			-
			('remove method from system (x)'	removeMessage)
				-
			('browse full (b)'					browseMethodFull)
			('browse hierarchy (h)'				spawnHierarchy)
			('browse method (O)'				openSingleMessageBrowser)
			('browse protocol (p)'				browseFullProtocol)
			-
			('fileOut'							fileOutMessage)
			('printOut'							printOutMessage)
			-
			('senders of... (n)'					browseSendersOfMessages)
			('implementors of... (m)'				browseMessages)
			('inheritance (i)'					methodHierarchy)
			('versions (v)'						browseVersions)
			-
			('more...'							shiftedYellowButtonActivity)).
	^ aMenu
! !


!Inspector methodsFor: 'accessing' stamp: 'edc 2/16/2007 08:27'!
baseFieldList
	"Answer an Array consisting of 'self' 
	and the instance variable names of the inspected object."
	^ (Array with: 'self' with: 'all inst vars')
		, object class allInstVarNames asSortedCollection! !

!Inspector methodsFor: 'menu commands' stamp: 'edc 11/18/2007 07:26'!
defsOfSelection
	"Open a browser on all defining references to the selected instance variable, if that's what currently selected. "
	| aClass sel |

	self selectionUnmodifiable ifTrue: [^ self changed: #flash].
	(aClass := self object class) isVariable ifTrue: [^ self changed: #flash].

	sel := aClass allInstVarNames asSortedCollection at: self selectionIndex - 2.
	self systemNavigation  browseAllStoresInto: sel from: aClass! !

!Inspector methodsFor: 'selecting' stamp: 'edc 2/16/2007 10:05'!
selection
	"The receiver has a list of variables of its inspected object.  
	One of these is selected. Answer the value of the selected  
	variable."
	| basicIndex varName |
	selectionIndex = 0
		ifTrue: [^ ''].
	selectionIndex = 1
		ifTrue: [^ object].
	selectionIndex = 2
		ifTrue: [^ object longPrintString].
	selectionIndex - 2 <= object class instSize
		ifTrue: [varName := object class allInstVarNames asSortedCollection at: selectionIndex - 2 .
			^ object instVarNamed: varName].
	basicIndex := selectionIndex - 2 - object class instSize.
	(object basicSize <= (self i1 + self i2)
			or: [basicIndex <= self i1])
		ifTrue: [^ object basicAt: basicIndex]
		ifFalse: [^ object basicAt: object basicSize - (self i1 + self i2) + basicIndex]! !


!TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'edc 4/21/2005 09:57'!
windowsMenu
        "Build the windows menu for the world."

        ^ self fillIn: (self menu: 'windows') from: {  
                { 'find window' . { #myWorld . #findWindow: }. 'Presents a list of all windows; if you choose one from the list, it becomes the active window.'}.

                { 'find changed browsers...' . { #myWorld . #findDirtyBrowsers: }. 'Presents a list of browsers that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}.

                { 'find changed windows...' . { #myWorld . #findDirtyWindows: }. 'Presents a list of all windows that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}.
			nil.

                { 'find a transcript (t)' . { #myWorld . #findATranscript: }. 'Brings an open Transcript to the front, creating one if necessary, and makes it the active window'}.

               { 'find a fileList (L)' . { #myWorld . #findAFileList: }. 'Brings an open fileList  to the front, creating one if necessary, and makes it the active window'}.

               { 'find a change sorter (C)' . { #myWorld . #findAChangeSorter: }. 'Brings an open change sorter to the front, creating one if necessary, and makes it the active window'}.

			{ 'find message names (W)' . { #myWorld . #findAMessageNamesWindow: }. 'Brings an open MessageNames window to the front, creating one if necessary, and makes it the active window'}.

			 nil.
                { #staggerPolicyString . { self . #toggleWindowPolicy }. 'stagger: new windows positioned so you can see a portion of each one.
                tile: new windows positioned so that they do not overlap others, if possible.'}.

                nil.
                { 'collapse all windows' . { #myWorld . #collapseAllWindows }. 'Reduce all open windows to collapsed forms that only show titles.'}.
                { 'expand all windows' . { #myWorld . #expandAll }. 'Expand all collapsed windows back to their expanded forms.'}.
                { 'close top window (w)' . { SystemWindow . #closeTopWindow }. 'Close the topmost window if possible.'}.
                { 'send top window to back (\)' . { SystemWindow . #sendTopWindowToBack  }. 'Make the topmost window become the backmost one, and activate the window just beneath it.'}.
			 { 'move windows onscreen' . { #myWorld . #bringWindowsFullOnscreen }. 'Make all windows fully visible on the screen'}.

                nil.
                { 'delete unchanged windows' . { #myWorld . #closeUnchangedWindows }. 'Deletes all windows that do not have unsaved text edits.'}.
                { 'delete non-windows' . { #myWorld . #deleteNonWindows }. 'Deletes all non-window morphs lying on the world.'}.
                { 'delete both of the above' . { self . #cleanUpWorld }. 'deletes all unchanged windows and also all non-window morphs lying on the world, other than flaps.'}.

        }! !

-------------- next part --------------
'From Squeak3.9 of 17 July 2009 [latest update: #7159] on 17 July 2009 at 7:17:57 pm'!
"Change Set:		7068AdvanceToThreeDotTenAlpha
Date:			17 July 2009
Author:			Edgar J. De Cleene

"



"Offer the chance to advance the version number."
(self confirm: 'There are no further updates for Squeak 3.10.
Do you wish to advance to version 3.11alpha?
[Yes] Your system will be marked as 3.11alpha, and you will
subsequently receive ''test pilot'' updates for 3.11.
[No] Your system will be marked as 3.10, allowing you
to receive only final fixes for the 3.10 stable release.
[Neither] You may choose No, and immediately quit without saving,
allowing you to make a backup copy before adopting this change.
DO YOU WANT TO ADVANCE to Version 3.11alpha now?')
	ifTrue: [SystemVersion newVersion: 'Squeak3.11alpha'.
			SystemVersion current date: Time now asDate.
			self inform: 'You may now save this Version 3.11alpha image
and retrieve updates again for 3.11alpha and beyond.']
	ifFalse: [self inform: 'You may now save this Version 3.10 final image.
- - - - -
(If you quit without saving now, your image will revert to
3.10 without any of the updates you just loaded)']!

-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7243] on 30 September 2009 at 10:25:02 am'!

!Preferences class methodsFor: 'get/set' stamp: 'sw 11/11/1998 11:40'!
doesNotUnderstand: aMessage
	"Look up the message selector as a flag."
	aMessage arguments size > 0 ifTrue: [^ super doesNotUnderstand: aMessage].
	^ self valueOfFlag: aMessage selector
! !

-------------- next part --------------
'From Squeak3.11alpha of 1 September 2009 [latest update: #7163] on 1 September 2009 at 9:18:36 am'!
ReleaseBuilderFor3dot10 subclass: #ReleaseBuilderFor3dot11
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ReleaseBuilder'!

!ReleaseBuilderFor3dot11 methodsFor: 'cleaning' stamp: 'edc 7/16/2009 19:48'!
cleanupPhaseFinal
" ReleaseBuilderFor3dot11 new cleanupPhaseFinal "
| tasks |
    tasks := OrderedCollection new
        
                add: [Smalltalk removeEmptyMessageCategories];
                add: [Workspace
                        allSubInstancesDo: [:each | each setBindings: Dictionary new]];
                add: [Undeclared removeUnreferencedKeys];
                add: [Categorizer sortAllCategories];
                add: [Symbol compactSymbolTable];
	add: [#(#TheWorldMenu #FileServices #AppRegistry #Preferences #FileList )
		do: [:cl | (Smalltalk at: cl) removeObsolete]]; add:[Flaps freshFlapsStart]; add:[MCFileBasedRepository flushAllCaches];
                 add: [PackageOrganizer default unregisterPackageNamed: 'FlexibleVocabularies'.Command zapObsolete.HandMorph releaseCachedState;
	initForEvents.self fixObsoleteReferences];
                add: [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].Smalltalk garbageCollectMost];
                 yourself.
Utilities
        informUserDuring: [:bar | tasks
                do: [:block |
                    bar value: block printString.
                    [block value]
                        on: Error
                        do: [:error | Transcript show: error;
                                 cr]]].
 SystemNavigation default obsoleteClasses isEmpty
        ifTrue: [SmalltalkImage current saveSession]
        ifFalse: [SystemNavigation default obsoleteClasses
                do: [:each | [PointerFinder on: each]
                        on: Error
                        do: [:error | Transcript show: error; cr]]].
                        self cleanUnwantedCs


! !

!ReleaseBuilderFor3dot11 methodsFor: 'cleaning' stamp: 'edc 7/16/2009 17:37'!
cleanupPhasePrepare
self cleanUnwantedCs.
                "SMSqueakMap default clearCaches."
" Commented out for no Undeclared on image "
#(zapMVCprojects zapAllOtherProjects discardFlash discardFFI
computeImageSegmentation discardSpeech ) do:[:ea| 
SystemDictionary removeSelector:ea].
#( reserveUrl: saveAsResource saveDocPane saveOnURL saveOnURL:
saveOnURLbasic isTurtleRow objectViewed inATwoWayScrollPane) do:[:ea| 
Morph removeSelector: ea].

#(playfieldOptionsMenu presentPlayfieldMenu allScriptEditors
attemptCleanupReporting: modernizeBJProject
scriptorForTextualScript:ofPlayer:) do:[:ea| 
PasteUpMorph removeSelector:   ea].
#(isUniversalTiles noteDeletionOf:fromWorld: scriptorsForSelector:inWorld: tilesToCall: handMeTilesToFire) do:[:ea| 
Player removeSelector:   ea].
Player class removeCategory: 'turtles'.
Player removeCategory: 'slots-user'.
Morph removeCategory: 'scripting'.
ColorType removeCategory: 'tiles'.
TheWorldMainDockingBar removeSelector: #hideAllViewersIn: .
#(test1 test2) do:[:ea|
WorldWindow class removeSelector:   ea].
SystemOrganization removeCategoriesMatching: 'UserObjects'.
FileList2 class organization classify: #morphicViewOnDirectory: under: 'morphic ui'.
FileList2 class organization classify: #morphicView under: 'morphic ui'.
SystemOrganization classifyAll: #(AbstractMediaEventMorph ColorSwatch) under: 'MorphicExtras-AdditionalSupport'.
Morph class organization classify: #isTileScriptingElement under: '*Unload-scripting'
Morph class organization classify: #partName:categories:documentation:sampleImageForm: under: '*Unload-eToys-new-morph participation'! !


!ReleaseBuilderFor3dot11 methodsFor: 'sources managment' stamp: 'edc 2/12/2008 09:04'!
createCompressedSources
" ReleaseBuilderFor3dot11 new createCompressedSources"
| unzipped nameToUse zipped buffer dir |
ProtoObject allSubclassesWithLevelDo:[:cl :l| 
	dir := self createDirIfnotExists:cl category.
	
	
	Cursor write showWhile: [nameToUse :=  cl printString .
		(dir fileExists: nameToUse) ifFalse:[
			unzipped :=RWBinaryOrTextStream on: ''.
			unzipped header; timeStamp.
	 cl  fileOutOn: unzipped moveSource: false toFile: 0.
	unzipped trailer.
	
			unzipped reset.
			zipped := dir newFileNamed: (nameToUse, FileDirectory dot, ImageSegment compressedFileExtension).
	zipped binary.
	zipped := GZipWriteStream on: zipped.
	buffer := ByteArray new: 50000.
	'Compressing ', nameToUse displayProgressAt: Sensor cursorPoint
		from: 0 to: unzipped size
		during:[:bar|
			[unzipped atEnd] whileFalse:[
				bar value: unzipped position.
				zipped nextPutAll: (unzipped nextInto: buffer)].
			zipped close.
			unzipped close]]]] startingLevel: 0! !

!ReleaseBuilderFor3dot11 methodsFor: 'sources managment' stamp: 'edc 2/12/2008 07:43'!
createDirIfnotExists: aDirName
(FileDirectory default directoryExists:aDirName)
		ifFalse: [FileDirectory default createDirectory: aDirName].
	^FileDirectory default directoryNamed: aDirName! !


!ReleaseBuilderFor3dot11 methodsFor: 'squeakThreeEleven' stamp: 'edc 2/5/2008 07:21'!
createBackgroundColor
| gf |
gf := GradientFillStyle  ramp: {0.0->(Color r: 0.97 g: 0.98 b: 1.0) .
1.0->(Color r: 0.0 g: 0.658 b: 0.474)}.
	gf	origin: 0 @ 0;
		direction: 0 at 400;
		normal: 640 at 0;
		radial: false.
World fillStyle: gf! !

!ReleaseBuilderFor3dot11 methodsFor: 'squeakThreeEleven' stamp: 'edc 9/1/2009 09:18'!
makeSqueakThreeTenEleven
	"ReleaseBuilderFor3dot11 new makeSqueakThreeTenEleven"
	Transcript open.
	self cleanupPhasePrepare
	"prepareforUnloadBookMorphandFriends;"
	;prepareforUnloadEtoys;
	prepareforUnloadNebraska
	;groupingTests;
	unloadSomeMore;unloadSomeMore3;cleanupPhaseFinal;createBackgroundColor.
	"World removeAllMorphs."
! !

!ReleaseBuilderFor3dot11 methodsFor: 'squeakThreeEleven' stamp: 'edc 6/5/2008 08:12'!
saveInLadrillos: packageName 
	| monti ances repo montiNames |
	monti := MCWorkingCopyBrowser new.
	repo := MCHttpRepository
				location: 'http://www.squeaksource.com/Ladrillos'
				user: ''
				password: ''.
	montiNames := repo readableFileNames.
	
	(SystemOrganization categoriesMatching: packageName , '*')
		do: [:cat | 
			| workingCopy | 
			PackageInfo registerPackageName: cat asString.
			workingCopy := MCWorkingCopy
						forPackage: (MCPackage new name: cat asString).
			workingCopy repositoryGroup addRepository: repo.
			repo user
				ifEmpty: [repo
						user: (UIManager default request: 'Ladrillos Repository username').
					repo
						password: (UIManager default request: 'Ladrillos Repository  password')].
			ances := montiNames
						detect: [:ea | ea beginsWith: cat asString]
						ifNone: [].
			ances
				ifNil: [repo
						storeVersion: (workingCopy newVersionWithName: workingCopy uniqueVersionName message: 'Starting Morphic partition')].
			monti workingCopyListChanged; changed: #workingCopySelection; changed: #repositoryList]! !


!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 2/5/2008 07:56'!
groupingTests
" this is how I build Tests-edc.35 for unload "
| classList |

classList := OrderedCollection new.
	#(TestCase TestResource) do: [:cl|  (Smalltalk at:  cl)
		allSubclassesWithLevelDo: [:c :i | classList addFirst: c]
		startingLevel: 0].		
				 
	Smalltalk organization addCategory: 'Tests-Others'.
	 classList select: [:ea| ((ea basicCategory asString) match: '*Test*') not] thenDo: [:any|  SystemOrganization classify: any name under: 'Tests-Others'].

! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 6/2/2008 09:33'!
prepareToUnloadTraits
"ReleaseBuilderFor3dot11 new  prepareToUnloadTraits"
SystemChangeNotifier uniqueInstance
noMoreNotificationsFor: ProvidedSelectors current;
noMoreNotificationsFor: RequiredSelectors current;
noMoreNotificationsFor: LocalSends current.
self unloadTraitsStubOutAcessors.

[ClassDescription subclass: #Metaclass
instanceVariableNames: 'thisClass'
classVariableNames: ' '
poolDictionaries: ' '
category: 'Kernel-Classes'.
ClassDescription subclass: #Class
instanceVariableNames: 'subclasses name classPool sharedPools environment category'
classVariableNames: ' '
poolDictionaries: ' '
category: 'Kernel-Classes'.
] on: Warning do: [:warning | warning resume].

Smalltalk allTraits do: [:trait | trait removeFromSystem. trait := nil].
"Recompile all methods that were part of a trait"
SystemNavigation default allBehaviorsDo: [:class | class selectorsAndMethodsDo: [:sel :method | class ~~ method methodClass ifTrue: [class recompile: sel]. method := nil]. class := nil].
"Remove references to traits from various places in the code"
self unloadTraits! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 4/11/2008 04:41'!
prepareforUnloadBookMorphandFriends
SystemOrganization addCategory: #BookMorphandFriends.

SystemOrganization classifyAll: #( BookMorph BookPageSorterMorph BookPageThumbnailMorph BooklikeMorph FlexMorph FloatingBookControlsMorph KedamaMorph MethodMorph  MorphThumbnail   StoryboardBookMorph ) under: 'BookMorphandFriends'.
! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 7/16/2009 19:48'!
prepareforUnloadEtoys
Smalltalk removeClassNamed: #FlexibleVocabulariesInfo.
Smalltalk removeClassNamed: #ColorSwatch.
SystemOrganization classifyAll: #(ActorState MethodMorph Player Presenter StickySketchMorph UnscriptedPlayer SlotInformation UnscriptedCardPlayer) under: 'MorphicExtras-EToys-Scripting'.
#( actorState actorState: isPartsDonor isPartsDonor: player player:) do: [:method|
MorphExtension organization classify: method under: '*MorphicExtras-accessing' suppressIfDefault: false].
HaloMorph organization classify: #doMakeSiblingOrDup:with: under: 'Old Etoys-handles'.
HaloMorph organization classify: #doDupOrMakeSibling:with: under: 'Old Etoys-handles'.
"self loadTogether: #('Morphic-CandidatesForGo-edc.3.mcz' ) merge: false."
SystemOrganization classifyAll: #(ScriptEditorMorph TwoWayScrollPane TabSorterMorph) under:
'Morphic-CandidatesForGo'.

#('*eToys-queries' '*eToys-eToy vocabularies' '*eToys-color' '*eToys-customevents-custom events' '*eToys-type vocabularies') do:[:ea| 
Vocabulary class removeCategory: ea].

#('*flexibleVocabularies-flexiblevocabularies-scripting' '*flexibleVocabularies-flexibleVocabularies' '*eToys-scripting' '*eToys-new-morph participation' '*eToys-customevents-user events') do:[:ea|
Morph class removeCategory:  ea].
#(nascentUserScriptInstance userScriptForPlayer: selector:  ) do:[:ea|
Player class removeSelector:  ea].
Smalltalk removeClassNamed: #FlexibleVocabulariesInfo.
Preferences removePreference: #allowEtoyUserCustomEvents. 
Morph organization classify: #partName:categories:documentation:sampleImageForm: under: '*MorphicExtras-new-morph participation'.
#(possiblyReplaceEToyFlaps twiddleSuppliesButtonsIn:) do: [:ea| 
Flaps class removeSelector:   ea].
Flaps clobberFlapTabList.
Flaps addStandardFlaps.
SystemOrganization classifyAll: #(ComponentLikeModel) under: 'MorphicExtras-Components'
! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 2/15/2008 10:19'!
prepareforUnloadNebraska
SystemOrganization addCategory: #'Nebraska-Refactoring'.

SystemOrganization classifyAll: #(EToyGenericDialogMorph EToyProjectDetailsMorph EToyProjectHistoryMorph EToyProjectQueryMorph EToyProjectRenamerMorph EtoyUpdatingThreePhaseButtonMorph) under: 'Nebraska-Refactoring'.
WorldState organization classify: #remoteCanvasesDo: under: '*MorphicExtras-nebraska compatible'.
! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 3/13/2008 10:29'!
unloadSomeMore
#('Tests' 'SMLoader' 'SMBase' 'SUnit' 'SUnitGUI' 'ScriptLoader' 'Universes' 'Installer' 'XML-Parser' )
		do: [:ea | (MCPackage named: ea) unload].
		self fixObsoleteReferences ! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 3/13/2008 10:29'!
unloadSomeMore2
"ReleaseBuilderFor3dot11 new unloadSomeMore2;cleanupPhaseFinal "
#('BookMorphandFriends'   )
		do: [:ea | (MCPackage named: ea) unload].self fixObsoleteReferences! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 7/16/2009 19:49'!
unloadSomeMore3
"ReleaseBuilderFor3dot11 new unloadSomeMore3;cleanupPhaseFinal;cleanUnwantedCs "
#('MorphicExtras-Demo'  'Morphic-CandidatesForGo' 'Nebraska' 'UserObjects')
		do: [:ea | (MCPackage named: ea) unload].
		SystemOrganization removeCategoriesMatching: 'EToys*'.
		self fixObsoleteReferences! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 6/2/2008 10:14'!
unloadTraits
	"ReleaseBuilderFor3dot11 new unloadTraits"
	self saveInLadrillos: 'Traits'.
	self unloadTraitsClearRefs.
	(MCPackage named: 'Traits') unload.
	self unloadTraitsTraitsStubs.
	self fixObsoleteReferences! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 6/2/2008 09:44'!
unloadTraitsClearRefs

| loader |
	loader _ CodeLoader new.
	loader baseURL:'http://installer.pbwiki.org/f/'.
	
	"Sources and segments can be loaded in parallel"
	loader loadSourceFiles: #('UnloadTraits-ClearRefs.cs' ).
	! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 6/2/2008 09:34'!
unloadTraitsStubOutAcessors

| loader |
	loader _ CodeLoader new.
	loader baseURL:'http://installer.pbwiki.org/f/'.
	
	"Sources and segments can be loaded in parallel"
	loader loadSourceFiles: #('UnloadTraits-StubOutAcessors.cs' ).
	! !

!ReleaseBuilderFor3dot11 methodsFor: 'unloadPackages' stamp: 'edc 6/2/2008 09:45'!
unloadTraitsTraitsStubs

| loader |
	loader _ CodeLoader new.
	loader baseURL:'http://installer.pbwiki.org/f/'.
	
	"Sources and segments can be loaded in parallel"
	loader loadSourceFiles: #('UnloadTraits-TraitsStubs.cs' ).
	! !


!ReleaseBuilderFor3dot11 methodsFor: 'updates' stamp: 'edc 7/16/2009 17:38'!
installtrunk

" ReleaseBuilderFor3dot11 new installtrunk"

	MCWorkingCopy allManagers
		do: [:each | each repositoryGroup addRepository: (MCHttpRepository new location: 'http://source.squeak.org/trunk';
					 user: 'squeak';
					 password: 'squeak')]! !

!ReleaseBuilderFor3dot11 methodsFor: 'updates' stamp: 'edc 7/15/2009 16:45'!
loadLastVersion: aListOfPackageNames 
	| mcw montiNames package version |
	mcw := MCWorkingCopyBrowser new
				repository: (MCHttpRepository
						location:  'http://source.squeak.org/trunk/'
						user: ''
						password: '').
	mcw repository
		ifNotNilDo: [:repos | montiNames := repos readableFileNames].
	aListOfPackageNames
		do: [:mo | 
			package := montiNames
						detect: [:ea | (ea findTokens: '-' ) first = mo]
						ifNone: [].
			package
				ifNotNil: [version := mcw repository loadVersionFromFileNamed: package.
					version load]].
	^ version! !

!ReleaseBuilderFor3dot11 methodsFor: 'updates' stamp: 'edc 7/16/2009 17:38'!
repository
	repository isNil
		ifTrue: [repository := MCHttpRepository
						location: 'http://source.squeak.org/trunk'
						user: ''
						password: ''].
	^ repository! !
-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7228] on 15 July 2009 at 5:32:02 pm'!

!MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'edc 7/15/2009 17:07'!
hasPostscript
	^ false! !

!MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'edc 7/15/2009 17:07'!
hasPreamble
^ false! !

-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7263] on 1 October 2009 at 9:13:54 am'!

!ByteString methodsFor: 'converting' stamp: 'edc 11/19/2007 10:49'!
asJoliet
|badChars |
badChars := #( $: $< $> $| $/ $\ $? $* $") asSet.
^ self copyWithoutAll: badChars! !
-------------- next part --------------
'From Squeak3.10beta of 22 July 2007 [latest update: #7159] on 5 September 2009 at 8:19:02 am'!




!MCPackageLoader methodsFor: 'private' stamp: 'edc 9/1/2009 03:37'!
useChangeSetNamed: baseName during: aBlock
    "Use the named change set, or create one with the given name."
    | changeHolder oldChanges newChanges csName |

    changeHolder := (ChangeSet respondsTo: #newChanges:)
                        ifTrue: [ChangeSet]
                        ifFalse: [Smalltalk].
    oldChanges := (ChangeSet respondsTo: #current)
                        ifTrue: [ChangeSet current]
                        ifFalse: [Smalltalk changes].
csName := (SystemVersion current highestUpdate + 1) asString,baseName.
    newChanges := (ChangesOrganizer changeSetNamed: csName) ifNil: [ ChangeSet new name: csName ].
    changeHolder newChanges: newChanges.
    [aBlock value] ensure: [changeHolder newChanges: oldChanges].
SystemVersion current registerUpdate: SystemVersion current highestUpdate + 1
! !

-------------- next part --------------
'From SqueakLight|II of 31 May 2008 [latest update: #7237] on 12 August 2009 at 9:36:15 am'!

!ReleaseBuilderFor3dot10 methodsFor: 'managing updates' stamp: 'edc 8/12/2009 09:27'!
flushCaches
	MCFileBasedRepository flushAllCaches.
	MCDefinition clearInstances.
	Smalltalk garbageCollect.
	"Initialization required for tests: strange why this is not a teardwon
	method "
	"SendCaches initializeAllInstances"! !

-------------- next part --------------
'From Squeak3.10.2 of ''5 June 2008'' [latest update: #7179] on 30 September 2009 at 10:02:29 am'!
Object subclass: #MCMcmUpdater
	instanceVariableNames: ''
	classVariableNames: 'LastUpdateMap'
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

MCMcmUpdater class
	instanceVariableNames: ''!

!MCMcmUpdater class methodsFor: 'class initialization' stamp: 'ar 8/12/2009 22:15'!
initialize
	"MCMcmUpdater initialize"
	LastUpdateMap := Dictionary new.
! !


!MCMcmUpdater class methodsFor: 'updating' stamp: 'ar 8/12/2009 22:13'!
updateFromRepositories: repositoryUrls
	"MCMcmUpdater updateFromRepositories: #(
		'http://squeaksource.com/MCUpdateTest'
	)"

	| repos updateList parts base author version type config minVersion |
	Preferences enable: #upgradeIsMerge.
	LastUpdateMap ifNil:[LastUpdateMap := Dictionary new].
	"The list of repositories to consult in order"
	repos := repositoryUrls collect:[:url| 
		MCRepositoryGroup default repositories 
			detect:[:r| r description = url]
			ifNone:[ | r |
				r := MCHttpRepository location: url user: '' password: ''.
				MCRepositoryGroup default addRepository: r.
				r]].

	"The list of updates-author.version.mcm sorted by version"
	repos do:[:r|
		updateList := SortedCollection new.
		minVersion := LastUpdateMap at: r description ifAbsent:[0].
		"Find all the updates-author.version.mcm files"
		r allFileNames do:[:versionedName|
			parts := versionedName findTokens: '.-'.
			parts size = 4 ifTrue:[
				base := parts at: 1.
				author := parts at: 2.
				version := [(parts at: 3) asNumber] on: Error do:[:ex| ex return: 0].
				type := parts at: 4.
			].
			(base = 'update' and:[version >= minVersion and:[type = 'mcm']]) 
				ifTrue:[updateList add: version -> versionedName]].
		
		"Proceed only if there are updates available at all."
		updateList ifNotEmpty: [
			"Now process each update file. Check if we have all dependencies and if not,
			load the entire configuration (this is mostly to skip older updates quickly)"
			updateList do:[:assoc|
				ProgressNotification signal: '' extra: 'Processing ', assoc value.
				config := r versionFromFileNamed: assoc value.
				(config dependencies allSatisfy:[:dep| dep isFulfilled]) 
					ifFalse:[config upgrade].
				LastUpdateMap at: r description put: assoc key.
			] displayingProgress: 'Processing configurations'.
			"We've loaded all the provided update configurations.
			Use the latest configuration to update all the remaining packages."
			config updateFromRepositories.
			config upgrade.
		].
	].! !


MCMcmUpdater initialize!
-------------- next part --------------
'From Squeak3.11alpha of 1 September 2009 [latest update: #7168] on 1 September 2009 at 9:07:16 am'!
"Change Set:		7234
Date:			11 August 2009
Author:			Edgar J. De Cleene

First step to synch with trunk"
ReleaseBuilderFor3dot11 new installtrunk.
ReleaseBuilderFor3dot11 new updatePackages: 'MonticelloConfigurations-ar.58.mcz'.!



More information about the Squeak-dev mailing list