--- a/MessageTracer.st	Tue Jul 29 11:16:53 2014 +0200
+++ b/MessageTracer.st	Tue Jul 29 13:33:07 2014 +0200
@@ -2885,8 +2885,8 @@
     "
     (aSelector == #class
     or:[aSelector == #changeClassTo:]) ifTrue:[
-	Transcript showCR:'sorry, cannot place trap on: ' , aSelector.
-	^ self
+        Transcript showCR:'sorry, cannot place trap on: ' , aSelector.
+        ^ self
     ].
 
     WrappedMethod autoload.     "/ just to make sure ...
@@ -2897,19 +2897,19 @@
     "
     orgClass := anObject class.
     orgClass category == #'* trapping *' ifTrue:[
-	newClass := orgClass
+        newClass := orgClass
     ] ifFalse:[
-	myMetaclass := orgClass class.
-
-	newClass := myMetaclass copy new.
-	newClass setSuperclass:orgClass.
-	newClass instSize:orgClass instSize.
-	newClass flags:orgClass flags.
-	newClass isMeta ifFalse:[newClass setClassVariableString:''].
-	newClass setInstanceVariableString:''.
-	newClass setName:orgClass name.
-	newClass setCategory:#'* trapping *'.
-	newClass methodDictionary:MethodDictionary new.
+        myMetaclass := orgClass class.
+
+        newClass := myMetaclass copy new.
+        newClass setSuperclass:orgClass.
+        newClass instSize:orgClass instSize.
+        newClass flags:orgClass flags.
+        newClass isMeta ifFalse:[newClass setClassVariableString:''].
+        newClass setInstanceVariableString:''.
+        newClass setName:orgClass name.
+        newClass setCategory:#'* trapping *'.
+        newClass methodDictionary:MethodDictionary new.
     ].
 
     "
@@ -2921,68 +2921,74 @@
     s nextPutAll:' <context: #return>'.
     s nextPutAll:' |retVal stubClass '.
     additionalVariables notNil ifTrue:[
-	s nextPutAll:additionalVariables.
+        s nextPutAll:additionalVariables.
     ].
     s nextPutAll:'| '.
     withOriginalClass ifTrue:[
-	s nextPutAll:'stubClass := self class. '.
-	s nextPutAll:'self changeClassTo:(stubClass superclass). '.
+        s nextPutAll:'stubClass := self class. '.
+        s nextPutAll:'self changeClassTo:(stubClass superclass). '.
     ].
     additionalEntryCode notNil ifTrue:[
-	s nextPutAll:additionalEntryCode.
+        s nextPutAll:additionalEntryCode.
     ].
     entryBlock notNil ifTrue:[
-	s nextPutAll:'#literal1 yourself value:thisContext. '.               "/ #literal1 will be replaced by the entryBlock
+        s nextPutAll:'#literal1 yourself value:thisContext. '.               "/ #literal1 will be replaced by the entryBlock
     ].
     s nextPutAll:('retVal := #originalMethod. ').                            "/ just to get a place for the originalMethod
     s nextPutAll:('retVal := super ' , spec , '. ').
     exitBlock notNil ifTrue:[
-	s nextPutAll:'#literal2 yourself value:thisContext value:retVal. '.  "/ #literal2 will be replaced by the exitBlock
+        s nextPutAll:'#literal2 yourself value:thisContext value:retVal. '.  "/ #literal2 will be replaced by the exitBlock
     ].
     additionalExitCode notNil ifTrue:[
-	s nextPutAll:additionalExitCode.
+        s nextPutAll:additionalExitCode.
     ].
     withOriginalClass ifTrue:[
-	s nextPutAll:'self changeClassTo:stubClass. '.
+        s nextPutAll:'self changeClassTo:stubClass. '.
     ].
     s nextPutAll:'^ retVal'; cr.
 
     ParserFlags
-	withSTCCompilation:#never
-	do:[
-	    Class withoutUpdatingChangesDo:[
-		trapMethod := Compiler
-				compile:s contents
-				forClass:newClass
-				inCategory:'breakpointed'
-				notifying:nil
-				install:false
-				skipIfSame:false
-				silent:true.
-	    ]
-	].
+        withSTCCompilation:#never
+        do:[
+            Class withoutUpdatingChangesDo:[
+                [
+                    trapMethod := Compiler
+                                    compile:s contents
+                                    forClass:newClass
+                                    inCategory:'breakpointed'
+                                    notifying:nil
+                                    install:false
+                                    skipIfSame:false
+                                    silent:true.
+                ] on: ParseError do:[:ex |
+                    "/ Sigh, compiler used to return #Error but now raises
+                    "/ a ParseError. Simulate old behaviour
+                    trapMethod := #Error
+                ].
+            ]
+        ].
 
     trapMethod == #Error ifTrue:[
