"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

Object subclass:#WindowGroup

	 instanceVariableNames:'views topViews myProcess mySensor isModal previousGroup'

	 classVariableNames:'ActiveGroup ScheduledWindowGroups LeaveSignal'

	 poolDictionaries:''

	 category:'Interface-Support'

!

WindowGroup comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

'!

!WindowGroup class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

"

! !

!WindowGroup class methodsFor:'initialization'!

initialize

    LeaveSignal isNil ifTrue:[

	LeaveSignal := (Signal new) mayProceed:true.

	LeaveSignal nameClass:self message:#leaveSignal.

	LeaveSignal notifierString:'unhandled leave signal'.

	"/ ScheduledWindowGroups := IdentitySet new.

    ].

    "WindowGroup initialize"

! !

!WindowGroup class methodsFor:'signal access'!

leaveSignal

    ^ LeaveSignal

! !

!WindowGroup class methodsFor:'instance creation'!

new

    "create and return a new WindowGroup object"

    ^ self basicNew initialize

! !

!WindowGroup class methodsFor:'accessing'!

activeGroup

    "return the currently active windowGroup"

    ^ ActiveGroup

!

scheduledWindowGroups

    ^ ScheduledWindowGroups

! !

!WindowGroup methodsFor:'accessing'!

sensor

    "return the windowGroups sensor"

    ^ mySensor

!

addView:aView

    "add aView to the windowGroup"

    views isNil ifTrue:[

	views := OrderedCollection new.

    ].

    views add:aView

!

addTopView:aView

    "add a topview to the group"

    topViews isNil ifTrue:[

	topViews := OrderedCollection new.

    ].

    topViews add:aView

!

removeView:aView

    "remove aView from the windowGroup;

     if this was the last view in this group, 

     also shut down the corresponding process 

     (actually, only wake it up here - it will terminate itself 

      when finding out that all views are gone)"

    views notNil ifTrue:[

	views remove:aView ifAbsent:[].

	views isEmpty ifTrue:[

	    views := nil

	]

    ].

    topViews notNil ifTrue:[

	topViews remove:aView ifAbsent:[].

	topViews isEmpty ifTrue:[

	    topViews := nil

	]

    ].

    "

     wakeup my process to look if last view has been

     removed (and terminate if so)

    "

    mySensor notNil ifTrue:[mySensor eventSemaphore signal]

!

views

    "return the views accociated to this windowGroup"

    ^ views

!

topViews

    "return the topviews accociated to this windowGroup"

    ^ topViews

!

process 

    "return the windowGroups process"

    ^ myProcess

!

isModal

    ^ isModal

!

previousGroup

    "return the windowgroup that started this group.

     (for modal groups only)"

    ^ previousGroup

!

mainGroup

    "return the main windowgroup (that is the top one,

     which is not modal)"

    |g|

    g := self.

    [g notNil and:[g isModal]] whileTrue:[

	g := g previousGroup

    ].

    ^ g

!

sensor:aSensor

    "set the windowGroups sensor"

    mySensor := aSensor

! !

!WindowGroup methodsFor:'enumeration'!

allViewsDo:aBlock

    "evaluate aBlock for all views & topviews in this group"

    topViews notNil ifTrue:[topViews do:aBlock].

    views notNil ifTrue:[views do:aBlock]

! 

allTopViewsExcept:aView do:aBlock

    "evaluate aBlock for all topviews except aView in this group"

    topViews notNil ifTrue:[

	topViews do:[:v |

	    v ~~ aView ifTrue:[aBlock value:v]

	]

    ].

! !

!WindowGroup methodsFor:'special'!

showCursor:aCursor

    "change the cursor to aCursor in all of my views"

    |c|

    c := aCursor.

    self allViewsDo:[:aView |  

	c := c on:(aView device).

	aView device setCursor:c id in:aView id.

    ].

!

restoreCursors

    "restore the original cursors in all of my views"

    |c|

    self allViewsDo:[:aView |  

	c := aView cursor on:(aView device).

	aView device setCursor:(c id) in:(aView id).

    ].

!

withCursor:aCursor do:aBlock

    "evaluate aBlock while showing aCursor in all

     my views (used to show wait-cursor while doing something)"

    |oldCursors|

    "

     get mapping of view->cursor for all of my subviews

    "

    oldCursors := IdentityDictionary new.

    self allViewsDo:[:aView |

	oldCursors at:aView put:(aView cursor).

	aView cursor:aCursor

    ].

    aBlock valueNowOrOnUnwindDo:[

	"

	 restore cursors

	"

	oldCursors keysAndValuesDo:[:view :cursor |

	    view cursor:cursor

	]

    ]

! !

!WindowGroup methodsFor:'event handling'!

processEvent

    "process a single event from either the damage- or user input queues.

     Debugger abort brings us back here."

    |event|

    self processExposeEvents.

    [mySensor hasEvents] whileTrue:[

	event := mySensor nextEvent.

	(views isNil and:[topViews isNil]) ifFalse:[

	    event sendEvent.

	].

    ]

!

