[squeak-dev] The Trunk: Morphic-cmm.1009.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Oct 5 18:57:41 UTC 2015


Chris Muller uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-cmm.1009.mcz

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

Name: Morphic-cmm.1009
Author: cmm
Time: 5 October 2015, 1:56:52.458 pm
UUID: f0ce65ed-cf24-44b5-9ae5-17c5cb319b9c
Ancestors: Morphic-cmm.1008, Morphic-mt.1007

Merged.

=============== Diff against Morphic-mt.1007 ===============

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: [
+ 			delta := lastMouse ifNil: [0 at 0] ifNotNil: [anEvent cursorPoint - lastMouse].
- 			delta := anEvent cursorPoint - lastMouse.
  			lastMouse := anEvent cursorPoint.
  			self apply: delta.
  			self bounds: (self bounds origin + delta extent: self bounds extent)].!

Item was changed:
  ----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
  handleEvent: anEvent
  	| evt ofs |
  	owner ifNil:[^self].
  	evt := anEvent.
  
  	EventStats ifNil:[EventStats := IdentityDictionary new].
  	EventStats at: #count put: (EventStats at: #count ifAbsent:[0]) + 1.
  	EventStats at: evt type put: (EventStats at: evt type ifAbsent:[0]) + 1.
  
  	evt isMouseOver ifTrue:[^self sendMouseEvent: evt].
  
  ShowEvents == true ifTrue:[
+ 	Display fill: (0 at 0 extent: 300 at 120) rule: Form over fillColor: Color white.
- 	Display fill: (0 at 0 extent: 250 at 120) rule: Form over fillColor: Color white.
  	ofs := (owner hands indexOf: self) - 1 * 60.
+ 	evt isKeyboard
+ 		ifTrue: [ 'key: ', evt printString displayAt: (0 at ofs) + (0 at 30) ]
+ 		ifFalse: [ 'evt: ', evt printString displayAt: (0 at ofs) + (0 at 0) ].
+ 	'kf:  ', self keyboardFocus printString displayAt: (0 at ofs)+(0 at 45).
- 	evt printString displayAt: (0 at ofs) + (evt isKeyboard ifTrue:[0 at 30] ifFalse:[0 at 0]).
- 	self keyboardFocus printString displayAt: (0 at ofs)+(0 at 45).
  ].
  	"Notify listeners"
  	self sendListenEvent: evt to: self eventListeners.
  
  	evt isWindowEvent ifTrue: [
  		self sendEvent: evt focus: nil.
  		^self mouseOverHandler processMouseOver: lastMouseEvent].
  
  	evt isKeyboard ifTrue:[
  		self sendListenEvent: evt to: self keyboardListeners.
  		self sendKeyboardEvent: evt.
  		^self mouseOverHandler processMouseOver: lastMouseEvent].
  
  	evt isDropEvent ifTrue:[
  		self sendEvent: evt focus: nil.
  		^self mouseOverHandler processMouseOver: lastMouseEvent].
  
  	evt isMouse ifTrue:[
  		self sendListenEvent: evt to: self mouseListeners.
  		lastMouseEvent := evt].
  
  	"Check for pending drag or double click operations."
  	mouseClickState ifNotNil:[
  		(mouseClickState handleEvent: evt from: self) ifFalse:[
  			"Possibly dispatched #click: or something and will not re-establish otherwise"
  			^self mouseOverHandler processMouseOver: lastMouseEvent]].
  
  	evt isMove ifTrue:[
  		self position: evt position.
  		self sendMouseEvent: evt.
  	] ifFalse:[
  		"Issue a synthetic move event if we're not at the position of the event"
  		(evt position = self position) ifFalse:[self moveToEvent: evt].
  		"Drop submorphs on button events"
  		(self hasSubmorphs) 
  			ifTrue:[self dropMorphs: evt]
  			ifFalse:[self sendMouseEvent: evt].
  	].
+ 	ShowEvents == true ifTrue:['mf: ', self mouseFocus printString displayAt: (0 at ofs) + (0 at 15)].
- 	ShowEvents == true ifTrue:[self mouseFocus printString displayAt: (0 at ofs) + (0 at 15)].
  	self mouseOverHandler processMouseOver: lastMouseEvent.
  	"self handleDragOutside: anEvent."
  !

Item was added:
+ ----- Method: HandMorph>>windowUnderneath (in category 'accessing') -----
+ windowUnderneath
+ 	ActiveWorld submorphsDo:
+ 		[ : each | (each isSystemWindow and: [ each containsPoint: self position ]) ifTrue: [ ^ each ] ].
+ 	^ nil!

