*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Fri, 21 Sep 2001 12:29:05 +0200
changeset 1071 b63a3093e0db
parent 1070 3f87ae65a554
child 1072 be2dc8ccd3d7
*** empty log message ***
MessageTracer.st
--- a/MessageTracer.st	Mon Sep 10 16:12:24 2001 +0200
+++ b/MessageTracer.st	Fri Sep 21 12:29:05 2001 +0200
@@ -1396,6 +1396,43 @@
     "Modified: 22.10.1996 / 17:39:33 / cg"
 !
 
+traceUpdateMethod:aMethod on:aStream
+    "arrange for a trace message to be output on aStream, 
+     when aMethod is executed. 
+     Traces both entry and exit.
+     Use unwrapMethod to remove this.
+     This one is specialized for change-update calling i.e. it traces from the update
+     back to the origial change message."
+
+    |lvl inside|
+
+    ^ self 
+        wrapMethod:aMethod
+        onEntry:[:con |
+                        inside isNil ifTrue:[
+                            inside := true.
+                            CallingLevel isNil ifTrue:[
+                                CallingLevel := 0.
+                            ].
+                            lvl notNil ifTrue:[
+                                lvl := lvl + 1
+                            ] ifFalse:[
+                                CallingLevel := lvl := CallingLevel + 1.
+                            ].
+                            MessageTracer printUpdateEntryFull:con level:lvl on:aStream.
+                            inside := nil
+                        ]
+                 ]
+        onExit:[:con :retVal |
+                        inside isNil ifTrue:[
+                            inside := true.
+                            MessageTracer printExit:con with:retVal level:lvl on:aStream.
+                            CallingLevel := lvl := lvl - 1.
+                            inside := nil
+                        ]
+                ]
+!
+
 untraceMethod:aMethod
     "remove tracing of aMethod"
 
@@ -2829,7 +2866,14 @@
 !
 
 printFull:aContext on:aStream withSender:withSender
-    |sender mClass mClassName|
+    self
+        printFull:aContext on:aStream 
+        withSenderContext:(withSender ifTrue:[aContext sender]
+                                      ifFalse:[nil])
+!
+
+printFull:aContext on:aStream withSenderContext:aSenderContextOrNil
+    |mClass mClassName|
 
     mClass := aContext methodClass.
     mClass isNil ifTrue:[
@@ -2855,19 +2899,10 @@
         aStream nextPutAll:'] '.
     ].
 
-    withSender ifTrue:[
-        sender := aContext sender.
-        sender notNil ifTrue:[
-            (sender selector startsWith:'perform:') ifTrue:[
-                sender := sender sender.
-            ].
-        ].
-        aStream nextPutAll:'from:'. 
-        sender printOn:aStream.
+    aSenderContextOrNil notNil ifTrue:[
+        self printSender:aSenderContextOrNil on:aStream.
     ].
     aStream cr; flush.
-
-    "Modified: 5.3.1997 / 12:40:55 / cg"
 !
 
 printObject:anObject on:aStream
@@ -2880,6 +2915,55 @@
     aStream nextPutAll:s
 !
 
+printSender:aSenderContext on:aStream
+    |sender|
+
+    sender := aSenderContext.
+    sender notNil ifTrue:[
+        (sender selector startsWith:'perform:') ifTrue:[
+            sender := sender sender.
+        ].
+    ].
+    aStream nextPutAll:'from:'. 
+    aStream bold.
+    sender printOn:aStream.
+    aStream normal.
+!
+
+printUpdateEntryFull:aContext level:lvl on:aStream
+    |con|
+
+    con := aContext.
+
+    [con notNil
+     and:[con selector ~~ #'changed:with:'] 
+    ] whileTrue:[
+        con := con sender.
+    ].
+    "/ con is #'changed:with:'
+    con isNil ifTrue:[
+        ^ self printEntryFull:aContext level:lvl on:aStream.
+    ].
+
+    (con sender notNil
+    and:[ con sender selector == #'changed:']) ifTrue:[
+        con := con sender.
+    ].
+    (con sender notNil
+    and:[ con sender selector == #'changed']) ifTrue:[
+        con := con sender.
+    ].
+    (con sender notNil) ifTrue:[
+        con := con sender.
+    ].
+
+    aStream spaces:lvl; nextPutAll:'enter '.
+    self
+        printFull:aContext 
+        on:aStream 
+        withSenderContext:con
+!
+
 traceEntryFull:aContext on:aStream
     aStream nextPutLine:'-----------------------------------------'.
     aContext fullPrintAllOn:aStream
@@ -3039,6 +3123,6 @@
 !MessageTracer class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.93 2000-12-04 11:28:45 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.94 2001-09-21 10:29:05 cg Exp $'
 ! !
 MessageTracer initialize!