nicer context presentation
authorClaus Gittinger <cg@exept.de>
Mon, 21 May 2007 15:11:52 +0200
changeset 10549 e5a55b8ae41f
parent 10548 8a3fdcd87fd9
child 10550 0f2a07595d1c
nicer context presentation
Context.st
--- a/Context.st	Wed May 16 20:41:59 2007 +0200
+++ b/Context.st	Mon May 21 15:11:52 2007 +0200
@@ -1503,11 +1503,16 @@
     "append a printed description of the receiver onto aStream"
 
     aStream nextPutAll:(self receiverPrintString).
-    aStream space.
+    "/ aStream nextPutAll:' '.
+    aStream nextPutAll:' >> '.
+
+    aStream bold.
     self selector printOn:aStream.
+    aStream normal.
     aStream space.
     aStream nextPutAll:' ['; nextPutAll:self lineNumber printString; nextPutAll:']' .
 
+    "Modified: / 21-05-2007 / 13:29:21 / cg"
 !
 
 receiverPrintString
@@ -1515,16 +1520,7 @@
 
     |receiverClass receiverClassName newString implementorClass|
 
-%{
-    /*
-     * special handling for (invalid) free objects.
-     * these only appear if some primitiveCode does not correctly use SEND macros,
-     * which may lead to sends to free objects. In normal operation, this 'cannot' happen.
-     */ 
-    if (__isNonNilObject(__INST(receiver)) && (__qClass(__INST(receiver))==nil)) {
-        receiverClassName = __MKSTRING("FreeObject");
-    }
-%}.
+    receiverClassName := self saveReceiverClassName.
     receiverClassName notNil ifTrue:[^ receiverClassName].
 
     receiverClass := receiver class.
@@ -1559,26 +1555,50 @@
 
         implementorClass notNil ifTrue: [
             (implementorClass ~~ receiverClass) ifTrue: [
-                newString := newString , '>>>',
-                             implementorClass name printString
+                "/ newString := newString , '>>>', implementorClass name printString
+                newString := newString,'(',implementorClass name printString,')'
             ]
         ] ifFalse:[
             self searchClass ~~ receiverClass ifTrue:[
-                newString := newString , '>>>' , self searchClass name
+                "/ newString := newString , '>>>' , self searchClass name
+                newString := newString,'(',self searchClass name,')'
             ].
             "
              kludge for doIt - these unbound methods are not
              found in the classes methodDictionary
             "
             (selector ~~ #doIt and:[selector ~~ #doIt:]) ifTrue:[
-                newString := newString , '>>>**NONE**'
+                "/ newString := newString , '>>>**NONE**'
+                newString := newString , '(**NONE**)'
             ]
         ]
     ].
 
     ^ newString
 
-    "Modified: / 16.11.2001 / 16:04:21 / cg"
+    "Modified: / 21-05-2007 / 13:21:24 / cg"
+!
+
+saveReceiverClassName
+    "return the receivers class-name string or nil, if the receiver is invalid.
+     This cares for invalid (free) objects which may appear with bad primitive code,
+     and prevents a crash in such a case."
+
+    |receiverClassName|
+
+%{
+    /*
+     * special handling for (invalid) free objects.
+     * these only appear if some primitiveCode does not correctly use SEND macros,
+     * which may lead to sends to free objects. In normal operation, this 'cannot' happen.
+     */ 
+    if (__isNonNilObject(__INST(receiver)) && (__qClass(__INST(receiver))==nil)) {
+        receiverClassName = __MKSTRING("FreeObject");
+    }
+%}.
+    ^ receiverClassName
+
+    "Created: / 21-05-2007 / 13:19:37 / cg"
 ! !
 
 !Context methodsFor:'private-accessing'!
@@ -2223,7 +2243,7 @@
 !Context class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.135 2007-05-02 14:12:14 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.136 2007-05-21 13:11:52 cg Exp $'
 ! !
 
 Context initialize!