The Trunk: System-mt.724.mcz

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

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

Name: System-mt.724
Author: mt
Time: 21 April 2015, 5:02:56.983 pm
UUID: 52871848-7fab-d248-801d-0043ca48c4f7
Ancestors: System-ul.723

Move check for big displays from SystemWindow to RealEstateManager. Some refactorings in RealEstateManager.

=============== Diff against System-ul.723 ===============

Item was removed:
- ----- Method: RealEstateAgent class>>initialFrameFor: (in category 'framing') -----
- initialFrameFor: aView
- "Find a plausible initial screen area for the supplied view.  See called method."
-
- self error: 'please use #initialFrameFor:world:'!

Item was removed:
- ----- Method: RealEstateAgent class>>initialFrameFor:initialExtent: (in category 'framing') -----
- initialFrameFor: aView initialExtent: initialExtent
-
- self error: 'please use #initialFrameFor:initialExtent:world:'!

Item was changed:
  ----- Method: RealEstateAgent class>>initialFrameFor:initialExtent:world: (in category 'framing') -----
  initialFrameFor: aView initialExtent: initialExtent world: aWorld
- "Find a plausible initial screen area for the supplied view, which should be a StandardSystemView, taking into account the 'reverseWindowStagger' Preference, the size needed, and other windows currently on the screen."
 
+ | scaledExtent |
+ scaledExtent := Preferences bigDisplay
+ ifTrue: [(initialExtent * 1.75) rounded]
+ ifFalse: [initialExtent].
- | allOrigins screenRight screenBottom putativeOrigin putativeFrame allowedArea staggerOrigin otherFrames |
 
