Support for Block>>#on:do:on:do:
authorStefan Vogel <sv@exept.de>
Thu, 20 Jan 2005 13:26:20 +0100
changeset 8681 38aa963476a5
parent 8680 21698f6f2e5f
child 8682 3bbf34191ca2
Support for Block>>#on:do:on:do:
ExceptionHandlerSet.st
GenericException.st
Notification.st
Query.st
QueryWithoutDefault.st
Signal.st
SignalSet.st
Warning.st
--- a/ExceptionHandlerSet.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/ExceptionHandlerSet.st	Thu Jan 20 13:26:20 2005 +0100
@@ -137,16 +137,25 @@
 
 !ExceptionHandlerSet methodsFor:'queries'!
 
-accepts:aSignal
+accepts:anExceptionHandler
     "return true, if the receiver accepts the argument, aSignal.
      (i.e. if any of the receivers elements is aSignal or a parent of it)."
 
-    self keysDo:[:sig | (sig==aSignal or:[sig accepts:aSignal]) ifTrue:[^ true]].
+    self keysDo:[:eachExceptionHandler | 
+        (eachExceptionHandler==anExceptionHandler 
+         or:[eachExceptionHandler accepts:anExceptionHandler]) ifTrue:[^ true].
+    ].
     ^ false
 
     "Created: / 26.7.1999 / 09:53:09 / stefan"
 !
 
+exceptionHandlerFor:anException in:aContext
+    "answer the exceptionHandler for anException from aContext."
+
+    ^ self
+!
+
 handlerForSignal:signal
     "answer the handler block for signal"
 
@@ -199,10 +208,14 @@
 
 !
 
-handlingExceptionInContext:theContext
-    "answer the handling exceptionHandlerSet from aContext."
+handles:anException
+    "return true, if the receiver handles the argument, anException.
+     (i.e. if any of the receivers elements handles anException)."
 
-    ^ self
+    self keysDo:[:eachExceptionHandler| 
+        (eachExceptionHandler handles:anException) ifTrue:[^ true]
+    ].
+    ^ false
 !
 
 isExceptionHandler
@@ -313,5 +326,5 @@
 !ExceptionHandlerSet class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ExceptionHandlerSet.st,v 1.14 2004-09-23 12:58:57 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ExceptionHandlerSet.st,v 1.15 2005-01-20 12:26:10 stefan Exp $'
 ! !
