The Trunk: System-dtl.989.mcz

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

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

Name: System-dtl.989
Author: dtl
Time: 17 December 2017, 10:56:50.75998 am
UUID: 3a87ca02-6189-4f1e-b9f0-0853f9452351
Ancestors: System-dtl.985, System-eem.988

Emergency evaluator project enhancements. Project class>>handlePrimitiveError: will first try to find a parent project of different type (e.g. MVC if current project is Morphic, or vice versa) in which to host an emergency debugger. If no suitable parent project is found, search all projects to find any other project of different type. If no such project is found, then the traditional emergency evaluator transcript is opened.

A guard flag prevents recursion when entering projects for emergency evaluation. For example, if a failure occurs in a Morphic project, and an MVC project has been entered for emergency evaluation, then subsequent error handling (if needed) will drop into the traditional emergency evaluator.

When entering a project for emergency evaluation, let the resulting debugger display the name of the project from which the failure originated.

A typical scenario is the case of an image with many Morphic projects, and one MVC project anywhere in the project hierarchy. In the event of an unrecoverable error in any of the Morphic projects, the MVC project will be identified as the project for emergency recovery. This permits an MVC debugger to be used to recover from the error condition, after which the failed Morphic user interface can be reentered.

Other kinds of projects can also participate. If the parent project of a Morphic project is a SqueakShellProject, then a fatal error in the Morphic project will be handled by the SqueakShellProject.

See the treated inbox for System-dtl.981 through System-dtl.985.

=============== Diff against System-eem.988 ===============

Item was changed:
  Model subclass: #Project
  instanceVariableNames: 'world uiManager changeSet transcript parentProject previousProject displayDepth viewSize thumbnail nextProject projectParameters version urlList lastDirectory lastSavedAtSeconds projectPreferenceFlagDictionary resourceManager'
+ classVariableNames: 'AllProjects CurrentProject EmergencyRecoveryRequested GoalFreePercent GoalNotMoreThan'
- classVariableNames: 'AllProjects CurrentProject GoalFreePercent GoalNotMoreThan'
  poolDictionaries: ''
  category: 'System-Support'!
 
  !Project commentStamp: 'cbr 7/27/2010 21:36' prior: 0!
  A Project stores the state of a complete Squeak desktop, including
  the windows, and the currently active changeSet.  A project knows who
  its parent project is.  When you change projects, whether by entering
  or exiting, the screen state of the project being exited is saved in
  that project.
 
  A project is retained by its view in the parent world.  It is
  effectively named by the name of its changeSet, which can be changed
  either by renaming in a changeSorter, or by editing the label of its
  view from the parent project.
 
  As the site of major context switch, Projects are the locus of
  swapping between the old MVC and the new Morphic worlds.  The
  distinction is based on whether the variable 'world' contains a
  WorldMorph or a ControlManager.
 
  Saving and Loading
  Projects may be stored on the disk in external format.  (Project
  named: 'xxx') exportSegment, or choose 'store project on file...'.
  Projects may be loaded from a server and stored back.  Storing on a
  server never overwrites;  it always makes a new version.  A project
  remembers the url of where it lives in urlList.  The list is length
  one, for now.  The url may point to a local disk instead of a server.
  All projects that the user looks at are cached in the Squeaklet
  folder.  Sorted by server.  The cache holds the most recent version
  only.
 
  When a project is loaded into Squeak, its objects are converted to
  the current version.  There are three levels of conversion.  First,
  each object is converted from raw bits to an object in its old
  format.  Then it is sent some or all of these messages:
  comeFullyUpOnReload: smartRefStream   Used to
  re-discover an object that already exists in this image, such as a
  resource, global variable, Character, or Symbol.  (sent to objects in
  outPointers)
  convertToCurrentVersion: varDict refStream: smartRefStrm
  fill in fields that have been added to a class since
  the object was stored.  Used to set the extra inst var to a default
  value.  Or, return a new object of a different class.  (sent to
  objects that changed instance variables)
  fixUponLoad: aProject refStream: smartRefStrm
  change the object due to conventions that have changed on the
  project level.  (sent to all objects in the incoming project)
 
  Here is the calling sequence for storing out a Project:
  Project saveAs
  Project storeOnServer
  Project storeOnServerWithProgressInfo
  Project storeOnServerInnards
  Project exportSegmentFileName:directory:
  Project exportSegmentWithChangeSet:fileName:directory:
  ImageSegment writeForExportWithSources:inDirectory:changeSet:
 
  !

