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