--- a/GenericException.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/GenericException.st	Thu Jan 20 13:26:20 2005 +0100
@@ -344,7 +344,7 @@
     self isQuerySignal ifTrue:[
         sig := QuerySignal basicNew.
         mayProceedBoolean ifFalse:[
-            'Exception [warning]: nonProceedable Queries do not make sense' infoPrintCR.
+            'Exception [warning]: nonProceedable queries do not make sense' infoPrintCR.
         ].
     ] ifFalse:[
         sig := Signal basicNew.
@@ -403,7 +403,7 @@
     self == aSignal ifTrue:[^ true].
     aSignal isQuerySignal ifTrue:[^ false].
 
-    s := aSignal.
+    s := aSignal parent.
     [s notNil] whileTrue:[
         self == s ifTrue:[^ true].
         s := s parent
@@ -446,6 +446,20 @@
     ^ false
 !
 
+exceptionHandlerFor:anException in:aContext
+    "answer the exceptionHandler for anException from aContext."
+
+    |sel|
+
+    sel := aContext selector.
+    (sel == #'handle:from:do:'
+     or:[sel == #'handle:do:']) ifTrue:[
+        ^ aContext receiver
+    ].
+
+    ^ nil
+!
+
 handlerForSignal:signal context:theContext originator:originator
     "answer the handler block for the signal from originator.
      The block is retrieved from aContext.
@@ -477,18 +491,21 @@
     ]].
 !
 
-handlingExceptionInContext:theContext
-    "answer the handling exception from aContext."
-
-    |sel|
-
-    sel := theContext selector.
-    (sel == #'handle:from:do:'
-     or:[sel == #'handle:do:']) ifTrue:[
-        ^ theContext receiver
+handles:anException
+    "return true, if the receiver handles the argument, anException.
+     (i.e. the receiver is anExceptions signal or a parent of it)"
+
+    |signal|
+
+    signal := anException signal.
+
+    self == signal ifTrue:[^ true].               "quick check"
+    anException isNotification ifTrue:[^ false].  "speed up queries by not traversing the parent chain"
+
+    [(signal := signal parent) notNil] whileTrue:[
+        self == signal ifTrue:[^ true].
     ].
-
-    ^ nil
+    ^ false
 !
 
 inheritsFrom:anotherSignal
@@ -1114,6 +1131,33 @@
     "Modified: / 12.3.1998 / 15:30:45 / stefan"
 !
 
+handler
+    "return the exception handler (Signal or SignalSet or ExceptionHandlerSet or Exception)
+     that handles the exception.
+     This is only valid during handler evaluation, and answers
+     the object which accepted the actual exception."
+
+    handlerContext isNil ifTrue:[
+        ^ nil.
+    ].
+    ^ handlerContext receiver exceptionHandlerFor:self in:handlerContext.
+
+    "
+      [
+          2 // 0
+      ] on:Error do:[:ex| ex handler inspect]
+
+      [
+          2 // 0
+      ] on:ArithmeticError, Error do:[:ex| ex handler inspect]
+
+      [
+          2 // 0
+      ] on:MessageNotUnderstood do:[:ex| ex handler inspect]
+        on:Error do:[:ex| ex handler inspect]
+    "
+!
+
 handlerContext
     "return the context of the handler"
 
@@ -1121,12 +1165,8 @@
 !
 
 handlingException
-    "return the handling exception (or signalSet or Exception).
-     This is only valid during handler evaluation, and answers
-     the object which accepted the actual signal.
-     (i.e. the parent or signalSet or handlerCollection)"
-
-    ^ handlingException
+    <resource: #obsolete>
+    ^ self handler
 !
 
 isResumable
@@ -1808,8 +1848,6 @@
             ) ifTrue:[
                 "call the handler"
 
-                "remember the handling signal, sigSet, exception or whatever"
-                handlingException := r handlingExceptionInContext:currentContext.
                 handlerContext := currentContext.
                 currentContext := nil.
                 self doCallHandler:handler.
@@ -1958,12 +1996,16 @@
     ^ true
 
     "Created: / 17.11.2001 / 18:37:27 / cg"
+!
+
+isNotification
+    ^ false
 ! !
 
 !GenericException class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.93 2005-01-13 12:34:59 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.94 2005-01-20 12:25:46 stefan Exp $'
 ! !
 
 GenericException initialize!
--- a/Notification.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/Notification.st	Thu Jan 20 13:26:20 2005 +0100
@@ -132,7 +132,7 @@
     self == aSignal ifTrue:[^ true].
     aSignal isQuerySignal ifFalse:[^ false].
 
-    s := aSignal.
+    s := aSignal parent.
     [s notNil] whileTrue:[
         self == s ifTrue:[^ true].
         s := s parent
@@ -177,6 +177,23 @@
     "Created: / 25.7.1999 / 23:11:55 / stefan"
 !
 
+handles:anException
+    "return true, if the receiver handles the argument, anException.
+     (i.e. the receiver is anExceptions signal or a parent of it)"
+
+    |signal|
+
+    signal := anException signal.
+
+    self == signal ifTrue:[^ true].               "quick check"
+    anException isNotification ifFalse:[^ false]. "speed up non-queries by not traversing the parent chain"
+
+    [(signal := signal parent) notNil] whileTrue:[
+        self == signal ifTrue:[^ true].
+    ].
+    ^ false
+!
+
 isQuerySignal
     "return true, if this is a querySignal - always return true here"
 
@@ -249,10 +266,16 @@
     "Modified: / 23.7.1999 / 15:13:34 / stefan"
 ! !
 
+!Notification methodsFor:'testing'!
+
+isNotification
+    ^ true
+! !
+
 !Notification class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.13 2004-09-03 12:49:28 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.14 2005-01-20 12:26:11 stefan Exp $'
 ! !
 
 Notification initialize!
--- a/Query.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/Query.st	Thu Jan 20 13:26:20 2005 +0100
@@ -214,6 +214,7 @@
 !Query class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Query.st,v 1.10 2002-03-01 15:05:14 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Query.st,v 1.11 2005-01-20 12:26:18 stefan Exp $'
 ! !
+
 Query initialize!
--- a/QueryWithoutDefault.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/QueryWithoutDefault.st	Thu Jan 20 13:26:20 2005 +0100
@@ -83,6 +83,7 @@
 !QueryWithoutDefault class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/QueryWithoutDefault.st,v 1.2 2002-03-07 07:54:07 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/QueryWithoutDefault.st,v 1.3 2005-01-20 12:26:17 stefan Exp $'
 ! !
+
 QueryWithoutDefault initialize!
--- a/Signal.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/Signal.st	Thu Jan 20 13:26:20 2005 +0100
@@ -331,6 +331,29 @@
     "Created: / 31.3.1998 / 15:43:01 / cg"
 ! !
 
+!Signal methodsFor:'exception creation'!
+
+newException
+    "answer a new exception object for this signal.
+     Subclasses may redefine this method"
+
+    ^ Exception signal:self originator:nil
+
+    "Created: / 26.2.1998 / 19:53:56 / stefan"
+    "Modified: / 23.7.1999 / 13:41:00 / stefan"
+!
+
+newExceptionFrom:originator
+    "answer a new exception object for this signal.
+     Set the originator.
+     Subclasses may redefine this method"
+
+    ^ Exception signal:self originator:originator
+
+    "Created: / 27.2.1998 / 09:17:00 / stefan"
+    "Modified: / 23.7.1999 / 13:41:15 / stefan"
+! !
+
 !Signal methodsFor:'instance creation'!
 
 newSignal
@@ -403,7 +426,7 @@
     self == aSignal ifTrue:[^ true].
     aSignal isQuerySignal ifTrue:[^ false].
 
-    s := aSignal.
+    s := aSignal parent.
     [s notNil] whileTrue:[
         self == s ifTrue:[^ true].
         s := s parent
@@ -413,6 +436,12 @@
     "Modified: / 22.3.1999 / 12:45:42 / stefan"
 !
 
+exceptionHandlerFor:anException in:aContext
+    "answer the exceptionHandler for anException from aContext."
+
+    ^ self
+!
+
 handlerForSignal:signal context:theContext originator:originator
     "answer the handler block for the signal from originator.
      The block is retrieved from aContext.
@@ -444,10 +473,21 @@
 
 !
 
-handlingExceptionInContext:theContext
-    "answer the handling signal from aContext."
+handles:anException
+    "return true, if the receiver handles the argument, anException.
+     (i.e. the receiver is anExceptions signal or a parent of it)"
+
+    |signal|
+
+    signal := anException signal.
 
-    ^ self
+    self == signal ifTrue:[^ true].               "quick check"
+    anException isNotification ifTrue:[^ false].  "speed up queries by not traversing the parent chain"
+
+    [(signal := signal parent) notNil] whileTrue:[
+        self == signal ifTrue:[^ true].
+    ].
+    ^ false
 !
 
 inheritsFrom:anotherSignal
@@ -508,27 +548,6 @@
 
 !Signal methodsFor:'raising'!
 
-newException
-    "answer a new exception object for this signal.
-     Subclasses may redefine this method"
-
-    ^ Exception signal:self originator:nil
-
-    "Created: / 26.2.1998 / 19:53:56 / stefan"
-    "Modified: / 23.7.1999 / 13:41:00 / stefan"
-!
-
-newExceptionFrom:originator
-    "answer a new exception object for this signal.
-     Set the originator.
-     Subclasses may redefine this method"
-
-    ^ Exception signal:self originator:originator
-
-    "Created: / 27.2.1998 / 09:17:00 / stefan"
-    "Modified: / 23.7.1999 / 13:41:15 / stefan"
-!
-
 raise
     "raise a signal nonproceedable.
      The signals notifierString is used as errorString."
@@ -891,5 +910,5 @@
 !Signal class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.95 2004-06-08 17:10:47 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.96 2005-01-20 12:26:14 stefan Exp $'
 ! !
--- a/SignalSet.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/SignalSet.st	Thu Jan 20 13:26:20 2005 +0100
@@ -92,16 +92,25 @@
 
 !SignalSet methodsFor:'queries'!
 
-accepts:aSignal
+accepts:anExceptionHandler
     "return true, if the receiver accepts the argument, aSignal.
      (i.e. if any of the receivers elements is aSignal or a parent of it).
      False otherwise. The special anySet accepts any (non-query) signal."
 
-    (self == SetOfAnySignal) ifTrue:[^ aSignal isQuerySignal not].
-    self do:[:sig | (sig == aSignal or:[sig accepts:aSignal]) ifTrue:[^ true]].
+    (self == SetOfAnySignal) ifTrue:[^ anExceptionHandler isQuerySignal not].
+    self do:[:eachExceptionHandler | 
+        (eachExceptionHandler==anExceptionHandler 
+         or:[eachExceptionHandler accepts:anExceptionHandler]) ifTrue:[^ true].
+    ].
     ^ false
 !
 
+exceptionHandlerFor:anException in:aContext
+    "answer the exceptionHandler for anException from aContext."
+
+    ^ self
+!
+
 handlerForSignal:signal context:theContext originator:originator
     "answer the handler block for the signal from originator.
      The block is retrieved from aContext.
@@ -138,11 +147,15 @@
     "Created: / 25.7.1999 / 23:46:48 / stefan"
 !
 
-handlingExceptionInContext:theContext
-    "answer the handling signalSet from aContext."
+handles:anException
+    "return true, if the receiver handles the argument, anException.
+     (i.e. if any of the receivers elements handles anException)."
 
-    ^ self
-
+    self == SetOfAnySignal ifTrue:[^ anException isNotification not].
+    self do:[:eachExceptionHandler| 
+        (eachExceptionHandler handles:anException) ifTrue:[^ true]
+    ].
+    ^ false
 !
 
 includes:aSignal
@@ -303,5 +316,5 @@
 !SignalSet class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/SignalSet.st,v 1.38 2002-07-15 09:45:45 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/SignalSet.st,v 1.39 2005-01-20 12:26:20 stefan Exp $'
 ! !
--- a/Warning.st	Tue Jan 18 10:18:31 2005 +0100
+++ b/Warning.st	Thu Jan 20 13:26:20 2005 +0100
@@ -155,7 +155,7 @@
 !Warning class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Warning.st,v 1.10 2003-02-18 13:45:36 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Warning.st,v 1.11 2005-01-20 12:25:49 stefan Exp $'
 ! !
 
 Warning initialize!