dont change cursors of mainGroup
in #withCursorDo: of a modalGroup.
"
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 pointerView
isForModalSubview'
classVariableNames:'LastActiveGroup LastActiveProcess LeaveSignal
WindowGroupQuerySignal LastEventQuerySignal'
poolDictionaries:''
category:'Interface-Support'
!
!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.
"
!
documentation
"
In Smalltalk/X, the known (ST-80) concept of a controller has been
extended (split) into a WindowGroup which handles process related stuff,
and the Controller, which only handles events for a view and defines the user interaction.
All interaction is via event queues - 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 windowGroup share a single windowSensor which holds the
event queue (therefore subviews all share the same input event queue).
The event queues are filled with incoming events as arriving from the physical display.
This is done by a separate process (so called event-dispatcher) which runs at a higher
priority. The event dispatcher determines the queue into which an event has to be placed
by the view for which the event is destined (via the views sensor).
There may be multiple event dispatchers running (to support multiple displays);
see the documentation/examples in DeviceWorkstation/XWorkstation on how this is done.
Except for modal boxes, a separate process is created for each windowGroup
which waits for events to arrive and processes them, by sending corresponding
event messages to the views controller or the view (*).
The controller is determined by asking the view (for which the event is destined);
if the returned controller is nil, the event is sent directly to the view.
This allows for simple views to work without a controller.
(all of this is actually done in a WindowEvent method)
Therefore, multiple applications run pseudo parallel.
Even if some window performs a long time computation, events are still received
and entered into the corresponding event queues (because the event dispatcher process
runs at a higher priority). However, the actual processing of the event is only
possibly if no other process is busy at the same or a higher priority.
It is possible to change a windowProcesses priority in order to give other windows
a chance to execute (some views do this while performing longtime actions).
Modal boxes create an extra window group for the components of the modal
box, but execute the event-processing loop for this new group in the original process -
therefore, the original windowgroup is blocked for the duration of the modal
interaction.
However, the modal-event processing loop peeks into the original groups event queue
from time to time, and handles expose events. Thus, even while blocked for user input,
the original group continues to get update/redraw events.
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.
Even if the fileBrowser is busy reading the pipe, the killButton is still
working and allows terminating the pipe-read action).
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.
Multiple topviews within a windowGropup can be configured to behave like one
unit with respect to iconification, deiconification and termination.
This is done by creating multiple topViews in one group, and setting up a master/slave
or partner relation among them (see TopView>>beSlave and TopView>>bePartner).
WindowGroups also support a focus window: this is the one that gets the
keyboard input - even if the cursor is located in another subview.
The sequence is defined by the topView or its model (typically an applicationModel).
It should return an orderedCollection of subviews when asked via #focusSequence.
For debugging, windowGroups allow hooks to be installed around the processing of
events - preEventHook is sent a #procesEvent: message before an event is processed,
postEventHook is informed after the event has been processed.
The preEventHook should return true - if it returns true, the event is considered
being already processed by the hook and ignored.
This allows for event-tracing, timing or even filtering (if preEventHook returns true).
(notice: there is also an eventHook facility available in the sensor class.)
Finally, windowgroups are the perfect place for things like defining a
cursor for all associated views, flushing all input, waiting for expose
events etc.
Dont get confused:
You dont have to care for details in the normal case, a windowgroup is
created for you automatically, when a view is opened.
All of the internals are not required to be known for most applications.
[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
[class variables:]
LeaveSignal if raised, a modal box leaves (closes)
WindowGroupQuerySignal to ask for the current windowGroup,
anywhere in the program, simply raise this
signal. The raise returns nil, for processes,
which are not under control of a windowGroup.
(i.e. wg := WindowGroup windowGroupQuerySignal raise)
LastEventQuerySignal to ask for the event which was responsible
for being where you are (whereever that is).
The raise returns nil, if you did not arrive
there due to an event.
(i.e. ev := WindowGroup lastEventQuerySignal raise)
The event can be asked for the view, the type
of event, x/y position etc.
(*)
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.
For more information, read 'introduction to view programming' in the
doc/online directory.
[author:]
Claus Gittinger
[see also:]
WindowSensor WindowEvent EventListener KeyboardForwarder
DeviceWorkstation
View StandardSystemView
ApplicationModel
Process ProcessorScheduler
(``Working with processes (programmers manual)'': programming/processes.html#VIEWSNPROCS)
"
! !
!WindowGroup class methodsFor:'initialization'!
initialize
LeaveSignal isNil ifTrue:[
LeaveSignal := (Signal new) mayProceed:true.
LeaveSignal nameClass:self message:#leaveSignal.
LeaveSignal notifierString:'unhandled leave signal'.
WindowGroupQuerySignal := QuerySignal new.
WindowGroupQuerySignal nameClass:self message:#windowGroupQuerySignal.
WindowGroupQuerySignal notifierString:'query for windowgroup'.
LastEventQuerySignal := QuerySignal new.
LastEventQuerySignal nameClass:self message:#lastEventQuerySignal.
LastEventQuerySignal notifierString:'query for last event'.
].
"WindowGroup initialize"
"Modified: 9.11.1996 / 17:00:53 / cg"
! !
!WindowGroup class methodsFor:'instance creation'!
new
"create and return a new WindowGroup object"
^ self basicNew initialize
! !
!WindowGroup class methodsFor:'Signal constants'!
lastEventQuerySignal
"return the signal which is used to query for the last event"
^ LastEventQuerySignal
"Created: 17.7.1996 / 20:36:04 / cg"
!
leaveSignal
"return the signal which is used to exit a modal loop.
This private signal, is always caught while a modalbox is active.
Raising it will exit the modal loop and return from the views #openModal
method."
^ LeaveSignal
!
windowGroupQuerySignal
"return the signal which is used to query for the windowGroup"
^ WindowGroupQuerySignal
"Created: 17.7.1996 / 20:36:04 / cg"
! !
!WindowGroup class methodsFor:'accessing'!
activeGroup
"return the currently active windowGroup.
The returned value may not be fully correct, in case the current process
handles multiple windowGroups simultaneously. In this case,
(usually) the first group is returned (prefering a modal if there is one).
(maybe we should return a collection of windowGroups here).
This method is required to simulate the historic ST-80 single display
behavior for Cursor>>show / Cursor>>showWhile and some others (raising the
activeGroups topView when modalBoxes appear) on multiple display screens.
These methods should change the cursor for the currently
active windowGroup ONLY, instead of globally affecting the display or
all views
(since, depending on the priority, other views could be unaffacted by this
and an overall cursor change does not make sense.)"
|activeProcess groups wg|
Processor isNil ifTrue:[^ nil]. "/ only during very early init phase
activeProcess := Processor activeProcess.
" caching the last value ..."
activeProcess == LastActiveProcess ifTrue:[
LastActiveGroup process == LastActiveProcess ifTrue:[
^ LastActiveGroup
]
].
wg := WindowGroupQuerySignal raise.
wg isNil ifTrue:[
"/ mhmh - noone willing to answer that question ...
"/ (how can this happen ?)
groups := self scheduledWindowGroups
select:[:wg | wg process == activeProcess].
groups size == 1 ifTrue:[
wg := groups anElement
] ifFalse:[
wg := groups detect:[:wg | wg isModal] ifNone:nil.
wg isNil ifTrue:[
wg := groups anElement
]
].
].
wg notNil ifTrue:[
LastActiveProcess := activeProcess.
LastActiveGroup := wg.
].
^ wg
"
WindowGroup activeGroup
"
"Modified: / 3.9.1995 / 14:49:53 / claus"
"Modified: / 17.4.1998 / 11:49:28 / cg"
!
scheduledWindowGroups
"return a collection of all windowGroups (possibly for different
display devices) which are scheduled (i.e. which have a process
running, handling events)."
|set screens|
screens := Screen allScreens.
screens size == 0 ifTrue:[^ #()].
set := IdentitySet new.
screens do:[:aDevice |
aDevice allViewsDo:[:aView |
|wg|
(wg := aView windowGroup) notNil ifTrue:[
wg process notNil ifTrue:[
set add:wg
]
].
].
].
^ set asArray
"
WindowGroup scheduledWindowGroups
"
"Modified: 1.9.1995 / 13:43:09 / claus"
"Modified: 18.8.1997 / 18:44:29 / cg"
!
setActiveGroup:aGroup
"set the currently active windowGroup.
Temporary; do not use this interface, it will vanish."
LastActiveProcess := Processor activeProcess.
LastActiveGroup := aGroup
! !
!WindowGroup methodsFor:'accessing'!
device
"return the device, we receive our events from"
self obsoleteMethodWarning:'use #graphicsDevice'.
^ self graphicsDevice
"Modified: 5.7.1996 / 17:53:58 / cg"
!
graphicsDevice
"return the device, we receive our events from"
|dev|
topViews notNil ifTrue:[
topViews do:[:v |
|app|
(app := v application) notNil ifTrue:[
"/
"/ ok, it has an application;
"/ ask it for preferences.
"/
(dev := app graphicsDevice) notNil ifTrue:[
^ dev
]
].
(dev := v graphicsDevice) notNil ifTrue:[
^ dev
]
]
].
views notNil ifTrue:[
views do:[:v |
(dev := v graphicsDevice) notNil ifTrue:[
^ dev
]
]
].
^ nil
"Modified: 7.2.1997 / 16:14:24 / cg"
!
isModal
"return true, if the receiver is in a modal mode
(i.e. for a modal box)"
^ isModal
"Modified: 7.3.1996 / 14:29:46 / cg"
!
mainGroup
"return the main windowgroup (for modal groups only)
that is the top one, which is not modal.
NonModal groups return themSelf.
There is one exception to this: the debugger (which is sort of modal)
returns itself as mainGroup (not its debuggee)."
|g prev|
g := self.
[g notNil and:[g isModal and:[(prev := g previousGroup) notNil]]] whileTrue:[
g := prev
].
^ g
"Modified: 3.9.1995 / 14:57:20 / claus"
"Modified: 7.3.1996 / 14:29:28 / cg"
!
mainGroup:aWindowGroup
"set the main windowgroup (for modal/autonomous groups only)
Exposeevents for that windowGroup will be handled by this group
as well."
previousGroup := aWindowGroup
"Created: 20.8.1997 / 17:57:35 / cg"
!
previousGroup
"return the windowgroup that started this group. (for modal groups only).
This may be another modalGroup (for boxes opened by boxes).
NonModal groups return nil."
^ previousGroup
"Modified: 7.3.1996 / 14:28:46 / cg"
!
process
"return the windowGroups process"
^ myProcess
!
sensor
"return the windowGroups sensor.
All events for any of the groups views is handled by that sensor."
^ mySensor
"Modified: 7.3.1996 / 14:30:21 / cg"
!
sensor:aSensor
"set the windowGroups sensor"
mySensor := aSensor
! !
!WindowGroup methodsFor:'accessing-hook'!
postEventHook
"return the postEventHook if any"
^ postEventHook
"Created: 7.3.1996 / 14:42:46 / cg"
!
postEventHook:anObject
"set the postEventHook - this one will get all events
passed after being processed here (via #processEvent:)."
postEventHook := anObject
!
preEventHook
"return the preEventHook if any"
^ preEventHook
"Created: 7.3.1996 / 14:42:42 / cg"
!
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
! !
!WindowGroup methodsFor:'accessing-views'!
addTopView:aView
"add a topview to the group"
topViews isNil ifTrue:[
topViews := OrderedCollection new.
].
(topViews includesIdentical:aView) ifFalse:[
topViews add:aView
]
"Modified: 6.3.1996 / 15:35:15 / cg"
!
addView:aView
"add aView to the windowGroup"
views isNil ifTrue:[
views := OrderedCollection new.
].
(views includesIdentical:aView) ifFalse:[
views add:aView
]
"Modified: 6.3.1996 / 15:35:41 / cg"
!
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)"
|sema|
views notNil ifTrue:[
views removeIdentical:aView ifAbsent:[].
views isEmpty ifTrue:[
views := nil
]
].
topViews notNil ifTrue:[
topViews removeIdentical:aView ifAbsent:[].
topViews isEmpty ifTrue:[
topViews := nil
]
].
"
wakeup my process to look if last view has been
removed (modalBoxes terminate their modalLoop if so)
"
mySensor notNil ifTrue:[
(sema := mySensor eventSemaphore) notNil ifTrue:[
sema signal
]
]
"Modified: 1.2.1997 / 12:13:26 / cg"
!
topViews
"return the topviews accociated to this windowGroup"
^ topViews
!
views
"return the views accociated to this windowGroup"
^ views
! !
!WindowGroup methodsFor:'activation / deactivation'!
closeDownViews
"destroy all views associated to this window group"
topViews notNil ifTrue:[
topViews do:[:aTopView | aTopView notNil ifTrue:[aTopView destroy]]
].
views := nil.
topViews := nil.
mySensor := nil.
!
realizeTopViews
"realize all topViews associated to this windowGroup."
topViews notNil ifTrue:[
topViews do:[:aView |
aView realize.
].
].
"Created: 24.7.1997 / 12:56:09 / cg"
!
rerealizeTopViews
"rerealize all topViews associated to this windowGroup.
and tell topViews about it."
topViews notNil ifTrue:[
topViews do:[:aView |
aView isPopUpView
ifFalse:
[
aView realize.
aView restarted
].
].
].
!
restart
"restart after a snapin.
This reopens all views in this group."
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 name:'WGroup eventSema').
isModal ifFalse:[
self startupWith:[self rerealizeTopViews].
]
]
"Modified: 24.7.1997 / 13:00:12 / cg"
!
shutDown
"shutdown the window group; close all views and
terminate the process"
|p|
self closeDownViews.
myProcess notNil ifTrue:[
p := myProcess.
myProcess := nil.
p terminate.
]
"Created: 22.4.1996 / 17:58:37 / cg"
"Modified: 8.2.1997 / 16:46:31 / cg"
!
startupModal:checkBlock
"startup the window-group in a modal loop
(i.e. under the currently running process);
checkBlock is evaluated and the modal loop is left,
whenever false is returned."
^ self startupModal:checkBlock forGroup:(WindowGroup activeGroup).
"Created: 10.12.1995 / 14:15:11 / cg"
"Modified: 20.8.1997 / 17:54:33 / cg"
!
startupModal:checkBlock forGroup:mainGroup
"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.
The mainGroup info is required to allow peeking into its
event queue in order for its expose/redraws to be handled."
"set previousGroup to the main (non-modal) group"
previousGroup := mainGroup.
isModal := true.
WindowGroupQuerySignal handle:[:ex |
ex proceedWith:self
] do:[
self realizeTopViews.
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.
"/ ].
]
]
"Created: 10.12.1995 / 14:14:26 / cg"
"Modified: 20.8.1997 / 18:12:20 / cg"
!
startupWith:startupAction
"startup the window-group;
this creates a new window group process, which does the event processing.
The startupAction arg is evaluated by the windowGroup process,
before the eventLoop is entered, and is used to realize any views.
[this is done to have the new process realize its views, instead of
the caller - which may make a difference in case of errors and/or
blocking operations ...]"
|top nm dev devNm|
previousGroup := nil.
myProcess isNil ifTrue:[
isModal := false.
"/
"/ this is the windowGroup process;
"/ realize all views, then handle events forever
"/ (well, not really forever ... ;-)
myProcess := [
WindowGroupQuerySignal handle:[:ex |
ex proceedWith:self
] do:[
[
startupAction value.
self eventLoopWhile:[true] onLeave:[]
] valueNowOrOnUnwindDo:[
self closeDownViews
]
]
] forkAt:(Processor userSchedulingPriority).
(topViews size > 0) ifTrue:[
"/
"/ give the windowGroup process a user friendly name
"/ ask its topView for the processName, and
"/ optionally append the displayName (if its not the default)
"/
top := topViews first.
nm := top processName.
(dev := top graphicsDevice) notNil ifTrue:[
devNm := dev displayName.
(devNm notNil and:[devNm ~= Display displayName]) ifTrue:[
nm := nm , ' (' , devNm , ')'
]
]
] ifFalse:[
nm := 'window handler'.
].
myProcess name:nm.
myProcess beGroupLeader.
"/
"/ when the process gets suspended,
"/ there maybe still buffered draw requests.
"/ Arrange for them to be flushed then.
"/ (otherwise, you would not see the output of a process,
"/ which suspends and waits - or we had to add buffer flushes
"/ all over the place)
"/
myProcess addSuspendAction:[
|dev|
dev := self graphicsDevice.
dev notNil ifTrue:[dev flush].
].
]
"Modified: / 13.12.1995 / 14:04:53 / stefan"
"Created: / 24.7.1997 / 12:52:04 / cg"
"Modified: / 4.12.1997 / 14:13:35 / cg"
! !
!WindowGroup methodsFor:'enumerating'!
allNonTopViewsDo:aBlock
"evaluate aBlock for all nonTopviews (i.e. subviews) in this group.
This enumerates a copy of the view collection, to allow for
destroy and other collection changing operations to be performed in the loop."
views notNil ifTrue:[
views copy nonNilElementsDo:aBlock
]
"Modified: 12.2.1997 / 12:20:25 / cg"
!
allTopViewsDo:aBlock
"evaluate aBlock for all topviews in this group.
This enumerates a copy of the view collection, to allow for
destroy and other collection changing operations to be performed in the loop."
topViews notNil ifTrue:[
topViews copy nonNilElementsDo:aBlock
]
"Modified: 12.2.1997 / 12:20:30 / cg"
!
allTopViewsExcept:aView do:aBlock
"evaluate aBlock for all topviews except aView in this group.
This enumerates a copy of the view collection, to allow for
destroy and other collection changing operations to be performed in the loop."
self allTopViewsDo:[:v |
v ~~ aView ifTrue:[aBlock value:v]
].
"Modified: 12.2.1997 / 12:22:10 / cg"
!
allViewsDo:aBlock
"evaluate aBlock for all views & topviews in this group.
This enumerates a copy of the view collection, to allow for
destroy and other collection changing operations to be performed in the loop."
self allTopViewsDo:aBlock.
self allNonTopViewsDo:aBlock.
"Modified: 12.2.1997 / 12:20:20 / cg"
!
partnersDo:aBlock
"evaluate aBlock for all partnerViews.
This enumerates a copy of the view collection, to allow for
destroy and other collection changing operations to be performed in the loop."
self allTopViewsDo:[:v |
(v type == #partner) ifTrue:[aBlock value:v].
].
"Modified: 12.2.1997 / 12:21:41 / cg"
!
slavesDo:aBlock
"evaluate aBlock for all slaveViews.
This enumerates a copy of the view collection, to allow for
destroy and other collection changing operations to be performed in the loop."
self allTopViewsDo:[:v |
(v type == #slave) ifTrue:[aBlock value:v].
].
"Modified: 12.2.1997 / 12:21:46 / cg"
! !
!WindowGroup methodsFor:'event debugging'!
traceEvents:trueOrFalse
|hook|
trueOrFalse ifFalse:[
"/
"/ remove any eventHook on the receiver
"/
self preEventHook:nil.
"/ Transcript showCR:'removed eventHook'.
] ifTrue:[
"/
"/ set an eventHook on its windowGroup
"/
hook := Plug new.
hook respondTo:#processEvent:
with:[:ev | ev displayString printCR. false].
self preEventHook:hook.
"/ Transcript showCR:'set eventHook for tracing'.
]
"Created: 24.4.1996 / 10:25:21 / cg"
"Modified: 20.5.1996 / 10:30:00 / cg"
! !
!WindowGroup methodsFor:'event handling'!
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.
Some signals are caught & handled:
LeaveSignal forces an exit from the eventLoop;
AbortSignal brings us back into the loop, processing the next event;
ActivityNotifications send a #showActivity: if nonModal,
otherwise they are ignored."
|thisProcess sigs otherSema|
thisProcess := Processor activeProcess.
sigs := SignalSet
with:AbortSignal
with:LeaveSignal
with:(self class activityNotificationSignal).
[
|p g mainGroup mySema waitSema|
waitSema := mySema := mySensor eventSemaphore.
isModal ifTrue:[
mainGroup := self mainGroup.
mainGroup == self ifTrue:[
mainGroup := nil
].
] ifFalse:[
mainGroup := previousGroup
].
mainGroup notNil ifTrue:[
otherSema := mainGroup sensor eventSemaphore.
waitSema := SemaphoreSet with:mySema with:otherSema.
].
[aBlock value] whileTrue:[
LastActiveGroup := self.
LastActiveProcess := thisProcess.
(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
].
sigs handle:[:ex |
|theSig|
(theSig := ex signal) == AbortSignal ifTrue:[
"/
"/ on abort, stay in loop
"/
ex return
].
theSig == LeaveSignal ifTrue:[
"/
"/ on leave, exit the event loop
"/
^ self
].
"/ ActivityNotification
"/
"/ if I am a modal-group, let it be handled
"/ by the outer main-groups handler
"/ otherwise show the activityMessage and continue.
"/
isModal ifTrue:[
ex reject
"never reached"
].
self showActivity:(ex errorString).
ex proceed.
] do:[
|dev gotSema mainView|
"/ Flush device output before going to sleep.
"/ This may produce more events to arrive.
"/ Q: is this still needed (see suspendAction) ?
"/ dev := self graphicsDevice.
"/ dev notNil ifTrue:[dev flush].
"/ now, wait for an event to arrive
thisProcess setStateTo:#eventWait if:#active.
gotSema := waitSema wait.
LastActiveGroup := self.
LastActiveProcess := thisProcess.
gotSema == mySema ifTrue:[
"/
"/ an event for me
"/
self processEventsWithModalGroup:nil
] ifFalse:[
"/
"/ an event for my mainGroup
"/
mainGroup topViews notNil ifTrue:[
mainView := mainGroup topViews first
].
mainView notNil ifTrue:[
"/
"/ if anything happened to the mainGroup
"/ bring my own topView back to the front
"/ This keeps modalBoxes visible
"/
(mainGroup sensor hasConfigureEventFor:mainView) ifTrue:[
topViews size > 0 ifTrue:[
topViews first raiseDeiconified
]
]
].
"
if modal, also check for redraw events in my maingroup
(we arrive here after we woke up on maingroup sensor eventSemaphore)
"
mainGroup processEventsWithModalGroup:self.
]
].
].
] valueNowOrOnUnwindDo:[
"/
"/ perform any cleanupActions
"/
cleanupActions notNil ifTrue:[cleanupActions value]
]
"Modified: 14.12.1995 / 11:12:24 / stefan"
"Modified: 20.8.1997 / 19:10:23 / cg"
!
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
!
processEvents
"process events from either the damage- or user input queues.
Abort is assumed to be handled elsewhere."
self processEventsWithModalGroup:nil
"Modified: 5.3.1997 / 11:33:51 / cg"
!
processEventsWithModalGroup:modalGroup
"process events from either the damage- or user input queues.
Abort is assumed to be handled elsewhere."
<resource: #keyboard (#Escape )>
|event ignore key focus modalTops modalTop modalDelegate syntheticEvent|
self processExposeEvents.
[mySensor hasEvents] whileTrue:[
event := mySensor nextEvent.
event notNil ifTrue:[
ignore := false.
focus := focusView.
modalDelegate := false.
modalGroup notNil ifTrue:[
"/ an incoming event for a masterView,
"/ while being blocked by some other modalView.
modalTops := modalGroup topViews.
modalTops size > 0 ifTrue:[
modalTop := modalTops first.
].
event isKeyEvent ifTrue:[
"/ forward keyboard events to my modal
"/ groups first topView ...
modalTop notNil ifTrue:[
focus := modalTop.
modalDelegate := true.
]
] ifFalse:[
event isFocusEvent ifTrue:[
event isFocusInEvent ifTrue:[
"/ focusIn is forwarded to the modalGroup
"/ (since keyboard is forwarded)
event view:modalTop.
focus := modalTop.
] ifFalse:[
"/ focusOut goes to both the modal and
"/ the blocked main-group
"/ (actually, only the very first focusOut
"/ is needed in the mainGroup (to turn off the cursor)
"/ all others are only needed in the modalGroup)
"/ syntheticEvent := event copy.
"/ syntheticEvent view:modalTop.
"/ LastEventQuerySignal handle:[:ex |
"/ ex proceedWith:syntheticEvent
"/ ] do:[
"/ syntheticEvent sendEventWithFocusOn:nil.
"/ ].
event view:modalTop.
].
modalDelegate := true.
] ifFalse:[
event isPointerLeaveEvent ifTrue:[
] ifFalse:[
event isUserEvent ifTrue:[
ignore := true
]
]
]
]
].
ignore ifFalse:[
(views notNil or:[topViews notNil]) ifTrue:[
LastEventQuerySignal handle:[:ex |
ex proceedWith:event
] do:[
(preEventHook notNil
and:[preEventHook processEvent:event]) ifTrue:[
ignore := true.
].
ignore ifFalse:[
event isKeyPressEvent ifTrue:[
key := event key.
key == #Escape ifTrue:[
modalDelegate ifTrue:[
modalTop hideRequest
] ifFalse:[
isModal ifTrue:[
topViews first hideRequest
]
]
]
].
event isPointerEnterEvent ifTrue:[
pointerView := event view
].
event isPointerLeaveEvent ifTrue:[
pointerView := nil
].
ignore ifFalse:[
"/
"/ buttonPress events turn off explicit focus, and revert
"/ to implicit focus control
"/
(focusView notNil
and:[event isButtonPressEvent]) ifTrue:[
self focusView:nil
].
"/
"/ let the event forward itself
"/
LastActiveGroup := self.
LastActiveProcess := Processor activeProcess.
"
if there is no view information in the event,
it must have been sent directly to the sensor.
Send it to the first topView.
"
event view isNil ifTrue:[
topViews first notNil ifTrue:[
topViews first perform:event type withArguments:event arguments
]
] ifFalse:[
event sendEventWithFocusOn:focus.
]
]
].
postEventHook notNil ifTrue:[
postEventHook processEvent:event
].
]
]
].
event := nil.
].
]
"Created: 5.3.1997 / 11:33:11 / cg"
"Modified: 20.8.1997 / 15:23:31 / cg"
!
processExposeEvents
"process only expose events from the damage queue"
|event view rect x y w h sensor thisProcess|
(sensor := mySensor) isNil ifTrue:[^ self].
thisProcess := Processor activeProcess.
[sensor damageCount ~~ 0] whileTrue:[
LastActiveGroup := self.
LastActiveProcess := thisProcess.
event := sensor nextDamage.
event notNil ifTrue:[
(views notNil or:[topViews notNil]) ifTrue:[
LastEventQuerySignal handle:[:ex |
ex proceedWith:event
] do:[
(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:[
LastActiveGroup := self.
LastActiveProcess := thisProcess.
"/ rect := event rectangle.
"/ x := rect left.
"/ y := rect top.
"/ w := rect width.
"/ h := rect height.
"/
"/ view transformation notNil ifTrue:[
"/ view deviceExposeX:x y:y width:w height:h
"/ ] ifFalse:[
"/ view exposeX:x y:y width:w height:h
"/ ]
event sendEventWithFocusOn:nil.
] ifFalse:[
"/ ('WGROUP: damage for ' , view displayString , ' ignored') infoPrintCR.
]
] ifFalse:[
"
mhmh - could we possibly arrive here ?
"
LastActiveGroup := self.
LastActiveProcess := thisProcess.
event sendEventWithFocusOn:nil.
]
].
postEventHook notNil ifTrue:[
postEventHook processEvent:event
]
]
]
]
]
"Modified: / 5.4.1998 / 11:35:21 / cg"
!
processRealExposeEvents
"process only expose events from the damage queue
(for any of my views).
This is required after a scroll operation,
to wait for either a noExpose or a real expose."
self processRealExposeEventsFor:nil
!
processRealExposeEventsFor:someViewOrNil
"process only expose events from the damage queue
(for any of my views if the arg is nil).
This is required after a scroll operation,
to wait for either a noExpose or a real expose."
|event view rect x y w h sensor thisProcess|
(sensor := mySensor) isNil ifTrue:[^ self].
sensor damageCount == 0 ifTrue:[^ self].
thisProcess := Processor activeProcess.
[true] whileTrue:[
LastActiveGroup := self.
LastActiveProcess := thisProcess.
"/ event := aView nextDamage.
event := sensor nextExposeEventFor:someViewOrNil.
event isNil ifTrue:[^ self].
(views notNil or:[topViews notNil]) ifTrue:[
LastEventQuerySignal handle:[:ex |
ex proceedWith:event
] do:[
(preEventHook notNil
and:[preEventHook processEvent:event]) ifFalse:[
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.
LastActiveGroup := self.
LastActiveProcess := thisProcess.
view transformation notNil ifTrue:[
view deviceExposeX:x y:y width:w height:h
] ifFalse:[
view exposeX:x y:y width:w height:h
]
]
].
postEventHook notNil ifTrue:[
postEventHook processEvent:event
]
]
]
]
"Created: / 2.7.1997 / 14:32:19 / cg"
"Modified: / 5.4.1998 / 11:35:43 / cg"
!
waitForExposeFor:aView
"wait for a noExpose event for aView, then process all exposes.
To be used after a scroll.
This is very Xspecific and not needed with other systems
(i.e. a synthetic noExpose may be generated there)."
mySensor waitForExposeFor:aView.
AbortSignal catch:[
self processRealExposeEventsFor:aView
]
"Modified: 6.8.1997 / 19:50:24 / cg"
! !
!WindowGroup methodsFor:'focus control'!
focusNext
"give focus to the next view in the focusSequence.
Skip invisible views."
|index "{ Class: SmallInteger }"
lastIndex "{ Class: SmallInteger }"
index0 next sequence|
sequence := self focusSequence.
(lastIndex := sequence size) == 0 ifTrue:[^ self].
focusView notNil ifTrue:[
index := index0 := (sequence identityIndexOf:focusView).
] ifFalse:[
index := 0.
].
[next isNil] whileTrue:[
index := index + 1.
index > lastIndex ifTrue:[
index := 1.
index0 isNil ifTrue:[^ self].
].
index == index0 ifTrue:[^ self].
next := (sequence at:index).
next realized not ifTrue:[
next := nil
] ifFalse:[
next enabled ifFalse:[
next := nil
]
]
].
self focusView:next
"
|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.
"
"Modified: / 31.10.1997 / 19:22:34 / cg"
!
focusPrevious
"give focus to previous view in focusSequence"
|index "{ Class: SmallInteger }"
lastIndex "{ Class: SmallInteger }"
prev index0 sequence|
sequence := self focusSequence.
(lastIndex := sequence size) == 0 ifTrue:[^ self].
focusView notNil ifTrue:[
index := index0 := (sequence identityIndexOf:focusView).
] ifFalse:[
index := lastIndex + 1.
].
[prev isNil] whileTrue:[
index := index - 1.
index < 1 ifTrue:[
index := lastIndex.
index0 isNil ifTrue:[^ self].
].
index == index0 ifTrue:[^ self].
prev := (sequence at:index).
prev realized not ifTrue:[
prev := nil
] ifFalse:[
prev enabled ifFalse:[
prev := nil
]
].
].
self focusView:prev
"Modified: / 31.10.1997 / 19:21:50 / cg"
!
focusSequence
"return my focus sequence for focusNext/focusPrevious.
Focus is stepped in the order in which subviews occur in
the sequence"
|sequence|
"/ a fix focusSequence ...
focusSequence notNil ifTrue:[^ focusSequence].
topViews do:[:top |
sequence := top focusSequence.
sequence notNil ifTrue:[^ sequence].
].
^ nil
"Modified: / 31.10.1997 / 20:37:54 / cg"
!
focusSequence:aSequenceableCollection
"define the focus sequence for focusNext/focusPrevious.
Focus is stepped in the order in which subviews occur in
the sequence."
focusSequence := aSequenceableCollection
"Modified: / 31.10.1997 / 20:40:04 / cg"
!
focusView
"return the view which currently has the focus"
^ focusView
!
focusView:aViewOrNil
"give focus to aViewOrNil"
focusView == aViewOrNil ifTrue:[^ self].
focusView notNil ifTrue:[
"/ lost explicit focus
focusView == aViewOrNil ifTrue:[^ self].
focusView showNoFocus:true.
] ifFalse:[
pointerView notNil ifTrue:[
pointerView ~~ aViewOrNil ifTrue:[
"/ lost implicit focus
pointerView showNoFocus:false
]
].
].
focusView := aViewOrNil.
focusView notNil ifTrue:[
"/ got explicit focus
focusView showFocus:true.
].
"
|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.
"
"Modified: 31.5.1996 / 21:13:25 / cg"
! !
!WindowGroup methodsFor:'initialization'!
initialize
"setup the windowgroup, by creating a new sensor
and an event semaphore"
mySensor := WindowSensor new.
mySensor eventSemaphore:(Semaphore new name:'WGroup eventSema').
isModal := false.
isForModalSubview := false.
"Modified: 25.1.1997 / 00:20:19 / cg"
!
reinitialize
"reinitialize the windowgroup after an image restart"
"throw away old (zombie) process"
myProcess notNil ifTrue:[
"/ careful: the old processes exit-actions must be cleared.
"/ otherwise, it might do destroy or other actions when it
"/ gets finalized ...
"/ myProcess removeAllExitActions.
myProcess removeAllSuspendActions.
myProcess := nil.
].
"throw away old events"
mySensor reinitialize
"Modified: 13.12.1995 / 13:45:35 / stefan"
"Modified: 12.1.1997 / 00:45:01 / cg"
! !
!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 , ')')
! !
!WindowGroup methodsFor:'special'!
restoreCursors
"restore the original cursors in all of my views"
self allViewsDo:[:aView |
|c dev id cid|
dev := aView graphicsDevice.
dev notNil ifTrue:[
(id := aView id) notNil ifTrue:[
c := aView cursor onDevice:dev.
(cid := c id) notNil ifTrue:[
dev setCursor:cid in:id.
]
]
]
].
"Modified: / 22.4.1998 / 14:28:22 / cg"
!
showActivity:someMessage
"some activityNotification shalt be communicated to
the user;
forward it to my first topView if there is one
(that one should know how to deal with it)"
topViews notNil ifTrue:[
topViews first showActivity:someMessage
]
"Created: 16.12.1995 / 18:39:40 / cg"
"Modified: 23.4.1996 / 21:36:54 / cg"
!
showCursor:aCursor
"change the cursor to aCursor in all of my views."
|c cId vId dev|
c := aCursor.
self allViewsDo:[:aView |
dev := aView graphicsDevice.
dev notNil ifTrue:[
c := c onDevice:dev.
(cId := c id) notNil ifTrue:[
(vId := aView id) notNil ifTrue:[
dev setCursor:cId in:vId.
]
]
]
].
"Modified: / 22.4.1998 / 14:26:45 / cg"
!
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 dev deviceCursor action|
dev := self graphicsDevice.
dev isNil ifTrue:[
^ aBlock value
].
deviceCursor := aCursor onDevice:dev.
"
get mapping of view->cursor for all of my subviews
"
oldCursors := IdentityDictionary new.
self allViewsDo:[:aView |
|old|
old := aView cursor.
old ~~ aCursor ifTrue:[
oldCursors at:aView put:old.
aView cursor:deviceCursor now:false
]
].
oldCursors size == 0 ifTrue:[
action := aBlock
] ifFalse:[
action := [
|rslt|
"/
"/ here sync looks better; flush leads to almost invisible cursors when accepting.
"/ I dont really know why (maybe unix does not context-switch to the Xserver
"/ early enough after the requests have been sent ?)
"/
dev sync.
rslt := aBlock valueNowOrOnUnwindDo:[
"
restore cursors from the mapping
"
oldCursors keysAndValuesDo:[:view :cursor |
view cursor:cursor now:false.
].
dev flush
].
rslt
]
].
"/ (self isModal and:[previousGroup notNil]) ifTrue:[
"/ "/ pass the work to my parentGroup
"/ ^ previousGroup withCursor:aCursor do:action
"/ ].
^ action value.
"Modified: / 22.4.1998 / 14:36:47 / cg"
!
withWaitCursorDo:aBlock
"evaluate aBlock while showing a waitCursor in all
my views (used to show wait-cursor while doing something time consuming).
Return the result as returned by aBlock."
^ self withCursor:(Cursor wait) do:aBlock
"Created: 6.2.1996 / 19:51:53 / cg"
! !
!WindowGroup methodsFor:'special accessing'!
isForModalSubview
"special for windowgroups for modal subviews.
These must be flagged specially to avoid the views being reassigned
to the maingroup.
This is a private interface to the SimpleView class"
^ isForModalSubview
!
isForModalSubview:aBoolean
"special for windowgroups for modal subviews.
These must be flagged specially to avoid the views being reassigned
to the maingroup.
This is a private interface to the SimpleView class"
isForModalSubview := aBoolean
!
setModal:aBoolean
"special entry for debugger: set the modal flag.
Not for public use"
isModal := aBoolean
"Modified: 3.9.1995 / 14:51:04 / claus"
!
setPreviousGroup:aGroup
"special entry for debugger:
set the windowgroup that started this group (for modal groups only).
This is not a public interface."
previousGroup := aGroup
"Modified: 3.9.1995 / 14:55:40 / claus"
!
setProcess:aProcess
"special entry for debugger: set the windowGroups process.
Not for public use."
myProcess := aProcess
"Modified: 3.9.1995 / 14:25:38 / claus"
! !
!WindowGroup class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.133 1998-04-22 12:55:06 cg Exp $'
! !
WindowGroup initialize!