Item was changed:
  ----- Method: Morph>>handleMouseDown: (in category 'events-processing') -----
  handleMouseDown: anEvent
  	"System level event handling."
  	anEvent wasHandled ifTrue:[^self]. "not interested"
  	anEvent hand removePendingBalloonFor: self.
  	anEvent hand removePendingHaloFor: self.
  	anEvent wasHandled: true.
  
  	(anEvent controlKeyPressed
  			and: [anEvent blueButtonChanged not
  				and: [Preferences cmdGesturesEnabled]])
  		ifTrue: [^ self invokeMetaMenu: anEvent].
  
  	"Make me modal during mouse transitions"
  	anEvent hand newMouseFocus: self event: anEvent.
  	anEvent blueButtonChanged ifTrue:[^self blueButtonDown: anEvent].
  	
  	"this mouse down could be the start of a gesture, or the end of a gesture focus"
  	(self isGestureStart: anEvent)
  		ifTrue: [^ self gestureStart: anEvent].
  
+ 	"Filter events sent to the subwidgets of non-MorphicModels in inactive windows, if they are not supposed to receive them due to windowActiveOnFirstClick being set to false.  I don't like having this check for owningWindow here, is there another way?"
+ 	SystemWindow allWindowsAcceptInput 
+ 		ifTrue: 
+ 			[ self owningWindow
+ 				ifNil: [ self mouseDown: anEvent ]
+ 				ifNotNil:
+ 					[ : owningWindow |
+ 					(owningWindow canProcessMouseDown: anEvent)
+ 						ifTrue: [ self mouseDown: anEvent ]
+ 						ifFalse: [ owningWindow activate ] ] ]
+ 		ifFalse: [ self mouseDown: anEvent ].
- 	self mouseDown: anEvent.
  
  	Preferences maintainHalos
  		ifFalse:[ anEvent hand removeHaloFromClick: anEvent on: self ].
  
  	(self handlesMouseStillDown: anEvent) ifTrue:[
  		self startStepping: #handleMouseStillDown: 
  			at: Time millisecondClockValue + self mouseStillDownThreshold
  			arguments: {anEvent copy resetHandlerFields}
  			stepTime: self mouseStillDownStepRate ].
  !

Item was changed:
  ----- Method: Morph>>keyboardFocusChange: (in category 'event handling') -----
+ keyboardFocusChange: aBoolean 
- keyboardFocusChange: aBoolean
  	"The message is sent to a morph when its keyboard focus change. The given argument indicates that the receiver is gaining keyboard focus (versus losing) the keyboard focus. Morphs that accept keystrokes should change their appearance in some way when they are the current keyboard focus."
+ 	self eventHandler ifNotNil:
+ 		[ : h | h
+ 			keyboardFocusChange: aBoolean
+ 			fromMorph: self ].
+ 	"Support for 'Focus Follows Mouse'.  Want the window to maintain focus even after the pointer moves into its title bar."
+ 	self owningWindow ifNotNil: [ : window | window lookFocused: (aBoolean or: [ window containsPoint: ActiveHand position]) ].
+ 	self indicateKeyboardFocus ifTrue: [ self changed ]!
- 
- 	self eventHandler
- 		ifNotNil: [:h | h keyboardFocusChange: aBoolean fromMorph: self].
- 
- 	self indicateKeyboardFocus
- 		ifTrue: [self changed].!

Item was added:
+ ----- Method: Morph>>owningWindow (in category 'private') -----
+ owningWindow
+ 	self withAllOwnersDo: [ : each | each isSystemWindow ifTrue: [ ^ each ] ].
+ 	^ nil!

Item was added:
+ ----- Method: MorphicModel>>handleMouseDown: (in category 'events-processing') -----
+ handleMouseDown: aMouseEvent 
+ 	SystemWindow allWindowsAcceptInput ifTrue:
+ 		[ "This override is needed so that, when 'Window Active On First Click' is false, clicking on a PluggableListMorph of an inactive window will, correctly, NOT update the selection in the list; it will only activate the window."
+ 		aMouseEvent blueButtonChanged ifFalse:
+ 			[ self owningWindow ifNotNil:
+ 				[ : window | (window canProcessMouseDown: aMouseEvent) ifFalse: [ ^ window activate ].
+ 				Model windowActiveOnFirstClick ifTrue: [ window activate ] ] ] ].
+ 	super handleMouseDown: aMouseEvent!

