# HG changeset patch # User werner # Date 1080924736 -7200 # Node ID 836eccb0d4cb2ec56d1b59eb5defb8e685576425 # Parent 952de474cb7fdaabfc669005365e725d78f8e59a WO's stuff diff -r 952de474cb7f -r 836eccb0d4cb ExternalTopView.st --- a/ExternalTopView.st Fri Apr 02 14:32:24 2004 +0200 +++ b/ExternalTopView.st Fri Apr 02 18:52:16 2004 +0200 @@ -14,7 +14,7 @@ "{ Package: 'stx:libview2' }" TopView subclass:#ExternalTopView - instanceVariableNames:'' + instanceVariableNames:'windowClosedPollProcess' classVariableNames:'' poolDictionaries:'' category:'Graphics-Support' @@ -70,25 +70,62 @@ !ExternalTopView methodsFor:'private'! +alienViewHasBeenDestroyed +'alienViewHasBeenDestroyed' printCR. + self sensor notNil ifTrue:[ + self sensor destroyedView:self + ] ifFalse:[ + self destroyed + ] +! + checkWindowStillAlive "check for a destroyed topView - (must poll, since we do not get any events from X)" + (must poll, since we do not get any events from X for the alien topView)" - |prevHandler ok| + |prevHandler stillAlive prevErrorPrintingFlag| + + prevErrorPrintingFlag := device class errorPrinting. + device class errorPrinting:true. -"/ Transcript showCR:'check ...'. + drawableId notNil ifTrue:[ + stillAlive := device isValidWindowId:drawableId. + ] ifFalse:[ + stillAlive := false + ]. + device flush. - ok := device isValidWindowId:drawableId. + device class errorPrinting:prevErrorPrintingFlag. + + ^ stillAlive. +! - ok ifFalse:[ -"/ Transcript showCR:'no ...'. - self destroyed. - ] ifTrue:[ - Processor - addTimedBlock:[self checkWindowStillAlive] - for:nil - afterMilliseconds:1000 - ] +checkWindowStillAliveLoop + [self checkWindowStillAlive] whileTrue:[ + Delay waitForSeconds:0.5. + ]. + + self alienViewHasBeenDestroyed +! + +startWindowClosedPollProcess + windowClosedPollProcess isNil ifTrue:[ + windowClosedPollProcess := + [ + [ + self checkWindowStillAliveLoop + ] valueNowOrOnUnwindDo:[ + windowClosedPollProcess := nil. + ] + ] fork. + ]. +! + +stopWindowClosedPollProcess + windowClosedPollProcess notNil ifTrue:[ + windowClosedPollProcess terminate. + windowClosedPollProcess waitUntilTerminated + ]. ! ! !ExternalTopView methodsFor:'private accessing'! @@ -112,8 +149,10 @@ "never destroyed by ST/X - instead, the view is under control of the host application ..." + self stopWindowClosedPollProcess. realized := false. drawableId := nil. + ! open @@ -123,7 +162,8 @@ application)" super open. - self checkWindowStillAlive + "/ self checkWindowStillAlive + self startWindowClosedPollProcess. ! unmap @@ -140,6 +180,95 @@ "add myself to the windowGroup of anSTXWindow ... and reparent anSTXWindow to be the (only) child of myself" + self old_becomeParentOf:anSTXWindow +! + +new_becomeParentOf:anSTXWindow + "add myself to the windowGroup of anSTXWindow ... + and reparent anSTXWindow to be the (only) child of myself" + + |wg oldTopView retryCount deviceErrorOccured| + + anSTXWindow borderWidth:0. anSTXWindow forceBorderWidth. + self borderWidth:0. self forceBorderWidth. + self borderColor:Color red. + + anSTXWindow createWithAllSubViews. + oldTopView := anSTXWindow topView. + + wg := anSTXWindow windowGroup. + wg notNil ifTrue:[ + windowGroup notNil ifTrue:[ + self halt. + windowGroup removeTopView:self. + ]. + wg addTopView:self. + windowGroup := wg. + ]. + + oldTopView == anSTXWindow ifTrue:[ + oldTopView container:self. + ]. + + self open. "/ not really an open; however it starts its event handler + wg isNil ifTrue:[ + oldTopView windowGroup:self windowGroup. + ] ifFalse:[ + windowGroup ~~ anSTXWindow windowGroup ifTrue:[self halt]. + ]. + +"/'childID: ' print. anSTXWindow id displayString printCR. +"/'parentID: ' print. self id displayString printCR. + self addSubView:anSTXWindow. + + self checkWindowStillAlive ifFalse:[ Transcript showCR:'x1'. ^ true]. + + + anSTXWindow device + reparentWindow:anSTXWindow id + to:self id. + anSTXWindow device unBuffered. + retryCount := 0. + deviceErrorOccured := false. + [ + + GLXWorkstation deviceErrorSignal handle:[:ex| + 'DeviceErrorSignal raised in becomeParentOf: ' printNL. + deviceErrorOccured := true. +"/ (Delay waitForSeconds: 1). +"/ retryCount := retryCount + 1. +"/ retryCount > 5 ifTrue:[ +"/ ex proceed +"/ ]. + ex proceed + ] do:[ + deviceErrorOccured := false. + anSTXWindow enableEvent:#structureNotify. + ]. + ] ensure:[ + anSTXWindow device buffered. + ]. + deviceErrorOccured ifTrue:[^false]. + + + self checkWindowStillAlive ifFalse:[ Transcript showCR:'x2'. ^ true]. + + anSTXWindow realize. + anSTXWindow map. + ^true + +"/ wg notNil ifTrue:[ +"/ wg removeView:oldTopView. +"/ wg addView:oldTopView. +"/ ]. + +"/ anSTXWindow origin:0.0 @ 0.0 corner:1.0 @ 1.0. +! + +old_becomeParentOf:anSTXWindow + "add myself to the windowGroup of anSTXWindow ... + and reparent anSTXWindow to be the (only) child of myself" + |wg oldTopView| anSTXWindow createWithAllSubViews. @@ -176,12 +305,10 @@ ]. anSTXWindow origin:0.0 @ 0.0 corner:1.0 @ 1.0. - - ! ! !ExternalTopView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview2/ExternalTopView.st,v 1.11 2002-05-07 11:33:59 cg Exp $' + ^ '$Header: /cvs/stx/stx/libview2/ExternalTopView.st,v 1.12 2004-04-02 16:52:16 werner Exp $' ! !