# HG changeset patch # User Claus Gittinger # Date 1026392469 -7200 # Node ID 7ed096386bd375908a5643e9cc823f51e59a72b3 # Parent 2194ea7e8fecd7be1c43cbd67b73d0e0cfcf0eb8 refactored event dispatch loop; fixed finish of dispatchLoop when last window closes. diff -r 2194ea7e8fec -r 7ed096386bd3 DeviceWorkstation.st --- 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!