Item was changed:
  ----- Method: PluggableListMorph>>mouseEnter: (in category 'events') -----
+ mouseEnter: event 
- mouseEnter: event
- 	
  	super mouseEnter: event.
+ 	(SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) ifTrue: [ event hand newKeyboardFocus: self ]!
- 	
- 	Preferences mouseOverForKeyboardFocus ifTrue:[
- 		event hand newKeyboardFocus: self. ]!

Item was changed:
  ----- Method: PluggableListMorph>>mouseLeave: (in category 'events') -----
+ mouseLeave: event 
+ 	"The mouse has left the bounds of the receiver"
- mouseLeave: event
- 	"The mouse has left the area of the receiver"
- 
  	super mouseLeave: event.
- 	
  	self hoverRow: nil.
+ 	(SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) ifTrue: [ event hand releaseKeyboardFocus: self ]!
- 	
- 	Preferences mouseOverForKeyboardFocus ifTrue:[
- 		event hand releaseKeyboardFocus: self].!

Item was changed:
  ----- Method: PluggableTextMorph>>mouseEnter: (in category 'event handling') -----
  mouseEnter: event
  	super mouseEnter: event.
  	selectionInterval ifNotNil:
  		[textMorph editor selectInterval: selectionInterval; setEmphasisHere].
  	textMorph selectionChanged.
