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