+ ^ Preferences reverseWindowStagger
+ ifTrue: [self strictlyStaggeredInitialFrameFor: aView initialExtent: scaledExtent world: aWorld]
+ ifFalse: [self normalInitialFrameFor: aView initialExtent: scaledExtent world: aWorld]!
- Preferences reverseWindowStagger ifTrue:
- [^ self strictlyStaggeredInitialFrameFor: aView initialExtent: initialExtent world: aWorld].
-
- allowedArea := self maximumUsableAreaInWorld: aWorld.
- screenRight := allowedArea right.
- screenBottom := allowedArea bottom.
-
- otherFrames := Smalltalk isMorphic
- ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not])
- collect: [:w | w bounds]]
- ifFalse: [ScheduledControllers scheduledWindowControllers
- select: [:aController | aController view ~~ nil]
- thenCollect: [:aController | aController view isCollapsed
- ifTrue: [aController view expandedFrame]
- ifFalse: [aController view displayBox]]].
-
- allOrigins := otherFrames collect: [:f | f origin].
- (self standardPositionsInWorld: aWorld) do:  "First see if one of the standard positions is free"
- [:aPosition | (allOrigins includes: aPosition)
- ifFalse:
- [^ (aPosition extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]].
-
- staggerOrigin := (self standardPositionsInWorld: aWorld) first.  "Fallback: try offsetting from top left"
- putativeOrigin := staggerOrigin.
-
- [putativeOrigin := putativeOrigin + StaggerOffset.
- putativeFrame := putativeOrigin extent: initialExtent.
- (putativeFrame bottom < screenBottom) and:
- [putativeFrame right < screenRight]]
- whileTrue:
- [(allOrigins includes: putativeOrigin)
- ifFalse:
- [^ (putativeOrigin extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]].
- ^ (self scrollBarSetback @ self screenTopSetback extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea!

Item was added:
+ ----- Method: RealEstateAgent class>>normalInitialFrameFor:initialExtent:world: (in category 'framing - private') -----
+ normalInitialFrameFor: aView initialExtent: initialExtent world: aWorld
+ "Find a plausible initial screen area for the supplied view, which should be a StandardSystemView, taking into account the 'reverseWindowStagger' Preference, the size needed, and other windows currently on the screen."
+
+ | allOrigins screenRight screenBottom putativeOrigin putativeFrame allowedArea staggerOrigin otherFrames |
+
+ allowedArea := self maximumUsableAreaInWorld: aWorld.
+ screenRight := allowedArea right.
+ screenBottom := allowedArea bottom.
+
+ otherFrames := Smalltalk isMorphic
+ ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not])
+ collect: [:w | w bounds]]
+ ifFalse: [ScheduledControllers scheduledWindowControllers
+ select: [:aController | aController view ~~ nil]
+ thenCollect: [:aController | aController view isCollapsed
+ ifTrue: [aController view expandedFrame]
+ ifFalse: [aController view displayBox]]].
+
+ allOrigins := otherFrames collect: [:f | f origin].
+ (self standardPositionsInWorld: aWorld) do:  "First see if one of the standard positions is free"
+ [:aPosition | (allOrigins includes: aPosition)
+ ifFalse:
+ [^ (aPosition extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]].
+
+ staggerOrigin := (self standardPositionsInWorld: aWorld) first.  "Fallback: try offsetting from top left"
+ putativeOrigin := staggerOrigin.
+
+ [putativeOrigin := putativeOrigin + StaggerOffset.
+ putativeFrame := putativeOrigin extent: initialExtent.
+ (putativeFrame bottom < screenBottom) and:
+ [putativeFrame right < screenRight]]
+ whileTrue:
+ [(allOrigins includes: putativeOrigin)
+ ifFalse:
+ [^ (putativeOrigin extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]].
+ ^ (self scrollBarSetback @ self screenTopSetback extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea!

Item was removed:
- ----- Method: RealEstateAgent class>>strictlyStaggeredInitialFrameFor:initialExtent: (in category 'framing') -----
- strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent
-
- self error: 'please use #strictlyStaggeredInitialFrameFor:initialExtent:world:'!

Item was changed:
+ ----- Method: RealEstateAgent class>>strictlyStaggeredInitialFrameFor:initialExtent:world: (in category 'framing - private') -----
- ----- Method: RealEstateAgent class>>strictlyStaggeredInitialFrameFor:initialExtent:world: (in category 'framing') -----
  strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorld
  "This method implements a staggered window placement policy that I (di) like.
  Basically it provides for up to 4 windows, staggered from each of the 4 corners.
  The windows are staggered so that there will always be a corner visible."
 
  | allowedArea grid initialFrame otherFrames cornerSel corner delta putativeCorner free maxLevel |
 
  allowedArea :=(self maximumUsableAreaInWorld: aWorld)
  insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0@0).
  "Number to be staggered at each corner (less on small screens)"
  maxLevel := allowedArea area > 300000 ifTrue: [3] ifFalse: [2].
  "Amount by which to stagger (less on small screens)"
  grid := allowedArea area > 500000 ifTrue: [40] ifFalse: [20].
  initialFrame := 0@0 extent: ((initialExtent
  "min: (allowedArea extent - (grid*(maxLevel+1*2) + (grid//2))))
  min: 600@400")).
  otherFrames := Smalltalk isMorphic
  ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not])
  collect: [:w | w bounds]]
  ifFalse: [ScheduledControllers scheduledWindowControllers
  select: [:aController | aController view ~~ nil]
  thenCollect: [:aController | aController view isCollapsed
  ifTrue: [aController view expandedFrame]
  ifFalse: [aController view displayBox]]].
  0 to: maxLevel do:
  [:level |
  1 to: 4 do:
  [:ci | cornerSel := #(topLeft topRight bottomRight bottomLeft) at: ci.
  corner := allowedArea perform: cornerSel.
  "The extra grid//2 in delta helps to keep title tabs distinct"
  delta := (maxLevel-level*grid+(grid//2)) @ (level*grid).
  1 to: ci-1 do: [:i | delta := delta rotateBy: #right centerAt: 0@0]. "slow way"
  putativeCorner := corner + delta.
  free := true.
  otherFrames do:
  [:w |
  free := free & ((w perform: cornerSel) ~= putativeCorner)].
  free ifTrue:
  [^ (initialFrame align: (initialFrame perform: cornerSel)
  with: putativeCorner)
  translatedAndSquishedToBeWithin: allowedArea]]].
  "If all else fails..."
  ^ (self scrollBarSetback @ self screenTopSetback extent: initialFrame extent)
  translatedAndSquishedToBeWithin: allowedArea!