refactored event dispatch loop;
fixed finish of dispatchLoop when last window closes.
--- a/DeviceWorkstation.st Thu Jul 11 14:23:18 2002 +0200
+++ b/DeviceWorkstation.st Thu Jul 11 15:01:09 2002 +0200
@@ -4249,27 +4249,28 @@
dispatching ifFalse:[^ self].
self == Display ifTrue:[
- ExitOnLastClose == true ifFalse:[^ self].
+ ExitOnLastClose == true ifFalse:[^ self].
].
exitOnLastClose == true ifFalse:[^ self].
knownViews notNil ifTrue:[
- (knownViews findFirst:[:slot |
- slot notNil
- and:[slot ~~ 0 "/ if there is no non-popup
- and:[slot isRootView not "/ non-dialog ...
- and:[slot isTopView "/ stop dispatching.
- and:[slot isPopUpView not
- and:[slot isModal not
- "and:[slot realized]"]]]]]]) == 0 ifTrue:[
- "/ my last view was closed
- dispatching := false.
- 'DeviceWorkstation [info]: finished dispatch (last view closed)' infoPrintCR.
- LastActiveScreen == self ifTrue:[
- LastActiveScreen := nil.
- LastActiveProcess := nil.
- ].
- ]
+ (knownViews findFirst:[:slot |
+ slot notNil
+ and:[slot ~~ 0 "/ if there is no non-popup
+ and:[slot isRootView not "/ non-dialog ...
+ and:[slot isTopView "/ stop dispatching.
+ and:[slot isPopUpView not
+ and:[slot isModal not
+ "and:[slot realized]"]]]]]]) == 0 ifTrue:[
+ "/ my last view was closed
+ dispatching := false.
+ 'DeviceWorkstation [info]: finished dispatch (last view closed)' infoPrintCR.
+ LastActiveScreen == self ifTrue:[
+ LastActiveScreen := nil.
+ LastActiveProcess := nil.
+ ].
+ eventSema signal. "/ get dispatchLoop out of its wait...
+ ]
].
"Modified: 19.9.1995 / 11:31:54 / claus"
@@ -4295,6 +4296,24 @@
^ self subclassResponsibility
!
+dispatchLoop
+ "the actual event dispatching loop."
+
+ [dispatching] whileTrue:[
+ AbortSignal handle:[:ex |
+ ex return
+ ] do:[
+ self eventPending ifFalse:[
+ Processor activeProcess setStateTo:#ioWait if:#active.
+ eventSema wait.
+ ].
+ dispatching ifTrue:[
+ self dispatchPendingEvents.
+ ].
+ ]
+ ]
+!
+
dispatchModalWhile:aBlock
"get and process next event for any view as long as the
argument-block evaluates to true.
@@ -4426,10 +4445,70 @@
^ self subclassResponsibility
!
+setupDispatchLoop
+ "create & start the display event dispatch process."
+
+ |fd checkBlock|
+
+ fd := self displayFileDescriptor.
+
+ eventSema := Semaphore new name:'display inputSema'.
+
+ "/ arrange for the processor to signal that semaphore when input
+ "/ is available or #eventPending returns true
+
+ fd isNil ifTrue:[
+ "no fd -- so have to check for input also"
+ checkBlock := [self eventPending].
+ ] ifFalse:[
+ "there is a fd, so checkblock has to check only the internal queue"
+ checkBlock := [self eventQueued].
+ ].
+
+ "/ handle all incoming events from the device, sitting on a semaphore.
+ "/ Tell Processor to trigger this semaphore when some event arrives
+ "/ for me. Since a select alone may not be enough to know if events are pending
+ "/ (Xlib reads out event-queue while doing output), we also install a poll-check block.
+ "/ The poll check is also req'd for systems where we cannot do a select
+ "/ on the eventQ (i.e. windows).
+
+ Processor signal:eventSema onInput:fd orCheck:checkBlock.
+
+
+ DeviceIOErrorSignal handle:[:ex |
+ "/ test for handlerBlock until the signal is changed to be classed based.
+ ex signal handlerBlock notNil ifTrue:[
+ ex defaultAction.
+ ] ifFalse:[
+ 'DeviceWorkstation [warning]: stop dispatch due to I/O error' errorPrintCR.
+ self brokenConnection.
+ ].
+ ex return.
+ ] do:[
+ self initializeDeviceResources.
+ [
+ self dispatchLoop
+ ] ifCurtailed:[
+ eventSema notNil ifTrue:[
+ Processor disableSemaphore:eventSema.
+ eventSema := nil.
+ ].
+ dispatchProcess := nil.
+ self emergencyCloseConnection.
+ ].
+ eventSema notNil ifTrue:[
+ Processor disableSemaphore:eventSema.
+ eventSema := nil.
+ ].
+ dispatchProcess := nil.
+ self close.
+ ].
+!
+
startDispatch
"create & start the display event dispatch process."
- |inputSema fd p nm checkBlock|
+ |p nm|
"/
"/ only allow one dispatcher process per display
@@ -4438,94 +4517,25 @@
dispatching := true.
AllScreens isNil ifTrue:[
- AllScreens := IdentitySet new:1
+ AllScreens := IdentitySet new:1
].
AllScreens add:self.
- fd := self displayFileDescriptor.
-
- "/ handle all incoming events from the device, sitting on a semaphore.
- "/ Tell Processor to trigger this semaphore when some event arrives
- "/ for me. Since a select alone may not be enough to know if events are pending
- "/ (Xlib reads out event-queue while doing output), we also install a poll-check block.
- "/ The poll check is also req'd for systems where we cannot do a select
- "/ on the eventQ (i.e. windows).
-
- inputSema := Semaphore new name:'display inputSema'.
-
- p := [
- self initializeDeviceResources.
-
- DeviceIOErrorSignal handle:[:ex |
- "/ test for handlerBlock until the signal is changed to be classed based.
- ex signal handlerBlock notNil ifTrue:[
- ex defaultAction.
- ] ifFalse:[
- 'DeviceWorkstation [warning]: stop dispatch due to I/O error' errorPrintCR.
- self brokenConnection.
- ].
- ex return.
- ] do:[
- [
- [dispatching] whileTrue:[
- AbortSignal handle:[:ex |
- ex return
- ] do:[
- self eventPending ifFalse:[
- Processor activeProcess setStateTo:#ioWait if:#active.
- inputSema wait.
- ].
- dispatching ifTrue:[
- self dispatchPendingEvents.
- ].
- ]
- ]
- ] ifCurtailed:[
- inputSema notNil ifTrue:[
- Processor disableSemaphore:inputSema.
- inputSema := nil.
- ].
- dispatchProcess := nil.
- self emergencyCloseConnection.
- ].
- inputSema notNil ifTrue:[
- Processor disableSemaphore:inputSema.
- inputSema := nil.
- ].
- dispatchProcess := nil.
- self close.
- ].
- ] newProcess.
+ p := [ self setupDispatchLoop ] newProcess.
"/
"/ give the process a nice name (for the processMonitor)
"/
(nm := self displayName) notNil ifTrue:[
- nm := 'event dispatcher (' , nm , ')'.
+ nm := 'event dispatcher (' , nm , ')'.
] ifFalse:[
- nm := 'event dispatcher'.
+ nm := 'event dispatcher'.
].
p name:nm.
p priority:(Processor userInterruptPriority).
p beSystemProcess.
dispatchProcess := p.
p resume.
-
- "/ finally, arrange for the processor to signal that semaphore when input
- "/ is available or #eventPending returns true
-
- fd isNil ifTrue:[
- "no fd -- so have to check for input also"
- checkBlock := [self eventPending].
- ] ifFalse:[
- "there is a fd, so checkblock has to check only the internal queue"
- checkBlock := [self eventQueued].
- ].
-
- Processor signal:inputSema onInput:fd orCheck:checkBlock.
-
- "Modified: / 12.12.1995 / 20:52:57 / stefan"
- "Modified: / 24.8.1998 / 18:36:29 / cg"
!
stopDispatch
@@ -7550,6 +7560,6 @@
!DeviceWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.415 2002-07-11 12:23:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.416 2002-07-11 13:01:09 cg Exp $'
! !
DeviceWorkstation initialize!