--- 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!