The Trunk: Morphic-mt.1154.mcz

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

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

Name: Morphic-mt.1154
Author: mt
Time: 31 May 2016, 10:41:59.45866 am
UUID: 37fee264-be7d-a442-8ea5-cf72d229cab3
Ancestors: Morphic-ul.1153

Another refactoring of SystemWindow. Improves readability of window properties:

Windows Raise on Any Click
Windows' Contents Are Always Active
Windows' Controls Are Always Active

Thanks to Chris for pointing out several issues.

=============== Diff against Morphic-ul.1153 ===============

Item was added:
+ ----- Method: CornerGripMorph>>mouseDown: (in category 'as yet unclassified') -----
+ mouseDown: anEvent
+ "Disable drop shadow to improve performance."
+
+ super mouseDown: anEvent.
+
+ target ifNil: [^ self].
+ target fastFramingOn ifFalse: [
+ self setProperty: #targetHadDropShadow toValue: target hasDropShadow.
+ target hasDropShadow: false].!

Item was changed:
  ----- Method: CornerGripMorph>>mouseMove: (in category 'as yet unclassified') -----
  mouseMove: anEvent
  | delta |
  target ifNil: [^ self].
  target fastFramingOn
  ifTrue: [delta := target doFastWindowReframe: self ptName]
  ifFalse: [
- target hasDropShadow: false.
  delta := lastMouse ifNil: [0@0] ifNotNil: [anEvent cursorPoint - lastMouse].
  lastMouse := anEvent cursorPoint.
  self apply: delta.
  self bounds: (self bounds origin + delta extent: self bounds extent)].!

