[squeak-dev] The Trunk: EToys-tfel.260.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Sep 29 10:11:05 UTC 2016

Tim Felgentreff uploaded a new version of EToys to project The Trunk:

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

Name: EToys-tfel.260
Author: tfel
Time: 29 September 2016, 12:10:17.056594 pm
UUID: eddd1b98-0a8e-4a23-b671-287897615d1b
Ancestors: EToys-tfel.259

for performance, write sexp on DataStream

=============== Diff against EToys-tfel.259 ===============

Item was changed:
  ----- Method: Project>>writeForExportInSexp:withSources:inDirectory:changeSet: (in category '*Etoys-Squeakland-file in/out') -----
  writeForExportInSexp: sexp withSources: actualName inDirectory: aDirectory changeSet:
  	| fileStream tempFileName zipper |
  	tempFileName := aDirectory nextNameFor: 'SqProject' extension: 'temp'.
  	zipper := [
  		aDirectory rename: tempFileName toBe: actualName.
  		aDirectory deleteFileNamed: tempFileName ifAbsent: []
+ 	aDirectory forceNewFileNamed: tempFileName do: [:f |
+ 		f binary;
+ 		  nextPutAll: ((DataStream on: (WriteStream on: (ByteArray new: sexp elements size * 50)))
+ 							nextPut: sexp;
+ 							contents)].
- 	fileStream := aDirectory newFileNamed: tempFileName.
- 	sexp printOn: fileStream.
- 	fileStream close.
  	fileStream := aDirectory newFileNamed: 'changes.cs'.
  	aChangeSetOrNil ifNotNil: [aChangeSetOrNil fileOutOn: fileStream].
  	fileStream close.
  	zipper value.!

Item was changed:
  ----- Method: ProjectLoading class>>loadSexpProjectDict:stream:fromDirectory:withProjectView: (in category '*etoys') -----
  loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView
+    	| archive anObject newProj d member memberStream members newSet allNames realName oldSet s |
-    	| archive anObject newProj d member b s memberStream members newSet allNames realName oldSet |
  	(self checkStream: preStream) ifTrue: [^ nil].
  	ProgressNotification signal: '0.2'.
  	preStream reset.
  	archive := preStream isZipArchive
  		ifTrue:[ZipArchive new readFrom: preStream]
  	members := archive  membersMatching: '*.cs'.
  	members do: [:e | newSet := ChangeSorter newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString].
  	member := (archive membersMatching: '*.sexp') first.
  	memberStream := member contentStream.
  	(self checkSecurity: member name preStream: preStream projStream: memberStream)
  		ifFalse: [^nil].
+ 	self flag: #tfel. "load all projects and save them again in the new format, then get rid of the error block!!"
- 	b := String new: member uncompressedSize.
  	s := memberStream basicUpToEnd.
+ 	d := [(DataStream on: memberStream) next] on: Error do: [:e |
+ 		(Smalltalk at: #MSExpParser) parse: s with: #ksexp].
- 	d := (Smalltalk at: #MSExpParser) parse: s with: #ksexp.
  	anObject := d sissReadObjectsAsEtoysProject.
  	preStream close.
  	"anObject := (MSExpParser parse: (archive membersMatching: '*.sexp') first contents with: #ksexp) sissReadObjects."
  	anObject ifNil: [^ nil].
  	(anObject isKindOf: PasteUpMorph) ifFalse: [^ World addMorph: anObject].
  	ProgressNotification  signal: '0.7'.
  	newProj := MorphicProject new.
  	newProj installPasteUpAsWorld: anObject.
  	newSet ifNotNil: [oldSet := newProj changeSet.  newProj setChangeSet: newSet. ChangeSorter removeChangeSet: oldSet].
  	dict at: 'projectname' ifPresent: [:n |
  		allNames := Project allNames.
  		realName := Utilities keyLike: n  satisfying:
  		[:nn | (allNames includes: nn) not].
  		newProj renameTo: realName.
  	anObject valueOfProperty: #projectVersion ifPresentDo: [:v | newProj version: v].
  	newProj  noteManifestDetailsIn: dict.
  	ProgressNotification  signal: '0.8'.
  	^ newProj.!

Item was changed:
  ----- Method: SugarNavigatorBar>>loadASexp (in category 'button actions') -----
  	| file siss sexp |
  	file := FileList2 modalFileSelectorForSuffixes: #('sexp').
  	file ifNil: [^ self].
+ 	file binary.
  	siss := file contents.
+ 	sexp := [(DataStream on: (file reset; yourself)) next] on: Error do: [:e |
+ 		(Smalltalk at: #MSExpParser) parse: siss with: #ksexp].
- 	file close.
- 	sexp := (Smalltalk at: #MSExpParser) parse: siss with: #ksexp.
  	sexp sissReadObjectsAsEtoysProject submorphs do: #openInWorld.

Item was changed:
  ----- Method: SugarNavigatorBar>>publishSexp (in category 'button actions') -----
  	| morphs siss tempPasteUp directory fileModel window prevSubmorphs |
  	self world paintBoxOrNil ifNotNil: [
  		self inform: 'You seem to be painting a sketch. You should finish or cancel your painting first' translated.
  		^ self].
  	tempPasteUp := PasteUpMorph new
  						bounds: (self world bounds);
  	morphs := self world submorphs
  			select: [:m |
  				(m player notNil and: [m player externalName ~= 'dot'])
  					or: [m isKindOf: ScriptEditorMorph]].
  	prevSubmorphs := self world submorphs.
  	tempPasteUp addAllMorphs: morphs.
  	siss := tempPasteUp sissScanObjectsAsEtoysProject.
  	tempPasteUp delete.
  	self world addAllMorphs: prevSubmorphs.
  	window := FileList2 morphicViewProjectSaverFor: Project current.
  	(window findDeepSubmorphThat: [:m |
  		m eventHandler notNil and: [m eventHandler mouseUpSelector = #saveLocalOnlyHit]] ifAbsent: [])
  			ifNotNil: [:m | m delete].
  	fileModel := window valueOfProperty: #FileList.
  	self world addMorphInLayer: window.
  	self world startSteppingSubmorphsOf: window.
  	FileList2 modalLoopOn: window.
  	directory := fileModel getSelectedDirectory withoutListWrapper.
  	directory ifNil: [^ self].
+ 	directory forceNewFileNamed: (Project current name, '.sexp') do: [:f |
+ 		f binary;
+ 		  nextPutAll: ((DataStream on: (WriteStream on: (ByteArray new: siss elements size * 50)))
+ 							nextPut: siss;
+ 							contents)].
- 	directory forceNewFileNamed: (Project current name, '.sexp') do: [:f | siss printOn: f].

More information about the Squeak-dev mailing list