added conditional wrap
authorclaus
Mon, 21 Nov 1994 17:40:42 +0100
changeset 12 2bfc13a2b95a
parent 11 3553d053d5b8
child 13 e416e7aa11e1
added conditional wrap
MessageTracer.st
MsgTracer.st
--- a/MessageTracer.st	Mon Oct 10 01:52:49 1994 +0100
+++ b/MessageTracer.st	Mon Nov 21 17:40:42 1994 +0100
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1994 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.4 1994-10-10 00:52:49 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.5 1994-11-21 16:40:42 claus Exp $
 '!
 
 !MessageTracer class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.4 1994-10-10 00:52:49 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.5 1994-11-21 16:40:42 claus Exp $
 "
 !
 
@@ -81,6 +81,15 @@
 
 
 
+    trapping evaluation of a specific method with
+    receiver being an instance of some class:
+
+	MessageTracer trapMethod:aMethod forInstancesOf:aClass
+	...
+	MessageTracer unwrapMethod:aMethod
+
+
+
     tracing sends to a specific object:
 
 	MessageTracer trace:anObject selector:aSelector
@@ -107,6 +116,43 @@
 	...
 	MessageTracer unwrapmethod:aMethod
 "
+!
+
+examples
+"
+  For the common cases, you will find a menu entry in the SystemBrowser.
+  Howeever, more special cases (especially with condition checks) can be
+  set up by evaluating the lower level entries.
+
+
+  trapping specific methods:
+  (by class/selector):
+
+     MessageTracer trapClass:Collection selector:#select:.
+     Dictionary new select:[:e | ].       'not cought - Dictionary has its own select'.
+     (Array new:10) select:[:e | ].       'not cought - SeqColl has its own select'.
+     Set new select:[:e | ].              'cought - Set inherits this from Collection'.
+     MessageTracer untrapClass:Collection 
+
+  (by method):
+     MessageTracer trapMethod:(Collection compiledMethodAt:#select:).
+     Dictionary new select:[:e | ].       'not cought - Dictionary has its own select'.
+     (Array new:10) select:[:e | ].       'not cought - SeqColl has its own select'.
+     Set new select:[:e | ].              'cought - Set inherits this from Collection'.
+     MessageTracer unwrapMethod:(Collection compiledMethodAt:#select:).
+
+  tracing specific methods:
+  (by class/selector):
+
+     MessageTracer traceClass:SequenceableCollection selector:#quickSortFrom:to:.
+     #(6 1 9 66 2 17) copy sort.
+     MessageTracer untraceClass:SequenceableCollection 
+
+  (by method):
+     MessageTracer traceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+     #(6 1 9 66 2 17) copy sort.
+     MessageTracer unwrapMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:). 
+"
 ! !
 
 !MessageTracer class methodsFor:'initialization'!
@@ -843,7 +889,6 @@
     ^ self wrapMethod:aMethod
 	      onEntry:[:context |
 			 BreakpointSignal raise
-			 "/ Debugger enter:context withMessage:'breakPoint hit'
 		      ]
 	       onExit:[:context :retVal | ].
 
@@ -863,9 +908,28 @@
      trace facilities ..."
 
     ^ self unwrapMethod:aMethod
-! !
+!
+
+trapMethod:aMethod forInstancesOf:aClass
+    "arrange for the debugger to be entered when aMethod is about to be executed
+     for an instance of aClass.
+     Use unwrapMethod or untrapClass to remove this trap.
+     Be careful, to not place a trap on code needed in the debugger (i.e. on scrollBars etc.);
+     if there is a need to trap those, use the low-level wrap-methods, and put a check into the
+     entry/leave blocks."
 
-!MessageTracer class methodsFor:'class breakpointing'!
+    ^ self wrapMethod:aMethod
+	      onEntry:[:context |
+			 (context receiver isMemberOf:aClass) ifTrue:[
+			     BreakpointSignal raise
+			 ]
+		      ]
+	       onExit:[:context :retVal | ].
+
+    "
+     MessageTracer trapMethod:(View compiledMethodAt:#redraw) forInstancesOf:myView.
+    "
+!
 
 trapClass:aClass selector:aSelector
     "arrange for the debugger to be entered when a message with aSelector is 
@@ -874,12 +938,7 @@
      if there is a need to trap those, use the low-level wrap-methods, and put a check into the
      entry/leave blocks."
 
-    self wrapMethod:(aClass compiledMethodAt:aSelector)
-	 onEntry:[:context |
-		     BreakpointSignal raise
-		     "/ Debugger enter:context withMessage:'breakPoint hit'
-		 ]
-	 onExit:[:context :retVal | ].
+    self trapMethod:(aClass compiledMethodAt:aSelector)
 
     "
      MessageTracer trapClass:Collection selector:#select:.
@@ -1096,24 +1155,6 @@
     ^ self wrapMethod:aMethod
 	 onEntry:[:con | MessageTracer printEntryFull:con]
 	 onExit:[:con :retVal | MessageTracer printExit:con with:retVal]
-"
-    ^ self wrapMethod:aMethod
-	 onEntry:[:con | 
-		     'enter ' errorPrint. con receiver class name errorPrint.
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' args=' errorPrint. (con args) printString errorPrint.
-		     ' from:' errorPrint. con sender errorPrintNL.
-		 ]
-	 onExit:[:con :retVal |
-		     'leave ' errorPrint. con receiver class name errorPrint. 
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' returning:' errorPrint. retVal printString errorPrintNL.
-		].
-"
 
     "
      MessageTracer traceMethod:(Integer compiledMethodAt:#factorial).
@@ -1142,16 +1183,6 @@
     ^ self wrapMethod:aMethod
 	      onEntry:[:con | MessageTracer printEntrySender:con]
 	      onExit:[:con :retVal | ].
-"
-    ^ self wrapMethod:aMethod
-	      onEntry:[:con |
-			  con receiver class name errorPrint.
-			  '>>' errorPrint. con selector errorPrint. 
-			  ' from ' errorPrint.
-			  con sender errorPrintNL.  
-		      ]
-	      onExit:[:con :retVal | ].
-"
 !
 
 untraceMethod:aMethod
@@ -1173,24 +1204,6 @@
 	 onEntry:[:con | MessageTracer printEntryFull:con]
 	 onExit:[:con :retVal | MessageTracer printExit:con with:retVal]
 
-"
-    self wrapMethod:(aClass compiledMethodAt:aSelector)
-	 onEntry:[:con | 
-		     'enter ' errorPrint. con receiver class name errorPrint.
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' args=' errorPrint. (con args) printString errorPrint.
-		     ' from:' errorPrint. con sender errorPrintNL.
-		 ]
-	 onExit:[:con :retVal |
-		     'leave ' errorPrint. con receiver class name errorPrint. 
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' returning:' errorPrint. retVal printString errorPrintNL.
-		].
-"
 
     "
      MessageTracer traceClass:Integer selector:#factorial.
--- a/MsgTracer.st	Mon Oct 10 01:52:49 1994 +0100
+++ b/MsgTracer.st	Mon Nov 21 17:40:42 1994 +0100
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1994 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.4 1994-10-10 00:52:49 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.5 1994-11-21 16:40:42 claus Exp $
 '!
 
 !MessageTracer class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.4 1994-10-10 00:52:49 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.5 1994-11-21 16:40:42 claus Exp $
 "
 !
 
@@ -81,6 +81,15 @@
 
 
 
+    trapping evaluation of a specific method with
+    receiver being an instance of some class:
+
+	MessageTracer trapMethod:aMethod forInstancesOf:aClass
+	...
+	MessageTracer unwrapMethod:aMethod
+
+
+
     tracing sends to a specific object:
 
 	MessageTracer trace:anObject selector:aSelector
@@ -107,6 +116,43 @@
 	...
 	MessageTracer unwrapmethod:aMethod
 "
+!
+
+examples
+"
+  For the common cases, you will find a menu entry in the SystemBrowser.
+  Howeever, more special cases (especially with condition checks) can be
+  set up by evaluating the lower level entries.
+
+
+  trapping specific methods:
+  (by class/selector):
+
+     MessageTracer trapClass:Collection selector:#select:.
+     Dictionary new select:[:e | ].       'not cought - Dictionary has its own select'.
+     (Array new:10) select:[:e | ].       'not cought - SeqColl has its own select'.
+     Set new select:[:e | ].              'cought - Set inherits this from Collection'.
+     MessageTracer untrapClass:Collection 
+
+  (by method):
+     MessageTracer trapMethod:(Collection compiledMethodAt:#select:).
+     Dictionary new select:[:e | ].       'not cought - Dictionary has its own select'.
+     (Array new:10) select:[:e | ].       'not cought - SeqColl has its own select'.
+     Set new select:[:e | ].              'cought - Set inherits this from Collection'.
+     MessageTracer unwrapMethod:(Collection compiledMethodAt:#select:).
+
+  tracing specific methods:
+  (by class/selector):
+
+     MessageTracer traceClass:SequenceableCollection selector:#quickSortFrom:to:.
+     #(6 1 9 66 2 17) copy sort.
+     MessageTracer untraceClass:SequenceableCollection 
+
+  (by method):
+     MessageTracer traceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+     #(6 1 9 66 2 17) copy sort.
+     MessageTracer unwrapMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:). 
+"
 ! !
 
 !MessageTracer class methodsFor:'initialization'!
@@ -843,7 +889,6 @@
     ^ self wrapMethod:aMethod
 	      onEntry:[:context |
 			 BreakpointSignal raise
-			 "/ Debugger enter:context withMessage:'breakPoint hit'
 		      ]
 	       onExit:[:context :retVal | ].
 
@@ -863,9 +908,28 @@
      trace facilities ..."
 
     ^ self unwrapMethod:aMethod
-! !
+!
+
+trapMethod:aMethod forInstancesOf:aClass
+    "arrange for the debugger to be entered when aMethod is about to be executed
+     for an instance of aClass.
+     Use unwrapMethod or untrapClass to remove this trap.
+     Be careful, to not place a trap on code needed in the debugger (i.e. on scrollBars etc.);
+     if there is a need to trap those, use the low-level wrap-methods, and put a check into the
+     entry/leave blocks."
 
-!MessageTracer class methodsFor:'class breakpointing'!
+    ^ self wrapMethod:aMethod
+	      onEntry:[:context |
+			 (context receiver isMemberOf:aClass) ifTrue:[
+			     BreakpointSignal raise
+			 ]
+		      ]
+	       onExit:[:context :retVal | ].
+
+    "
+     MessageTracer trapMethod:(View compiledMethodAt:#redraw) forInstancesOf:myView.
+    "
+!
 
 trapClass:aClass selector:aSelector
     "arrange for the debugger to be entered when a message with aSelector is 
@@ -874,12 +938,7 @@
      if there is a need to trap those, use the low-level wrap-methods, and put a check into the
      entry/leave blocks."
 
-    self wrapMethod:(aClass compiledMethodAt:aSelector)
-	 onEntry:[:context |
-		     BreakpointSignal raise
-		     "/ Debugger enter:context withMessage:'breakPoint hit'
-		 ]
-	 onExit:[:context :retVal | ].
+    self trapMethod:(aClass compiledMethodAt:aSelector)
 
     "
      MessageTracer trapClass:Collection selector:#select:.
@@ -1096,24 +1155,6 @@
     ^ self wrapMethod:aMethod
 	 onEntry:[:con | MessageTracer printEntryFull:con]
 	 onExit:[:con :retVal | MessageTracer printExit:con with:retVal]
-"
-    ^ self wrapMethod:aMethod
-	 onEntry:[:con | 
-		     'enter ' errorPrint. con receiver class name errorPrint.
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' args=' errorPrint. (con args) printString errorPrint.
-		     ' from:' errorPrint. con sender errorPrintNL.
-		 ]
-	 onExit:[:con :retVal |
-		     'leave ' errorPrint. con receiver class name errorPrint. 
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' returning:' errorPrint. retVal printString errorPrintNL.
-		].
-"
 
     "
      MessageTracer traceMethod:(Integer compiledMethodAt:#factorial).
@@ -1142,16 +1183,6 @@
     ^ self wrapMethod:aMethod
 	      onEntry:[:con | MessageTracer printEntrySender:con]
 	      onExit:[:con :retVal | ].
-"
-    ^ self wrapMethod:aMethod
-	      onEntry:[:con |
-			  con receiver class name errorPrint.
-			  '>>' errorPrint. con selector errorPrint. 
-			  ' from ' errorPrint.
-			  con sender errorPrintNL.  
-		      ]
-	      onExit:[:con :retVal | ].
-"
 !
 
 untraceMethod:aMethod
@@ -1173,24 +1204,6 @@
 	 onEntry:[:con | MessageTracer printEntryFull:con]
 	 onExit:[:con :retVal | MessageTracer printExit:con with:retVal]
 
-"
-    self wrapMethod:(aClass compiledMethodAt:aSelector)
-	 onEntry:[:con | 
-		     'enter ' errorPrint. con receiver class name errorPrint.
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' args=' errorPrint. (con args) printString errorPrint.
-		     ' from:' errorPrint. con sender errorPrintNL.
-		 ]
-	 onExit:[:con :retVal |
-		     'leave ' errorPrint. con receiver class name errorPrint. 
-					  '>>' errorPrint.
-					  con selector errorPrint. 
-		     ' receiver=' errorPrint. con receiver printString errorPrint.
-		     ' returning:' errorPrint. retVal printString errorPrintNL.
-		].
-"
 
     "
      MessageTracer traceClass:Integer selector:#factorial.