The Trunk: EToys-tfel.260.mcz

Tim Felgentreff uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-tfel.260.mcz

==================== 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:
  aChangeSetOrNil
 
  | 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]
  ifFalse:[nil].
 
  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') -----
  loadASexp
 
  | 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') -----
  publishSexp
 
  | 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);
  openInWorld;
  yourself.
  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].
  !