processExposeEvents

    "process all expose events from the damage queue"

    |event view rect oldActive|

    oldActive := ActiveGroup.

    ActiveGroup := self.

    [mySensor notNil and:[mySensor hasDamage]] whileTrue:[

	event := mySensor nextDamage.

	event notNil ifTrue:[

	    (views isNil and:[topViews isNil]) ifFalse:[

		event isDamage ifTrue:[

		    view := event view.

		    rect := event rectangle.

		    view shown ifTrue:[

			view transformation notNil ifTrue:[

			] ifFalse:[

			    view exposeX:(rect left) y:(rect top) width:(rect width) height:(rect height)

			]

		    ]

		] ifFalse:[

		    event sendEvent.

		]

	    ]

	]

    ].

    ActiveGroup := oldActive

!

eventLoop

    "loop executed by windowGroup process;

     wait-for and process events forever"

   self eventLoopWhile:[true]

!

eventLoopWhile:aBlock

    "wait-for and process events while aBlock evaluates to true."

    |abortSignal|

    abortSignal := Object abortSignal.

    "/ ScheduledWindowGroups add:self.

    (SignalSet with:LeaveSignal with:abortSignal)

    handle:[:ex |

	ex return

    ] do:[

	|p g oldActive mainGroup|

	isModal ifTrue:[

	    mainGroup := self mainGroup.

	].

	aBlock whileTrue:[ 

	    (views isNil and:[topViews isNil]) ifTrue:[

		"/ ScheduledWindowGroups remove:self ifAbsent:[].

		myProcess notNil ifTrue:[

		    p := myProcess.

		    myProcess := nil.

		    p terminate.

		    "not reached - there is no life after death"

		 ].

		 "

		  this is the end of a modal loop

		  (not having a private process ...)

		 "

		 ^ self

	    ].

	    abortSignal handle:[:ex |

		ex return

	    ] do:[

		"

		 if modal, break out of the wait after some time

		 to allow servicing update-events of the blocked

		 windowgroup.

		"

		isModal ifTrue:[

		    mySensor eventSemaphore waitWithTimeout:0.2.

		] ifFalse:[

		    Processor activeProcess setStateTo:#eventWait if:#active.

		    mySensor eventSemaphore wait.

		].

		oldActive := ActiveGroup.

		ActiveGroup := self.

		self processEvent

	    ].

	    ActiveGroup := oldActive.

	    oldActive := nil.

	    "

	     if modal, also check for redraw events in my maingroup

	     (we arrive here after every event for myself or after the

	      above timeout)

	    "

	    mainGroup notNil ifTrue:[

		mainGroup processExposeEvents.

	    ]

	]

    ].

    "/ ScheduledWindowGroups remove:self ifAbsent:[].

!

waitForExposeFor:aView

    "wait for a noExpose on aView, then process all exposes.

     To be used after a scroll"

    mySensor waitForExposeFor:aView.

    self processExposeEvents

!

leaveEventLoop

    ^ LeaveSignal raise

! !

!WindowGroup methodsFor:'activation / deactivation'!

restart

    "restart after a snapin."

    topViews notNil ifTrue:[

	"

	 need a new semaphore, since obsolete processes 

	 (from our previous live) may still sit on the current semaphore

	"

	mySensor eventSemaphore:Semaphore new.

	isModal ifFalse:[

	    self startup

	]

    ]

!

startup

    "startup the window-group;

     this creates a new window group process, which

     does the event processing."

    |nm|

    previousGroup := nil.

    myProcess isNil ifTrue:[

	isModal := false.

	"/ ScheduledWindowGroups add:self.

	myProcess := [

	    topViews notNil ifTrue:[

		topViews do:[:aView |

		    aView realize

		].

	    ].

	    self eventLoopWhile:[true]

	] forkAt:Processor userSchedulingPriority.

	(topViews notNil and:[topViews isEmpty not]) ifTrue:[

	    "give the handler process a user friendly name"

	    nm := topViews first name.

	    nm isNil ifTrue:[

		nm := topViews first label.

	    ].

	    myProcess name:(topViews first name)

	] ifFalse:[

	    myProcess name:'window handler'.

	].

	"when the process dies, we have to close-down

	 the views as well

	"

	myProcess exitAction:[self closeDownViews]

    ]

!

startupModal:checkBlock

    "startup the window-group in a modal loop (i.e. under the

     currently running process);

     checkBlock is evaluated and loop is left, when false is

     returned."

    "set previousGroup to the main (non-modal) group"

    previousGroup := WindowGroup activeGroup.

    isModal := true.

    topViews do:[:aView |

	aView realize.

    ].

    [

	self eventLoopWhile:checkBlock.

    ] valueNowOrOnUnwindDo:[

	"

	 cleanup, in case of a terminate

	"

	previousGroup := nil.

	topViews := nil.

	views := nil.

	topViews notNil ifTrue:[

	    topViews do:[:aView |

		aView destroy

	    ].

	].

	views notNil ifTrue:[

	    views do:[:aView |

		aView destroy

	    ]

	].

    ].

!

closeDownViews

    "destroy all views associated to this window group"

    topViews notNil ifTrue:[

	topViews do:[:aTopView | aTopView destroy]