The Trunk: MorphicExtras-mt.277.mcz

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-mt.277.mcz

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

Name: MorphicExtras-mt.277
Author: mt
Time: 11 October 2020, 1:42:03.313652 pm
UUID: e6043696-c235-7545-8b29-fdf608dbed76
Ancestors: MorphicExtras-kfr.276

Refactoring 'Active' variables -- Step 2 of 2. Removes all uses of Active(World|Hand|Event) by replacing those with "self current(World|Hand|Event)" or "Project current world" when required to not add/cement Morphic dependency.

See http://forum.world.st/Changeset-Eliminating-global-state-from-Morphic-td5121690.html

=============== Diff against MorphicExtras-kfr.276 ===============

Item was changed:
  ----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
  openFromFile: fullName
  "Reconstitute a Morph from the selected file, presumed to be represent
  a Morph saved via the SmartRefStream mechanism, and open it in an
  appropriate Morphic world"
 
  | book aFileStream |
  Smalltalk verifyMorphicAvailability ifFalse: [^ self].
 
  aFileStream := FileStream readOnlyFileNamed: fullName.
  book := BookMorph new.
  book setProperty: #url toValue: aFileStream url.
  book fromRemoteStream: aFileStream.
  aFileStream close.
 
  Smalltalk isMorphic
