[BROKEN][ENH] Autoraise Windows in Morphic (with attachment ;)

Rob Withers slosher2 at home.com
Tue Jul 18 04:11:25 UTC 2000


Well, I think this is good for 2.9 alpha but it breaks badly in 2.8. 
Any window you try to open will blow up.   Unfortunately, I modified
SystemWindow>>openInWorld: to link in the WindowRaiser.  This is *bad*,
*bad* , *bad* and that is what is breaking.  There was a new call to the
RealEstateAgent that I munged.    Is there any way to link in to a
#windowOpened event, whenever a Window is created so I register my own
event?

Attached is the working version for 2.8 but it is still a hack...

regards,
Rob


Rob Withers wrote:
> 
> Here is a little modification which I made which allows the Morphic
> windows to auto raise, a la XWindows, after 400 milliseconds.  I updated
> it for the new Preferences and separate Worlds.
> 
> It initializes to disabled.  Look under the Windows tab on the
> Preferences Control Panel.
> 
> Enjoy!
> Rob
> 

-- 
--------------------------------------------------
Smalltalking by choice.  Isn't it nice to have one!
-------------- next part --------------
'From Squeak2.8 of 16 July 2000 [latest update: #2348] on 16 July 2000 at 4:52:56 pm'!
Object subclass: #WindowRaiser
	instanceVariableNames: 'view isRaising '
	classVariableNames: 'EventRegister '
	poolDictionaries: ''
	category: 'Morphic-Support'!

!Morph methodsFor: 'event handling' stamp: 'rww 7/14/2000 02:13'!
autoRiseOnMouseEntry
	WindowRaiser installOnMorph: self.
! !

!Morph methodsFor: 'event handling' stamp: 'rww 7/14/2000 02:13'!
cancelAutoRiseOnMouseEntry
	WindowRaiser deinstallOnMorph: self.
! !


!Preferences class methodsFor: 'preferences dictionary' stamp: 'rww 7/15/2000 20:09'!
noteThatFlag: prefSymbol justChangedTo: aBoolean
	"Provides a hook so that a user's toggling of a preference might precipitate some immediate action"
	| keep |
	prefSymbol == #useGlobalFlaps ifTrue:
		[aBoolean
			ifFalse:		"Turning off use of flaps"
				[keep _ self confirm:
'Do you want to preserve the existing
global flaps for future use?'.
				Utilities globalFlapTabsIfAny do:
					[:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: keep.
					aFlapTab isInWorld ifTrue: [self error: 'Flap problem']].
				keep ifFalse: [Utilities clobberFlapTabList]]

			ifTrue:		"Turning on use of flaps"
				[Smalltalk isMorphic ifTrue:
					[self currentWorld addGlobalFlaps]]].

	prefSymbol == #roundedWindowCorners ifTrue: [Display repaintMorphicDisplay].

	prefSymbol == #optionalButtons ifTrue:
		[Utilities replacePartSatisfying: [:el |  (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isKindOf: FileList]]]
