"
 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 
				focusView focusSequence preEventHook postEventHook'
	 classVariableNames:'ActiveGroup ScheduledWindowGroups LeaveSignal'
	 poolDictionaries:''
	 category:'Interface-Support'
!

WindowGroup comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.32 1995-08-24 20:39:10 claus Exp $
'!

!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
"
$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.32 1995-08-24 20:39:10 claus Exp $
"
!

documentation
"
    In Smalltalk/X, the known (ST-80) concept of a controller has been
    extended to a WindowGroup which handles process related stuff, and
    the Controller, which handles events only and defines the user interaction.
    There is no polling in controllers (not even conceptionally).

    WindowGroups are responsible to wait for and forward events for a group of 
    windows. All views in a group share a single windowSensor which holdes the
    event queue (therefore views all share the same input event queue).

    Except for modal boxes, a separate process is created for each windowGroup 
    which waits for events and processes them, by sending corresponding
    event messages to the views controller or the view (*). 
    Therefore, multiple applications run in parallel.
    Modal boxes create an extra window group for the components of the modal
    box, but execute the event-processing loop in the original process - 
    therefore, the original windowgroup is blocked for the duration of the modal 
    interaction (**).

    Normally, one windowgroup is associated to each topview (StandardSystemView)
    and all of its subviews. However, this is not strictly required; 
    it is possible to create extra windowgroups for subviews, which will let them
    run in parallel 
	(for example, the FileBrowsers kill Button is created that 
	 way, to allow a kill of an executing unix command, while the browser 
	 itself reads the pipeStream for incoming text).

    On the other hand, multiple topviews can be placed into the same windowGroup;
    which allows for multiview applications, of which only one communicates with
    the user at a time.

    Although currently not implemented, it is planned for a future version,
    to also handle all topviews of a windowgroup as a unit with respect to
    iconification and deiconification: if any of a windowgroups topviews gets
    iconified, all others will be as well.

    WindowGroups also support a focus window: this is the one that gets the
    keyboard input - even if the cursor is located in another subview.
    (this is a brand new feature and not yet released for public use)

    Finally, windowgroups are the perfect place for things like defining a
    cursor for all associated views, flushing all input, waiting for expose
    events etc.

    You dont have to care for details in the normal case, a windowgroup is
    created for you automatically, when a view is opened.

    instance variables:

	views                   collection of views of this group

	topViews                collection of topviews of this group

	myProcess               the process executing the events

	mySensor                my input sensor

	isModal                 true if this is for a modal box

	previousGroup           if modal, the group that started this one

	focusView               the one that has the focus (or nil)

	focusSequence           defines the focus sequence


    clas variables:
	LeaveSignal             if raised, a modal box leaves (closes)

	ActiveGroup             the currently active windowGroup

	ScheduledWindowGroups   -- not currently implemented / used --


    (*) 
	due to historic reasons, many views have the controller functionality
	integrated, and handle events themself. The windowSensor takes care
	of this, by checking if a view has a controller, and, if so, forwarding 
	the events to it. Otherwise, events are sent directly to the view.

	In the future, all views will be rewritten to actually use a controller.
	Currently (being in the middle of this migration), only some views
	(buttons, toggles and subclasses) do so.

    (**)
	the modal-event loop peeks into the original groups damage queue
	in regular time intervals - therefore, view updating is still done in
	the blocked group.

    For more information, read 'introduction to view programming' in the
    doc/online directory.
"
! !

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

leaveSignal
    "return the signal which is used to exit a modal loop.
     This private signal, is always cought while a modalbox is active.
     Raising it will exit the modal loop and return from the views #openModal
     method."

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

setActiveGroup:aGroup
    "set the currently active windowGroup.
     Temporary; do not use this interface, it will vanish."

    ActiveGroup := aGroup
!

scheduledWindowGroups
    "this is not yet implemented"

    ^ 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
    "return true, if I am in a modal mode"

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

