[GOODIE] Re: autoRise (was Re: woohoo! ...)

Robert Withers withers at vnet.net
Mon Jan 31 06:45:19 UTC 2000


Chris, all,

Here's a fix that chris pointed out to me.  (Thanks Chris!).  Everyone
doesn't have print defined on object (which is a great little method -
thanks to whoever posted that!), and there were a few situations where
UndefinedObject was sent a message oooppps!.

How's this?  (I'm embarassed to have left the 'blah2' print.  in there)

My FileList works.  Are you opening your FileList with a special size? 
If so, how can I do that!?!

I fixed the boom!  

cheers,
Rob


"Norton, Chris" wrote:
> 
> Hi Robert.
> 
> Thanks for the goodie.  I ran it on a fairly clean 2.7 and ran into a
> problem filing it in (fix is attached).  I also noticed that the File List
> dialog wasn't rising, so I added your enhancement to
> SystemWindow>>openInWorldExtent:.
> 
> BTW:  I found another bug, but I'm too tired tonight to look into it.  Here
> are the steps to reproduce it:
> 
> 1.  Using the morphic File List, load your change set into a clean image
> (you will need to fix the file in problem before you do this).
> 2.  Load in my change set (this will add support for the File List dialog).
> 3.  Use the global flap tab (left side of your world) to launch the
> preferences dialog.
> 4.  Click on the 'auto raise windows' 'false' (it will turn to 'true')
> 5.  Float your mouse over the File List dialog.
> 
> Ka-boom...  The WindowRaiser class>>installOnMorph: method will fail.  The
> problem seems to be returning self from inside a removeKey:ifAbsent:[]
> block.  Apparently, you can't do this.  I tried removing the code that
> returns self, but, of course, this causes a walk back too (nil doesn't
> understand 'stop').
> 
> Thanks again!
> 
> ---==> Chris
> 
>  <<WindowRaiserFixes.cs>>
> 
>   ------------------------------------------------------------------------
>                            Name: WindowRaiserFixes.cs
>    WindowRaiserFixes.cs    Type: unspecified type (application/octet-stream)
>                        Encoding: quoted-printable

-- 
--------------------------------------------------
Smalltalking by choice.  Isn't it nice to have one!
-------------- next part --------------
'From Squeak2.7 of 5 January 2000 [latest update: #1762] on 31 January 2000 at 1:37:20 am'!
"Change Set:		WindowRaiserTool
Date:			30 January 2000
Author:			Robert Withers

Beta:  Ok folks.  We are into the Preferences now.  On load the WindowRaiser installs a preference which defaults to disabled.  You have to enable it in help...preferences...   Special thanks goes to Stan Heckman, and Torge Husfeldt.

Special Warning: This changeset modifies Morph>>#openInWorld: aWorld, which is a core Morphic method.  It also modifies Preferences class>>noteThatFlag:justChangedTo:"!

Object subclass: #WindowRaiser
	instanceVariableNames: 'view isRaising '
	classVariableNames: 'EventRegister '
	poolDictionaries: ''
	category: 'Morphic-Support'!

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

!Morph methodsFor: 'event handling' stamp: 'rww 1/30/2000 02:18'!
cancelAutoRiseOnMouseEntry
	WindowRaiser deinstallOnMorph: self.
! !


!Preferences class methodsFor: 'preferences dictionary' stamp: 'ccn 1/30/2000 22:08'!
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:
		[World ifNotNil: [World fullRepaintNeeded]].

	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 == #useAnnotationPanes]) ifTrue:
		[Utilities replaceBrowserInToolsFlap].

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

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


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

!SystemWindow methodsFor: 'open/close' stamp: 'ccn 1/30/2000 22:10'!
openInWorldExtent: extent
	"This msg and its callees result in the window being activeOnlyOnTop"

	Smalltalk isMorphic
		ifFalse: [^self openInMVCExtent: extent].
	self autoRiseOnMouseEntry.
	self
		position: (RealEstateAgent initialFrameFor: self) topLeft;
		extent: extent.
	World addMorph: self.
	self activate.
	World startSteppingSubmorphsOf: self.! !


!WindowRaiser commentStamp: '<historical>' prior: 0!
To turn on window raising:
	WindowRaiser startAutoRise.

To turn window raising off again:
	WindowRaiser stopAutoRise.!

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 1/30/2000 02:41'!
isRaising
	"Answer the receiver's instance variable isRaising."

	^isRaising! !

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 1/30/2000 02:41'!
isRaising: aBoolean
	"Set the receiver's instance variable isRaising to aBoolean."

	isRaising := aBoolean! !

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 1/28/2000 01:33'!
view
	"Answer the receiver's instance variable view."

	^view! !

!WindowRaiser methodsFor: 'accessing' stamp: 'rww 1/28/2000 01:33'!
view: anObject
	"Set the receiver's instance variable view to anObject."

	view := anObject! !

!WindowRaiser methodsFor: 'action' stamp: 'rww 1/30/2000 02:39'!
raiseInMilliseconds: millisecondTime

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

!WindowRaiser methodsFor: 'action' stamp: 'rww 1/31/2000 01:35'!
raiseView

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

!WindowRaiser methodsFor: 'action' stamp: 'rww 1/30/2000 02:39'!
stop

	self isRaising: false.! !

!WindowRaiser methodsFor: 'initialize' stamp: 'rww 1/30/2000 02:40'!
initializeOn: aView

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


!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 1/30/2000 02:24'!
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 1/30/2000 02:10'!
eventRegister
	^EventRegister.
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 1/30/2000 10:48'!
initialize
	EventRegister := Dictionary new.
	Preferences disable: #autoRaiseWindows.! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 1/31/2000 01:34'!
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 1/28/2000 01:32'!
newOn: aView

	^super new initializeOn: aView
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 1/30/2000 10:44'!
startAutoRise
	SystemWindow allSubInstancesDo: [:aWindow | aWindow autoRiseOnMouseEntry].
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 1/30/2000 10:44'!
stopAutoRise
	SystemWindow allSubInstancesDo: [:aWindow | aWindow cancelAutoRiseOnMouseEntry].
! !


WindowRaiser initialize!


More information about the Squeak-dev mailing list