inGlobalFlapSatisfying: [:f1 | f1 wording = 'Tools'] with:  FileList openAsMorph applyModelExtent].

	(prefSymbol == #optionalButtons  or: [prefSymbol == #annotationPanes]) ifTrue:
		[Utilities replaceBrowserInToolsFlap].

	(prefSymbol == #smartUpdating) ifTrue:
		[SystemWindow allSubInstancesDo:
			[:aWindow | aWindow amendSteppingStatus]].

	(prefSymbol == #autoRaiseWindows) ifTrue:
		[aBoolean 
			ifTrue: [WindowRaiser startAutoRise]
			ifFalse: [WindowRaiser stopAutoRise]]
! !

!Preferences class methodsFor: 'standard preferences' stamp: 'rww 7/15/2000 20:22'!
autoRaiseWindows
	^ self valueOfFlag: #autoRaiseWindows! !

!Preferences class methodsFor: 'initial values' stamp: 'rww 7/15/2000 20:24'!
initialValuesAdditionAutoRaise
	^ #( (autoRaiseWindows false (windows ) ) )! !


!SystemWindow methodsFor: 'open/close' stamp: 'rww 7/15/2000 20:09'!
openInWorld: aWorld
	"This msg and its callees result in the window being activeOnlyOnTop"
	self bounds: (RealEstateAgent initialFrameFor: self).
	self autoRiseOnMouseEntry.
	aWorld addMorph: self.
	self activate.
	aWorld startSteppingSubmorphsOf: self.
! !

!SystemWindow methodsFor: 'open/close' stamp: 'rww 7/15/2000 20:12'!
openInWorld: aWorld extent: extent
	"This msg and its callees result in the window being activeOnlyOnTop"
	self position: (RealEstateAgent initialFrameFor: self) topLeft; extent: extent.
	self autoRiseOnMouseEntry.
	aWorld addMorph: self.
	self activate.
	aWorld startSteppingSubmorphsOf: self.! !


!WindowRaiser methodsFor: 'initialize' stamp: 'rww 7/14/2000 02:13'!
initializeOn: aView

	self view: aView.
	self isRaising: false.! !

!WindowRaiser methodsFor: 'action' stamp: 'rww 7/14/2000 02:13'!
raiseInMilliseconds: millisecondTime

	self isRaising: true.
	[(Delay forMilliseconds: millisecondTime) wait.
	self isRaising ifTrue: [self raiseView]] fork.! !

!WindowRaiser methodsFor: 'action' stamp: 'rww 7/14/2000 02:13'!
raiseView

	self view ifNotNil: [self view activate].
	! !

!WindowRaiser methodsFor: 'action' stamp: 'rww 7/14/2000 02:13'!
stop

	self isRaising: false.! !

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 7/14/2000 02:13'!
isRaising
	"Answer the receiver's instance variable isRaising."

	^isRaising! !

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 7/14/2000 02:13'!
isRaising: aBoolean
	"Set the receiver's instance variable isRaising to aBoolean."

	isRaising := aBoolean! !

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 7/14/2000 02:13'!
view
	"Answer the receiver's instance variable view."

	^view! !

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 7/14/2000 02:13'!
view: anObject
	"Set the receiver's instance variable view to anObject."

	view := anObject! !


!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 7/14/2000 02:13'!
deinstallOnMorph: aMorph
	|raiser|
	raiser := self eventRegister removeKey: aMorph ifAbsent: [nil].
	raiser ifNotNil: [raiser stop].

	aMorph 
		on: #mouseEnter 
		send: nil 
		to: nil.
	aMorph 
		on: #mouseLeave 
		send: nil 
		to: nil.

! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 7/14/2000 02:13'!
eventRegister
	^EventRegister.
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 7/16/2000 16:44'!
initialize
	EventRegister := Dictionary new.
	Preferences disable: #autoRaiseWindows.
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 7/14/2000 02:13'!
installOnMorph: aMorph
	(Preferences autoRaiseWindows)
		ifTrue: [
			aMorph 
				on: #mouseEnter 
				send: #value 
				to:  [self eventRegister at: aMorph put: ((WindowRaiser newOn: aMorph) raiseInMilliseconds: 400)].
		        aMorph
				on: #mouseLeave 
				send: #value 
				to: [|raiser|
					raiser _ self eventRegister removeKey: aMorph ifAbsent: [nil].
					raiser ifNotNil: [raiser stop]]].! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 7/14/2000 02:13'!
newOn: aView

	^super new initializeOn: aView
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 7/14/2000 02:13'!
startAutoRise
	SystemWindow allSubInstancesDo: [:aWindow | aWindow autoRiseOnMouseEntry].
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 7/14/2000 02:13'!
stopAutoRise
	SystemWindow allSubInstancesDo: [:aWindow | aWindow cancelAutoRiseOnMouseEntry].
! !

WindowRaiser initialize!


More information about the Squeak-dev mailing list