#withCursor:do: for a modal group
authorca
Mon, 19 Jan 1998 16:59:37 +0100
changeset 1986 344c50a87cbe
parent 1985 4af804551b39
child 1987 49cdfda40715
#withCursor:do: for a modal group must also change the cursor of the parent group
WGroup.st
WindowGroup.st
--- a/WGroup.st	Sun Jan 18 19:23:26 1998 +0100
+++ b/WGroup.st	Mon Jan 19 16:59:37 1998 +0100
@@ -1672,11 +1672,11 @@
      my views (used to show wait-cursor while doing something).
      Return the result as returned by aBlock."
 
-    |oldCursors dev deviceCursor|
+    |oldCursors dev deviceCursor action|
 
     dev := self graphicsDevice.   
     dev isNil ifTrue:[
-	^ aBlock value
+        ^ aBlock value
     ].
 
     deviceCursor := aCursor onDevice:dev.
@@ -1686,36 +1686,46 @@
     "
     oldCursors := IdentityDictionary new.
     self allViewsDo:[:aView |
-	|old|
+        |old|
 
-	old := aView cursor.
-	old ~~ aCursor ifTrue:[
-	    oldCursors at:aView put:old.
-	    aView cursor:deviceCursor now:false
-	]
+        old := aView cursor.
+        old ~~ aCursor ifTrue:[
+            oldCursors at:aView put:old.
+            aView cursor:deviceCursor now:false
+        ]
     ].
 
     oldCursors size == 0 ifTrue:[
-	^ aBlock value
+        action := aBlock
+    ] ifFalse:[
+        action := [
+                    |rslt|
+
+                    "/
+                    "/ here sync looks better; flush leads to almost invisible cursors when accepting.
+                    "/ I dont really know why (maybe unix does not context-switch to the Xserver
+                    "/ early enough after the requests have been sent ?)
+                    "/
+                    dev sync.
+
+                    rslt := aBlock valueNowOrOnUnwindDo:[
+                        "
+                         restore cursors from the mapping
+                        "
+                        oldCursors keysAndValuesDo:[:view :cursor |
+                            view cursor:cursor now:false.
+                        ].
+                        dev flush
+                    ].
+                    rslt
+                  ]
     ].
 
-    "/
-    "/ here sync looks better; flush leads to almost invisible cursors when accepting.
-    "/ I dont really know why (maybe unix does not context-switch to the Xserver
-    "/ early enough after the requests have been sent ?)
-    "/
-"/    dev flush. 
-    dev sync.
-
-    ^ aBlock valueNowOrOnUnwindDo:[
-	"
-	 restore cursors from the mapping
-	"
-	oldCursors keysAndValuesDo:[:view :cursor |
-	    view cursor:cursor now:false.
-	].
-	dev flush "/ sync.
-    ]
+    self isModal ifTrue:[
+        "/ pass the work to my parentGroup
+        ^ self mainGroup withCursor:aCursor do:action
+    ].
+    ^ action value.
 
     "Modified: 24.4.1997 / 13:29:01 / cg"
 !
@@ -1781,6 +1791,6 @@
 !WindowGroup class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.125 1998-01-12 13:27:28 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.126 1998-01-19 15:59:37 ca Exp $'
 ! !
 WindowGroup initialize!
--- a/WindowGroup.st	Sun Jan 18 19:23:26 1998 +0100
+++ b/WindowGroup.st	Mon Jan 19 16:59:37 1998 +0100
@@ -1672,11 +1672,11 @@
      my views (used to show wait-cursor while doing something).
      Return the result as returned by aBlock."
 
-    |oldCursors dev deviceCursor|
+    |oldCursors dev deviceCursor action|
 
     dev := self graphicsDevice.   
     dev isNil ifTrue:[
-	^ aBlock value
+        ^ aBlock value
     ].
 
     deviceCursor := aCursor onDevice:dev.
@@ -1686,36 +1686,46 @@
     "
     oldCursors := IdentityDictionary new.
     self allViewsDo:[:aView |
-	|old|
+        |old|
 
-	old := aView cursor.
-	old ~~ aCursor ifTrue:[
-	    oldCursors at:aView put:old.
-	    aView cursor:deviceCursor now:false
-	]
+        old := aView cursor.
+        old ~~ aCursor ifTrue:[
+            oldCursors at:aView put:old.
+            aView cursor:deviceCursor now:false
+        ]
     ].
 
     oldCursors size == 0 ifTrue:[
-	^ aBlock value
+        action := aBlock
+    ] ifFalse:[
+        action := [
+                    |rslt|
+
+                    "/
+                    "/ here sync looks better; flush leads to almost invisible cursors when accepting.
+                    "/ I dont really know why (maybe unix does not context-switch to the Xserver
+                    "/ early enough after the requests have been sent ?)
+                    "/
+                    dev sync.
+
+                    rslt := aBlock valueNowOrOnUnwindDo:[
+                        "
+                         restore cursors from the mapping
+                        "
+                        oldCursors keysAndValuesDo:[:view :cursor |
+                            view cursor:cursor now:false.
+                        ].
+                        dev flush
+                    ].
+                    rslt
+                  ]
     ].
 
-    "/
-    "/ here sync looks better; flush leads to almost invisible cursors when accepting.
-    "/ I dont really know why (maybe unix does not context-switch to the Xserver
-    "/ early enough after the requests have been sent ?)
-    "/
-"/    dev flush. 
-    dev sync.
-
-    ^ aBlock valueNowOrOnUnwindDo:[
-	"
-	 restore cursors from the mapping
-	"
-	oldCursors keysAndValuesDo:[:view :cursor |
-	    view cursor:cursor now:false.
-	].
-	dev flush "/ sync.
-    ]
+    self isModal ifTrue:[
+        "/ pass the work to my parentGroup
+        ^ self mainGroup withCursor:aCursor do:action
+    ].
+    ^ action value.
 
     "Modified: 24.4.1997 / 13:29:01 / cg"
 !
@@ -1781,6 +1791,6 @@
 !WindowGroup class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.125 1998-01-12 13:27:28 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.126 1998-01-19 15:59:37 ca Exp $'
 ! !
 WindowGroup initialize!