+ 	(SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) ifTrue:[
- 	Preferences mouseOverForKeyboardFocus ifTrue:[
  		event hand newKeyboardFocus: self]!

Item was changed:
  ----- Method: PluggableTextMorph>>mouseLeave: (in category 'event handling') -----
  mouseLeave: event
+ 	"The mouse has left the bounds of the receiver"
- 	"The mouse has left the area of the receiver"
- 
  	textMorph ifNotNil: [selectionInterval := textMorph editor selectionInterval].
  	super mouseLeave: event.
+ 	(SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) ifTrue:
- 	Preferences mouseOverForKeyboardFocus ifTrue:
  		[event hand releaseKeyboardFocus: self]!

Item was changed:
  ----- Method: ProportionalSplitterMorph>>proposedCorrectionWouldCauseFocusChange: (in category 'layout') -----
  proposedCorrectionWouldCauseFocusChange: correction 
+ 	^ (SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) and:
- 	^ Preferences mouseOverForKeyboardFocus and:
  		[ | edge | splitsTopAndBottom
  			ifTrue:
  				[ edge := correction positive
  					ifTrue: [ self bottom + 3 ]
  					ifFalse: [ self top - 3 ].
  				ActiveHand position y
  					inRangeOf: edge
  					and: edge + correction ]
  			ifFalse:
  				[ edge := correction positive
  					ifTrue: [ self right ]
  					ifFalse: [ self left ].
  				ActiveHand position x
  					inRangeOf: edge
  					and: edge + correction ] ]!

Item was changed:
  ----- Method: ScrollPane>>mouseEnter: (in category 'event handling') -----
  mouseEnter: event
+ 	(SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) ifTrue:[hasFocus := true].
- 	Preferences mouseOverForKeyboardFocus ifTrue:[hasFocus := true].
  	(owner isSystemWindow) ifTrue: [owner paneTransition: event].
  	retractableScrollBar ifTrue:[ self hideOrShowScrollBars ].
  !

Item was changed:
  ----- Method: ScrollPane>>mouseLeave: (in category 'event handling') -----
  mouseLeave: event
+ 	(SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) ifTrue:[hasFocus := false].
- 	Preferences mouseOverForKeyboardFocus ifTrue:[hasFocus := false].
  	retractableScrollBar ifTrue: [self hideScrollBars].
  	(owner isSystemWindow) ifTrue: [owner paneTransition: event]
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>mouseLeave: (in category 'event handling') -----
  mouseLeave: aMouseEvent 
  	super mouseLeave: aMouseEvent.
+ 	(SystemWindow allWindowsAcceptInput or: [ Preferences mouseOverForKeyboardFocus ]) ifTrue: [ aMouseEvent hand releaseKeyboardFocus: self ]!
- 	Preferences mouseOverForKeyboardFocus ifTrue: [ aMouseEvent hand releaseKeyboardFocus: self ]!

Item was changed:
  MorphicModel subclass: #SystemWindow
  	instanceVariableNames: 'labelString stripes label closeBox collapseBox activeOnlyOnTop paneMorphs paneRects collapsedFrame fullFrame isCollapsed 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 WindowsRaiseOnClick'
- 	classVariableNames: 'ClickOnLabelToEdit CloseBoxFrame CloseBoxImageFlat CloseBoxImageGradient CollapseBoxImageFlat CollapseBoxImageGradient DoubleClickOnLabelToExpand ExpandBoxFrame ExpandBoxImageFlat ExpandBoxImageGradient GradientWindow HideExpandButton MenuBoxFrame MenuBoxImageFlat MenuBoxImageGradient ResizeAlongEdges ReuseWindows TopWindow'
  	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>>allWindowsAcceptInput (in category 'private') -----
+ allWindowsAcceptInput
+ 	"With either of these two preferences settings, inactive windows will not have their widgets locked.  All windows accept input as if they were active."
+ 	^ self focusFollowsMouse or: [ self windowsRaiseOnClick not ]!

Item was added:
+ ----- Method: SystemWindow class>>focusFollowsMouse (in category 'preferences') -----
+ focusFollowsMouse
+ 	<preference: 'Focus Follows Mouse'
+ 		category: 'windows'
+ 		description: 'When true, the widget under the hand has keyboard focus.'
+ 		type: #Boolean>
+ 	^ FocusFollowsMouse ifNil: [ false ]!

Item was added:
+ ----- Method: SystemWindow class>>focusFollowsMouse: (in category 'preferences') -----
+ focusFollowsMouse: aBoolean 
+ 	(FocusFollowsMouse := aBoolean) == true.
+ 	self reconfigureWindowsForFocus!

Item was added:
+ ----- Method: SystemWindow class>>reconfigureWindowsForFocus (in category 'private') -----
+ reconfigureWindowsForFocus
+ 	self withAllSubclasses do:
+ 		[ : eachSubclass | eachSubclass allInstances do:
+ 			[ : eachInstance | eachInstance configureFocus ] ]!

Item was added:
+ ----- Method: SystemWindow class>>windowsRaiseOnClick (in category 'preferences') -----
+ windowsRaiseOnClick
+ 	<preference: 'Windows Raise On Click'
+ 		category: 'windows'
+ 		description: 'If true, a click anywhere within a window will raise it above all other windows to become the active window.  If false, it won''t.'
+ 		type: #Boolean>
+ 	^ WindowsRaiseOnClick ifNil: [ true ]!

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

Item was changed:
  ----- Method: SystemWindow>>activate (in category 'top window') -----
  activate
  	"Activate the owner too."
  
  	|mo mc|
  	mo := self modalOwner.
  	mc := self modalChild.
  	mc isNil
  		ifFalse: [mc owner notNil ifTrue: [
  				mc activate.
  				^mc modalChild isNil ifTrue: [mc flash]]].
  	(isCollapsed not and: [ 
  		self paneMorphs size > 1 and: [ 
  			self splitters isEmpty ] ]) ifTrue: [ self addPaneSplitters ].
  	self activateWindow.
  	self rememberedKeyboardFocus
  		ifNil: [(self respondsTo: #navigateFocusForward)
  				ifTrue: [self navigateFocusForward]]
  		ifNotNil: [:m | m world
  						ifNil: [self rememberKeyboardFocus: nil] "deleted"
  						ifNotNil: [:w | 
  							m wantsKeyboardFocus
  								ifTrue: [m takeKeyboardFocus]
  								ifFalse: [(self respondsTo: #navigateFocusForward)
  											ifTrue: [self navigateFocusForward]]]].
+ 	(mo notNil and: [mo isSystemWindow])
- 	(mo notNil and: [mo isKindOf: SystemWindow])
  		ifTrue: [mo bringBehind: self]!

Item was changed:
  ----- Method: SystemWindow>>activateWindow (in category 'top window') -----
  activateWindow
  	"Bring me to the front and make me able to respond to mouse and keyboard.
  	Was #activate (sw 5/18/2001 23:20)"
+ 	| oldTop outerMorph sketchEditor pal windowUnderneath |	
- 
- 	| oldTop outerMorph sketchEditor pal |
- 	self hasDropShadow: Preferences menuAppearance3d.
- 	
  	outerMorph := self topRendererOrSelf.
  	outerMorph owner ifNil: [^ self "avoid spurious activate when drop in trash"].
+ 	self hasDropShadow: Preferences menuAppearance3d.
  	oldTop := TopWindow.
  	oldTop = self ifTrue: [^self].
  	TopWindow := self.
  	oldTop ifNotNil: [oldTop passivate].
  	outerMorph owner firstSubmorph == outerMorph
  		ifFalse: ["Bring me (with any flex) to the top if not already"
  				outerMorph owner addMorphFront: outerMorph].
+ 	self configureFocus.
- 	self submorphsDo: [:m | m unlock].
- 
- 	label ifNotNil: [label color: Color black].
- 
- 	self undimWindowButtons.
- 	labelArea ifNotNil: [labelArea submorphsDo: [:m | m unlock; show]].
- 	self
- 		setStripeColorsFrom: self paneColorToUse;
- 		adoptPaneColor: self paneColorToUse.
- 	
  	self isCollapsed ifFalse:
  		[model modelWakeUpIn: self.
  		self positionSubmorphs.
  		labelArea ifNil: [self adjustBorderUponActivationWhenLabeless]].
- 
  	(sketchEditor := self extantSketchEditor) ifNotNil:
  		[sketchEditor comeToFront.
  		(pal := self world findA: PaintBoxMorph) ifNotNil:
  			[pal comeToFront]].
+ 	self updatePaneColors.
+ 	"Newly spawned windows are normally active, but if focusFollowsMouse is set, then the focused window can only be the one under the hand."
+ 	(self class allWindowsAcceptInput not or: [ (windowUnderneath := ActiveHand windowUnderneath) isNil or: [ windowUnderneath == self ] ])
+ 		ifTrue: [ self lookFocused ]
+ 		ifFalse: [ self lookUnfocused ]!
- 
- 	self updatePaneColors.!

Item was added:
+ ----- Method: SystemWindow>>canProcessMouseDown: (in category 'top window') -----
+ canProcessMouseDown: anEvent
+ 	"In case 'Focus Follows Mouse' is set, then there are two possibilities for mouse input on a background window:  if 'Window Active On First Click' is set, it must be honored and the window must be activated.  If it is not set, then the behavior depends on 'Windows Raise On Click' setting.  If its true, then just activate the window and DON'T process aMouseEvent.  If false, then process the event in any case."
+ 	^ self isActive or: [ Model windowActiveOnFirstClick or: [ SystemWindow windowsRaiseOnClick not ] ]!

Item was added:
+ ----- Method: SystemWindow>>configureFocus (in category 'top window') -----
+ configureFocus
+ 	"Make me unable to respond to mouse and keyboard unless allWindowsAcceptInput is set or 'Window Active On First Click' is unset. Otherwise, the classic Squeak behavior of Control boxes remaining active, except in novice mode."
+ 	self submorphsDo:
+ 		[ : each | each lock:
+ 			(self isActive not and:
+ 				[ each == labelArea
+ 					ifTrue: [ self class windowsRaiseOnClick not ]
+ 					ifFalse: [ self class allWindowsAcceptInput not ] ]) ].
+ 	labelArea
+ 		ifNil: [ "i.e. label area is nil, so we're titleless"
+ 			self adjustBorderUponDeactivationWhenLabeless ]
+ 		ifNotNil:
+ 			[ labelArea submorphsDo:
+ 				[ : each | | classicSqueakBehavior |
+ 				classicSqueakBehavior := self class allWindowsAcceptInput not.
+ 				each lock:
+ 					(classicSqueakBehavior
+ 						ifTrue:
+ 							[ self isActive not and:
+ 								[ Preferences noviceMode or:
+ 									[ each ~~ closeBox and: [ each ~~ collapseBox ] ] ] ]
+ 						ifFalse:
+ 							[ self isActive not and: [ Model windowActiveOnFirstClick not ] ]) ] ]!

Item was changed:
  ----- Method: SystemWindow>>handleListenEvent: (in category 'events') -----
  handleListenEvent: evt
  	"Make sure we lock our contents after DnD has finished"
  	evt isMouse ifFalse:[^self].
  	evt hand hasSubmorphs ifTrue:[^self]. "still dragging"
+ 	(self isActive and: [ self class allWindowsAcceptInput not ]) ifFalse: [self configureFocus].
- 	self == TopWindow ifFalse:[self lockInactivePortions].
  	evt hand removeMouseListener: self.!

Item was added:
+ ----- Method: SystemWindow>>handlesMouseOver: (in category 'events') -----
+ handlesMouseOver: anEvent
+ 	^ true!

Item was removed:
- ----- Method: SystemWindow>>lockInactivePortions (in category 'top window') -----
- lockInactivePortions
- 	"Make me unable to respond to mouse and keyboard.  Control boxes remain active, except in novice mode"
- 
- 	self submorphsDo: [:m | m == labelArea ifFalse: [m lock]].
- 	self dimWindowButtons.
- 	labelArea ifNotNil: 
- 		[labelArea submorphsDo: 
- 				[:m | 
- 					(Preferences noviceMode or: [m ~~ closeBox and: [m ~~ collapseBox]]) 
- 						ifTrue: [m lock]]]
- 		ifNil: "i.e. label area is nil, so we're titleless"
- 			[self adjustBorderUponDeactivationWhenLabeless].!

Item was added:
+ ----- Method: SystemWindow>>lookFocused (in category 'top window') -----
+ lookFocused
+ 	label ifNotNil: [ label color: Color black ].
+ 	(self isActive or: [Model windowActiveOnFirstClick]) ifTrue: [ self undimWindowButtons ].
+ 	self
+ 		 updatePaneColors ;
+ 		 adoptPaneColor: self paneColorToUse!

Item was added:
+ ----- Method: SystemWindow>>lookFocused: (in category 'top window') -----
+ lookFocused: aBoolean 
+ 	aBoolean
+ 		ifTrue: [ self lookFocused ]
+ 		ifFalse: [ self lookUnfocused ]!

Item was added:
+ ----- Method: SystemWindow>>lookUnfocused (in category 'top window') -----
+ lookUnfocused
+ 	label ifNotNil: [ label color: Color darkGray ].
+ 	self dimWindowButtons.
+ 	self paneColorToUseWhenNotActive in:
+ 		[ : col | self
+ 			 setStripeColorsFrom: col ;
+ 			 adoptPaneColor: col ]!

Item was added:
+ ----- 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 class allWindowsAcceptInput ifTrue: [ self lookFocused ]!

Item was added:
+ ----- 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.
+ 	self class allWindowsAcceptInput ifTrue: [ self lookUnfocused ]!

Item was changed:
  ----- Method: SystemWindow>>mouseLeaveDragging: (in category 'events') -----
  mouseLeaveDragging: evt
  	"lock children after drop operations"
+ 	(self isActive and:[evt hand hasSubmorphs and: [self class allWindowsAcceptInput not]]) ifTrue:[
+ 		self configureFocus.
- 	(self ~~ TopWindow and:[evt hand hasSubmorphs]) ifTrue:[
- 		self lockInactivePortions.
  		evt hand removeMouseListener: self.
  	].!

Item was changed:
  ----- Method: SystemWindow>>passivate (in category 'top window') -----
  passivate
+ 	"Lose my drop shadlow and reconfigure my focus according to preferences."
+ 	self
+ 		 hasDropShadow: false ;
+ 		 configureFocus ;
+ 		 lookUnfocused.
+ 	model modelSleep!
- 	"Make me unable to respond to mouse and keyboard"
- 
- 	label ifNotNil: [label color: Color darkGray].
- 
- 	self hasDropShadow: false.
- 	self paneColorToUseWhenNotActive in: [:c |
- 			self
- 				setStripeColorsFrom: c;
- 				adoptPaneColor: c]. 
- 
- 	model modelSleep.
- 
- 	self lockInactivePortions
- !

Item was changed:
  ----- Method: SystemWindowButton>>mouseEnter: (in category 'visual properties') -----
+ mouseEnter: evt 
+ 	| classicSqueakBehavior |
+ 	classicSqueakBehavior := SystemWindow allWindowsAcceptInput not.
+ 	classicSqueakBehavior
+ 		ifTrue: [ self highlight ]
+ 		ifFalse:
+ 			[ self owningWindow ifNotNil:
+ 				[ : window | (window isActive or: [ Model windowActiveOnFirstClick ]) ifTrue: [ self highlight ] ] ]!
- mouseEnter: evt
- 
- 	self highlight.
- !

Item was changed:
  ----- Method: TextMorphForEditView>>mouseUp: (in category 'event handling') -----
  mouseUp: evt
  	super mouseUp: evt.
  	self stopSteppingSelector: #autoScrollView:.
+ 	SystemWindow allWindowsAcceptInput ifFalse: [editView scrollSelectionIntoView: evt].
- 	editView scrollSelectionIntoView: evt.
- 
  	self setCompositionWindow.
  !



More information about the Squeak-dev mailing list