Item was changed:
  ----- Method: Project class>>tryOtherProjectForRecovery: (in category 'error recovery') -----
  tryOtherProjectForRecovery: errorMessage
  "Try entering the parent project if it uses a different user interface. We determine this by comparing the project's class."
 
  | safeProject nextProject |
  nextProject := Project current.
  safeProject := nil.
+ "Search parent projects for one of a different type"
  [safeProject notNil or: [nextProject isTopProject]] whileFalse: [
  nextProject := nextProject parent.
  (Project current isKindOf: nextProject class)
  ifFalse: [safeProject := nextProject]].
+ "No suitable parent project found, search all projects for any one of different type."
+ safeProject ifNil: [Smalltalk garbageCollect.
+ safeProject := Project allSubInstances
+ detect: [:proj | (proj isKindOf: Project current class) not] ifNone: []].
  safeProject ifNotNil: [:p |
  p enterForEmergencyRecovery.
+ "Active process will usually suspend after this."].
+ !
- "Active process will usually suspend after this."].!

Item was changed:
  ----- Method: Project>>enter:revert:saveForRevert: (in category 'enter') -----
  enter: returningFlag revert: revertFlag saveForRevert: saveForRevert
  "Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case.
  If saveForRevert is true, save the ImageSegment of the project being left.
  If revertFlag is true, make stubs for the world of the project being left.
  If revertWithoutAsking is true in the project being left, then always revert."
 
  | leavingProject forceRevert response seg |
 
  self isIncompletelyLoaded
  ifTrue: [^ self loadFromServer: true].
  self isCurrentProject
  ifTrue: [^ self].
 
