From 256438ccf9eaf2f45a50c98349d2ac02f52755af Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Thu, 7 Aug 2008 15:45:58 +0200
Subject: Prettify LOAD output.

---
 MLKDynamicContext.m |  3 +++
 MLKInterpreter.m    |  9 +++++++--
 MLKRoot.m           | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 57 insertions(+), 3 deletions(-)

diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index 083fc14..ed01263 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -265,6 +265,9 @@ static MLKDynamicContext *global_context;
 
   [vars setObject:NIL forKey:[[MLKPackage findPackage:@"TOILET-SYSTEM"]
                                intern:@"*SYSTEM-INITIALISED-P*"]];
+  [vars setObject:[MLKInteger integerWithInt:0]
+        forKey:[[MLKPackage findPackage:@"TOILET-SYSTEM"]
+                 intern:@"*LOAD-LEVEL*"]];
 
   global_context = [[self alloc] initWithParent:nil
                                  variables:vars
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 159de2a..a2aa81e 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -1392,6 +1392,9 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
 +(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print
 {
   id eofValue = [[NSObject alloc] init];
+  int level = MLKIntWithInteger ([[MLKDynamicContext currentContext]
+                                   valueForSymbol:[sys intern:@"*LOAD-LEVEL*"]]);
+  int i;
 
   while (YES)
     {
@@ -1427,7 +1430,10 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
         formdesc = MLKPrintToString(code);
 
       //fprintf (stderr, "; COMPILE-MINIMALLY: %s\n", [formdesc UTF8String]);
-      fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]);
+      fprintf (stderr, "; ");
+      for (i = 0; i < level; i++)
+        fprintf (stderr, "| ");
+      fprintf (stderr, "LOAD: %s\n", [formdesc UTF8String]);
       expansion = denullify([[MLKInterpreter
                                eval:code
                                inLexicalContext:[MLKLexicalContext
@@ -1462,7 +1468,6 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
         }
     }
 
-  //NSLog (@"; LOAD: END");
   return YES;
 }
 @end
diff --git a/MLKRoot.m b/MLKRoot.m
index f726841..f295c77 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -150,18 +150,64 @@ static id truify (BOOL value)
 {
   // FIXME
   BOOL success;
+  int l, i;
   NSString *fileName = denullify ([args objectAtIndex:0]);
   NSInputStream *input = [NSInputStream inputStreamWithFileAtPath:fileName];
   MLKStream *stream = LAUTORELEASE ([[MLKStream alloc] initWithInputStream:input]);
+  MLKDynamicContext *oldContext = [MLKDynamicContext currentContext];
+  int level = MLKIntWithInteger ([oldContext
+                                   valueForSymbol:[sys intern:@"*LOAD-LEVEL*"]]);
+  MLKDynamicContext *ctx;
+
+  l = [fileName length];
+  fprintf (stderr, ";\n;  ");
+  for (i = 0; i < 68 - 2*level; i++)
+    fprintf (stderr, "_");
+
+  fprintf (stderr, "\n; /");
+  for (i = 0; i < 30 - l/2 - level; i++)
+    fprintf (stderr, "-");
+  fprintf (stderr, " LOAD: %s ", [fileName UTF8String]);
+  for (i = 0; i < 30 - (l+1)/2 - level; i++)
+    fprintf (stderr, "-");
+  fprintf (stderr, "\n; |\n");
 
   //NSLog (@"%d", [input hasBytesAvailable]);
   [input open];
   //NSLog (@"%d", [input hasBytesAvailable]);
 
-  success = [MLKInterpreter load:stream verbose:YES print:YES];
+  ctx = [[MLKDynamicContext alloc]
+          initWithParent:oldContext
+          variables:nil
+          handlers:nil
+          restarts:nil
+          catchTags:nil
+          activeHandlerEnvironment:nil];
+  [ctx addValue:MLKIntegerWithInt(level + 1)
+       forSymbol:[sys intern:@"*LOAD-LEVEL*"]];
+  [ctx pushContext];
 
+  NS_DURING
+    {
+      success = [MLKInterpreter load:stream verbose:YES print:YES];
+    }
+  NS_HANDLER
+    {
+      [MLKDynamicContext popContext];
+      LRELEASE (ctx);
+      [input close];
+    }
+  NS_ENDHANDLER;
+
+  [MLKDynamicContext popContext];
+  LRELEASE (ctx);
   [input close];
 
+  fprintf (stderr, "; \\");
+  for (i = 0; i < 68 - 2*level; i++)
+    fprintf (stderr, "_");
+  fprintf (stderr, "\n; \n");
+
   RETURN_VALUE (truify (success));
 }
 
-- 
cgit v1.2.3