preEventHook:anObject 
    "set the preEventHook - this one will get all events
     passed before being processed here (via #processEvent:).
     If this returns true, the event is supposed to be already
     processed and ignored here.
     Otherwise, it is processed as usual."

    preEventHook := anObject
!

postEventHook:anObject 
    "set the postEventHook - this one will get all events
     passed after being processed here (via #processEvent:)."

    postEventHook := anObject
! !

!WindowGroup methodsFor:'enumerating'!

allViewsDo:aBlock
    "evaluate aBlock for all views & topviews in this group.
     This works on a copy of the view collection, to allow for
     destroy and other collection changing operations to be done."

    topViews notNil ifTrue:[topViews copy do:aBlock].
    views notNil ifTrue:[views copy do:aBlock]
! 

allTopViewsExcept:aView do:aBlock
    "evaluate aBlock for all topviews except aView in this group.
     This works on a copy of the view collection, to allow for
     destroy and other collection changing operations to be done."

    topViews notNil ifTrue:[
	topViews copy do:[:v |
	    v ~~ aView ifTrue:[aBlock value:v]
	]
    ].
!

slavesDo:aBlock
    "evaluate aBlock for all slaveViews.
     This works on a copy of the view collection, to allow for
     destroy and other collection changing operations to be done."

    topViews notNil ifTrue:[
	topViews copy do:[:v |
	    v notNil ifTrue:[
		v type == #slave ifTrue:[aBlock value:v].
	    ]
	]
    ].
!

partnersDo:aBlock
    "evaluate aBlock for all partnerViews.
     This works on a copy of the view collection, to allow for
     destroy and other collection changing operations to be done."

    topViews notNil ifTrue:[
	topViews copy do:[:v |
	    v notNil ifTrue:[
		v type == #partner 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).
     Return the result as returned by aBlock."

    |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 from the mapping
	"
	oldCursors keysAndValuesDo:[:view :cursor |
	    view cursor:cursor
	]
    ]
! !

!WindowGroup methodsFor:'event handling'!

processEvents
    "process events from either the damage- or user input queues.
     Abort is assumed to be handled elsewhere."

    |event ignore|

    self processExposeEvents.
    [mySensor hasEvents] whileTrue:[
	event := mySensor nextEvent.
	event notNil ifTrue:[
	    (views notNil or:[topViews notNil]) ifTrue:[
		ignore := false.

		(preEventHook  notNil 
		and:[preEventHook processEvent:event]) ifTrue:[
		    ignore := true.
		].
		ignore ifFalse:[
		    "/
		    "/ FocusStepping is done right here
		    "/
		    event isKeyPressEvent ifTrue:[
			event key == #FocusNext ifTrue:[
			    self focusNext.
			    ignore := true
			].
			event key == #FocusPrevious ifTrue:[
			    self focusPrevious.
			    ignore := true
			].
		    ].
		    ignore ifFalse:[
			"/
			"/  button events turn off explicit focus, and revert
			"/  to implicit focus control
			"/
			(focusView notNil
			and:[event isButtonEvent]) ifTrue:[
			    self focusView:nil
			].
			"/
			"/ let the event forward itself
			"/
			ActiveGroup := self.
			event sendEventWithFocusOn:focusView.
		    ]
		].
		postEventHook notNil ifTrue:[
		    postEventHook processEvent:event
		]
	    ]
	].
    ]
!

processExposeEvents
    "process only expose events from the damage queue"

    |event view rect oldActive x y w h sensor|

    (sensor := mySensor) isNil ifTrue:[^ self].

    oldActive := ActiveGroup.
    [
	[sensor hasDamage] whileTrue:[
	    ActiveGroup := self.
	    event := sensor nextDamage.
	    event notNil ifTrue:[
		(views notNil or:[topViews notNil]) ifTrue:[
		    (preEventHook notNil 
		    and:[preEventHook processEvent:event]) ifFalse:[
			event isDamage ifTrue:[
			    view := event view.
			    "/
			    "/ if the view is no longer shown (iconified or closed),
			    "/ this is a leftover event and ignored.
			    "/
			    view shown ifTrue:[
				rect := event rectangle.
				x := rect left.
				y := rect top.
				w := rect width.
				h := rect height.
				ActiveGroup := self.
				view transformation notNil ifTrue:[
				    view deviceExposeX:x y:y width:w height:h
				] ifFalse:[
				    view exposeX:x y:y width:w height:h
				]
			    ]
			] ifFalse:[
			    "
			     mhmh - could we possibly arrive here ?
			    "
			    ActiveGroup := self.
			    event sendEvent.
			]
		    ].
		    postEventHook notNil ifTrue:[
			postEventHook processEvent:event
		    ]
		]
	    ]
	]
    ] valueNowOrOnUnwindDo:[
	ActiveGroup := oldActive.
	oldActive := nil
    ]
!

eventLoop
    "loop executed by windowGroup process;
     wait-for and process events forever"

   self eventLoopWhile:[true] onLeave:[]
!

eventLoopWhile:aBlock onLeave:cleanupActions
    "wait-for and process events. 
     Stay in this loop while there are still any views to dispatch for,
     and aBlock evaluates to true."

    |oldActive|

    oldActive := ActiveGroup.
    [
"/     ScheduledWindowGroups add:self.

	"/
	"/ on leave, exit the event loop
	"/
	LeaveSignal handle:[:ex |
	    ex return
	] do:[
	    |p g mainGroup thisProcess|

	    isModal ifTrue:[
		mainGroup := self mainGroup.
	    ].

	    thisProcess := Processor activeProcess.

	    aBlock whileTrue:[ 
		ActiveGroup := self.
		(views isNil and:[topViews isNil]) ifTrue:[
		    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
		].

		"/
		"/ on abort, stay in the event loop
		"/
		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.
		    "
		    thisProcess setStateTo:#eventWait if:#active.
		    isModal ifTrue:[
			mySensor eventSemaphore waitWithTimeout:0.2.
		    ] ifFalse:[
			mySensor eventSemaphore wait.
		    ].
		    ActiveGroup := self.
		    self processEvents.
		    ActiveGroup := oldActive.
		].

		"
		 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.
		    ActiveGroup := oldActive.
		]
	    ].
	].
    ] valueNowOrOnUnwindDo:[
"/        ScheduledWindowGroups remove:self ifAbsent:[].
	ActiveGroup := oldActive.
	oldActive := nil.
	cleanupActions notNil ifTrue:[cleanupActions value]
    ]