+ EmergencyRecoveryRequested := false. "normal project entry clears recursion guard"
  forceRevert := false.
  CurrentProject rawParameters
  ifNil: [revertFlag ifTrue: [^ self inform: 'nothing to revert to' translated]]
  ifNotNil: [saveForRevert ifFalse: [
  forceRevert := CurrentProject projectParameters
  at: #revertWithoutAsking ifAbsent: [false]]].
  forceRevert not & revertFlag ifTrue: [
  response := (UIManager default chooseFrom: {
  'Revert to saved version' translated.
  'Cancel' translated.
  } title: 'Are you sure you want to destroy this Project\ and revert to an older version?\\(From the parent project, click on this project''s thumbnail.)' translated withCRs) = 1.
  response ifFalse: [^ self]].
 
  revertFlag | forceRevert
  ifTrue: [seg := CurrentProject projectParameters at: #revertToMe ifAbsent: [
  ^ self inform: 'nothing to revert to' translated]]
  ifFalse: [
  CurrentProject makeThumbnail.
  returningFlag == #specialReturn
  ifTrue:
  [ProjectHistory forget: CurrentProject. "this guy is irrelevant"
  Project forget: CurrentProject]
  ifFalse:
  [ProjectHistory remember: CurrentProject]].
 
  (revertFlag | saveForRevert | forceRevert) ifFalse: [
  (Preferences valueOfFlag: #projectsSentToDisk)
  ifTrue: [
  self inform: 'Project serialization via image segments\does not work at the moment. Disabling the\preference #projectsSentToDisk now...' withCRs.
  Preferences disable: #projectsSentToDisk.
  "self storeToMakeRoom"]].
 
  "Update display depth for leaving and entring project."
  CurrentProject displayDepth: Display depth.
  displayDepth == nil ifTrue: [displayDepth := Display depth].
  self installNewDisplay: Display extent depth: displayDepth.
 
  returningFlag == #specialReturn ifTrue: [
  CurrentProject removeChangeSetIfPossible. "keep this stuff from accumulating"
  nextProject := nil
  ] ifFalse: [
  returningFlag
  ifTrue: [nextProject := CurrentProject]
  ifFalse: [previousProject := CurrentProject].
  ].
 
  CurrentProject world triggerEvent: #aboutToLeaveWorld.
  CurrentProject abortResourceLoading.
  CurrentProject finalExitActions: self.
  CurrentProject saveState.
 
  "********** SWITCHING CURRENT PROJECT **********"
  leavingProject := CurrentProject.
  CurrentProject := self.
  ProjectHistory remember: self.
  "********** SWITCHING CURRENT PROJECT **********"
 
  self loadState.
  self finalEnterActions: leavingProject.
  self addDeferredUIMessage: [self startResourceLoading].
  self world triggerEvent: #aboutToEnterWorld.
 
  "Save project for revert."
  saveForRevert ifTrue: [
  Smalltalk garbageCollect. "let go of pointers"
  leavingProject storeSegment.
  "result :=" leavingProject world isInMemory
  ifTrue: ['Can''t seem to write the project.']
  ifFalse: [leavingProject projectParameters at: #revertToMe put:
  leavingProject world xxxSegment shallowCopy].
  'Project written.'].
  "original is for coming back in and continuing."
  revertFlag | forceRevert ifTrue: [
  seg shallowCopy revert]. "non-cloned one is for reverting again later"
  self removeParameter: #exportState.
 
  "Now that everything is set up, we can show zoom animation."
  self showZoom
  ifTrue: [self displayZoom: leavingProject parent ~~ self "Entering?"]
  ifFalse: [self restore].
 
  "Update processes at last."
  self scheduleProcessForEnter.
  leavingProject terminateProcessForLeave.
  !

Item was changed:
  ----- Method: Project>>enterForEmergencyRecovery (in category 'enter - recovery') -----
  enterForEmergencyRecovery
  "Stripped down verion of #enter:revert:saveForRevert:. More error handling. Less features."
 
+ | leavingProject process titleForDebuggerWindow |
- | leavingProject process |
  self isCurrentProject ifTrue: [^ self].
+ EmergencyRecoveryRequested == true ifTrue: [^ self].
+ EmergencyRecoveryRequested := true. "set recursion guard"
+
+ titleForDebuggerWindow := 'FATAL PROJECT ERROR: Project was ''', CurrentProject name, ''''.
-
  ProjectHistory remember: CurrentProject.
  nextProject := CurrentProject.
 
  [ CurrentProject world triggerEvent: #aboutToLeaveWorld.
  CurrentProject abortResourceLoading.
  CurrentProject finalExitActions: self.
  CurrentProject saveState ] on: Error do: [:ex | "Ignore." ].
 
  "********** SWITCHING CURRENT PROJECT **********"
  leavingProject := CurrentProject.
  CurrentProject := self.
  ProjectHistory remember: self.
  "********** SWITCHING CURRENT PROJECT **********"
 
  self loadState.
  self finalEnterActions: leavingProject.
  self addDeferredUIMessage: [self startResourceLoading].
  self world triggerEvent: #aboutToEnterWorld.
 
  "Now that everything is set up, we can show zoom animation.
  Do we really need this in case of an emergency?"
  self showZoom
  ifTrue: [self displayZoom: leavingProject parent ~~ self "Entering?"]
  ifFalse: [self restore].
 
  "Update processes at last."
  self scheduleProcessForEnter.
 
  "Do not terminate but suspend the projects ui process to support debugging."
  process := leavingProject uiProcess.
+ self addDeferredUIMessage: [process debugWithTitle: titleForDebuggerWindow].
- self addDeferredUIMessage: [process debugWithTitle: 'FATAL PROJECT ERROR!!'].
  leavingProject suspendProcessForDebug.!