+ ifTrue: [self currentWorld addMorphsAndModel: book]
+ ifFalse: [book isMorph ifFalse: [^self inform: 'Can only load a single morph\into an mvc project via this mechanism.' withCRs translated].
- ifTrue: [ActiveWorld addMorphsAndModel: book]
- ifFalse:
- [book isMorph ifFalse: [^self inform: 'Can only load a single morph
- into an mvc project via this mechanism.' translated].
  book openInWorld].
  book goToPage: 1!

Item was changed:
  ----- Method: BookMorph>>findText:inStrings:startAt:container:pageNum: (in category 'menu') -----
  findText: keys inStrings: rawStrings startAt: startIndex container: oldContainer pageNum: pageNum
  "Call once to search a page of the book.  Return true if found and highlight the text.  oldContainer should be NIL.  
  (oldContainer is only non-nil when (1) doing a 'search again' and (2) the page is in memory and (3) keys has just one element.  oldContainer is a TextMorph.)"
 
  | container wasIn strings old good insideOf place start |
  good := true.
  start := startIndex.
  strings := oldContainer ifNil:
  ["normal case"
 
  rawStrings]
  ifNotNil:
  [(pages at: pageNum) isInMemory
  ifFalse: [rawStrings]
  ifTrue: [(pages at: pageNum) allStringsAfter: oldContainer]].
  keys do:
  [:searchString | | thisWord |
  "each key"
 
  good
  ifTrue:
  [thisWord := false.
  strings do:
  [:longString | | index |
  (index := longString
  findString: searchString
  startingAt: start
  caseSensitive: false) > 0
  ifTrue:
  [thisWord not & (searchString == keys first)
  ifTrue:
  [insideOf := longString.
  place := index].
  thisWord := true].
  start := 1]. "only first key on first container"
  good := thisWord]].
  good
  ifTrue:
  ["all are on this page"
 
  wasIn := (pages at: pageNum) isInMemory.
  self goToPage: pageNum.
  wasIn
  ifFalse:
  ["search again, on the real current text.  Know page is in."
 
  ^self
  findText: keys
  inStrings: ((pages at: pageNum) allStringsAfter: nil)
  startAt: startIndex
  container: oldContainer
  pageNum: pageNum "recompute"]].
  (old := self valueOfProperty: #searchContainer) ifNotNil:
  [(old respondsTo: #editor)
  ifTrue:
  [old editor selectFrom: 1 to: 0. "trying to remove the previous selection!!"
  old changed]].
  good
  ifTrue:
  ["have the exact string object"
 
  (container := oldContainer) ifNil:
  [container := self
  highlightText: keys first
  at: place
  in: insideOf]
  ifNotNil:
  [container userString == insideOf
  ifFalse:
  [container := self
  highlightText: keys first
  at: place
  in: insideOf]
  ifTrue:
  [(container isTextMorph)
  ifTrue:
  [container editor selectFrom: place to: keys first size - 1 + place.
  container changed]]].
  self setProperty: #searchContainer toValue: container.
  self setProperty: #searchOffset toValue: place.
  self setProperty: #searchKey toValue: keys. "override later"
+ self currentHand newKeyboardFocus: container.
- ActiveHand newKeyboardFocus: container.
  ^true].
  ^false!

Item was changed:
  ----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
  goToPageMorph: newPage transitionSpec: transitionSpec
  "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly.  Apply the transitionSpec provided."
 
  | pageIndex aWorld oldPageIndex ascending tSpec readIn |
  pages isEmpty ifTrue: [^self].
  self setProperty: #searchContainer toValue: nil. "forget previous search"
  self setProperty: #searchOffset toValue: nil.
  self setProperty: #searchKey toValue: nil.
  pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
  readIn := newPage isInMemory not.
  oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
  ascending := (oldPageIndex isNil or: [newPage == currentPage])
  ifTrue: [nil]
  ifFalse: [oldPageIndex < pageIndex].
  tSpec := transitionSpec ifNil:
  ["If transition not specified by requestor..."
 
  newPage valueOfProperty: #transitionSpec
  ifAbsent:
  [" ... then consult new page"
 
  self transitionSpecFor: self " ... otherwise this is the default"]].
  self flag: #arNote. "Probably unnecessary"
  (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
  currentPage ifNotNil: [currentPage updateCachedThumbnail].
  self currentPage notNil
  ifTrue:
  [(((pages at: pageIndex) owner isKindOf: TransitionMorph)
  and: [(pages at: pageIndex) isInWorld])
  ifTrue: [^self "In the process of a prior pageTurn"].
  self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: self currentWorld presenter.
- self removeViewersOnSubsIn: ActiveWorld presenter.
  ascending ifNotNil:
  ["Show appropriate page transition and start new page when done"
 
  currentPage stopStepping.
  (pages at: pageIndex) position: currentPage position.
  ^(TransitionMorph
  effect: tSpec second
  direction: tSpec third
  inverse: (ascending or: [transitionSpec notNil]) not)
  showTransitionFrom: currentPage
  to: (pages at: pageIndex)
  in: self
  whenStart: [self playPageFlipSound: tSpec first]
  whenDone:
  [currentPage
  delete;
  fullReleaseCachedState.
  self insertPageMorphInCorrectSpot: (pages at: pageIndex).
  self adjustCurrentPageForFullScreen.
  self snapToEdgeIfAppropriate.
  aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
  self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
  (aWorld := self world) ifNotNil:
  ["WHY??"
 
  aWorld displayWorld].
  readIn
  ifTrue:
  [currentPage updateThumbnailUrlInBook: self url.
  currentPage sqkPage computeThumbnail "just store it"]]].
 
  "No transition, but at least decommission current page"
  currentPage
  delete;
  fullReleaseCachedState].
  self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
  self adjustCurrentPageForFullScreen.
  self snapToEdgeIfAppropriate.
  aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
  self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
  (aWorld := self world) ifNotNil:
  ["WHY??"
  aWorld displayWorld].
  readIn
  ifTrue:
  [currentPage updateThumbnailUrl.
  currentPage sqkPage computeThumbnail "just store it"].
+ self currentWorld presenter flushPlayerListCache.!
- ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!

Item was changed:
  ----- Method: FlapTab>>toggleIsGlobalFlap (in category 'globalness') -----
  toggleIsGlobalFlap
  "Toggle whether the receiver is currently a global flap or not"
 
  | oldWorld |
  self hideFlap.
  oldWorld := self currentWorld.
  self isGlobalFlap
  ifTrue:
  [Flaps removeFromGlobalFlapTabList: self.
  oldWorld addMorphFront: self]
  ifFalse:
  [self delete.
  Flaps addGlobalFlap: self.
  self currentWorld addGlobalFlaps].
+ self currentWorld reformulateUpdatingMenus.!
- ActiveWorld reformulateUpdatingMenus
- !

Item was changed:
  ----- Method: Flaps class>>addLocalFlap (in category 'new flap') -----
  addLocalFlap
- "Menu command -- let the user add a new project-local flap.  Once the new flap is born, the user can tell it to become a shared flap.  Obtain an initial name and edge for the flap, launch the flap, and also launch a menu governing the flap, so that the user can get started right away with customizing it."
 
+ ^ self addLocalFlap: self currentEvent!
- | aMenu reply aFlapTab aWorld edge |
- edge := self askForEdgeOfNewFlap.
-
- edge ifNotNil:
- [reply := UIManager default request: 'Wording for this flap: ' translated initialAnswer: 'Flap' translated.
- reply isEmptyOrNil ifFalse:
- [aFlapTab := self newFlapTitled: reply onEdge: edge.
- (aWorld := self currentWorld) addMorphFront: aFlapTab.
- aFlapTab adaptToWorld: aWorld.
- aMenu := aFlapTab buildHandleMenu: ActiveHand.
- aFlapTab addTitleForHaloMenu: aMenu.
- aFlapTab computeEdgeFraction.
- aMenu popUpEvent: ActiveEvent in: ActiveWorld]]
-
- !

Item was added:
+ ----- Method: Flaps class>>addLocalFlap: (in category 'new flap') -----
+ addLocalFlap: anEvent
+ "Menu command -- let the user add a new project-local flap.  Once the new flap is born, the user can tell it to become a shared flap.  Obtain an initial name and edge for the flap, launch the flap, and also launch a menu governing the flap, so that the user can get started right away with customizing it."
+
+ | title edge |
+ edge := self askForEdgeOfNewFlap.
+ edge ifNil: [^ self].
+
+ title := UIManager default request: 'Wording for this flap:' translated initialAnswer: 'Flap' translated.
+ title isEmptyOrNil ifTrue: [^ self].
+
+ ^ self addLocalFlap: anEvent titled: title onEdge: edge!

Item was added:
+ ----- Method: Flaps class>>addLocalFlap:titled:onEdge: (in category 'new flap') -----
+ addLocalFlap: anEvent titled: title onEdge: edge
+
+ | flapTab menu world |
+ flapTab := self newFlapTitled: title onEdge: edge.
+ (world := anEvent hand world) addMorphFront: flapTab.
+ flapTab adaptToWorld: world.
+ menu := flapTab buildHandleMenu: anEvent hand.
+ flapTab addTitleForHaloMenu: menu.
+ flapTab computeEdgeFraction.
+ menu popUpEvent: anEvent in: world.!

Item was changed:
  ----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
  disableGlobalFlaps: interactive
  "Clobber all the shared flaps structures.  First read the user her Miranda rights."
 
  interactive
  ifTrue: [(self confirm:
  'CAUTION!! This will destroy all the shared
  flaps, so that they will not be present in
  *any* project.  If, later, you want them
  back, you will have to reenable them, from
  this same menu, whereupon the standard
  default set of shared flaps will be created.
  Do you really want to go ahead and clobber
  all shared flaps at this time?' translated) ifFalse: [^ self]].
 
  self globalFlapTabsIfAny do:
  [:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
  aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
  self clobberFlapTabList.
  self initializeFlapsQuads.
  SharedFlapsAllowed := false.
+ Smalltalk isMorphic ifTrue: [
+ Project current world
+ restoreMorphicDisplay;
+ reformulateUpdatingMenus].
+
- Smalltalk isMorphic ifTrue:
- [ActiveWorld restoreMorphicDisplay.
- ActiveWorld reformulateUpdatingMenus].
-
  "The following reduces the risk that flaps will be created with variant IDs
  such as 'Stack Tools2', potentially causing some shared flap logic to fail."
+ "Smalltalk garbageCollect."  "-- see if we are OK without this"!
- "Smalltalk garbageCollect."  "-- see if we are OK without this"
- !

Item was changed:
  ----- Method: Flaps class>>enableClassicNavigatorChanged (in category 'miscellaneous') -----
  enableClassicNavigatorChanged
  "The #classicNavigatorEnabled preference has changed.   No senders in easily traceable in the image, but this is really sent by a Preference object!!"
 
  Preferences classicNavigatorEnabled
  ifTrue:
  [Flaps disableGlobalFlapWithID: 'Navigator' translated.
  Preferences enable: #showProjectNavigator.
  self disableGlobalFlapWithID: 'Navigator' translated.]
  ifFalse:
  [self enableGlobalFlapWithID: 'Navigator' translated.
+ Project current world addGlobalFlaps].
- ActiveWorld addGlobalFlaps].
 
  self doAutomaticLayoutOfFlapsIfAppropriate.
  Project current assureNavigatorPresenceMatchesPreference.
+ Project current world reformulateUpdatingMenus.!
- ActiveWorld reformulateUpdatingMenus!

Item was changed:
  ----- Method: Flaps class>>enableGlobalFlaps (in category 'menu support') -----
  enableGlobalFlaps
  "Start using global flaps, given that they were not present."
 
+ Cursor wait showWhile: [
+ SharedFlapsAllowed := true.
- Cursor wait showWhile:
- [SharedFlapsAllowed := true.
  self globalFlapTabs. "This will create them"
+ Smalltalk isMorphic ifTrue: [
+ Project current world addGlobalFlaps.
- Smalltalk isMorphic ifTrue:
- [ActiveWorld addGlobalFlaps.
  self doAutomaticLayoutOfFlapsIfAppropriate.
+ FlapTab allInstancesDo: [:tab | tab computeEdgeFraction].
+ Project current world reformulateUpdatingMenus]]!
- FlapTab allInstancesDo:
- [:aTab | aTab computeEdgeFraction].
- ActiveWorld reformulateUpdatingMenus]]!

Item was changed:
  ----- Method: Flaps class>>enableOnlyGlobalFlapsWithIDs: (in category 'shared flaps') -----
  enableOnlyGlobalFlapsWithIDs: survivorList
  "In the current project, suppress all global flaps other than those with ids in the survivorList"
 
+ self globalFlapTabsIfAny do: [:flapTab |
+ (survivorList includes: flapTab flapID)
+ ifTrue: [self enableGlobalFlapWithID: flapTab flapID]
+ ifFalse: [self disableGlobalFlapWithID: flapTab flapID]].
+ Project current world addGlobalFlaps
- self globalFlapTabsIfAny do: [:aFlapTab |
- (survivorList includes: aFlapTab flapID)
- ifTrue:
- [self enableGlobalFlapWithID: aFlapTab flapID]
- ifFalse:
- [self disableGlobalFlapWithID: aFlapTab flapID]].
- ActiveWorld addGlobalFlaps
 
  "Flaps enableOnlyGlobalFlapsWithIDs: #('Supplies')"!

Item was changed:
  ----- Method: Flaps class>>makeNavigatorFlapResembleGoldenBar (in category 'miscellaneous') -----
  makeNavigatorFlapResembleGoldenBar
  "At explicit request, make the flap-based navigator resemble the golden bar.  No senders in the image, but sendable from a doit"
 
  "Flaps makeNavigatorFlapResembleGoldenBar"
 
  Preferences setPreference: #classicNavigatorEnabled toValue: false.
  Preferences setPreference: #showProjectNavigator toValue: false.
  (self globalFlapTabWithID: 'Navigator' translated) ifNil:
  [SharedFlapTabs add: self newNavigatorFlap delete].
  self enableGlobalFlapWithID: 'Navigator' translated.
  Preferences setPreference: #navigatorOnLeftEdge toValue: true.
  (self globalFlapTabWithID: 'Navigator' translated) arrangeToPopOutOnMouseOver: true.
+ Project current world addGlobalFlaps.
- ActiveWorld addGlobalFlaps.
  self doAutomaticLayoutOfFlapsIfAppropriate.
+ Project current assureNavigatorPresenceMatchesPreference. !
- Project current assureNavigatorPresenceMatchesPreference.
- !

Item was changed:
  ----- Method: Flaps class>>positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: (in category 'shared flaps') -----
  positionVisibleFlapsRightToLeftOnEdge: edgeSymbol butPlaceAtLeftFlapsWithIDs: idList
  "Lay out flaps along the designated edge right-to-left, while laying left-to-right any flaps found in the exception list
 
  Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapWithIDs: {'Navigator' translated. 'Supplies' translated}
  Flaps sharedFlapsAlongBottom"
 
  | leftX flapList flapsOnRight flapsOnLeft |
  flapList := self globalFlapTabsIfAny select:
  [:aFlapTab | aFlapTab isInWorld and: [aFlapTab edgeToAdhereTo == edgeSymbol]].
  flapsOnLeft := OrderedCollection new.
  flapsOnRight := OrderedCollection new.
 
  flapList do: [:fl |
  (idList includes: fl flapID)
  ifTrue: [ flapsOnLeft addLast: fl ]
  ifFalse: [ flapsOnRight addLast: fl ] ].
 
+ leftX := Project current world width - 15.
- leftX := ActiveWorld width - 15.
 
  flapsOnRight
  sort: [:f1 :f2 | f1 left > f2 left];
  do: [:aFlapTab |
  aFlapTab right: leftX - 3.
  leftX := aFlapTab left].
 
+ leftX := Project current world left.
- leftX := ActiveWorld left.
 
  flapsOnLeft
  sort: [:f1 :f2 | f1 left > f2 left];
  do: [:aFlapTab |
  aFlapTab left: leftX + 3.
  leftX := aFlapTab right].
 
  flapList do:
  [:ft | ft computeEdgeFraction.
  ft flapID = 'Navigator' translated ifTrue:
  [ft referent left: (ft center x - (ft referent width//2) max: 0)]]!

Item was changed:
  ----- Method: Flaps class>>possiblyReplaceEToyFlaps (in category 'construction support') -----
  possiblyReplaceEToyFlaps
  "If in eToyFriendly mode, and if it's ok to reinitialize flaps, replace the existing flaps with up-too-date etoy flaps.  Caution:  this is destructive of existing flaps.  If preserving the contents of existing flaps is important, set the preference 'okToReinitializeFlaps' to true"
 
  PartsBin thumbnailForPartsDescription: StickyPadMorph descriptionForPartsBin.  "Puts StickyPadMorph's custom icon back in the cache which typically will have been called"
  (Preferences eToyFriendly and: [Preferences okToReinitializeFlaps]) ifTrue:
  [Flaps disableGlobalFlaps: false.
  Flaps addAndEnableEToyFlaps.
+ Smalltalk isMorphic ifTrue: [Project current world enableGlobalFlaps]].
- Smalltalk isMorphic ifTrue: [ActiveWorld enableGlobalFlaps]].
  "PartsBin clearThumbnailCache"
 
  "Flaps possiblyReplaceEToyFlaps"!

Item was changed:
  ----- Method: Flaps class>>setUpSuppliesFlapOnly (in category 'menu support') -----
  setUpSuppliesFlapOnly
  "Set up the Supplies flap as the only shared flap.  A special version formulated for this stand-alone use is used, defined in #newLoneSuppliesFlap"
 
  | supplies |
  SharedFlapTabs isEmptyOrNil ifFalse:  "get rid of pre-existing guys if any"
  [SharedFlapTabs do:
  [:t | t referent delete.  t delete]].
 
  SharedFlapsAllowed := true.
  SharedFlapTabs := OrderedCollection new.
  SharedFlapTabs add: (supplies := self newLoneSuppliesFlap).
  self enableGlobalFlapWithID: 'Supplies' translated.
  supplies setToPopOutOnMouseOver: false.
 
+ Smalltalk isMorphic ifTrue: [
+ Project current world
+ addGlobalFlaps;
+ reformulateUpdatingMenus].!
- Smalltalk isMorphic ifTrue:
- [ActiveWorld addGlobalFlaps.
- ActiveWorld reformulateUpdatingMenus]!

Item was changed:
  ----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
  processEvents
  "Play back the next event"
 
  | evt hadMouse hadAny tracker  |
  suspended == true ifTrue: [^ self].
  hadMouse := hadAny := false.
  tracker := recorder objectTrackingEvents.
  [(evt := recorder nextEventToPlay) isNil] whileFalse:
  [
  ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
  tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
  evt type == #EOF
  ifTrue:
+ [recorder pauseIn: self currentWorld.
- [recorder pauseIn: ActiveWorld.
  ^ self].
  evt type == #startSound
  ifTrue:
  [recorder perhapsPlaySound: evt argument.
  recorder synchronize.
  ^ self].
  evt type == #startEventPlayback
  ifTrue:
  [evt argument launchPlayback.
  recorder synchronize.
  ^ self].
 
  evt type == #noteTheatreBounds
  ifTrue:
  ["The argument holds the content rect --for now we don't make any use of that info in this form."
  ^ self].
 
  evt isMouse ifTrue: [hadMouse := true].
  (evt isMouse or: [evt isKeyboard])
  ifTrue:
  [self handleEvent: (evt setHand: self) resetHandlerFields.
  hadAny := true]].
  (mouseClickState notNil and: [hadMouse not])
  ifTrue:
  ["No mouse events during this cycle. Make sure click states time out accordingly"
 
  mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
  hadAny
  ifFalse:
  ["No pending events. Make sure z-order is up to date"
 
  self mouseOverHandler processMouseOver: lastMouseEvent]!

Item was changed:
  ----- Method: InternalThreadNavigationMorph class>>openThreadNamed:atIndex:beKeyboardHandler: (in category 'known threads') -----
  openThreadNamed: nameOfThread atIndex: anInteger beKeyboardHandler: aBoolean
  "Activate the thread of the given name, from the given index; set it up to be navigated via desktop keys if indicated"
 
  | coll nav |
 
  coll := self knownThreads at: nameOfThread ifAbsent: [^self].
  nav := Project current world
  submorphThat: [ :each | (each isKindOf: self) and: [each threadName = nameOfThread]]
  ifNone:
  [nav := self basicNew.
  nav
  listOfPages: coll;
  threadName: nameOfThread index: anInteger;
  initialize;
  openInWorld;
  positionAppropriately.
+ aBoolean ifTrue: [Project current world keyboardNavigationHandler: nav].
- aBoolean ifTrue: [ActiveWorld keyboardNavigationHandler: nav].
  ^ self].
  nav
  listOfPages: coll;
  threadName: nameOfThread index: anInteger;
  removeAllMorphs;
  addButtons.
+ aBoolean ifTrue: [Project current world keyboardNavigationHandler: nav].!
- aBoolean ifTrue: [ActiveWorld keyboardNavigationHandler: nav]
-
- !

Item was changed:
  ----- Method: InternalThreadNavigationMorph>>destroyThread (in category 'navigation') -----
  destroyThread
  "Manually destroy the thread"
 
  (self confirm: ('Destroy thread <{1}> ?' translated format:{threadName})) ifFalse: [^ self].
  self class knownThreads removeKey: threadName ifAbsent: [].
  self setProperty: #moribund toValue: true.  "In case pointed to in some other project"
+ self currentWorld keyboardNavigationHandler == self ifTrue:
- ActiveWorld keyboardNavigationHandler == self ifTrue:
  [self stopKeyboardNavigation].
+ self delete.!
- self delete!

Item was changed:
  ----- Method: InternalThreadNavigationMorph>>loadPageWithProgress (in category 'private') -----
  loadPageWithProgress
  "Load the desired page, showing a progress indicator as we go"
 
  | projectInfo projectName beSpaceHandler |
  projectInfo := listOfPages at: currentIndex.
  projectName := projectInfo first.
  loadedProject := Project named: projectName.
  self class know: listOfPages as: threadName.
+ beSpaceHandler := (Project current world keyboardNavigationHandler == self).
+ self currentWorld addDeferredUIMessage:
- beSpaceHandler := (ActiveWorld keyboardNavigationHandler == self).
- WorldState addDeferredUIMessage:
  [InternalThreadNavigationMorph openThreadNamed: threadName atIndex: currentIndex beKeyboardHandler: beSpaceHandler].
 
  loadedProject ifNil: [
  ComplexProgressIndicator new
  targetMorph: self;
  historyCategory: 'project loading' translated;
  withProgressDo: [
  [
  loadedProject := Project current
  fromMyServerLoad: projectName
  ]
  on: ProjectViewOpenNotification
  do: [ :ex | ex resume: false]
  "we probably don't want a project view morph in this case"
  ].
  ].
  loadedProject ifNil: [
  ^self inform: 'I cannot find that project' translated
  ].
  self delete.
 
+ loadedProject enter.!
- loadedProject enter.
- !

Item was changed:
  ----- Method: InternalThreadNavigationMorph>>moreCommands (in category 'navigation') -----
  moreCommands
  "Put up a menu of options"
 
  | allThreads aMenu others target |
  allThreads := self class knownThreads.
  aMenu := MenuMorph new defaultTarget: self.
  aMenu addTitle: 'navigation' translated.
 
  Preferences noviceMode ifFalse:[
  self flag: #deferred.  "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled"
  aMenu addStayUpItem
  ].
 
  others := (allThreads keys reject: [ :each | each = threadName]) asArray sort.
  others do: [ :each |
  aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each
  ].
 
  aMenu addList: {
  {'switch to recent projects' translated.  #getRecentThread}.
  #-.
  {'create a new thread' translated.  #threadOfNoProjects}.
  {'edit this thread' translated.  #editThisThread}.
  {'create thread of all projects' translated.  #threadOfAllProjects}.
  #-.
  {'First project in thread' translated.  #firstPage}.
  {'Last project in thread' translated.  #lastPage}
  }.
 
  (target := self currentIndex + 2) > listOfPages size ifFalse: [
  aMenu
  add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first})
  action: #skipOverNext
  ].
 
  aMenu addList: {
  {'jump within this thread' translated.  #jumpWithinThread}.
  {'insert new project' translated.  #insertNewProject}.
  #-.
  {'simply close this navigator' translated.  #delete}.
  {'destroy this thread' translated. #destroyThread}.
  #-
  }.
 
+ (self currentWorld keyboardNavigationHandler == self) ifFalse:[
- (ActiveWorld keyboardNavigationHandler == self) ifFalse:[
  aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation
  ]
  ifTrue: [
  aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation
  ].
 
+ aMenu popUpInWorld.!
- aMenu popUpInWorld.
- !

Item was changed:
  ----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
  positionAppropriately
 
+ | others world otherRects overlaps bottomRight |
- | others otherRects overlaps bottomRight |
  (self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others := (world := Project currentWorld) submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- others := ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
  otherRects := others collect: [ :each | each bounds].
+ bottomRight := (world hasProperty: #threadNavigatorPosition)
+ ifTrue: [world valueOfProperty: #threadNavigatorPosition]
+ ifFalse: [world bottomRight].
- bottomRight := (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
- ActiveWorld valueOfProperty: #threadNavigatorPosition.
- ] ifFalse: [
- ActiveWorld bottomRight.
- ].
  self align: self fullBounds bottomRight with: bottomRight.
  self setProperty: #previousWorldBounds toValue: self world bounds.
 
  [
  overlaps := false.
  otherRects do: [ :r |
  (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
  ].
  self top < self world top ifTrue: [
  self bottom: bottomRight y.
  self right: self left - 1.
  ].
  overlaps
  ] whileTrue.!

Item was changed:
  ----- Method: InternalThreadNavigationMorph>>startKeyboardNavigation (in category 'navigation') -----
  startKeyboardNavigation
  "Tell the active world to starting navigating via desktop keyboard navigation via me"
 
+ self currentWorld keyboardNavigationHandler: self!
- ActiveWorld keyboardNavigationHandler: self!

Item was changed:
  ----- Method: InternalThreadNavigationMorph>>stopKeyboardNavigation (in category 'navigation') -----
  stopKeyboardNavigation
  "Cease navigating via the receiver in response to desktop keystrokes"
 
+ self currentWorld removeProperty: #keyboardNavigationHandler!
- ActiveWorld removeProperty: #keyboardNavigationHandler!

Item was changed:
  ----- Method: ObjectsTool>>showSearchPane (in category 'search') -----
  showSearchPane
  "Set the receiver up so that it shows the search pane"
 
  | tabsPane aPane |
  modeSymbol == #search ifTrue: [ ^self ].
 
  self partsBin removeAllMorphs.
 
  tabsPane := self tabsPane.
  aPane := self newSearchPane.
  self replaceSubmorph: tabsPane by: aPane.
 
  self modeSymbol: #search.
  self showMorphsMatchingSearchString.
+ self currentHand newKeyboardFocus: aPane!
- ActiveHand newKeyboardFocus: aPane!

Item was changed:
  ----- Method: ProjectNavigationMorph>>undoButtonWording (in category 'stepping and presenter') -----
  undoButtonWording
  "Answer the wording for the Undo button."
 
  | wdng |
+ wdng := Project current world commandHistory undoOrRedoMenuWording.
+ (wdng endsWith: ' (z)') ifTrue: [
+ wdng := wdng copyFrom: 1to: wdng size - 4].
- wdng := ActiveWorld commandHistory undoOrRedoMenuWording.
- (wdng endsWith: ' (z)') ifTrue:
- [wdng := wdng copyFrom: 1to: wdng size - 4].
  ^ wdng!

Item was changed:
  ----- Method: ProjectNavigationMorph>>undoOrRedoLastCommand (in category 'the actions') -----
  undoOrRedoLastCommand
  "Undo or redo the last command, as approrpiate."
 
+ ^ Project current world commandHistory undoOrRedoCommand!
- ActiveWorld commandHistory undoOrRedoCommand!

Item was changed:
  ----- Method: SketchEditorMorph>>cancelOutOfPainting (in category 'start & finish') -----
  cancelOutOfPainting
  "The user requested to back out of a painting session without saving"
 
  self deleteSelfAndSubordinates.
  emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!"
  hostView ifNotNil: [hostView changed].
+ Project current world resumeScriptsPausedByPainting.
- ActiveWorld resumeScriptsPausedByPainting.
  ^ nil!

Item was changed:
  ----- Method: SketchEditorMorph>>deliverPainting:evt: (in category 'start & finish') -----
  deliverPainting: result evt: evt
  "Done painting.  May come from resume, or from original call.  Execute user's post painting instructions in the block.  Always use this standard one.  4/21/97 tk"
 
  | newBox newForm ans |
  palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes"
  "rot := palette getRotations." "rotate with heading, or turn to and fro"
  "palette setRotation: #normal."
  result == #cancel ifTrue: [
  ans := UIManager default chooseFrom: {
  'throw it away' translated.
  'keep painting it' translated.
  } title: 'Do you really want to throw away
  what you just painted?' translated.
  ^ ans = 1 ifTrue: [self cancelOutOfPainting]
  ifFalse: [nil]]. "cancelled out of cancelling."
 
  "hostView rotationStyle: rot." "rotate with heading, or turn to and fro"
  newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent.
  registrationPoint ifNotNil:
  [registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin"
  newForm := Form extent: newBox extent depth: paintingForm depth.
  newForm copyBits: newBox from: paintingForm at: 0@0
  clippingBox: newForm boundingBox rule: Form over fillColor: nil.
  newForm isAllWhite ifTrue: [
  (self valueOfProperty: #background) == true
  ifFalse: [^ self cancelOutOfPainting]].
 
  newForm fixAlpha. "so alpha channel stays intact for 32bpp"
 
  self delete. "so won't find me again"
  dimForm ifNotNil: [dimForm delete].
  newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).
+ Project current world resumeScriptsPausedByPainting.!
- ActiveWorld resumeScriptsPausedByPainting
-
- !

Item was removed:
- ----- Method: WorldState>>activeHand: (in category '*MorphicExtras-hands') -----
- activeHand: aHandMorph
- "still needed until event loop with old code goes away"
- ActiveHand := aHandMorph.!

Item was changed:
  ----- Method: WorldState>>doOneCycleInBackground (in category '*MorphicExtras-update cycle') -----
  doOneCycleInBackground
  "Do one cycle of the interactive loop. This method is called repeatedly when this world is not the active window but is running in the background."
 
+ self halt. "not ready for prime time"
+
- self halt. "not ready for prime time"
-
  "process user input events, but only for remote hands"
+ self handsDo: [:hand |
+ (hand isKindOf: RemoteHandMorph) ifTrue: [
+ hand becomeActiveDuring: [
+ hand processEvents]]].
+
- self handsDo: [:h |
- (h isKindOf: RemoteHandMorph) ifTrue: [
- ActiveHand := h.
- h processEvents.
- ActiveHand := nil]].
-
  self runStepMethods.
+ self displayWorldSafely.!
- self displayWorldSafely.
- !

Item was changed:
  ----- Method: ZASMCameraMarkMorph>>setTransition (in category 'menu') -----
  setTransition
  "Set the transition"
 
+ ^ self setTransition: self currentEvent!
- ^ self setTransition: ActiveEvent!