autoRise (was Re: woohoo! It's my first squeak/morphic alpha code!)

Robert Withers withers at vnet.net
Sun Jan 30 08:38:47 UTC 2000


Robert Withers wrote:
> 
> I'm glad you like it.  I can't take any credit for the idea; it comes
> from Linux/XFree86.  Let me say that I think the list is the best place
> for this exchange because someone may take your additions and add their
> own.  I'm not worried about ownership issues; it's all of ours.   So
> it's not less than polite, but rather asynchronous pair programming.
> 
> Your fixes make a lot of sense.  Thanks!  I was wondering how to bring
> this to all Morphic windows, but I'm not familiar enough with the
> Classes yet.  I especially like your #autoRiseOnMouseEntry and your
> placement of the Register dictionary as a class var in WindowRaiser (we
> could call it a Necromancer if you wish! :)  ).  I don't know what I was
> thinking, putting it in the Smalltalk dictionary.  Just hacking, you
> know?
> 
> Could you post your changeset, please?   I want to build on it.   I'd
> like to figure out how to install a start/stop menu item in the World
> popup (or preferences).  I believe this would require removing the event
> registrations from the windows that are active
> (#cancelAutoRiseOnMouseEntry) and setting a class side flag in
> WindowRaiser to not install the events for new windows.  Finally, have
> #autoRiseOnMouseEntry and #cancelAutoRiseOnMouseEntry defer ot class
> methods on the WindowRaiser for installation/deinstallation of the
> events.  I also found that I like a 50 millisecond delay or none at
> all.  It's more immediate.
> 

Here's an update.  I incorporated most of Stan's recommendations and
extended a few others so that you can turn it on and off.  It defaults
to off.  See the class comment of WindowRaiser, which is now in
Morphic-Support, for instructions on turning this on and off.  I changed
the delay, and my previous change to 400 milliseconds.  It isn't as
immediate as I would like but it is more forgiving than 50!

I would love to put this into the Preferences, but, first, I wasn't sure
how, and second, it's prolly best to let it ripen a bit and see if y'all
find it useful.  I sure do!

Enjoy!  (thanks again Stan!)
Rob

> 
> --
> --------------------------------------------------
> Smalltalking by choice.  Isn't it nice to have one!

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

Beta:  This is still a hack to raise the window when the activeHand enters the SystemWindow.  See the class comment of WindowRaiser to find out how to start and stop the Window Raiser.  It defaults to disabled mode.  Special thanks goes to Stan Heckman for his cleanups and suggestions.  He brought this to all SystemWindows.   

Special Warning: This changeset modifies Morph>>#openInWorld: aWorld, which is a core Morphic method."!

Object subclass: #WindowRaiser
	instanceVariableNames: 'view isRaising '
	classVariableNames: 'EventRegister IsActive '
	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.
! !


!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! !


!WindowRaiser commentStamp: 'rww 1/30/2000 03:19' 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/28/2000 01:41'!
raiseView

	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:31'!
IsActive
	^IsActive! !

!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 03:20'!
initialize
	EventRegister := Dictionary new.
	IsActive := false.! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 1/30/2000 03:00'!
installOnMorph: aMorph
	aMorph 
		on: #mouseEnter 
		send: #value 
		to:  [self eventRegister at: aMorph put: ((WindowRaiser newOn: aMorph) raiseInMilliseconds: 400)].
        aMorph
		on: #mouseLeave 
		send: #value 
		to: [(self eventRegister removeKey: aMorph ifAbsent: [^ self]) 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 02:58'!
startAutoRise
	IsActive := true.
	SystemWindow allSubInstancesDo: [:aWindow | aWindow autoRiseOnMouseEntry].
! !

!WindowRaiser class methodsFor: 'as yet unclassified' stamp: 'rww 1/30/2000 02:58'!
stopAutoRise
	IsActive := false.
	SystemWindow allSubInstancesDo: [:aWindow | aWindow cancelAutoRiseOnMouseEntry].
! !


WindowRaiser removeSelector: #timer:!
WindowRaiser removeSelector: #waitFor:!
WindowRaiser removeSelector: #timer!
WindowRaiser initialize!


More information about the Squeak-dev mailing list