!

waitForExposeFor:aView
    "wait for a noExpose on aView, then process all exposes.
     To be used after a scroll"

    mySensor waitForExposeFor:aView.
    AbortSignal catch:[
	self processExposeEvents
    ]
!

leaveEventLoop
    "immediately leave the event loop, returning way back.
     This can be used to leave (and closedown) a modal group.
     (for normal views, this does not make sense)"

    ^ LeaveSignal raise
! !

!WindowGroup methodsFor:'activation / deactivation'!

realizeTopViews:isRestart
    "realize all topViews associated to this windowGroup.
     If this is a restart, tell topViews about it."

    topViews notNil ifTrue:[
	topViews do:[:aView |
	    aView realize.
	    isRestart ifTrue:[
		aView restarted
	    ]
	].
    ].
!

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:true 
	]
    ]
!

startup:isRestart
    "startup the window-group;
     this creates a new window group process, which
     does the event processing."

    |top nm dev devNm|

    previousGroup := nil.
    myProcess isNil ifTrue:[
	isModal := false.
	myProcess := [
	    self realizeTopViews:isRestart.
	    self eventLoopWhile:[true] onLeave:[]
	] forkAt:Processor userSchedulingPriority.

	(topViews notNil and:[topViews isEmpty not]) ifTrue:[
	    "
	     give the handler process a user friendly name
	    "
	    top := topViews first.
	    nm := top processName.
	    (dev := top device) notNil ifTrue:[
		devNm := dev displayName.
		devNm notNil ifTrue:[
		    nm := nm , ' (' , devNm , ')'
		]
	    ]
	] ifFalse:[
	    nm := 'window handler'.
	].
	myProcess name:nm.

	"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.
    self realizeTopViews:false.
    self 
	eventLoopWhile:checkBlock 
	onLeave:[
	    "
	     cleanup, in case of a terminate
	    "
	    previousGroup := nil.
	    topViews := nil.
	    views := nil.
	    "
	     the following is rubbish;
	     the views could be reused ..
	    "
"
	    topViews notNil ifTrue:[
		topViews do:[:aView |
		    aView destroy
		].
		topViews := nil.
	    ].
	    views notNil ifTrue:[
		views do:[:aView |
		    aView destroy
		].
		views := nil.
	    ].
"
	]
!

closeDownViews
    "destroy all views associated to this window group"

    topViews notNil ifTrue:[
	topViews do:[:aTopView | aTopView destroy]
    ].
    views := nil.
    topViews := nil.
    mySensor := nil.
"/     ScheduledWindowGroups remove:self ifAbsent:[].
!

shutdown
    "shutdow the window group; close all views and
     terminate process"

    |p|

    self closeDownViews.
    myProcess notNil ifTrue:[
	p := myProcess.
	myProcess := nil.
"/         ScheduledWindowGroups remove:self ifAbsent:[].
	p terminate.
    ]
! !

!WindowGroup methodsFor:'initialization'!

reinitialize
    "reinitialize the windowgroup after an image restart"

    "throw away old (zombie) process"
    myProcess notNil ifTrue:[
	"careful: the old processes exitaction must be cleared
	 otherwise, it might do destroy or other actions when it
	 gets finalized ...
	"
	myProcess exitAction:nil.
	myProcess := nil.
    ].

    "throw away old events"
    mySensor reinitialize
!

initialize
    "setup the windowgroup, by creating a new sensor
     and an event semaphore"

    mySensor := WindowSensor new.
    mySensor eventSemaphore:Semaphore new.
    isModal := false.
! !

!WindowGroup methodsFor:'focus control'!

focusSequence
    "return the focus sequence for focusNext/focusPrevious.
     Focus is stepped in the order in which subviews occur in
     the sequence"

    ^ focusSequence
!

focusSequence:aSequenceableCollection
    "define the focus sequence for focusNext/focusPrevious.
     Focus is stepped in the order in which subviews occur in
     the sequence"

    focusSequence := aSequenceableCollection
!

focusView
    "return the view which currently has the focus"

    ^ focusView
!

focusView:aViewOrNil
    "give focus to aViewOrNil"

    focusView notNil ifTrue:[
	focusView focusOut.
    ].
    focusView := aViewOrNil.
    focusView notNil ifTrue:[
	focusView focusIn
    ].

    "
     |top v1 v2|

     top := StandardSystemView new.
     v1 := EditTextView origin:0.0@0.0 corner:1.0@0.5 in:top.
     v2 := EditTextView origin:0.0@0.5 corner:1.0@1.0 in:top.
     top open.
     top windowGroup focusView:v1.
    "
!

focusNext
    "give focus to next view in focusSequence"

    |index|

    focusSequence size == 0 ifTrue:[^ self].
    focusView notNil ifTrue:[
	index := (focusSequence indexOf:focusView) + 1.
	index > focusSequence size ifTrue:[index := 1].
    ] ifFalse:[
	index := 1.
    ].
    self focusView:(focusSequence at:index)

    "
     |top v1 v2|

     top := StandardSystemView new.
     v1 := EditTextView origin:0.0@0.0 corner:1.0@0.5 in:top.
     v2 := EditTextView origin:0.0@0.5 corner:1.0@1.0 in:top.
     top open.
     top windowGroup focusSequence:(Array with:v1 with:v2).
     top windowGroup focusOn:v1.
     (Delay forSeconds:10) wait.
     top windowGroup focusNext.
    "
!

focusPrevious
    "give focus to previous view in focusSequence"

    |index|

    focusSequence size == 0 ifTrue:[^ self].
    focusView notNil ifTrue:[
	index := (focusSequence indexOf:focusView) - 1.
	index < 1 ifTrue:[index := focusSequence size].
    ] ifFalse:[
	index := focusSequence size.
    ].
    self focusView:(focusSequence at:index)
! !

!WindowGroup methodsFor:'printing'!

printOn:aStream
    "return a printed representation;
     just for more user friendlyness: add name of process."

    myProcess isNil ifTrue:[
	(previousGroup notNil and:[previousGroup process notNil]) ifTrue:[
	    aStream nextPutAll:('WindowGroup(modal in ' , previousGroup process nameOrId , ')').
	    ^ self.
	].
	^ super printOn:aStream
    ].
    aStream nextPutAll:('WindowGroup(' , myProcess nameOrId , ')')
! !