initial checkin
authorStefan Vogel <sv@exept.de>
Fri, 23 Jul 1999 19:53:36 +0200
changeset 4446 4da4e51fc1ab
parent 4445 7011a3da6c72
child 4447 b41133d7941b
initial checkin
Query.st
Warning.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Query.st	Fri Jul 23 19:53:36 1999 +0200
@@ -0,0 +1,183 @@
+Exception subclass:#Query
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Kernel-Exceptions'
+!
+
+!Query class methodsFor:'documentation'!
+
+documentation
+"    
+    Query ist an abstract superclass of all query exceptions in the system
+
+    [author:]
+        Stefan Vogel
+
+    [see also:]
+        Signal QuerySignal
+"
+
+!
+
+examples
+"
+    examples to be added.
+								[exBegin]
+    ... add code fragment for 
+    ... executable example here ...
+								[exEnd]
+"
+!
+
+history
+    "Created: / 23.7.1999 / 14:16:16 / stefan"
+! !
+
+!Query class methodsFor:'answering queries'!
+
+answer:someAnswer do:aBlock
+     "evaluate the argument, aBlock.
+      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.
+
+      "
+       Query answer:true do:[
+          Transcript showCR:'query answers: ' , (Query query printString).
+       ]
+      "
+
+      "
+       Query answer:false do:[
+          Transcript showCR:'first query answers: ' , (Query query printString).
+          Query answer:true do:[
+              Transcript showCR:'second query answers: ' , (Query query printString).
+          ]
+       ]
+      "
+
+    "Created: / 10.7.1996 / 15:08:20 / cg"
+    "Modified: / 14.10.1996 / 16:59:18 / cg"
+    "Modified: / 23.7.1999 / 15:26:13 / stefan"
+! !
+
+!Query class methodsFor:'queries'!
+
+accepts:aSignal
+    "return true, if the receiver accepts the argument, aSignal.
+     (i.e. the receiver is aSignal or a parent of it). False otherwise."
+
+    |s|
+
+    aSignal isQuerySignal ifFalse:[^ false].
+
+    s := aSignal.
+    [s notNil] whileTrue:[
+        self == s ifTrue:[^ true].
+        s := s parent
+    ].
+    ^ false
+
+    "Modified: / 22.3.1999 / 12:45:32 / stefan"
+    "Created: / 23.7.1999 / 15:18:00 / stefan"
+!
+
+defaultAnswer
+    "Return the default answer to the Query. This method is called,
+     if nobody catches the signal.
+
+     Subclasses may redefine this method."
+
+    "Calling raiseRequest here will execute the exception's action method"    
+
+    ^ super raiseRequest
+
+    "Created: / 23.7.1999 / 15:16:03 / stefan"
+!
+
+isQuerySignal
+
+    ^ true
+
+    "Created: / 23.7.1999 / 14:59:50 / stefan"
+!
+
+raise
+    "QuerySignals are proceedable by definition,
+     so they should be raised with #query or #raiseRequest"
+
+    ^ self shouldNotImplement
+
+    "Created: / 23.7.1999 / 15:19:17 / stefan"
+!
+
+raiseRequest
+    "redefined to use #query"
+
+    ^ 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"
+! !
+
+!Query methodsFor:'default actions'!
+
+action
+    "the default action is to return the default value.
+     Subclasses may redefine this"
+
+    ^ nil
+
+    "Modified: / 23.7.1999 / 15:13:34 / stefan"
+! !
+
+!Query class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic/Query.st,v 1.1 1999-07-23 17:53:13 stefan Exp $'
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Warning.st	Fri Jul 23 19:53:36 1999 +0200
@@ -0,0 +1,65 @@
+Exception subclass:#Warning
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Kernel-Exceptions'
+!
+
+!Warning class methodsFor:'documentation'!
+
+documentation
+"
+    Warning ist an abstract superclass of all warning exceptions in the system
+
+    [author:]
+        Stefan Vogel
+
+    [see also:]
+        Signal
+"
+
+!
+
+examples
+"
+                                                            [exBegin]
+    Warning raiseRequest
+                                                            [exEnd]
+"
+
+! !
+
+!Warning class methodsFor:'initialization'!
+
+initialize
+
+    NotifierString := 'Warning'.
+
+    "
+     self initialize
+    "
+
+    "Created: / 23.7.1999 / 15:34:27 / stefan"
+! !
+
+!Warning methodsFor:'default actions'!
+
+action
+    "Default action for warnings: open a warn box with errorString"
+
+    self proceedWith:(Dialog warn:self errorString)
+
+
+    "
+      Warning raiseRequest
+    "
+
+    "Modified: / 23.7.1999 / 15:35:27 / stefan"
+! !
+
+!Warning class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic/Warning.st,v 1.1 1999-07-23 17:53:36 stefan Exp $'
+! !
+Warning initialize!