'From etoys3.0 of 24 February 2008 [latest update: #1997] on 12 May 2008 at 12:03:03 pm'!
"Change Set:		NotificationForOld-yo
Date:			9 May 2008
Author:			Yoshiki Ohshima

Add a do it in the project changeset.  The do it notifies if the project made in a newer image is loaded onto an old one."!


!ImageSegment methodsFor: 'read/write segment' stamp: 'yo 5/9/2008 11:24'!
writeForExportWithSources: fName inDirectory: aDirectory changeSet:
aChangeSetOrNil
	"Write the segment on the disk with all info needed to
reconstruct it in a new image.  For export.  Out pointers are encoded
as normal objects on the disk.  Append the source code of any classes
in roots.  Target system will quickly transfer the sources to its
changes file."
	"Files out a changeSet first, so that a project can contain
classes that are unique to the project."

	| fileStream temp tempFileName zipper allClassesInRoots
classesToWriteEntirely methodsWithSource |
	state = #activeCopy ifFalse: [self error: 'wrong state'].
	(fName includes: $.) ifFalse: [
		^ self inform: 'Please use ''.pr'' or ''.extSeg'' at
the end of the file name'.].
	temp _ endMarker.
	endMarker _ nil.
	tempFileName _ aDirectory nextNameFor: 'SqProject' extension: 'temp'.
	zipper _ [
		Preferences debugPrintSpaceLog ifTrue:[
			fileStream _ aDirectory newFileNamed:
				(fName copyFrom: 1 to: (fName
lastIndexOf: $.)), 'space'.
			self printSpaceAnalysisOn: fileStream.
			fileStream close].
		ProgressNotification signal: '3:uncompressedSaveComplete'.
		(aDirectory oldFileNamed: tempFileName) compressFile.
	"makes xxx.gz"
		aDirectory
			rename: (tempFileName, FileDirectory dot, 'gz')
			toBe: fName.
		aDirectory
			deleteFileNamed: tempFileName
			ifAbsent: []
	].
	fileStream _ aDirectory newFileNamed: tempFileName.
	fileStream fileOutChangeSet: aChangeSetOrNil andObject: self withVersionNotification: true.
		"remember extra structures.  Note class names."
	endMarker _ temp.

	"append sources"
	allClassesInRoots _ arrayOfRoots select: [:cls | cls
isKindOf: Behavior].
	classesToWriteEntirely _ allClassesInRoots select: [ :cls |
cls theNonMetaClass isSystemDefined].
	methodsWithSource _ OrderedCollection new.
	allClassesInRoots do: [ :cls |
		(classesToWriteEntirely includes: cls) ifFalse: [
			cls selectorsAndMethodsDo: [ :sel :meth |
				meth sourcePointer = 0 ifFalse:
[methodsWithSource add: {cls. sel. meth}].
			].
		].
	].
	(classesToWriteEntirely isEmpty and: [methodsWithSource
isEmpty]) ifTrue: [zipper value. ^ self].

	fileStream reopen; setToEnd.
	fileStream nextPutAll: '\\!!ImageSegment new!!\\' withCRs.
	methodsWithSource do: [ :each |
		fileStream nextPut: $!!.	"try to pacify
ImageSegment>>scanFrom:"
		fileStream nextChunkPut: 'RenamedClassSourceReader
formerClassName: ',
				each first name printString,' methodsFor: ',
				(each first organization
categoryOfElement: each second) asString printString,
				' stamp: ',(Utilities
timeStampForMethod: each third) printString; cr.
		fileStream nextChunkPut: (each third getSourceFor:
each second in: each first) asString.
		fileStream nextChunkPut: ' '; cr.
	].
	classesToWriteEntirely do: [:cls |
		cls isMeta ifFalse: [fileStream nextPutAll:
						(cls name, '
category: ''', cls category, '''.!!'); cr; cr].
		cls organization
			putCommentOnFile: fileStream
			numbered: 0
			moveSource: false
			forClass: cls.	"does nothing if metaclass"
		cls organization categories do:
			[:heading |
			cls fileOutCategory: heading
				on: fileStream
				moveSource: false
				toFile: 0]].
	"no class initialization -- it came in as a real object"
	fileStream close.
	zipper value.
! !


!ReadWriteStream methodsFor: 'fileIn/Out' stamp: 'yo 5/9/2008 11:21'!
fileOutChangeSet: aChangeSetOrNil andObject: theObject

	^ self fileOutChangeSet: aChangeSetOrNil andObject: theObject withVersionNotification: false.
! !

!ReadWriteStream methodsFor: 'fileIn/Out' stamp: 'yo 5/9/2008 11:21'!
fileOutChangeSet: aChangeSetOrNil andObject: theObject withVersionNotification: withNotification
	"Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."

	"An experimental version to fileout a changeSet first so that a project can contain its own classes"


	self setFileTypeToObject.
		"Type and Creator not to be text, so can attach correctly to an email msg"
	self header; timeStamp.

	(withNotification or: [aChangeSetOrNil notNil]) ifTrue: [
		withNotification ifTrue: [
			self fileOutVersionCheckNotification.
		].
		aChangeSetOrNil ifNotNil: [
			aChangeSetOrNil fileOutPreambleOn: self.
			aChangeSetOrNil fileOutOn: self.
			aChangeSetOrNil fileOutPostscriptOn: self.
		].
	].

	self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"

	"Append the object's raw data"
	(SmartRefStream on: self)
		nextPut: theObject;  "and all subobjects"
		close.		"also closes me"
! !

!ReadWriteStream methodsFor: 'fileIn/Out' stamp: 'yo 5/12/2008 12:02'!
fileOutVersionCheckNotification

	self nextChunkPut: ' | cont | (Smalltalk includesKey: #MorphExtensionPlus) ifFalse: [self inform: ''This project cannot be loaded into an older system.\Please use an OLPC Etoys compatible image.'' translated withCRs.
		cont _ thisContext.
		[cont notNil] whileTrue: [
			cont selector == #handleEvent: ifTrue: [cont return: nil].
			cont _ cont sender.
		]]'; cr.
! !