Item was changed:
  ----- Method: CornerGripMorph>>mouseUp: (in category 'as yet unclassified') -----
  mouseUp: anEvent
 
  target ifNil: [^ self].
  target fastFramingOn ifFalse: [
+ (self valueOfProperty: #targetHadDropShadow ifAbsent: [false]) ifTrue: [target hasDropShadow: true].
+ self removeProperty: #targetHadDropShadow].!
- target hasDropShadow: Preferences menuAppearance3d].!

Item was changed:
  MorphicModel subclass: #SystemWindow
  instanceVariableNames: 'labelString stripes label closeBox collapseBox paneMorphs paneRects collapsedFrame fullFrame isCollapsed isActive menuBox mustNotClose labelWidgetAllowance updatablePanes allowReframeHandles labelArea expandBox'
+ classVariableNames: 'ClickOnLabelToEdit CloseBoxFrame CloseBoxImageFlat CloseBoxImageGradient CollapseBoxImageFlat CollapseBoxImageGradient DoubleClickOnLabelToExpand ExpandBoxFrame ExpandBoxImageFlat ExpandBoxImageGradient FocusFollowsMouse GradientWindow HideExpandButton MenuBoxFrame MenuBoxImageFlat MenuBoxImageGradient ResizeAlongEdges ReuseWindows TopWindow WindowTitleActiveOnFirstClick WindowsRaiseOnClick'
- classVariableNames: 'ClickOnLabelToEdit CloseBoxFrame CloseBoxImageFlat CloseBoxImageGradient CollapseBoxImageFlat CollapseBoxImageGradient DoubleClickOnLabelToExpand ExpandBoxFrame ExpandBoxImageFlat ExpandBoxImageGradient FocusFollowsMouse GradientWindow HideExpandButton MenuBoxFrame MenuBoxImageFlat MenuBoxImageGradient ResizeAlongEdges ReuseWindows TopWindow WindowsActiveOnlyOnTop'
  poolDictionaries: ''
  category: 'Morphic-Windows'!
 
  !SystemWindow commentStamp: '<historical>' prior: 0!
  SystemWindow is the Morphic equivalent of StandardSystemView -- a labelled container for rectangular views, with iconic facilities for close, collapse/expand, and resizing.
 
  The attribute onlyActiveOnTop, if set to true (and any call to activate will set this), determines that only the top member of a collection of such windows on the screen shall be active.  To be not active means that a mouse click in any region will only result in bringing the window to the top and then making it active.!

Item was added:
+ ----- Method: SystemWindow class>>windowTitleActiveOnFirstClick (in category 'preferences') -----
+ windowTitleActiveOnFirstClick
+ <preference: 'Windows'' Controls Are Always Active'
+ category: 'windows'
+ description: '... except for grips and splitters. Those remain always active and an option to bring the window to the front.'
+ type: #Boolean>
+ ^ WindowTitleActiveOnFirstClick ifNil: [ true ]!

Item was added:
+ ----- Method: SystemWindow class>>windowTitleActiveOnFirstClick: (in category 'preferences') -----
+ windowTitleActiveOnFirstClick: boolean
+ WindowTitleActiveOnFirstClick := boolean.
+ self reconfigureWindowsForFocus.!

Item was removed:
- ----- Method: SystemWindow class>>windowsActiveOnlyOnTop (in category 'preferences') -----
- windowsActiveOnlyOnTop
- <preference: 'Windows Active Only On Top'
- category: 'windows'
- description: 'If true, a click anywhere within a background window will raise it above all other windows to become the active window. If false, all windows remain active and occluded windows will only raise when clicking in the title bar, splitters, or grips.'
- type: #Boolean>
- ^ WindowsActiveOnlyOnTop ifNil: [ true ]!

Item was removed:
- ----- Method: SystemWindow class>>windowsActiveOnlyOnTop: (in category 'preferences') -----
- windowsActiveOnlyOnTop: aBoolean
-
- aBoolean = WindowsActiveOnlyOnTop ifTrue: [^ self].
- WindowsActiveOnlyOnTop := aBoolean.
- self reconfigureWindowsForFocus.!

Item was added:
+ ----- Method: SystemWindow class>>windowsRaiseOnClick (in category 'preferences') -----
+ windowsRaiseOnClick
+ <preference: 'Windows Raise On Any Click'
+ category: 'windows'
+ description: 'If false, windows only raise when clicking on window decorations.'
+ type: #Boolean>
+ ^ WindowsRaiseOnClick ifNil: [ true ]!

Item was added:
+ ----- Method: SystemWindow class>>windowsRaiseOnClick: (in category 'preferences') -----
+ windowsRaiseOnClick: boolean
+ WindowsRaiseOnClick := boolean.!

Item was changed:
  ----- Method: SystemWindow>>activate (in category 'focus') -----
  activate
  "Bring the receiver to the top.  If I am modal, bring along my modal owning window and my model child as well."
 
  self isActive ifTrue: [self lookFocused. ^ self].
  self topRendererOrSelf owner ifNil: [^ self "avoid spurious activate when drop in trash"].
 
  self isActive: true.
 
  "Special handling for expanded windows."
  self isCollapsed ifFalse: [
  model modelWakeUpIn: self.
  self positionSubmorphs].
 
  self submorphsDo: [:each | each unlock].
 
+ self lookFocused.!
- self
- lookFocused;
- updateFocusLookAtHand.!

Item was changed:
  ----- Method: SystemWindow>>beKeyWindow (in category 'top window') -----
  beKeyWindow
  "Let me be the most important window on the screen. I am at the top and I can have a shadow to get more attention by the user. I am the window that is responsible for window keyboard shortcuts."
 
  | oldKeyWindow |
  self isKeyWindow ifTrue: [^ self].
 
  oldKeyWindow := TopWindow.
  TopWindow := self.
 
  PasteUpMorph globalCommandKeysEnabled ifTrue:
  [ self activeHand addKeyboardListener: self ].
 
  self
  unlockWindowDecorations; "here, because all windows might be active anyway"
  activate; "if not already active, activate now"
  comeToFront. "key windows are on top"
 
  "Change appearance to get noticed."
  self hasDropShadow: Preferences menuAppearance3d.
  (self valueOfProperty: #borderWidthWhenActive)
  ifNotNil: [:bw | self acquireBorderWidth: bw].
 
  oldKeyWindow ifNotNil: [:wnd |
  wnd passivateIfNeeded.
 
  self activeHand removeKeyboardListener: oldKeyWindow.
 
  "Change appearance to not look prettier than the new key window."
  wnd hasDropShadow: false.
  (wnd valueOfProperty: #borderWidthWhenInactive)
+ ifNotNil: [:bw | wnd acquireBorderWidth: bw]].
+
+ "Synchronize focus look with position of current hand because any call could have made this window the new key window."
+ self updateFocusLookAtHand.!
- ifNotNil: [:bw | wnd acquireBorderWidth: bw]].!

Item was added:
+ ----- Method: SystemWindow>>handleMouseDown: (in category 'events') -----
+ handleMouseDown: evt
+
+ "If my submorphs handled the events, we still need to use this hook to raise."
+ (self isKeyWindow not
+ and: [self class windowsRaiseOnClick
+ or: [self windowDecorations anySatisfy: [:morph | morph bounds containsPoint: evt position]] ])
+ ifTrue: [self beKeyWindow].
+
+ ^ super handleMouseDown: evt!

Item was changed:
  ----- Method: SystemWindow>>justDroppedInto:event: (in category 'geometry') -----
  justDroppedInto: aMorph event: anEvent
 
+ isCollapsed
+ ifTrue: [self position: ((self position max: 0@0) grid: 8@8).
+ collapsedFrame := self bounds]
+ ifFalse: [fullFrame := self bounds].
+
+ self beKeyWindow.
+ self hasDropShadow: true. "See #startDragFromLabel:."
+
+ aMorph == self world ifTrue: [self assureLabelAreaVisible].
+
  (ToolBuilder openToolsAttachedToMouseCursor and: (self hasProperty: #initialDrop))
  ifTrue: [
  self removeProperty: #initialDrop.
  (self submorphs detect: [:m | m isKindOf: BottomRightGripMorph] ifNone: [])
  ifNotNil: [:grip |
+ grip
+ referencePoint: anEvent position;
+ setProperty: #targetHadDropShadow toValue: true "See MorphicToolBuilder >> #open:".
+ self hasDropShadow: false.
- grip referencePoint: anEvent position.
  anEvent hand newMouseFocus: grip]].
-
- self hasDropShadow: (self isKeyWindow and: [Preferences menuAppearance3d]).
-
- isCollapsed
- ifTrue: [self position: ((self position max: 0@0) grid: 8@8).
- collapsedFrame := self bounds]
- ifFalse: [fullFrame := self bounds.
- self beKeyWindow].
 
- aMorph == self world ifTrue: [self assureLabelAreaVisible].
-
  ^super justDroppedInto: aMorph event: anEvent!

Item was changed:
  ----- Method: SystemWindow>>lockWindowDecorations (in category 'focus') -----
  lockWindowDecorations
  "Lock all window decrations, that is grips, splitters, and title bar."
 
+ self windowDecorations do: [:m | m lock].!
- self submorphsDo: [:m |
- (self paneMorphs includes: m)
- ifFalse: [m lock]].!

Item was added:
+ ----- Method: SystemWindow>>lockWindowTitle (in category 'focus') -----
+ lockWindowTitle
+
+ labelArea ifNotNil: [:m | m lock].!

Item was changed:
  ----- Method: SystemWindow>>lookFocused (in category 'focus') -----
  lookFocused
  label ifNotNil: [ label color: Color black ].
+
+ (self isKeyWindow or: [self class windowTitleActiveOnFirstClick])
-
- (self isKeyWindow or: [model windowActiveOnFirstClick])
  ifTrue: [self undimWindowButtons].
+
-
  self paneColorToUse in: [ : col |
  self
  setStripeColorsFrom: col ;
  adoptPaneColor: col].!

Item was changed:
  ----- Method: SystemWindow>>mouseDown: (in category 'events') -----
  mouseDown: evt
 
- | wasKeyWindow |
- (wasKeyWindow := self isKeyWindow) ifFalse: [
- evt hand releaseKeyboardFocus.
- self beKeyWindow].
-
- "If the window was locked, we did unlock it by now. If the user does not want to invest an additional click to interact with an actual widget, re-process the event."
- (wasKeyWindow not and: [model windowActiveOnFirstClick])
- ifTrue: [
- evt wasHandled: false.
- ^ self processEvent: evt].
-
  evt hand
  waitForClicksOrDrag: self
  event: evt
  selectors: { nil. nil. nil. #startDragFromLabel: }
  threshold: HandMorph dragThreshold.!

Item was changed:
  ----- Method: SystemWindow>>mouseEnter: (in category 'events') -----
  mouseEnter: anEvent
  "Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."
  super mouseEnter: anEvent.
 
+ self isActive ifTrue: [self lookFocused].!
- self isActive
- ifTrue: [self lookFocused]
- ifFalse: [model windowActiveOnFirstClick
- ifTrue: [self undimWindowButtons]].!

Item was changed:
  ----- Method: SystemWindow>>mouseEnterDragging: (in category 'events') -----
  mouseEnterDragging: evt
  "unlock children for drop operations"
 
  self flag: #performance. "mt: There may be no need to change appearance if no widget wants the drop."
+ self isActive ifTrue: [self lookFocused].
- self isActive
- ifTrue: [self lookFocused]
- ifFalse: [model windowActiveOnFirstClick
- ifTrue: [self undimWindowButtons]].
 
  (self isActive not and: [evt hand hasSubmorphs]) ifTrue: [
  self activate. "unlock contents for drop"
  evt hand addMouseListener: self. "for drop completion on submorph"
  ].!

Item was changed:
  ----- Method: SystemWindow>>mouseLeave: (in category 'events') -----
  mouseLeave: anEvent
  "Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."
  super mouseLeave: anEvent.
 
+ model windowActiveOnFirstClick ifTrue: [self lookUnfocused].!
- (self isActive and: [self class windowsActiveOnlyOnTop not])
- ifTrue: [self lookUnfocused]
- ifFalse: [self isKeyWindow
- ifFalse: [self dimWindowButtons]].!

Item was changed:
  ----- Method: SystemWindow>>mouseLeaveDragging: (in category 'events') -----
  mouseLeaveDragging: evt
  "Passivate after drop operations if needed."
 
+ model windowActiveOnFirstClick ifTrue: [self lookUnfocused].
- (self isActive and: [self class windowsActiveOnlyOnTop not])
- ifTrue: [self lookUnfocused]
- ifFalse: [self isKeyWindow
- ifFalse: [self dimWindowButtons]].
 
  (self isKeyWindow not and: [evt hand hasSubmorphs]) ifTrue:[
  self passivateIfNeeded.
  evt hand removeMouseListener: self. "no more drop completion possible on submorph"
  ].!

Item was changed:
  ----- Method: SystemWindow>>passivateIfNeeded (in category 'focus') -----
  passivateIfNeeded
 
+ model windowActiveOnFirstClick
+ ifFalse: [self passivate]
+ ifTrue: [self lookUnfocused].
+
+ self unlockWindowDecorations.
+
+ self class windowTitleActiveOnFirstClick
+ ifFalse: [self lockWindowTitle]
+ ifTrue: [self unlockWindowTitle].!
- self class windowsActiveOnlyOnTop
- ifTrue: [self passivate]
- ifFalse: [self lockWindowDecorations; lookUnfocused].!

Item was changed:
  ----- Method: SystemWindow>>unlockWindowDecorations (in category 'focus') -----
  unlockWindowDecorations
  "Unlock all window decrations, that is grips, splitters, and title bar."
 
+ self windowDecorations do: [:m | m unlock].
- self submorphsDo: [:m |
- (self paneMorphs includes: m)
- ifFalse: [m unlock]].
-
 
+ "Migrate old window instances. Can be removed in the future."
- "Migrate old window instances."
  labelArea ifNotNil: [:m | m submorphsDo: [:sm | sm unlock]].!

Item was added:
+ ----- Method: SystemWindow>>unlockWindowTitle (in category 'focus') -----
+ unlockWindowTitle
+
+ labelArea ifNotNil: [:m | m unlock].!

Item was changed:
  ----- Method: SystemWindow>>updateFocusLookAtHand (in category 'focus') -----
  updateFocusLookAtHand
  "If there is more than one active window, look for the mouse cursor and update the window focus look accordingly. This method is not on the class-side because we need our world and some active hand."
 
+ model windowActiveOnFirstClick ifFalse: [^ self].
- self class windowsActiveOnlyOnTop ifTrue: [^ self].
 
  ((self class windowsIn: self world)
  do: [:window | window lookUnfocused];
  select: [:window | window bounds containsPoint: self activeHand position])
+ ifNotEmpty: [:windowsPointed | windowsPointed first lookFocused "only to foremost window"].!
- ifNotEmpty: [:windowsPointed | windowsPointed first lookFocused "only to foremost window"].
-
- self class keyWindow lookFocused.!

Item was added:
+ ----- Method: SystemWindow>>windowDecorations (in category 'focus') -----
+ windowDecorations
+
+ ^ self submorphs copyWithoutAll: self paneMorphs!

Item was changed:
+ (PackageInfo named: 'Morphic') postscript: 'SystemWindow reconfigureWindowsForFocus.'!
- (PackageInfo named: 'Morphic') postscript: 'MorphicAlarmQueue allInstancesDo: #migrate'!