-	Transcript showCR:('cannot place trap on method: ' , aSelector).
-	^ self
+        Transcript showCR:('cannot place trap on method: ' , aSelector).
+        ^ self
     ].
 
     implClass := orgClass whichClassIncludesSelector:aSelector.
     implClass isNil ifTrue:[
-	Transcript showCR:aSelector , ' is not understood by ' , orgClass name.
+        Transcript showCR:aSelector , ' is not understood by ' , orgClass name.
     ] ifFalse:[
-	originalMethod := (implClass compiledMethodAt:aSelector).
-	originalMethod notNil ifTrue:[
-	    trapMethod setPackage:originalMethod package.
-	].
-
-	trapMethod changeLiteral:#originalMethod to:originalMethod.
+        originalMethod := (implClass compiledMethodAt:aSelector).
+        originalMethod notNil ifTrue:[
+            trapMethod setPackage:originalMethod package.
+        ].
+
+        trapMethod changeLiteral:#originalMethod to:originalMethod.
     ].
     entryBlock notNil ifTrue:[
-	trapMethod changeLiteral:#literal1 to:entryBlock.
+        trapMethod changeLiteral:#literal1 to:entryBlock.
     ].
     exitBlock notNil ifTrue:[
-	trapMethod changeLiteral:#literal2 to:exitBlock.
+        trapMethod changeLiteral:#literal2 to:exitBlock.
     ].
     "
      change the source of this new method
@@ -2998,33 +3004,33 @@
     dict := newClass methodDictionary.
     dict := dict at:aSelector putOrAppend:trapMethod.
     flushCaches ifTrue:[
-	newClass methodDictionary:dict.
+        newClass methodDictionary:dict.
     ] ifFalse:[
-	newClass setMethodDictionary:dict.
+        newClass setMethodDictionary:dict.
     ].
 
     "
      and finally, the big trick:
     "
     newClass ~~ orgClass ifTrue:[
-	anObject changeClassTo:newClass
+        anObject changeClassTo:newClass
     ].
 
     "
-									[exBegin]
+                                                                        [exBegin]
      |p|
 
      p := Point new copy.
      MessageTracer
-		wrap:p
-	    selector:#y:
-	     onEntry:nil
-	      onExit:[:context :retVal |
-			 Transcript show:'leave Point>>y:, returning:'.
-			 Transcript showCR:retVal printString.
-			 Transcript endEntry
-		     ]
-	       withOriginalClass:true.
+                wrap:p
+            selector:#y:
+             onEntry:nil
+              onExit:[:context :retVal |
+                         Transcript show:'leave Point>>y:, returning:'.
+                         Transcript showCR:retVal printString.
+                         Transcript endEntry
+                     ]
+               withOriginalClass:true.
      Transcript showCR:'sending x: ...'.
      p x:1.
      Transcript showCR:'sending y: ...'.
@@ -3034,19 +3040,19 @@
      p x:2.
      Transcript showCR:'sending y: ...'.
      p y:1.
-									[exEnd]
+                                                                        [exEnd]
     "
 
     "
-									[exBegin]
+                                                                        [exBegin]
      |p|
 
      p := Point new copy.
      MessageTracer wrap:p
-	       selector:#y:
-		onEntry:[:context | self halt:'y: you are trapped']
-		 onExit:nil
-		  withOriginalClass:false.
+               selector:#y:
+                onEntry:[:context | self halt:'y: you are trapped']
+                 onExit:nil
+                  withOriginalClass:false.
      Transcript showCR:'sending x: ...'.
      p x:1.
      Transcript showCR:'sending y: ...'.
@@ -3056,11 +3062,12 @@
      p x:2.
      Transcript showCR:'sending y: ...'.
      p y:1.
-									[exEnd]
+                                                                        [exEnd]
     "
 
     "Modified: / 25-06-1996 / 22:11:21 / stefan"
     "Created: / 21-04-1998 / 15:30:27 / cg"
+    "Modified: / 29-07-2014 / 11:58:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 wrap:anObject selector:aSelector onEntry:entryBlock onExit:exitBlock withOriginalClass:withOriginalClass flushCaches:flushCaches
@@ -3674,7 +3681,7 @@
 !MessageTracer class methodsFor:'documentation'!
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.132 2014-07-29 09:15:28 vrany Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.133 2014-07-29 11:33:07 vrany Exp $'
 ! !