cosmetic: avoid flickering cursor
authorca
Wed, 08 Dec 1999 21:43:01 +0100
changeset 2471 4476877ee790
parent 2470 a92294c402bf
child 2472 03b50188ac9b
cosmetic: avoid flickering cursor
BrowserView.st
--- a/BrowserView.st	Tue Dec 07 17:06:22 1999 +0100
+++ b/BrowserView.st	Wed Dec 08 21:43:01 1999 +0100
@@ -2779,19 +2779,19 @@
         codeModified := false.
 
         codeView acceptAction:[:theCode |
-            codeView cursor:Cursor execute.
-            Object abortSignal catch:[
-                Class nameSpaceQuerySignal answer:Smalltalk
-                do:[
-                    Compiler evaluate:theCode asString notifying:codeView compile:false.
+            codeView withWaitCursorDo:[
+                Object abortSignal catch:[
+                    Class nameSpaceQuerySignal answer:Smalltalk
+                    do:[
+                        Compiler evaluate:theCode asString notifying:codeView compile:false.
+                    ].
+
+                    codeView modified:false.
+                    codeModified := false.
+                    self normalLabel.
+                    self updateClassList.
                 ].
-
-                codeView modified:false.
-                codeModified := false.
-                self normalLabel.
-                self updateClassList.
             ].
-            codeView cursor:Cursor normal.
         ].
         self clearExplainAction.
         methodListView notNil ifTrue:[
@@ -5465,77 +5465,77 @@
     |oldMethodCategory oldMethod oldSelector|
 
     self withBusyCursorDo:[
-	"/ alien classes have no methodCategories; hide that list ...
-
-	currentClass notNil ifTrue:[
-	    currentClass supportsMethodCategories ifFalse:[
-		self hideMethodCategoryList
-	    ] ifTrue:[
-		self showMethodCategoryList
-	    ].
-	].
-
-	"/ temporarily nil the aspect, to avoid
-	"/ double redraw.
-	aspect := nil. "/ #definition.
-
-	oldMethodCategory := currentMethodCategory.
-	oldMethod := currentMethod.
-	oldSelector := currentSelector.
-
-	showInstance ifTrue:[
-	    actualClass := acceptClass := currentClass
-	] ifFalse:[
-	    actualClass := acceptClass := currentClass class
-	].
-	currentMethodCategory := nil.
-	self releaseMethod.
-
-	self updateMethodCategoryList.
-
-	oldMethodCategory notNil ifTrue:[
-	    methodCategoryListView setSelectElement:oldMethodCategory.
-	    methodCategoryListView hasSelection ifTrue:[
-		currentMethodCategory := oldMethodCategory.
-		self methodCategorySelectionChanged
-	    ]
-	].
-	aspect := #definition.
-
-	self updateMethodList.
-	"/ self updateCodeView.
-	self updateVariableList.
-
-	fullClass ifTrue:[
-	    self updateCodeView.
-	    codeView acceptAction:[:theCode |
-		codeView cursor:Cursor execute.
-		Object abortSignal catch:[
-		    self compileCode:theCode asString.
-		    codeView modified:false.
-		    codeModified := false.
-		].
-		codeView cursor:Cursor normal.
-	    ].
-	] ifFalse:[
+        "/ alien classes have no methodCategories; hide that list ...
+
+        currentClass notNil ifTrue:[
+            currentClass supportsMethodCategories ifFalse:[
+                self hideMethodCategoryList
+            ] ifTrue:[
+                self showMethodCategoryList
+            ].
+        ].
+
+        "/ temporarily nil the aspect, to avoid
+        "/ double redraw.
+        aspect := nil. "/ #definition.
+
+        oldMethodCategory := currentMethodCategory.
+        oldMethod := currentMethod.
+        oldSelector := currentSelector.
+
+        showInstance ifTrue:[
+            actualClass := acceptClass := currentClass
+        ] ifFalse:[
+            actualClass := acceptClass := currentClass class
+        ].
+        currentMethodCategory := nil.
+        self releaseMethod.
+
+        self updateMethodCategoryList.
+
+        oldMethodCategory notNil ifTrue:[
+            methodCategoryListView setSelectElement:oldMethodCategory.
+            methodCategoryListView hasSelection ifTrue:[
+                currentMethodCategory := oldMethodCategory.
+                self methodCategorySelectionChanged
+            ]
+        ].
+        aspect := #definition.
+
+        self updateMethodList.
+        "/ self updateCodeView.
+        self updateVariableList.
+
+        fullClass ifTrue:[
+            self updateCodeView.
+            codeView acceptAction:[:theCode |
+                codeView withWaitCursorDo:[
+                    Object abortSignal catch:[
+                        self compileCode:theCode asString.
+                        codeView modified:false.
+                        codeModified := false.
+                    ].
+                ].
+            ].
+        ] ifFalse:[
 "/            self classDefinition.
-	    self classListUpdate.
-	    self setAcceptActionForClass.
-	].
-	self clearExplainAction.
-
-	(classCategoryListView notNil and:[currentClass notNil]) ifTrue:[
-	    (currentClassCategory = currentClass category) ifFalse:[
-		currentClassCategory := currentClass category.
-		(classCategoryListView list includes:currentClassCategory) ifTrue:[
-		    classCategoryListView setSelectElement:currentClassCategory
-		] ifFalse:[
-		    classCategoryListView setSelection:nil
-		]
-	    ]
-	].
-
-	self setDoitActionForClass
+            self classListUpdate.
+            self setAcceptActionForClass.
+        ].
+        self clearExplainAction.
+
+        (classCategoryListView notNil and:[currentClass notNil]) ifTrue:[
+            (currentClassCategory = currentClass category) ifFalse:[
+                currentClassCategory := currentClass category.
+                (classCategoryListView list includes:currentClassCategory) ifTrue:[
+                    classCategoryListView setSelectElement:currentClassCategory
+                ] ifFalse:[
+                    classCategoryListView setSelection:nil
+                ]
+            ]
+        ].
+
+        self setDoitActionForClass
     ]
 
     "Created: / 23.11.1995 / 11:32:03 / cg"
@@ -12313,26 +12313,26 @@
                 ns := nil
             ].
 
-            codeView cursor:Cursor execute.
-
-            Class nameSpaceQuerySignal handle:[:ex |
-                ns isNil ifTrue:[
-                    ex reject
-                ].
-                ex proceedWith:ns
-            ] do:[
-                Object abortSignal catch:[
-                    UndefinedObject createMinimumProtocolInNewSubclassQuery
-                    answer:true
-                    do:[
-                        (Class classRedefinitionSignal)handle:[:ex |
-                            |answer oldVsNew oldPkg newPkg|
-
-                            oldVsNew := ex parameter.
-                            oldPkg := oldVsNew key package.
-                            newPkg := oldVsNew value package.
-                            answer := OptionBox 
-                                          request: 
+            codeView withWaitCursorDo:[
+
+                Class nameSpaceQuerySignal handle:[:ex |
+                    ns isNil ifTrue:[
+                        ex reject
+                    ].
+                    ex proceedWith:ns
+                ] do:[
+                    Object abortSignal catch:[
+                        UndefinedObject createMinimumProtocolInNewSubclassQuery
+                        answer:true
+                        do:[
+                            (Class classRedefinitionSignal)handle:[:ex |
+                                |answer oldVsNew oldPkg newPkg|
+
+                                oldVsNew := ex parameter.
+                                oldPkg := oldVsNew key package.
+                                newPkg := oldVsNew value package.
+                                answer := OptionBox 
+                                              request: 
 ('You are about to define a class from another (system-) package.
 The classes original packageID was ''%1''. 
 If you proceed with ''%3'', the new class will be marked as belonging
@@ -12342,40 +12342,40 @@
 Otherwise, hit ''%5'' to leave the class unchanged.
 
 PS: you can disable these checks in the launchers settings-compilation dialog.' 
-                                              bindWith:(oldPkg asText allBold) 
-                                                  with:(newPkg asText allBold)
-                                                  with:(resources string:'continue')
-                                                  with:(resources string:'keep')
-                                                  with:(resources string:'cancel'))
-
-                                          label:'Class redefinition'
-                                          form:(WarningBox iconBitmap)
-                                          buttonLabels:#('cancel' 'keep' 'continue')
-                                          values:#(#cancel #keep #continue)
-                                          default:#keep.
-
-                            (answer ~~ #cancel) ifTrue:[
-                                ex proceedWith:answer
+                                                  bindWith:(oldPkg asText allBold) 
+                                                      with:(newPkg asText allBold)
+                                                      with:(resources string:'continue')
+                                                      with:(resources string:'keep')
+                                                      with:(resources string:'cancel'))
+
+                                              label:'Class redefinition'
+                                              form:(WarningBox iconBitmap)
+                                              buttonLabels:#('cancel' 'keep' 'continue')
+                                              values:#(#cancel #keep #continue)
+                                              default:#keep.
+
+                                (answer ~~ #cancel) ifTrue:[
+                                    ex proceedWith:answer
+                                ]
+                            ] do:[
+                                |rslt|
+
+                                rslt := Compiler 
+                                            evaluate:theCode asString 
+                                            notifying:codeView 
+                                            compile:false.
+
+                                rslt isBehavior ifTrue:[
+                                    self classCategoryUpdate.
+                                    self updateClassListWithScroll:false.
+                                    codeView modified:false.
+                                    codeModified := false.
+                                ].
                             ]
-                        ] do:[
-                            |rslt|
-
-                            rslt := Compiler 
-                                        evaluate:theCode asString 
-                                        notifying:codeView 
-                                        compile:false.
-
-                            rslt isBehavior ifTrue:[
-                                self classCategoryUpdate.
-                                self updateClassListWithScroll:false.
-                                codeView modified:false.
-                                codeModified := false.
-                            ].
                         ]
-                    ]
+                    ].
                 ].
             ].
-            codeView cursor:Cursor normal.
         ].
     ]
 
@@ -12392,30 +12392,30 @@
     "tell the codeView what to do on accept and explain"
 
     codeView acceptAction:[:theCode |
-        codeView cursor:Cursor execute.
-        Object abortSignal catch:[
-            |cls|
-
-            Object errorSignal handle:[:ex |
-                codeView error:ex errorString
-                         position:1 to:nil from:nil.
-            ] do:[
-                Class nameSpaceQuerySignal answer:Smalltalk
-                do:[
-
-                    cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
-                    cls isBehavior ifTrue:[
-                        codeView modified:false.
-                        self classCategoryUpdate.
-                        self updateClassListWithScroll:false.
-                        cls isNamespace ifFalse:[
-                            self switchToClassNamed:(cls name).
+        codeView withWaitCursorDo:[
+            Object abortSignal catch:[
+                |cls|
+
+                Object errorSignal handle:[:ex |
+                    codeView error:ex errorString
+                             position:1 to:nil from:nil.
+                ] do:[
+                    Class nameSpaceQuerySignal answer:Smalltalk
+                    do:[
+
+                        cls := (Compiler evaluate:theCode asString notifying:codeView compile:false).
+                        cls isBehavior ifTrue:[
+                            codeView modified:false.
+                            self classCategoryUpdate.
+                            self updateClassListWithScroll:false.
+                            cls isNamespace ifFalse:[
+                                self switchToClassNamed:(cls name).
+                            ]
                         ]
                     ]
                 ]
-            ]
-        ].
-        codeView cursor:(Cursor normal).
+            ].
+        ].
     ].
     self clearExplainAction.
 
@@ -12425,29 +12425,29 @@
     "tell the codeView what to do on accept and explain"
 
     codeView acceptAction:[:theCode |
-        codeView cursor:Cursor execute.
-        Object abortSignal catch:[
-            |cls|
-
-            Object errorSignal handle:[:ex |
-                ex signal == Object haltSignal ifTrue:[
-                    ex reject
-                ].
-                codeView error:ex errorString position:1 to:nil from:nil.
-            ] do:[
-                cls := JavaCompiler 
-                            evaluateClassDefinition:theCode asString 
-                            notifying:codeView.
-                cls isBehavior ifTrue:[
-                    codeView modified:false.
-                    self classCategoryUpdate.
-                    self updateClassListWithScroll:false.
-                    self switchToClassNamed:(cls name).
-                    self classDefinition.
+        codeView withWaitCursorDo:[
+            Object abortSignal catch:[
+                |cls|
+
+                Object errorSignal handle:[:ex |
+                    ex signal == Object haltSignal ifTrue:[
+                        ex reject
+                    ].
+                    codeView error:ex errorString position:1 to:nil from:nil.
+                ] do:[
+                    cls := JavaCompiler 
+                                evaluateClassDefinition:theCode asString 
+                                notifying:codeView.
+                    cls isBehavior ifTrue:[
+                        codeView modified:false.
+                        self classCategoryUpdate.
+                        self updateClassListWithScroll:false.
+                        self switchToClassNamed:(cls name).
+                        self classDefinition.
+                    ]
                 ]
-            ]
-        ].
-        codeView cursor:(Cursor normal).
+            ].
+        ].
     ].
     self clearExplainAction.
 
@@ -12470,26 +12470,26 @@
             ].
         ].
 
-        codeView cursor:Cursor execute.
-
-        (cat := currentMethodCategory) = '* all *' ifTrue:[
-            "must check from which category this code came from ...
-             ... thanks to Arno for pointing this out"
-
-            cat := self askForMethodCategory.
-        ].
-        (cat notNil and:[cat notEmpty]) ifTrue:[
-            Object abortSignal catch:[
-                lockUpdates := true.
-
-                (Class methodRedefinitionSignal) handle:[:ex |
-                    |answer oldVsNew oldPkg newPkg|
-
-                    oldVsNew := ex parameter.
-                    oldPkg := oldVsNew key package.
-                    newPkg := oldVsNew value package.
-                    answer := OptionBox 
-                                  request: 
+        codeView withWaitCursorDo:[
+
+            (cat := currentMethodCategory) = '* all *' ifTrue:[
+                "must check from which category this code came from ...
+                 ... thanks to Arno for pointing this out"
+
+                cat := self askForMethodCategory.
+            ].
+            (cat notNil and:[cat notEmpty]) ifTrue:[
+                Object abortSignal catch:[
+                    lockUpdates := true.
+
+                    (Class methodRedefinitionSignal) handle:[:ex |
+                        |answer oldVsNew oldPkg newPkg|
+
+                        oldVsNew := ex parameter.
+                        oldPkg := oldVsNew key package.
+                        newPkg := oldVsNew value package.
+                        answer := OptionBox 
+                                      request: 
 ('You are about to change a method from another (system-) package.
 The methods original packageID was ''%1''. 
 If you proceed, the new method will be marked as belonging
@@ -12499,41 +12499,41 @@
 Otherwise, hit ''cancel'' to leave the code unchanged.
 
 PS: you can disable these checks in the launchers settings-compilation dialog.' 
-                                        bindWith:(oldPkg asText allBold)
-                                            with:(newPkg asText allBold))
-
-                                  label:'Method redefinition'
-                                  form:(WarningBox iconBitmap)
-                                  buttonLabels:#('cancel' 'keep' 'continue')
-                                  values:#(#cancel #keep #continue)
-                                  default:#continue.
-
-                    (answer ~~ #cancel) ifTrue:[
-                        ex proceedWith:answer
+                                            bindWith:(oldPkg asText allBold)
+                                                with:(newPkg asText allBold))
+
+                                      label:'Method redefinition'
+                                      form:(WarningBox iconBitmap)
+                                      buttonLabels:#('cancel' 'keep' 'continue')
+                                      values:#(#cancel #keep #continue)
+                                      default:#continue.
+
+                        (answer ~~ #cancel) ifTrue:[
+                            ex proceedWith:answer
+                        ]
+                    ] do:[
+
+                        rslt := actualClass compilerClass 
+                            compile:theCode asString
+                            forClass:cls
+                            inCategory:cat 
+                            notifying:codeView.
+
+                        codeView modified:false.
+                        codeModified := false.
+                        currentMethod := actualClass compiledMethodAt:currentSelector.
+                        methodCategoryListView notNil ifTrue:[    
+                            (methodCategoryListView list includes:cat) ifFalse:[
+                                self updateMethodCategoryListWithScroll:false.
+                            ]
+                        ].
+                        self updateMethodListWithScroll:false keepSelection:(rslt == currentMethod).
+                        self normalLabel.
                     ]
-                ] do:[
-
-                    rslt := actualClass compilerClass 
-                        compile:theCode asString
-                        forClass:cls
-                        inCategory:cat 
-                        notifying:codeView.
-
-                    codeView modified:false.
-                    codeModified := false.
-                    currentMethod := actualClass compiledMethodAt:currentSelector.
-                    methodCategoryListView notNil ifTrue:[    
-                        (methodCategoryListView list includes:cat) ifFalse:[
-                            self updateMethodCategoryListWithScroll:false.
-                        ]
-                    ].
-                    self updateMethodListWithScroll:false keepSelection:(rslt == currentMethod).
-                    self normalLabel.
-                ]
+                ].
+                lockUpdates := false.
             ].
-            lockUpdates := false.
-        ].
-        codeView cursor:Cursor normal.
+        ].
     ].
 
     codeView explainAction:[:theCode :theSelection |
@@ -14016,6 +14016,6 @@
 !BrowserView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.574 1999-12-03 14:29:36 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.575 1999-12-08 20:43:01 ca Exp $'
 ! !
 BrowserView initialize!