WO's stuff
authorwerner
Fri, 02 Apr 2004 18:52:16 +0200
changeset 1973 836eccb0d4cb
parent 1972 952de474cb7f
child 1974 025c3119062b
WO's stuff
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 $'
 ! !