--- a/Query.st Tue Jul 27 16:54:33 1999 +0200
+++ b/Query.st Wed Jul 28 09:53:29 1999 +0200
@@ -1,3 +1,5 @@
+'From Smalltalk/X, Version:3.5.3 on 26-jul-1999 at 00:02:41' !
+
Exception subclass:#Query
instanceVariableNames:''
classVariableNames:''
@@ -20,14 +22,139 @@
!
-examples
+examples
"
- examples to be added.
- [exBegin]
- ... add code fragment for
- ... executable example here ...
- [exEnd]
+ an up-query from a deeply nested operation to a higher level:
+ [exBegin]
+ |zero|
+
+ zero := 0.
+ Query handle:[:ex |
+ Transcript showCR:'query'.
+ ex proceedWith:true
+ ] do:[
+ 'nesting'.
+ [
+ [
+ Object errorSignal handle:[:ex |
+ Transcript showCR:'some error: ' , ex errorString.
+ ex proceed
+ ] do:[
+ [
+ 1 // zero. 'an error which is caught in the handler'.
+ (Query query) == true ifTrue:[
+ Transcript showCR:'query says: ok'.
+ ] ifFalse:[
+ Transcript showCR:'query says: no'
+ ]
+ ] value
+ ]
+ ] value
+ ] value
+ ]
+ [exEnd]
+ for lazy typists, a more compact interface is also provided
+ (which is also easier to read):
+ [exBegin]
+ Query answer:true do:[
+ 'nesting'.
+ [
+ [
+ (Query query) == true ifTrue:[
+ Transcript showCR:'query says: ok'.
+ ] ifFalse:[
+ Transcript showCR:'query says: no'
+ ]
+ ] value
+ ] value
+ ]
+ [exEnd]
+ an up-query from a deeply nested operation, for which there
+ is no handler:
+ (notice, this would not work with normal signals, which would raise
+ another unhandled exception-exception;
+ also notice the == check #raise's return value being true,
+ instead of a simple ifTrue; this handles a nil-value from
+ the unhandled query)
+ [exBegin]
+ |zero|
+
+ zero := 0.
+ [
+ 'nesting'.
+ [
+ [
+ Object errorSignal handle:[:ex |
+ Transcript showCR:'some error: ' , ex errorString.
+ ex proceed
+ ] do:[
+ [
+ 1 // zero. 'an error which is caught in the handler'.
+ (Query raise) == true ifTrue:[
+ Transcript showCR:'query says: ok'.
+ ] ifFalse:[
+ Transcript showCR:'query says: no'
+ ]
+ ] value
+ ]
+ ] value
+ ] value
+ ] value
+ [exEnd]
+ counter-example, just to show that things would not work this way
+ with regular signals:
+ [exBegin]
+ |signal|
+
+ signal := Signal new.
+ 'nesting deeply'.
+ [
+ [
+ [
+ [
+ [
+ (signal raise) == true ifTrue:[
+ Transcript showCR:'query says: ok'.
+ ] ifFalse:[
+ Transcript showCR:'query says: no'
+ ]
+ ] value
+ ] value
+ ] value
+ ] value
+ ] value
+ [exEnd]
+
+ except, by handling the unhandled exception
+ (but we think, that querySignals are easier to use and
+ better document the intent):
+ [exBegin]
+ |signal|
+
+ signal := Signal new.
+ 'nesting deeply'.
+ [
+ [
+ [
+ [
+ [
+ Signal noHandlerSignal handle:[:ex |
+ ex proceedWith:nil
+ ] do:[
+ (signal raise) == true ifTrue:[
+ Transcript showCR:'query says: ok'.
+ ] ifFalse:[
+ Transcript showCR:'query says: no'
+ ]
+ ]
+ ] value
+ ] value
+ ] value
+ ] value
+ ] value
+ [exEnd]
"
+
!
history
@@ -41,7 +168,8 @@
If the receiver is queried during evaluation, answer with someAnswer.
This is a wrapper for #handle:do: for lazy typists; no new functionality."
- ^ self handle:[:ex | ex proceedWith:someAnswer] do:aBlock.
+ thisContext markForHandle.
+ aBlock value.
"
Query answer:true do:[
@@ -60,7 +188,7 @@
"Created: / 10.7.1996 / 15:08:20 / cg"
"Modified: / 14.10.1996 / 16:59:18 / cg"
- "Modified: / 23.7.1999 / 15:26:13 / stefan"
+ "Modified: / 25.7.1999 / 23:12:19 / stefan"
! !
!Query class methodsFor:'queries'!
@@ -97,6 +225,27 @@
"Created: / 23.7.1999 / 15:16:03 / stefan"
!
+handlerForSignal:signal context:theContext originator:originator
+ "answer the handler block for the signal from originator.
+ The block is retrieved from aContext.
+ Answer nil if the signal is not handled"
+
+ |arg|
+
+ theContext selector == #'answer:do:' ifTrue:[
+ (self accepts:signal) ifTrue:[
+ arg := theContext argAt:1.
+ ^ [:ex| ex proceedWith:arg].
+ ]
+ ] ifFalse:[
+ ^ super handlerForSignal:signal context:theContext originator:originator.
+ ].
+
+ ^ nil
+
+ "Created: / 25.7.1999 / 23:11:55 / stefan"
+!
+
isQuerySignal
^ true
@@ -104,6 +253,37 @@
"Created: / 23.7.1999 / 14:59:50 / stefan"
!
+query
+ "raise the query - return the handlers value, or the default
+ value, if there is no handler.
+ Invoking the handler is exactly the functionality of Signal>>raiseRequest,
+ but we can do it faster here."
+
+ |con s|
+
+ con := thisContext sender.
+ [con notNil] whileTrue:[
+ con := con findSpecialHandle:true raise:true.
+ con notNil ifTrue:[
+ (con selector == #answer:do:) ifFalse:[
+ ^ super raiseRequest
+ ].
+ (s := con receiver) == self ifTrue:[
+ ^ con argAt:1
+ ] ifFalse:[
+ (s accepts:self) ifTrue:[
+ ^ super raiseRequest
+ ]
+ ]
+ ]
+ ].
+ "/ no handler found - return the default value
+ ^ self defaultAnswer
+
+ "Modified: / 15.6.1998 / 21:27:37 / cg"
+ "Modified: / 25.7.1999 / 23:15:16 / stefan"
+!
+
raise
"QuerySignals are proceedable by definition,
so they should be raised with #query or #raiseRequest"
@@ -118,51 +298,7 @@
^ self query
- "Created: / 23.7.1999 / 15:19:35 / stefan"
-! !
-
-!Query class methodsFor:'query'!
-
-query
- "raise the query - return the handlers value, or the default
- value, if there is no handler.
- Invoking the handler is exactly the functionality of Signal>>raiseRequest,
- but we can do it faster here."
-
- |con s|
-
- con := thisContext sender.
- [con notNil] whileTrue:[
- con := con findNextContextWithSelector:#doRaise
- or:#handle:do:
- or:#handle:from:do:.
- con notNil ifTrue:[
- (con selector == #handle:do:) ifFalse:[
- ^ super raiseRequest
- ].
- (s := con receiver) == self ifTrue:[
- "/ found a non-busy handler ...
- "/ if its sender is a #answer context,
- "/ fetch its value quickly from it.
- con := con sender.
- con selector == #answer:do: ifFalse:[
- con receiver == self ifFalse:[
- ^ super raiseRequest
- ]
- ].
- ^ con argAt:1
- ] ifFalse:[
- (s accepts:self) ifTrue:[
- ^ super raiseRequest
- ]
- ]
- ]
- ].
- "/ no handler found - return the default value
- ^ self defaultAnswer
-
- "Modified: / 15.6.1998 / 21:27:37 / cg"
- "Modified: / 23.7.1999 / 15:19:59 / stefan"
+ "Created: / 25.7.1999 / 23:25:59 / stefan"
! !
!Query methodsFor:'default actions'!
@@ -179,5 +315,5 @@
!Query class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Query.st,v 1.1 1999-07-23 17:53:13 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Query.st,v 1.2 1999-07-28 07:53:26 stefan Exp $'
! !