The Trunk: Morphic-dtl.722.mcz

David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.722.mcz

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

Name: Morphic-dtl.722
Author: dtl
Time: 30 March 2014, 10:02:04.538 am
UUID: 46f78b95-7ef0-4ade-89eb-5a9ddf96c53e
Ancestors: Morphic-cmm.721

Utilities emptyScrapsBook is now ScrapBook current emptyScrapBook. Fix misspelling in references (emptyScrapBook not emptyScrapsBook). Retain deprecated Utilities emptyScrapsBook in case of references in external projects.

=============== Diff against Morphic-cmm.721 ===============

Item was changed:
  ----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') -----
  exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory
  "Store my project out on the disk as an *exported* ImageSegment.  All outPointers will be in a form that can be resolved in the target image.  Name it <project name>.extSeg.  What do we do about subProjects, especially if they are out as local image segments?  Force them to come in?
  Player classes are included automatically."
 
  | is str ans revertSeg roots holder |
  self flag: #toRemove.
  self halt.  "unused"
  "world == World ifTrue: [^ false]."
  "self inform: 'Can''t send the current world out'."
  world ifNil: [^ false].  world presenter ifNil: [^ false].
 
+ ScrapBook default emptyScrapBook.
- ScrapBook default emptyScrapsBook.
  world currentHand pasteBuffer: nil.  "don't write the paste buffer."
  world currentHand mouseOverHandler initialize.  "forget about any references here"
  "Display checkCurrentHandForObjectToPaste."
  Command initialize.
  world clearCommandHistory.
  world fullReleaseCachedState; releaseViewers.
  world cleanseStepList.
  world localFlapTabs size = world flapTabs size ifFalse: [
  self error: 'Still holding onto Global flaps'].
  world releaseSqueakPages.
  holder := Project allProjects. "force them in to outPointers, where DiskProxys are made"
 
  "Just export me, not my previous version"
  revertSeg := self parameterAt: #revertToMe.
  self projectParameters removeKey: #revertToMe ifAbsent: [].
 
  roots := OrderedCollection new.
  roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
  roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]).
 
  roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"
 
  catList do: [:sysCat |
  (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb |
  roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]].
 
  is := ImageSegment new copySmartRootsExport: roots asArray.
  "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"
 
  is state = #tooBig ifTrue: [^ false].
 
  str := ''.
  "considered legal to save a project that has never been entered"
  (is outPointers includes: world) ifTrue: [
  str := str, '\Project''s own world is not in the segment.' withCRs].
  str isEmpty ifFalse: [
  ans := (UIManager default
  chooseFrom: #('Do not write file' 'Write file anyway' 'Debug')
  title: str).
  ans = 1 ifTrue: [
  revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg].
  ^ false].
  ans = 3 ifTrue: [self halt: 'Segment not written']].
 
  is writeForExportWithSources: aFileName inDirectory: aDirectory.
  revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg].
  holder.
  world flapTabs do: [:ft |
  (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
  is arrayOfRoots do: [:obj |
  obj isScriptEditorMorph ifTrue: [obj unhibernate]].
  ^ true
  !

Item was changed:
  ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') -----
  exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
  directory: aDirectory
  "Store my project out on the disk as an *exported*
  ImageSegment.  All outPointers will be in a form that can be resolved
  in the target image.  Name it <project name>.extSeg.  Whatdo we do
  about subProjects, especially if they are out as local image
  segments?  Force them to come in?
  Player classes are included automatically."
 
  | is str ans revertSeg roots holder collector fd mgr stacks |
 
  "Files out a changeSet first, so that a project can contain
  its own classes"
  world ifNil: [^ false].  world presenter ifNil: [^ false].
 
+ ScrapBook default emptyScrapBook.
- ScrapBook default emptyScrapsBook.
  world currentHand pasteBuffer: nil.  "don't write the paste buffer."
  world currentHand mouseOverHandler initialize.  "forget about any
  references here"
  "Display checkCurrentHandForObjectToPaste."
  Command initialize.
  world clearCommandHistory.
  world fullReleaseCachedState; releaseViewers.
  world cleanseStepList.
  world localFlapTabs size = world flapTabs size ifFalse: [
  self error: 'Still holding onto Global flaps'].
  world releaseSqueakPages.
  holder := Project allProjects. "force them in to outPointers, where
  DiskProxys are made"
 
  "Just export me, not my previous version"
  revertSeg := self parameterAt: #revertToMe.
  self removeParameter: #revertToMe.
 
  roots := OrderedCollection new.
  roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
  roots add: world activeHand.
 
  "; addAll: classList; addAll: (classList collect: [:cls | cls class])"
 
  roots := roots reject: [ :x | x isNil]. "early saves may not have
  active hand or thumbnail"
 
  fd := aDirectory directoryNamed: self resourceDirectoryName.
  fd assureExistence.
  "Clean up resource references before writing out"
  mgr := self resourceManager.
  self resourceManager: nil.
  ResourceCollector current: ResourceCollector new.
  ResourceCollector current localDirectory: fd.
  ResourceCollector current baseUrl: self resourceUrl.
  ResourceCollector current initializeFrom: mgr.
  ProgressNotification signal: '2:findingResources' extra:
  '(collecting resources...)' translated.
  "Must activate old world because this is run at #armsLength.
  Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
  will not be captured correctly if referenced from blocks or user code."
  world becomeActiveDuring:[
  is := ImageSegment new copySmartRootsExport: roots asArray.
  "old way was (is := ImageSegment new
  copyFromRootsForExport: roots asArray)"
  ].
  self resourceManager: mgr.
  collector := ResourceCollector current.
  ResourceCollector current: nil.
  ProgressNotification signal: '2:foundResources' extra: ''.
  is state = #tooBig ifTrue: [
  collector replaceAll.
  ^ false].
 
  str := ''.
  "considered legal to save a project that has never been entered"
  (is outPointers includes: world) ifTrue: [
  str := str, '\Project''s own world is not in the segment.' translated withCRs].
  str isEmpty ifFalse: [
  ans := UIManager default chooseFrom: {
  'Do not write file' translated.
  'Write file anyway' translated.
  'Debug' translated.
  } title: str.
  ans = 1 ifTrue: [
  revertSeg ifNotNil: [projectParameters at:
  #revertToMe put: revertSeg].
  collector replaceAll.
  ^ false].
  ans = 3 ifTrue: [
  collector replaceAll.
  self halt: 'Segment not written' translated]].
  stacks := is findStacks.
 
  is
  writeForExportWithSources: aFileName
  inDirectory: fd
  changeSet: aChangeSetOrNil.
  SecurityManager default signFile: aFileName directory: fd.
  "Compress all files and update check sums"
  collector forgetObsolete.
  self storeResourceList: collector in: fd.
  self storeHtmlPageIn: fd.
  self storeManifestFileIn: fd.
  self writeStackText: stacks in: fd registerIn: collector.
  "local proj.005.myStack.t"
  self compressFilesIn: fd to: aFileName in: aDirectory
  resources: collector.
  "also deletes the resource directory"
  "Now update everything that we know about"
  mgr updateResourcesFrom: collector.
 
  revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
  holder.
 
  collector replaceAll.
 
  world flapTabs do: [:ft |
  (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
  is arrayOfRoots do: [:obj |
  obj isScriptEditorMorph ifTrue: [obj unhibernate]].
  ^ true
  !

Item was changed:
  ----- Method: MorphicProject>>storeSegment (in category 'file in/out') -----
  storeSegment
  "Store my project out on the disk as an ImageSegment.  Keep the outPointers in memory.  Name it <project name>.seg.  *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***"
 
  | is sizeHint |
  (World == world) ifTrue: [^ false].
  "self inform: 'Can''t send the current world out'."
  world isInMemory ifFalse: [^ false].  "already done"
  world ifNil: [^ false].  world presenter ifNil: [^ false].
 
+ ScrapBook default emptyScrapBook.
- ScrapBook default emptyScrapsBook.
  World checkCurrentHandForObjectToPaste.
  world releaseSqueakPages.
  sizeHint := self projectParameters at: #segmentSize ifAbsent: [0].
 
  is := ImageSegment new copyFromRootsLocalFileFor:
  (Array with: world presenter with: world) "world, and all Players"
  sizeHint: sizeHint.
 
  is state = #tooBig ifTrue: [^ false].
  is segment size < 2000 ifTrue: ["debugging"
  Transcript show: self name, ' only ', is segment size printString,
  'bytes in Segment.'; cr].
  self projectParameters at: #segmentSize put: is segment size.
  is extract; writeToFile: self name.
  ^ true
  !

Item was changed:
  ----- Method: MorphicProject>>storeSegmentNoFile (in category 'file in/out') -----
  storeSegmentNoFile
  "For testing.  Make an ImageSegment.  Keep the outPointers in memory.  Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
 
  | is |
  (World == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'."
  world isInMemory ifFalse: [^ self].  "already done"
  world ifNil: [^ self].  world presenter ifNil: [^ self].
 
  "Do this on project enter"
  World flapTabs do: [:ft | ft referent adaptToWorld: World].
  "Hack to keep the Menu flap from pointing at my project"
  "Preferences setPreference: #useGlobalFlaps toValue: false."
  "Utilities globalFlapTabsIfAny do:
  [:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false].
  Utilities clobberFlapTabList. "
  "project world deleteAllFlapArtifacts."
  "self currentWorld deleteAllFlapArtifacts. "
+ ScrapBook default emptyScrapBook.
- ScrapBook default emptyScrapsBook.
  World checkCurrentHandForObjectToPaste2.
 
  is := ImageSegment new copyFromRootsLocalFileFor:
  (Array with: world presenter with: world) "world, and all Players"
  sizeHint: 0.
 
  is segment size < 800 ifTrue: ["debugging"
  Transcript show: self name, ' did not get enough objects'; cr.  ^ Beeper beep].
 
  is extract.
  "is instVarAt: 2 put: is segment clone." "different memory"
  !