GScheme-20050303.tar

#EnvWindow.m#

@@ -0,0 +1,171 @@
+
+#import "EnvWindow.h"
+#import "VScheme.h"
+
+@implementation EnvWindow
+
+#define WIDTH  300
+#define HEIGHT 200
+
+static int count = 0;
+- initWithEnv:(Environment *)env
+{
+    NSWindow *window;
+    Environment *layer; int lind;
+    NSRect contentRect = {{0, 0}, {WIDTH, HEIGHT}};
+    NSRect winRect = 
+    {{250+(count%12)*24, 100+(count%12)*24}, {WIDTH, HEIGHT}};
+    NSRect textRect;
+    unsigned int style = NSTitledWindowMask | NSClosableWindowMask |
+        NSMiniaturizableWindowMask | NSResizableWindowMask;
+    NSString *title =              
+        [NSString stringWithFormat:@"Scheme Env. # %d", ++count];              
+
+    length = [env chainLength];
+    names = NSZoneMalloc([self zone], length*sizeof(id));
+    values = NSZoneMalloc([self zone], length*sizeof(id));
+
+    NSAutoreleasePool *pool = [NSAutoreleasePool new];
+    
+    for(lind=length-1, layer = env; lind>=0; lind--){
+        NSMapTable *data = [layer data];
+
+        names[lind] = [NSMutableArray arrayWithArray:[data allKeys]];
+        [names[lind] sortUsingSelector:@selector(compare:)];
+	[names[lind] retain];
+	
+	values[lind] = [NSMutableArray arrayWithCapacity:[names[lind] count]];
+	[values[lind] retain];
+
+        NSMapEnumerator en = [names[lind] objectEnumerator];
+	id key, val;
+        while(NSNextMapEnumeratorPair(&enumerator, (void**)&key, (void**)&val)){
+            id obj = NSMapGet(data, key);
+	    [values[lind] addObject:[VScheme valToString:obj]];
+        }
+                
+        layer = [layer parent];
+    }
+
+    [pool release];
+
+    [self initWithContentRect:winRect
+          styleMask:style
+          backing:NSBackingStoreRetained
+          defer:NO];
+    [self setMinSize:NSMakeSize(WIDTH, HEIGHT)];
+    [self setReleasedWhenClosed:YES];
+
+
+    NSTableColumn *nameColumn, *valueColumn;
+
+    nameColumn = 
+	[(NSTableColumn *)[NSTableColumn alloc] 
+			  initWithIdentifier: @"Name"];
+    [nameColumn setEditable: NO];
+    [[nameColumn headerCell] setStringValue: @"Name"];
+    [nameColumn setMinWidth:WIDTH/2];
+
+    valueColumn = 
+	[(NSTableColumn *)[NSTableColumn alloc] 
+			  initWithIdentifier: @"Value"];
+    [valueColumn setEditable: NO];
+    [[valueColumn headerCell] setStringValue: @"Value"];
+    [valueColumn setMinWidth:WIDTH/2];
+
+    table = 
+	[[NSTableView alloc] initWithFrame:contentRect];
+    [table addTableColumn:nameColumn]; RELEASE(nameColumn);
+    [table addTableColumn:valueColumn]; RELEASE(valueColumn);
+
+    current=length-1;
+    [table setDataSource:self];
+   
+    scrollView = [[NSScrollView alloc] initWithFrame:contentRect];
+    [scrollView setHasHorizontalScroller:YES];
+    [scrollView setHasVerticalScroller:YES]; 
+    [scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
+    [[scrollView contentView] 
+	setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
+    [[scrollView contentView] setAutoresizesSubviews:YES];
+
+    [table setFrameSize:[scrollView contentSize]];
+    [scrollView setDocumentView:table];
+
+    [self setContentView:scrollView];
+    // RELEASE(scrollView);
+
+    [self setTitle:title];
+    [self display];
+    [self makeKeyAndOrderFront:nil];
+
+    return self;
+}
+
+- up:(id)sender
+{
+    if(!current){
+        NSBeep();
+    }
+    else{
+        current--;
+	[table reloadData];
+    }
+
+    return self;
+}
+
+- down:(id)sender
+{
+    if(current==length-1){
+        NSBeep();
+    }
+    else{
+        current++;
+	[table reloadData];
+    }
+
+    return self;
+}
+
+- (int)numberOfRowsInTableView:(NSTableView *)aTableView
+{
+    return [names[current] count];
+}
+
+-            (id)tableView:(NSTableView *)aTableView 
+ objectValueForTableColumn:(NSTableColumn *)aTableColumn 
+                       row:(int)rowIndex
+{
+    if(rowIndex>=[names[current] count]){
+	return nil;
+    }
+
+    if([[aTableColumn identifier] isEqualToString:@"Name"]){
+	return [names[current] objectAtIndex:rowIndex];
+    }
+    else{
+	return [values[current] objectAtIndex:rowIndex];
+    }
+}
+
+- (void)dealloc
+{
+    int ind;
+
+    [table release];
+    [scrollView release];
+    
+    for(ind=0; ind<length; ind++){
+        // NSLog(@"%@ %d %d\n", self, ind, [tables[ind] retainCount]);
+	[names[ind] release];
+	[values[ind] release];
+    }
+
+    NSZoneFree([self zone], names);
+    NSZoneFree([self zone], values);
+
+    [super dealloc];
+}
+@end
+

Document.h

@@ -27,19 +27,21 @@
 #import <Foundation/NSData.h>
 #import <Foundation/NSAttributedString.h>
 #import <AppKit/NSDocument.h>
-#import <AppKit/NSTextView.h>
+
+#import "SCMTextView.h"
 
 @interface Document : NSDocument
 {
-    NSTextView *tview;
+    NSScrollView *sview;
+    SCMTextView *tview;
+
     NSString *progstr;
     BOOL readOnly;
 }
 
 - init;
 
-- (void)dealloc;
+- (void)textDidChange:(NSNotification *)textObject;
-
 - (void)makeWindowControllers;
 
 - evaluate:(id)sender;
@@ -48,6 +50,8 @@
 - (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)aType;
 
 - (BOOL)readFromFile:(NSString *)fileName ofType:(NSString *)docType;
-- (BOOL)writeToFile:(NSString *)fileName ofType:(NSString *)docType;
+- (BOOL)writeToFile:(NSString *)fullDocumentPath ofType:(NSString *)docType 
+       originalFile:(NSString *)fullOriginalDocumentPath 
+      saveOperation:(NSSaveOperationType)saveOperationType;
 
 @end

Document.m

@@ -26,6 +26,7 @@
  */
 #include <AppKit/AppKit.h>
 #include <AppKit/NSWindowController.h>
+
 #include "Document.h"
 #include "SCMTextView.h"
 
@@ -43,10 +44,9 @@
     return [super init];
 }
 
-- (void)dealloc
+- (void)textDidChange:(NSNotification *)textObject
 {
-  // RELEASE (tview);
+    [self updateChangeCount: NSChangeDone];
-  [super dealloc];
 }
 
 - (NSData *)dataRepresentationOfType:(NSString *)aType 
@@ -58,7 +58,6 @@
       NSString *msg = [NSString stringWithFormat: @"Unknown type: %@", 
                                 [aType uppercaseString]];
       NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
-      // [msg autorelease];
       return nil;
   }
 }
@@ -73,8 +72,7 @@
         NSString *msg = [NSString stringWithFormat: @"Unknown type: %@", 
                                   [aType uppercaseString]];
         NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
-        // [msg autorelease];
+          return NO;
-        return NO;
     }
 
     return YES;
@@ -90,29 +88,31 @@
         readOnly = YES;
 
         NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
-        // [msg autorelease];
+      }
-    }
 
     return [super readFromFile:fileName ofType:docType];
 }
 
-- (BOOL)writeToFile:(NSString *)fileName ofType:(NSString *)docType
+- (BOOL)writeToFile:(NSString *)fullDocumentPath ofType:(NSString *)docType 
+       originalFile:(NSString *)fullOriginalDocumentPath 
+      saveOperation:(NSSaveOperationType)saveOperationType;
 {
-    BOOL result = [super writeToFile:fileName ofType:docType];
+    BOOL result = 
-    if(result==YES && readOnly==YES){
+	[super writeToFile:fullDocumentPath ofType:docType
+	       originalFile:fullOriginalDocumentPath
+	       saveOperation:saveOperationType];
+    if(result==YES && readOnly==YES && saveOperationType==NSSaveAsOperation){
         NSString *msg = [NSString stringWithFormat: @"File now writable: %@", 
-                                  fileName];
+                                  fullDocumentPath];
         NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
-        // [msg autorelease];
+  
-
         readOnly = NO;
         [tview setEditable:YES];
     }
     else if(result==NO){
         NSString *msg = [NSString stringWithFormat: @"Write failed: %@", 
-                                  fileName];
+                                  fullDocumentPath];
         NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
-        // [msg autorelease];
     }
 
     return result;
@@ -136,12 +136,19 @@ extern NSWindow *interpreterWindow;
     res = [vm processString:progstr mode:MODE_EVALUATE];
 
     if(res==NO){
+	int errpos = [vm errpos];
+	if(errpos!=-1){
+	    [tview selectLineAtPos:errpos];
+	}
+	
         NSRunAlertPanel(@"Error", [vm errmsg], 
                         @"Ok", nil, nil);
     }
     else{
         [interpreterWindow makeKeyAndOrderFront:self];
     }
+
+    return self;
 }
 
 - (void) makeWindowControllers
@@ -150,88 +157,89 @@ extern NSWindow *interpreterWindow;
   NSWindow *win = [self makeWindow];
   
   controller = [[NSWindowController alloc] initWithWindow: win];
-  // RELEASE (win);
+  RELEASE (win);
   [self addWindowController:controller];
-  // RELEASE(controller);
+  RELEASE(controller);
 
   // We have to do this ourself, as there is currently no nib file
   [self windowControllerDidLoadNib:controller];
 } 
 
-
 @end
 
+int shiftPos = 0;
+#define WREP 7
+
 @implementation Document (Private)
 
-static int shiftPos = 0;
-#define WREP 7
-
 - (NSWindow*)makeWindow
 {
-  NSWindow *window;
+    NSWindow *window;
-  NSScrollView *scrollView;
+    NSScrollView *scrollView;
-  NSTextView *textView;
+    SCMTextView *textView;
-  NSRect scrollViewRect = {{0, 0}, {470, 400}};
+    NSRect scrollViewRect = {{0, 0}, {470, 400}};
-  NSRect winRect = {{100+25*(shiftPos%WREP), 100+25*(shiftPos%WREP)},
+    NSRect winRect = {{100+25*(shiftPos%WREP), 100+25*(shiftPos%WREP)},
-                    {470, 400}};
+		      {470, 400}};
-  NSRect textRect;
+    NSRect textRect;
-  unsigned int style = NSTitledWindowMask | NSClosableWindowMask | 
+    unsigned int style = NSTitledWindowMask | NSClosableWindowMask | 
-      NSMiniaturizableWindowMask | NSResizableWindowMask;
+	NSMiniaturizableWindowMask | NSResizableWindowMask;
-  shiftPos++;
+    shiftPos++;
   
-  // This is expected to be retained, as it would normaly come from a
+    // This is expected to be retained, as it would normaly come from a
-  // nib file, where the owner would retain it.
+    // nib file, where the owner would retain it.
-  window = [[NSWindow alloc] initWithContentRect: winRect
+    window = [[NSWindow alloc] initWithContentRect: winRect
-			     styleMask: style
+			       styleMask: style
-			     backing: NSBackingStoreRetained
+			       backing: NSBackingStoreRetained
-			     defer: NO];
+			       defer: NO];
-  [window setMinSize:NSMakeSize(300, 300)];
+    [window setMinSize:NSMakeSize(300, 300)];
+    [window setReleasedWhenClosed:YES];
    
-  scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
+    scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
-  [scrollView setHasHorizontalScroller: NO];
+    [scrollView setHasHorizontalScroller: NO];
-  [scrollView setHasVerticalScroller: YES]; 
+    [scrollView setHasVerticalScroller: YES]; 
-  [scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
+    [scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
-  [[scrollView contentView] setAutoresizingMask: NSViewHeightSizable 
+    [[scrollView contentView] setAutoresizingMask: NSViewHeightSizable 
-			    | NSViewWidthSizable];
+			      | NSViewWidthSizable];
-  [[scrollView contentView] setAutoresizesSubviews:YES];
+    [[scrollView contentView] setAutoresizesSubviews:YES];
+    sview = scrollView;
 
-  // Build up the text network
+    // Build up the text network
-  textRect = [[scrollView contentView] frame];
+    textRect = [[scrollView contentView] frame];
-  textView = [[SCMTextView alloc] initWithFrame: textRect];
+    textView = [[SCMTextView alloc] initWithFrame: textRect];
 
-  [textView setBackgroundColor: [NSColor whiteColor]];
+    [textView setBackgroundColor: [NSColor whiteColor]];
 
-  [textView setString:progstr];
+    [textView setString:progstr];
-  [textView setFont:[NSFont userFixedPitchFontOfSize:12]];
+    [textView setFont:[NSFont userFixedPitchFontOfSize:12]];
-  [textView setEditable:(readOnly==NO ? YES : NO)];
+    [textView setEditable:(readOnly==NO ? YES : NO)];
 
-  [textView setDelegate: self];
+    [textView setDelegate: self];
-  [textView setHorizontallyResizable: NO];
+    [textView setHorizontallyResizable: NO];
-  [textView setVerticallyResizable: YES];
+    [textView setVerticallyResizable: YES];
-  [textView setMinSize: NSMakeSize (0, 0)];
+    [textView setMinSize: NSMakeSize (0, 0)];
-  [textView setMaxSize: NSMakeSize (1E7, 1E7)];
+    [textView setMaxSize: NSMakeSize (1E7, 1E7)];
-  [textView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
+    [textView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
-  [[textView textContainer] setContainerSize: NSMakeSize (textRect.size.width,
+    [[textView textContainer] setContainerSize: NSMakeSize (textRect.size.width,
-							  1e7)];
+							    1e7)];
-  [[textView textContainer] setWidthTracksTextView: YES];
+    [[textView textContainer] setWidthTracksTextView: YES];
-  // Store the text view in an ivar
+    // Store the text view in an ivar
-  tview = textView;
+    tview = textView;
 
-  [scrollView setDocumentView: textView];
+    [scrollView setDocumentView: textView];
-  // RELEASE(textView);
+    RELEASE(textView);
-  [window setContentView: scrollView];
+    [window setContentView: scrollView];
-  // RELEASE(scrollView);
+    RELEASE(scrollView);
 
-  // Make the Document the delegate of the window
+    // Make the Document the delegate of the window
-  [window setDelegate: self];
+    [window setDelegate: self];
+    [window setTitle:[self displayName]];
 
-  // Make the text view the first responder
+    // Make the text view the first responder
-  [window makeFirstResponder:textView];
+    [window makeFirstResponder:textView];
-  [window display];
+    [window display];
-  [window orderFront: nil];
+    [window orderFront: nil];
 
-  return window;
+    return window;
 }
 
-
 @end

EnvWindow.h

@@ -8,9 +8,11 @@
     int current;
     int length;
 
-    id *forms;
+    id *names;
+    id *values;
 
     NSScrollView *scrollView;
+    NSTableView *table;
 }
 
 - initWithEnv:(Environment *)env;
@@ -18,7 +20,13 @@
 - up:(id)sender;
 - down:(id)sender;
 
-- releaseForms;
+- (int)numberOfRowsInTableView:(NSTableView *)aTableView;
+-            (id)tableView:(NSTableView *)aTableView 
+ objectValueForTableColumn:(NSTableColumn *)aTableColumn 
+                       row:(int)rowIndex;
+
+
+- (void)dealloc;
 
 @end
 

EnvWindow.m

@@ -12,7 +12,7 @@ static int count = 0;
 {
     NSWindow *window;
     Environment *layer; int lind;
-    NSRect scrollViewRect = {{0, 0}, {WIDTH, HEIGHT}};
+    NSRect contentRect = {{0, 0}, {WIDTH, HEIGHT}};
     NSRect winRect = 
     {{250+(count%12)*24, 100+(count%12)*24}, {WIDTH, HEIGHT}};
     NSRect textRect;
@@ -21,59 +21,76 @@ static int count = 0;
     NSString *title =              
         [NSString stringWithFormat:@"Scheme Env. # %d", ++count];              
 
-    length = [env chainLength]; current=length-1;
+    length = [env chainLength];
-    forms = NSZoneMalloc([self zone], length*sizeof(id));
+    names = NSZoneMalloc([self zone], length*sizeof(id));
+    values = NSZoneMalloc([self zone], length*sizeof(id));
 
+    NSAutoreleasePool *pool = [NSAutoreleasePool new];
+    
     for(lind=length-1, layer = env; lind>=0; lind--){
-        NSMutableDictionary *data = [layer data];
+        NSMapTable *data = [layer data];
-        NSMutableArray *keys;
-        NSEnumerator *en;
-        id key, form;
 
-        keys = [NSMutableArray arrayWithCapacity:1];
+        names[lind] = [NSMutableArray arrayWithArray:NSAllMapTableKeys(data)];
-        [keys setArray:[data allKeys]];
+        [names[lind] sortUsingSelector:@selector(compare:)];
-        [keys sortUsingSelector:@selector(compare:)];
+	[names[lind] retain];
+	
+	values[lind] = [NSMutableArray arrayWithCapacity:[names[lind] count]];
+	[values[lind] retain];
 
-        en = [keys objectEnumerator];
+        NSEnumerator *en = [names[lind] objectEnumerator];
-
+	id key;
-
-        forms[lind] = form = 
-            [[NSForm alloc] initWithFrame:scrollViewRect];
         while((key = [en nextObject])!=nil){
-            id obj = [data objectForKey:key];
+            id obj = NSMapGet(data, key);
-            id ctitle = [NSString stringWithFormat:@" %@ ", key];
+	    [values[lind] addObject:[VScheme valToString:obj]];
-            id cell = [form addEntry:ctitle];
-
-            [cell setEditable:NO];
-            [cell setEnabled:NO];
-            [cell setStringValue:[VScheme valToString:obj]];
         }
-        
+                
-        [form setEntryWidth:WIDTH];
-        [form setAutosizesCells:YES];
-        [form setAutoresizingMask:NSViewWidthSizable];
-
-        // [form retain];
-        
         layer = [layer parent];
     }
 
+    [pool release];
+
     [self initWithContentRect:winRect
           styleMask:style
           backing:NSBackingStoreRetained
           defer:NO];
     [self setMinSize:NSMakeSize(WIDTH, HEIGHT)];
     [self setReleasedWhenClosed:YES];
+
+
+    NSTableColumn *nameColumn, *valueColumn;
+
+    nameColumn = 
+	[(NSTableColumn *)[NSTableColumn alloc] 
+			  initWithIdentifier: @"Name"];
+    [nameColumn setEditable: NO];
+    [[nameColumn headerCell] setStringValue: @"Name"];
+    [nameColumn setMinWidth:WIDTH/2];
+
+    valueColumn = 
+	[(NSTableColumn *)[NSTableColumn alloc] 
+			  initWithIdentifier: @"Value"];
+    [valueColumn setEditable: NO];
+    [[valueColumn headerCell] setStringValue: @"Value"];
+    [valueColumn setMinWidth:WIDTH/2];
+
+    table = 
+	[[NSTableView alloc] initWithFrame:contentRect];
+    [table addTableColumn:nameColumn]; RELEASE(nameColumn);
+    [table addTableColumn:valueColumn]; RELEASE(valueColumn);
+
+    current=length-1;
+    [table setDataSource:self];
    
-    scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
+    scrollView = [[NSScrollView alloc] initWithFrame:contentRect];
     [scrollView setHasHorizontalScroller:YES];
     [scrollView setHasVerticalScroller:YES]; 
     [scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
-    [[scrollView contentView] setAutoresizingMask: NSViewHeightSizable 
+    [[scrollView contentView] 
-                              | NSViewWidthSizable];
+	setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
     [[scrollView contentView] setAutoresizesSubviews:YES];
 
-    [scrollView setDocumentView:forms[current]];
+    [table setFrameSize:[scrollView contentSize]];
+    [scrollView setDocumentView:table];
 
     [self setContentView:scrollView];
     // RELEASE(scrollView);
@@ -91,10 +108,8 @@ static int count = 0;
         NSBeep();
     }
     else{
-        NSRect bounds = [forms[current] bounds];
         current--;
-        [forms[current] setEntryWidth:bounds.size.width];
+	[table reloadData];
-        [scrollView setDocumentView:forms[current]];
     }
 
     return self;
@@ -106,29 +121,51 @@ static int count = 0;
         NSBeep();
     }
     else{
-        NSRect bounds = [forms[current] bounds];
         current++;
-        [forms[current] setEntryWidth:bounds.size.width];
+	[table reloadData];
-        [scrollView setDocumentView:forms[current]];
     }
 
     return self;
 }
 
-- releaseForms
+- (int)numberOfRowsInTableView:(NSTableView *)aTableView
+{
+    return [names[current] count];
+}
+
+-            (id)tableView:(NSTableView *)aTableView 
+ objectValueForTableColumn:(NSTableColumn *)aTableColumn 
+                       row:(int)rowIndex
+{
+    if(rowIndex>=[names[current] count]){
+	return nil;
+    }
+
+    if([[aTableColumn identifier] isEqualToString:@"Name"]){
+	return [names[current] objectAtIndex:rowIndex];
+    }
+    else{
+	return [values[current] objectAtIndex:rowIndex];
+    }
+}
+
+- (void)dealloc
 {
     int ind;
 
-    [scrollView setDocumentView:nil];
+    [table release];
     [scrollView release];
     
     for(ind=0; ind<length; ind++){
-        // NSLog(@"%@ %d %d\n", self, ind, [forms[ind] retainCount]);
+        // NSLog(@"%@ %d %d\n", self, ind, [tables[ind] retainCount]);
-        [forms[ind] release];
+	[names[ind] release];
+	[values[ind] release];
     }
 
-    NSZoneFree([self zone], forms);
+    NSZoneFree([self zone], names);
-    return self;
+    NSZoneFree([self zone], values);
+
+    [super dealloc];
 }
 @end
 

GNUmakefile

@@ -25,7 +25,7 @@ SHARED_CFLAGS     += -g
 AUXILIARY_TOOL_LIBS += -lfl
 
 # The Resource files to be copied into the app's resources directory
-GScheme_RESOURCE_FILES = Scheme/*
+GScheme_RESOURCE_FILES = Scheme/* Icons/*
 
 -include GNUmakefile.preamble
 

GScheme.app/GScheme

@@ -1,218 +0,0 @@
-#!/bin/sh
-#
-# Copyright (C) 1999 Free Software Foundation, Inc.
-#
-# Author: Adam Fedor <fedor@gnu.org>
-# Date: May 1999
-# 
-# This file is part of the GNUstep Makefile Package.
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-# 
-# You should have received a copy of the GNU General Public
-# License along with this library; see the file COPYING.LIB.
-# If not, write to the Free Software Foundation,
-# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-# This is a shell script which attempts to find the GNUstep executable
-# of the same name based on the current host and library_combo.
-
-#--------------------------------------------------------------------------
-# Main body
-#--------------------------------------------------------------------------
-if [ -z "$EXEEXT" ]; then
-  EXEEXT=
-fi
-if [ -z "$LIBRARY_COMBO" ]; then
-  LIBRARY_COMBO=gnu-gnu-gnu
-fi
-
-# Process arguments
-app=$0
-show_available_platforms=0
-show_relative_path=0
-show_full_path=0
-while true
-do 
-  case $1 in
-
-    --script-help)
-	echo usage: `basename $0` [--library-combo=...]
-	echo "       [--available-platforms][--full-executable-path]"
-	echo "       [--relative-executable-path] [arguments...]"
-	echo
-	echo "   --library-combo=... specifies a GNUstep backend to use."
-	echo "   It overrides the default LIBRARY_COMBO environment variable."
-	echo
-	echo "   --available-platforms displays a list of valid exec hosts"
-	echo "   --full-executable-path displays full path to executable"
-	echo "   --relative-executable-path displays subdirectory path"
-	echo "   arguments... are the arguments to the application."
-	exit 0
-	;;
-    --library-combo=*)
-	LIBRARY_COMBO=`echo $1 | sed 's/--library-combo=//'`
-	shift
-	;;
-    --available-platforms)
-        show_available_platforms=1
-        exit 0
-	;;
-    --full-executable-path)
-	show_full_path=1
-        break
-	;;
-    --relative-executable-path)
-	show_relative_path=1
-        break
-	;;
-    *)
-        break;;
-    esac
-done
-
-if [ "$LIBRARY_COMBO" = nx ]; then
-  LIBRARY_COMBO=nx-nx-nx
-elif [ "$LIBRARY_COMBO" = gnu ]; then
-  LIBRARY_COMBO=gnu-gnu-gnu
-elif [ "$LIBRARY_COMBO" = fd ]; then
-  LIBRARY_COMBO=gnu-fd-gnu
-fi
-export LIBRARY_COMBO
-
-# Find path to ourself
-app=`echo $app | sed 's%/*$%%'`
-dir=`dirname $app`
-
-case $app in
-  /*)	# An absolute path.
-	full_appname=$dir;;
-  */*)	# A relative path
-	full_appname=`(cd $dir; pwd)`;;
-  *)	# A path that needs to be searched
-	if [ -n $GNUSTEP_PATHPREFIX_LIST ]; then
-	    SPATH=$GNUSTEP_PATHPREFIX_LIST
-	else
-	    SPATH=$PATH
-	fi
-	SPATH=.:$SPATH
-	IFS=:
-	for path_dir in $SPATH; do
-	  if [ -d $path_dir/$dir ]; then
-	    full_appname=`(cd $path_dir/$dir; pwd)`
-	    break;
-	  fi
-	  if [ -d $path_dir/Applications/$dir ]; then
-	    full_appname=`(cd $path_dir/Applications/$dir; pwd)`
-	    break;
-	  fi
-	done;;
-esac
-
-if [ -z "$full_appname" ]; then
-  echo "Can't find absolute path for $app! Please specify full path when"
-  echo "invoking executable"
-  exit 1
-fi
-
-#
-# get base app name
-#
-app=`echo $app | sed 's/\.[a-z]*$//'`
-app=`basename $app`
-appname=
-if [ -f "$full_appname/Resources/Info-gnustep.plist" ]; then
-# -n disable auto-print (for portability reasons)
-#   /^ *NSExecutable *=/ matches every line beginning with 
-#        zero or more spaces, followed by 'NSExecutable', followed by zero or
-#        more spaces, followed by '='
-#   to this line we apply the following commands:
-#   s/"//g; which deletes all " in the line.
-#   s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p;
-#     which replaces 'NSExecutable = Gorm; ' with 'Gorm', then, because
-#     of the 'p' at the end, prints out the result 
-#   q; which quits sed since we know there must be only a single line 
-#      to replace.
-  appname=`sed -n -e '/^ *NSExecutable *=/ \
-           {s/"//g; s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p; q;}' \
-                "$full_appname/Resources/Info-gnustep.plist"`
-fi
-if [ -z "$appname" ]; then
-  appname=$app
-fi
-
-appname="$appname$EXEEXT"
-
-if [ $show_available_platforms = 1 ]; then
-  cd $full_appname
-  #available_platforms
-  exit 0
-fi
-
-#
-# Determine the host information
-#
-if [ -z "$GNUSTEP_HOST" ]; then
-  GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.guess)`
-  GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.sub $GNUSTEP_HOST)`
-  export GNUSTEP_HOST
-fi
-if [ -z "$GNUSTEP_HOST_CPU" ]; then
-  GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/cpu.sh $GNUSTEP_HOST`
-  GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_cpu.sh $GNUSTEP_HOST_CPU`
-  export GNUSTEP_HOST_CPU
-fi
-if [ -z "$GNUSTEP_HOST_VENDOR" ]; then
-  GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/vendor.sh $GNUSTEP_HOST`
-  GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_vendor.sh $GNUSTEP_HOST_VENDOR`
-  export GNUSTEP_HOST_VENDOR
-fi
-if [ -z "$GNUSTEP_HOST_OS" ]; then
-  GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/os.sh $GNUSTEP_HOST`
-  GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_os.sh $GNUSTEP_HOST_OS`
-  export GNUSTEP_HOST_OS
-fi
-
-#
-# Make sure the executable is there
-#
-if [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname ]; then
-  relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname
-elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname ]; then
-  relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname
-elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$appname ]; then
-  relative_path=$GNUSTEP_HOST_CPU/$appname
-elif [ $appname != $app -a -x $full_appname/$appname ]; then
-  relative_path=$appname
-else
-  echo "$full_appname application does not have a binary for this kind of machine/operating system ($GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS)."
-  exit 1
-fi
-
-if [ $show_relative_path = 1 ]; then
-  echo $relative_path
-  exit 0
-fi
-if [ $show_full_path = 1 ]; then
-  echo $full_appname/$relative_path
-  exit 0
-fi
-
-if [ "$LIBRARY_COMBO" = nx-nx-nx -a $GNUSTEP_HOST_OS = nextstep4 ]; then
-  if [ -f "$full_appname/library_paths.openapp" ]; then
-    additional_library_paths="`cat $full_appname/library_paths.openapp`"
-  fi
-else
-  if [ -f "$full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp" ]; then
-    additional_library_paths="`cat $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp`"
-  fi
-fi
-
-# Load up LD_LIBRARY_PATH
-. $GNUSTEP_SYSTEM_ROOT/Makefiles/ld_lib_path.sh
-
-exec $full_appname/$relative_path "$@"
-

GScheme.app/Resources/GScheme.desktop

@@ -1,8 +0,0 @@
-[Desktop Entry]
-Encoding=UTF-8
-Type=Application
-Version=GScheme 0.1
-Name=GScheme
-Exec=openapp GScheme.app
-#TryExec=GScheme.app
-MimeType=

GScheme.app/Resources/Info-gnustep.plist

@@ -1,29 +0,0 @@
-{
-    ApplicationDescription = "A scheme interpreter";
-    ApplicationName = GScheme;
-    ApplicationRelease = "GScheme 0.1";
-    Authors = (
-	"Marko Riedel <mriedel@neuearbeit.de>"
-    );
-    Copyright = "Copyright (C) 2002 Free Software Foundation, Inc.";
-    CopyrightDescription = "This program is released under the GNU General Public License";
-    FullVersionID = "0.1, June 2002";
-    NOTE = "Automatically generated, do not edit!";
-    NSExecutable = GScheme;
-    NSMainNibFile = "";
-    NSPrincipalClass = NSApplication;
-    NSTypes = (
-	{
-	    NSDOSExtensions = (
-		scm
-	    );
-	    NSDocumentClass = Document;
-	    NSHumanReadableName = "Scheme program";
-	    NSName = scm;
-	    NSRole = Editor;
-	    NSUnixExtensions = (
-		scm
-	    );
-	}
-    );
-}

GScheme.app/Resources/library.scm

@@ -1,109 +0,0 @@
-
-(define vector
-  (lambda args
-    (list->vector args)))
-
-
-(define list-n 
-  (lambda (n) 
-    (if (zero? n) '() 
-	(cons n (list-n (- n 1))))))
-
-(define list-ref
-  (lambda (l n)
-    (if (zero? n)
-	(car l)
-	(list-ref (cdr l) (- n 1)))))
-
-(define length
-  (lambda (l)
-    (if (or (null? l) (not (pair? l))) 0
-        (+ 1 (length (cdr l))))))
-
-(define filter 
-  (lambda (l f) 
-    (if (null? l) '() 
-	(if (f (car l)) 
-	    (cons (car l) (filter (cdr l) f)) 
-	    (filter (cdr l) f)))))
-
-(define reverse
-  (letrec
-      ((rev
-	(lambda (l acc)
-	  (if (null? l) acc
-	      (rev (cdr l) (cons (car l) acc))))))
-    (lambda (l)
-      (rev l '()))))
-
-(define append
-  (lambda (l . ls)
-    (if (null? l)
-	(if (pair? ls)
-	    (if (pair? (cdr ls))
-		(apply append ls)
-		(car ls)) ls)
-	(cons (car l)
-	      (apply append (cons (cdr l) ls))))))
-
-(define eqv? eq?)
-(define equal?
-  (lambda (obj1 obj2)
-    (if (and (pair? obj1) (pair? obj2))
-	(and (equal? (car obj1) (car obj2))
-	     (equal? (cdr obj1) (cdr obj2)))
-	(if (or (pair? obj1) (pair? obj2)) #f
-	    (eqv? obj1 obj2)))))
-
-(define memgeneric
-  (lambda (obj l pred)
-    (if (null? l) '()
-	(if (pred obj (car l)) l
-	    (memgeneric obj (cdr l) pred)))))
-
-(define memq
-  (lambda (obj l) (memgeneric obj l eq?)))
-(define memv
-  (lambda (obj l) (memgeneric obj l eqv?)))
-(define member
-  (lambda (obj l) (memgeneric obj l equal?)))
-
-(define association
-  (lambda (obj l pred)
-    (if (null? l) #f
-	(if (and (pair? (car l))
-		 (pred obj (car (car l))))
-	    (car l)
-	    (association obj (cdr l) pred)))))
-
-(define assq
-  (lambda (obj l) (association obj l eq?)))
-(define assv
-  (lambda (obj l) (association obj l eqv?)))
-(define assoc
-  (lambda (obj l) (association obj l equal?)))
-
-
-(define map-over-single-list
-  (lambda (p l)
-    (if (null? l) '()
-	(cons (p (car l)) 
-	      (map-over-single-list p (cdr l))))))
-
-(define map
-  (lambda (proc . lists)
-    (if (memq '() lists) '()
-	(cons
-	 (apply proc 
-		(map-over-single-list car lists))
-	 (apply map 
-		(cons proc (map-over-single-list cdr lists)))))))
-
-(define for-each
-  (lambda (proc . lists)
-    (if (memq '() lists) '()
-	(begin
-	 (apply proc 
-		(map-over-single-list car lists))
-	 (apply for-each 
-		(cons proc (map-over-single-list cdr lists)))))))

GScheme.app/Resources/library.scm~

@@ -1,103 +0,0 @@
-(define list-n 
-  (lambda (n) 
-    (if (zero? n) '() 
-	(cons n (list-n (- n 1))))))
-
-(define list-ref
-  (lambda (l n)
-    (if (zero? n)
-	(car l)
-	(list-ref (cdr l) (- n 1)))))
-
-(define length
-  (lambda (l)
-    (if (or (null? l) (not (pair? l))) 0
-        (+ 1 (length (cdr l))))))
-
-(define filter 
-  (lambda (l f) 
-    (if (null? l) '() 
-	(if (f (car l)) 
-	    (cons (car l) (filter (cdr l) f)) 
-	    (filter (cdr l) f)))))
-
-(define reverse
-  (letrec
-      ((rev
-	(lambda (l acc)
-	  (if (null? l) acc
-	      (rev (cdr l) (cons (car l) acc))))))
-    (lambda (l)
-      (rev l '()))))
-
-(define append
-  (lambda (l . ls)
-    (if (null? l)
-	(if (pair? ls)
-	    (if (pair? (cdr ls))
-		(apply append ls)
-		(car ls)) ls)
-	(cons (car l)
-	      (apply append (cons (cdr l) ls))))))
-
-(define eqv? eq?)
-(define equal?
-  (lambda (obj1 obj2)
-    (if (and (pair? obj1) (pair? obj2))
-	(and (equal? (car obj1) (car obj2))
-	     (equal? (cdr obj1) (cdr obj2)))
-	(if (or (pair? obj1) (pair? obj2)) #f
-	    (eqv? obj1 obj2)))))
-
-(define memgeneric
-  (lambda (obj l pred)
-    (if (null? l) '()
-	(if (pred obj (car l)) l
-	    (memgeneric obj (cdr l) pred)))))
-
-(define memq
-  (lambda (obj l) (memgeneric obj l eq?)))
-(define memv
-  (lambda (obj l) (memgeneric obj l eqv?)))
-(define member
-  (lambda (obj l) (memgeneric obj l equal?)))
-
-(define association
-  (lambda (obj l pred)
-    (if (null? l) #f
-	(if (and (pair? (car l))
-		 (pred obj (car (car l))))
-	    (car l)
-	    (association obj (cdr l) pred)))))
-
-(define assq
-  (lambda (obj l) (association obj l eq?)))
-(define assv
-  (lambda (obj l) (association obj l eqv?)))
-(define assoc
-  (lambda (obj l) (association obj l equal?)))
-
-
-(define map-over-single-list
-  (lambda (p l)
-    (if (null? l) '()
-	(cons (p (car l)) 
-	      (map-over-single-list p (cdr l))))))
-
-(define map
-  (lambda (proc . lists)
-    (if (memq '() lists) '()
-	(cons
-	 (apply proc 
-		(map-over-single-list car lists))
-	 (apply map 
-		(cons proc (map-over-single-list cdr lists)))))))
-
-(define for-each
-  (lambda (proc . lists)
-    (if (memq '() lists) '()
-	(begin
-	 (apply proc 
-		(map-over-single-list car lists))
-	 (apply for-each 
-		(cons proc (map-over-single-list cdr lists)))))))

GSchemeInfo.plist

@@ -1,11 +1,12 @@
 {
   ApplicationName = "GScheme";
   ApplicationDescription = "A scheme interpreter";
-  ApplicationRelease = "GScheme 0.1";
+  ApplicationRelease = "GScheme 0.5";
-  FullVersionID = "0.1, June 2002";
+  FullVersionID = "0.5, January 2005";
   Authors = ("Marko Riedel <mriedel@neuearbeit.de>");
-  Copyright = "Copyright (C) 2002 Free Software Foundation, Inc.";
+  Copyright = "Copyright (C) 2005 Free Software Foundation, Inc.";
   CopyrightDescription = "This program is released under the GNU General Public License"; 
+  NSIcon = "GScheme.tiff";
   NSTypes = (
         {
              NSName = "scm";

NOTES

@@ -0,0 +1,6 @@
+wrp
+retaincount loop
+external
+paste
+stop button
+env browser

Primitive.h

@@ -18,6 +18,7 @@ BOOL isPair(id item);
 BOOL isVector(id item);
 BOOL isTriple(id item);
 BOOL isPrimitive(id item);
+BOOL isEval(id item);
 BOOL isClosure(id item);
 BOOL isThunk(id item);
 BOOL isFalse(id item);
@@ -118,6 +119,11 @@ typedef enum {
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
 @end
 
+@interface PRMRandom : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
 @interface PRMQuotient : Primitive
 - (NSString *)primName;
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@@ -183,6 +189,41 @@ typedef enum {
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
 @end
 
+@interface PRMDrawCircle : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMFillCircle : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMDrawRect : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMFillRect : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMDrawFont : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMDrawString : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMDrawShow : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
 @interface PRMSin : Primitive
 - (NSString *)primName;
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@@ -193,6 +234,26 @@ typedef enum {
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
 @end
 
+@interface PRMTan : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMExp : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMLog : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMATan : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
 @interface PRMASin : Primitive
 - (NSString *)primName;
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@@ -243,7 +304,76 @@ typedef enum {
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
 @end
 
+@interface PRMSymToStr : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMStrToSym : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMStringSize : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMStringLength : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMCharToInt : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMIntToChar : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMStringRef : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMListToStr : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMStrToList : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMStringAppend : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMMakeString : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMNumberToStr : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
+@interface PRMFormat : Primitive
+- (NSString *)primName;
+- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
+@end
+
 @interface PRMBrowseEnvironment : Primitive
 - (NSString *)primName;
 - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
 @end
+
+@interface PRMEval : Primitive
+- (NSString *)primName;
+@end

SCMTextView.h

@@ -4,6 +4,13 @@
 
 #import "VScheme.h"
 
+@interface NSTextView (Misc)
+
+- placeCursorAtEnd;
+- selectLineAtPos:(int)pos;
+
+@end
+
 @interface SCMTextView : NSTextView
 
 - (void)insertText:(id)aString;
@@ -18,8 +25,8 @@
 - (id)initWithFrame:(NSRect)frameRect;
 
 - (void)insertText:(id)aString;
+- (void)paste:(id)sender;
 
-- placeCursorAtEnd;
 
 - (NSString *)getSuffix;
 - (void)setString:(NSString *)aString;

SCMTextView.m

@@ -2,6 +2,28 @@
 #import "SCMTextView.h"
 #import "SchemeDelegate.h"
 
+@implementation NSTextView (Misc)
+
+- placeCursorAtEnd
+{
+    NSRange range = { [[self string] length], 0 };
+    [self setSelectedRange:range];
+    return self;
+}
+
+- selectLineAtPos:(int)pos
+{
+    NSString *data = [self string];
+    
+    unsigned startInd, endInd;
+    [data getLineStart:&startInd end:&endInd 
+	  contentsEnd:NULL forRange:NSMakeRange(pos, 0)];
+    [self setSelectedRange:NSMakeRange(startInd, endInd-startInd)];
+
+    return self;
+}
+
+@end
 
 @implementation SCMTextView
 
@@ -10,7 +32,7 @@
     int inslen = [aString length];
     unichar ch = [aString characterAtIndex:0];
     NSString *modified = @"", *single;
- 
+
     if(inslen == 1 && ch==NSNewlineCharacter){
         NSString *data = [self string];
         NSRange range = [self selectedRange];
@@ -68,17 +90,21 @@
 - (void)insertText:(id)aString
 {
     if([self selectedRange].location<lastRetrieved){
-        return;
+	NSRange range = { [[self string] length], 0 };
+	[self setSelectedRange:range];
     }
 
     [super insertText:aString];
 }
 
-- placeCursorAtEnd
+- (void)paste:(id)sender
 {
-    NSRange range = { [[self string] length], 0 };
+    if([self selectedRange].location<lastRetrieved){
-    [self setSelectedRange:range];
+	NSRange range = { [[self string] length], 0 };
-    return self;
+	[self setSelectedRange:range];
+    }
+
+    [super paste:sender];
 }
 
 - (NSString *)getSuffix
@@ -115,10 +141,18 @@
     
     if((ch==NSNewlineCharacter || ch==NSCarriageReturnCharacter) &&
        len==1 && (modifiers & NSControlKeyMask)){
-        BOOL res = [[self delegate] processString:[self getSuffix]
+	NSString *sfx = [self getSuffix];
-                                    mode:MODE_INTERACTIVE];
+
+	NSPasteboard *pb = [NSPasteboard generalPasteboard];
+	[pb declareTypes:[NSArray arrayWithObject:NSStringPboardType]
+	    owner:nil];
+	[pb setString:sfx forType:NSStringPboardType];
+
+        BOOL res = 
+	    [[self delegate] processString:sfx
+			     mode:MODE_INTERACTIVE];
         if(res==NO){
-            NSRunAlertPanel(@"Error", [[self delegate] errmsg], 
+            NSRunAlertPanel(@"Error", [(VScheme *)[self delegate] errmsg], 
                             @"Ok", nil, nil);
         }
         return;

Scheme/library.scm

@@ -107,3 +107,46 @@
 		(map-over-single-list car lists))
 	 (apply for-each 
 		(cons proc (map-over-single-list cdr lists)))))))
+
+(define pow (lambda (x y) (exp (* y (log x)))))
+
+(define caar (lambda (p) (car (car p))))
+(define cadr (lambda (p) (car (cdr p))))
+(define cdar (lambda (p) (cdr (car p))))
+(define cddr (lambda (p) (cdr (cdr p))))
+
+(define caaar (lambda (p) (car (car (car p)))))
+(define caadr (lambda (p) (car (car (cdr p)))))
+(define cadar (lambda (p) (car (cdr (car p)))))
+(define caddr (lambda (p) (car (cdr (cdr p)))))
+(define cdaar (lambda (p) (cdr (car (car p)))))
+(define cdadr (lambda (p) (cdr (car (cdr p)))))
+(define cddar (lambda (p) (cdr (cdr (car p)))))
+(define cdddr (lambda (p) (cdr (cdr (cdr p)))))
+
+(define min-max
+  (lambda (pred args)
+    (letrec 
+	((iter
+	  (lambda (l m)
+	    (if (null? l) m
+		(iter (cdr l)
+		      (if (pred (car l) m) (car l) m))))))
+      (iter (cdr args) (car args)))))
+
+(define min
+  (lambda args
+    (min-max < args)))
+
+(define max
+  (lambda args
+    (min-max > args)))
+
+
+(define make-range
+  (lambda (a b)
+    (if (= a b) (list a)
+	(cons 
+	 a (make-range (+ 1 a) b)))))
+
+	      

Scheme/library.scm~

@@ -1,3 +1,9 @@
+
+(define vector
+  (lambda args
+    (list->vector args)))
+
+
 (define list-n 
   (lambda (n) 
     (if (zero? n) '() 
@@ -101,3 +107,41 @@
 		(map-over-single-list car lists))
 	 (apply for-each 
 		(cons proc (map-over-single-list cdr lists)))))))
+
+(define pow (lambda (x y) (exp (* y (log x)))))
+
+(define caar (lambda (p) (car (car p))))
+(define cadr (lambda (p) (car (cdr p))))
+(define cdar (lambda (p) (cdr (car p))))
+(define cddr (lambda (p) (cdr (cdr p))))
+
+(define caaar (lambda (p) (car (car (car p)))))
+(define caadr (lambda (p) (car (car (cdr p)))))
+(define cadar (lambda (p) (car (cdr (car p)))))
+(define caddr (lambda (p) (car (cdr (cdr p)))))
+(define cdaar (lambda (p) (cdr (car (car p)))))
+(define cdadr (lambda (p) (cdr (car (cdr p)))))
+(define cddar (lambda (p) (cdr (cdr (car p)))))
+(define cdddr (lambda (p) (cdr (cdr (cdr p)))))
+
+(define min-max
+  (lambda (pred args)
+    (letrec 
+	((iter
+	  (lambda (l m)
+	    (if (null? l) m
+		(iter (cdr l)
+		      (if (pred (car l) m) (car l) m))))))
+      (iter (cdr args) (car args)))))
+
+(define min
+  (lambda args
+    (min-max < args)))
+
+(define max
+  (lambda args
+    (min-max > args)))
+
+
+
+

SchemeDelegate.h

@@ -14,13 +14,19 @@
 
     NSMutableArray *imageWindows;
     NSMutableArray *envWindows;
+
+    NSPanel *interruptPanel;
 }
 
 - (void)applicationWillFinishLaunching:(NSNotification *)not;
 - (void)applicationDidFinishLaunching:(NSNotification *)not;
 
+
 - makeInterpreterWindow;
-- makeStatisticsWindow;
+- makeStatisticsPanel;
+
+- makeInterruptPanel;
+- (NSPanel *)interruptPanel;
 
 - input:(NSString *)data;
 - output:(NSString *)data;
@@ -35,5 +41,7 @@
 
 
 - reset:(id)sender;
+- addExternal:(id)sender;
+- evaluateExternal:(id)sender;
 
 @end

SchemeDelegate.m

@@ -9,219 +9,224 @@ VScheme *vm = nil;
 - (void)applicationWillFinishLaunching:(NSNotification *)not
 {
     // CREATE_AUTORELEASE_POOL(pool);
-  NSMenu *menu;
+    NSMenu *menu, *info, *file, *scheme, *external, *env,
-  NSMenu *info;
+	*edit, *print, *services, *windows;
-  NSMenu *file;
-  NSMenu *scheme;
-  NSMenu *env;
-  NSMenu *edit;
-  NSMenu *print;
-  NSMenu *services;
-  NSMenu *windows;
 
-  //	Create the app menu
+    //	Create the app menu
-  menu = [NSMenu new];
+    menu = [NSMenu new];
 
-  [menu addItemWithTitle: @"Info"
+    [menu addItemWithTitle: @"Info"
-		  action: NULL
+	  action: NULL
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [menu addItemWithTitle: @"File"
+    [menu addItemWithTitle: @"File"
-		  action: NULL
+	  action: NULL
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [menu addItemWithTitle: @"Edit"
+    [menu addItemWithTitle: @"Edit"
-		  action: NULL
+	  action: NULL
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [menu addItemWithTitle: @"Windows"
+    [menu addItemWithTitle: @"Windows"
-		  action: NULL
+	  action: NULL
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [menu addItemWithTitle: @"Scheme"
+    [menu addItemWithTitle: @"Scheme"
-		  action: NULL
+	  action: NULL
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [menu addItemWithTitle: @"Environment"
+    [menu addItemWithTitle: @"Environment"
-		  action: NULL
+	  action: NULL
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [menu addItemWithTitle: @"Services"
+    [menu addItemWithTitle: @"Services"
-		  action: NULL
+	  action: NULL
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [menu addItemWithTitle: @"Hide"
+    [menu addItemWithTitle: @"Hide"
-		  action: @selector(hide:)
+	  action: @selector(hide:)
-	   keyEquivalent: @"h"];
+	  keyEquivalent: @"h"];
 
-  [menu addItemWithTitle: @"Quit"
+    [menu addItemWithTitle: @"Quit"
-		  action: @selector(terminate:)
+	  action: @selector(terminate:)
-	   keyEquivalent: @"q"];
+	  keyEquivalent: @"q"];
 
-  // Create the scheme submenu
+    // Create the scheme submenu
-  scheme = [NSMenu new];
+    scheme = [NSMenu new];
-  [menu setSubmenu: scheme
+    [menu setSubmenu: scheme
-	   forItem: [menu itemWithTitle: @"Scheme"]];
+	  forItem: [menu itemWithTitle: @"Scheme"]];
 
-  [scheme addItemWithTitle: @"Reset"
+    [scheme addItemWithTitle: @"Reset"
-          action: @selector(reset:)
+	    action: @selector(reset:)
-          keyEquivalent: @"+"];
+	    keyEquivalent: @"+"];
 
-  [scheme addItemWithTitle: @"Evaluate"
+    [scheme addItemWithTitle: @"Evaluate"
-          action: @selector(evaluate:)
+	    action: @selector(evaluate:)
-          keyEquivalent: @"#"];
+	    keyEquivalent: @"#"];
 
-  // Create the environment submenu
+    [scheme addItemWithTitle: @"Evaluate external"
-  env = [NSMenu new];
+	    action:NULL
-  [menu setSubmenu: env
+	    keyEquivalent: @""];
-	   forItem: [menu itemWithTitle: @"Environment"]];
 
-  [env addItemWithTitle: @"Up"
+    external = [NSMenu new];
-       action: @selector(up:)
+    [scheme setSubmenu: external
-       keyEquivalent: @""];
+	    forItem: [scheme itemWithTitle: @"Evaluate external"]];
+    [external addItemWithTitle: @"Add external"
+	      action: @selector(addExternal:)
+	      keyEquivalent: @""];
 
-  [env addItemWithTitle: @"Down"
-       action: @selector(down:)
-       keyEquivalent: @""];
 
-  // Create the info submenu
+    // Create the environment submenu
-  info = [NSMenu new];
+    env = [NSMenu new];
-  [menu setSubmenu: info
+    [menu setSubmenu: env
-	   forItem: [menu itemWithTitle: @"Info"]];
+	  forItem: [menu itemWithTitle: @"Environment"]];
 
-  [info addItemWithTitle: @"Info Panel..."
+    [env addItemWithTitle: @"Up"
-	          action: @selector(orderFrontStandardInfoPanel:)
+	 action: @selector(up:)
-	   keyEquivalent: @""];
+	 keyEquivalent: @""];
+
+    [env addItemWithTitle: @"Down"
+	 action: @selector(down:)
+	 keyEquivalent: @""];
+
+    // Create the info submenu
+    info = [NSMenu new];
+    [menu setSubmenu: info
+	  forItem: [menu itemWithTitle: @"Info"]];
+
+    [info addItemWithTitle: @"Info Panel..."
+	  action: @selector(orderFrontStandardInfoPanel:)
+	  keyEquivalent: @""];
 
 /*  
-  [info addItemWithTitle: @"Preferences..."
+    [info addItemWithTitle: @"Preferences..."
-		  action: NULL
+    action: NULL
-	   keyEquivalent: @""];
+    keyEquivalent: @""];
 */
-  [info addItemWithTitle: @"Help"
+    [info addItemWithTitle: @"Help"
-		  action: @selector (orderFrontHelpPanel:)
+	  action: @selector (orderFrontHelpPanel:)
-	   keyEquivalent: @"?"];
+	  keyEquivalent: @"?"];
-  // RELEASE(info);
+    // RELEASE(info);
 
-  // Create the file submenu
+    // Create the file submenu
-  file = [NSMenu new];
+    file = [NSMenu new];
-  [menu setSubmenu: file
+    [menu setSubmenu: file
-	   forItem: [menu itemWithTitle: @"File"]];
+	  forItem: [menu itemWithTitle: @"File"]];
 
-  [file addItemWithTitle: @"Open Document"
+    [file addItemWithTitle: @"Open Document"
-		  action: @selector(openDocument:)
+	  action: @selector(openDocument:)
-	   keyEquivalent: @"o"];
+	  keyEquivalent: @"o"];
 
-  [file addItemWithTitle: @"New Document"
+    [file addItemWithTitle: @"New Document"
-		  action: @selector(newDocument:)
+	  action: @selector(newDocument:)
-	   keyEquivalent: @"n"];
+	  keyEquivalent: @"n"];
 
-  [file addItemWithTitle: @"Save"
+    [file addItemWithTitle: @"Save"
-	          action: @selector(saveDocument:)
+	  action: @selector(saveDocument:)
-	   keyEquivalent: @"s"];
+	  keyEquivalent: @"s"];
 
-  [file addItemWithTitle: @"Save To..."
+    [file addItemWithTitle: @"Save To..."
-	          action: @selector(saveDocumentTo:)
+	  action: @selector(saveDocumentTo:)
-	   keyEquivalent: @"t"];
+	  keyEquivalent: @"t"];
 
-  [file addItemWithTitle: @"Save As..."
+    [file addItemWithTitle: @"Save As..."
-	          action: @selector(saveDocumentAs:)
+	  action: @selector(saveDocumentAs:)
-	   keyEquivalent: @"S"];
+	  keyEquivalent: @"S"];
 
-  [file addItemWithTitle: @"Save All"
+    [file addItemWithTitle: @"Save All"
-	action: @selector(saveDocumentAll:)
+	  action: @selector(saveDocumentAll:)
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [file addItemWithTitle: @"Revert to Saved"
+    [file addItemWithTitle: @"Revert to Saved"
-		  action: @selector(revertDocumentToSaved:)
+	  action: @selector(revertDocumentToSaved:)
-	   keyEquivalent: @"u"];
+	  keyEquivalent: @"u"];
 
-  [file addItemWithTitle: @"Close"
+    [file addItemWithTitle: @"Close"
-		  action: @selector(close)
+	  action: @selector(close)
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  [file addItemWithTitle: @"Insert File..."
+    [file addItemWithTitle: @"Insert File..."
-	          action: @selector(insertFile:)
+	  action: @selector(insertFile:)
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 
-  // RELEASE(file);
+    // RELEASE(file);
 
-  // Create the edit submenu
+    // Create the edit submenu
-  edit = [NSMenu new];
+    edit = [NSMenu new];
-  [menu setSubmenu: edit
+    [menu setSubmenu: edit
-	   forItem: [menu itemWithTitle: @"Edit"]];
+	  forItem: [menu itemWithTitle: @"Edit"]];
 
-  [edit addItemWithTitle: @"Cut"
+    [edit addItemWithTitle: @"Cut"
-	          action: @selector(cut:)
+	  action: @selector(cut:)
-	   keyEquivalent: @"x"];
+	  keyEquivalent: @"x"];
 
-  [edit addItemWithTitle: @"Copy"
+    [edit addItemWithTitle: @"Copy"
-	          action: @selector(copy:)
+	  action: @selector(copy:)
-	   keyEquivalent: @"c"];
+	  keyEquivalent: @"c"];
 
-  [edit addItemWithTitle: @"Paste"
+    [edit addItemWithTitle: @"Paste"
-		  action: @selector(paste:)
+	  action: @selector(paste:)
-	   keyEquivalent: @"v"];
+	  keyEquivalent: @"v"];
 
-  [edit addItemWithTitle: @"Delete"
+    [edit addItemWithTitle: @"Delete"
-   	          action: @selector(delete:)
+	  action: @selector(delete:)
-	   keyEquivalent: @""];
+	  keyEquivalent: @""];
 /*
   [edit addItemWithTitle: @"Undelete"
-		  action: NULL
+  action: NULL
-	   keyEquivalent: @""];
+  keyEquivalent: @""];
 */
-  [edit addItemWithTitle: @"Select All"
+    [edit addItemWithTitle: @"Select All"
-  	          action: @selector(selectAll:)
+	  action: @selector(selectAll:)
-	   keyEquivalent: @"a"];
+	  keyEquivalent: @"a"];
-  // RELEASE(edit);
+    // RELEASE(edit);
 
-  // Create the windows submenu
+    // Create the windows submenu
-  windows = [NSMenu new];
+    windows = [NSMenu new];
-  [menu setSubmenu: windows
+    [menu setSubmenu: windows
-	   forItem: [menu itemWithTitle: @"Windows"]];
+	  forItem: [menu itemWithTitle: @"Windows"]];
 
-  [windows addItemWithTitle: @"Arrange"
+    [windows addItemWithTitle: @"Arrange"
-		     action: @selector(arrangeInFront:)
+	     action: @selector(arrangeInFront:)
-	      keyEquivalent: @""];
+	     keyEquivalent: @""];
 
-  [windows addItemWithTitle: @"Miniaturize"
+    [windows addItemWithTitle: @"Miniaturize"
-		     action: @selector(performMiniaturize:)
+	     action: @selector(performMiniaturize:)
-	      keyEquivalent: @"m"];
+	     keyEquivalent: @"m"];
 
-  [windows addItemWithTitle: @"Close"
+    [windows addItemWithTitle: @"Close"
-		     action: @selector(performClose:)
+	     action: @selector(performClose:)
-	      keyEquivalent: @"w"];
+	     keyEquivalent: @"w"];
 
-  [windows addItemWithTitle: @"Close image windows"
+    [windows addItemWithTitle: @"Close image windows"
-		     action: @selector(closeImageWindows:)
+	     action: @selector(closeImageWindows:)
-	      keyEquivalent: @"W"];
+	     keyEquivalent: @"W"];
 
-  [windows addItemWithTitle: @"Close environment windows"
+    [windows addItemWithTitle: @"Close environment windows"
-		     action: @selector(closeEnvWindows:)
+	     action: @selector(closeEnvWindows:)
-	      keyEquivalent: @""];
+	     keyEquivalent: @""];
 
-  [NSApp setWindowsMenu: windows];
+    [NSApp setWindowsMenu: windows];
-  // RELEASE(windows);
+    // RELEASE(windows);
 
-  // Create the service submenu
+    // Create the service submenu
-  services = [NSMenu new];
+    services = [NSMenu new];
-  [menu setSubmenu: services
+    [menu setSubmenu: services
-	   forItem: [menu itemWithTitle: @"Services"]];
+	  forItem: [menu itemWithTitle: @"Services"]];
 
-  [NSApp setServicesMenu: services];
+    [NSApp setServicesMenu: services];
-  // RELEASE(services);
+    // RELEASE(services);
 
-  [NSApp setMainMenu: menu];
+    [NSApp setMainMenu: menu];
-  // RELEASE(menu);
+    // RELEASE(menu);
 
-  imageWindows = [NSMutableArray arrayWithCapacity:1];
+    imageWindows = [NSMutableArray arrayWithCapacity:1];
-  [imageWindows retain];
+    [imageWindows retain];
 
-  envWindows = [NSMutableArray arrayWithCapacity:1];
+    envWindows = [NSMutableArray arrayWithCapacity:1];
-  [envWindows retain];
+    [envWindows retain];
 
-  // RELEASE(pool);
+    // RELEASE(pool);
 }
 
 - (void)applicationDidFinishLaunching: (NSNotification *)not;
@@ -229,7 +234,8 @@ VScheme *vm = nil;
     vm = [[VScheme alloc] init];
     [vm setDelegate:self];
 
-    [self makeStatisticsWindow];
+    [self makeStatisticsPanel];
+    [self makeInterruptPanel];
     [self makeInterpreterWindow];
 
     // Make the DocumentController the delegate of the application, 
@@ -239,6 +245,7 @@ VScheme *vm = nil;
 
 NSWindow *interpreterWindow = nil;
 
+
 - makeInterpreterWindow
 {
     NSWindow *window;
@@ -310,9 +317,9 @@ NSWindow *interpreterWindow = nil;
     return self;
 }
 
-- makeStatisticsWindow
+- makeStatisticsPanel
 {
-    NSWindow *window;
+    NSPanel *panel;
     NSScrollView *scrollView;
     SCMInteractive *textView;
     NSRect scrollViewRect = {{0, 0}, {470, 400}};
@@ -323,11 +330,11 @@ NSWindow *interpreterWindow = nil;
 
     // This is expected to be retained, as it would normaly come from a
     // nib file, where the owner would retain it.
-    window = [[NSWindow alloc] initWithContentRect: winRect
+    panel = [[NSPanel alloc] initWithContentRect: winRect
                                styleMask: style
                                backing: NSBackingStoreRetained
                                defer: NO];
-    [window setMinSize:NSMakeSize(300, 300)];
+    [panel setMinSize:NSMakeSize(300, 300)];
    
     scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
     [scrollView setHasHorizontalScroller: NO];
@@ -363,21 +370,53 @@ NSWindow *interpreterWindow = nil;
 
     [scrollView setDocumentView: textView];
     // RELEASE(textView);
-    [window setContentView: scrollView];
+    [panel setContentView: scrollView];
     // RELEASE(scrollView);
 
-    // Make the Document the delegate of the window
+    // Make the Document the delegate of the panel
-    [window setDelegate: self];
+    [panel setDelegate: self];
+    [panel setWorksWhenModal:NO];
 
     // Make the text view the first responder
-    // [window makeFirstResponder:textView];
+    // [panel makeFirstResponder:textView];
-    [window setTitle:@"GScheme Statistics"];
+    [panel setTitle:@"GScheme Statistics"];
-    [window display];
+    [panel display];
-    [window orderFront:nil];
+    [panel orderFront:nil];
 
     return self;
 }
 
+#define IPCWIDTH   100
+#define IPCHEIGHT   30
+
+
+- makeInterruptPanel
+{
+    interruptPanel = 
+	[[NSPanel alloc]
+	    initWithContentRect:NSMakeRect(0, 0, IPCWIDTH, IPCHEIGHT)
+	    styleMask:NSBorderlessWindowMask
+	    backing:NSBackingStoreBuffered
+	    defer:NO];
+    [interruptPanel setReleasedWhenClosed:NO];
+
+    NSButton *stopper;
+    stopper = [NSButton new];
+    [stopper setTitle:@"Stop"];
+    [stopper setTarget:vm];
+    [stopper setAction:@selector(interrupt:)];
+
+    [interruptPanel setContentView:stopper];
+
+    return self;
+}
+
+- (NSPanel *)interruptPanel
+{
+    return interruptPanel;
+}
+
+
 - input:(NSString *)data
 {
     [intTextView appendString:data];
@@ -387,6 +426,7 @@ NSWindow *interpreterWindow = nil;
 - output:(NSString *)data
 {
     [intTextView appendString:data];
+    [intTextView placeCursorAtEnd];
     return self;
 }
 
@@ -402,7 +442,12 @@ NSWindow *interpreterWindow = nil;
 - statistics:(NSString *)stats
 {
     NSString *sofar = [statTextView string];
-    [statTextView setString:[sofar stringByAppendingString:stats]];
+    [statTextView
+	replaceCharactersInRange:NSMakeRange([sofar length], 0)
+	withString:stats];
+
+    [statTextView placeCursorAtEnd];
+
     return self;
 }
 
@@ -418,6 +463,67 @@ NSWindow *interpreterWindow = nil;
     [statTextView setString:GSCHEME];
 }
 
+- addExternal:(id)sender
+{
+    NSOpenPanel *openPanel = [NSOpenPanel openPanel];
+
+    [openPanel setTitle:@"Add external"];
+    [openPanel setAllowsMultipleSelection:NO];
+    [openPanel setPrompt:@"File:"];
+    [openPanel setCanChooseDirectories:NO];
+
+    if([openPanel 
+	   runModalForTypes:
+	       [NSArray arrayWithObject:@"scm"]]==NSOKButton){
+	[[sender menu] addItemWithTitle:[openPanel filename]
+		       action:@selector(evaluateExternal:)
+		       keyEquivalent: @""];
+    }
+
+    return self;
+}
+
+extern VScheme *vm;
+extern NSWindow *interpreterWindow;
+
+extern int errno;
+
+- evaluateExternal:(id)sender
+{
+    SCMInteractive *intView = 
+        [[interpreterWindow contentView] documentView];
+    NSString *suffix = [intView getSuffix];
+
+    if([suffix length]>0){
+        [intView appendString:@"\n> "];
+    }
+
+    NSString *progstr;
+    if((progstr = 
+	[NSString stringWithContentsOfFile:[sender title]])==nil){
+	NSString *msg = @"Load failed";
+	if(errno){
+	    char *estr = strerror(errno);
+	    msg = [msg stringByAppendingFormat:@": %s", estr];
+	}
+
+        NSRunAlertPanel(@"Error", msg, @"Ok", nil, nil);	
+	return self;
+    }
+
+    BOOL res = [vm processString:progstr mode:MODE_EVALUATE];
+    if(res==NO){
+        NSRunAlertPanel(@"Error", [vm errmsg], 
+                        @"Ok", nil, nil);
+    }
+    else{
+        [interpreterWindow makeKeyAndOrderFront:self];
+    }
+
+    return self;
+}
+
+
 - imageWindow:(NSWindow *)window
 {
     [imageWindows addObject:window];
@@ -441,21 +547,20 @@ NSWindow *interpreterWindow = nil;
     }
     else if([envWindows containsObject:win]==YES){
         [envWindows removeObject:win];
-        [win releaseForms];
     }
 }
 
 - closeImageWindows:(id)sender
 {
-    [imageWindows 
+    NSArray *cwins = [NSArray arrayWithArray:imageWindows];
-        makeObjectsPerformSelector:@selector(close)];
+    [cwins makeObjectsPerformSelector:@selector(close)];
     return self;
 }
 
 - closeEnvWindows:(id)sender
 {
-    [envWindows 
+    NSArray *cwins = [NSArray arrayWithArray:envWindows];
-        makeObjectsPerformSelector:@selector(close)];
+    [cwins makeObjectsPerformSelector:@selector(close)];
     return self;
 }
 

SchemeTypes.h

@@ -2,27 +2,13 @@
 #import <AppKit/AppKit.h>
 
 
-@interface NSMutableArray (Wrap)
-
-- (void)prependObjWRP:(id)anObject;
-- (void)addObjWRP:(id)anObject;
-
-- (void)replaceObjWRPAtIndex:(unsigned)index withObject:(id)anObject;
-
-@end
-
-@interface NSMutableDictionary (Wrap)
-
-- (void)setObjWRP:(id)anObject forKey:(id)aKey;
-
-@end
-
 #define MARKABLE(_item) \
  ((_item)!=nil && ((id)(_item))!=(id)[NSNull null] && \
   [(_item) isKindOfClass:[SCMType class]])
 
 @interface SCMType : NSObject
 {
+@protected
     int mark;
 }
 
@@ -107,6 +93,7 @@
     NSString *value;
 }
 
+- initSCMStringLEX:(char *)val;
 - initSCMString:(char *)val;
 - (NSString *)strVal;
 
@@ -199,18 +186,18 @@
 @interface Environment : SCMType
 {
     Environment *parent;
-    NSMutableDictionary *data;
+    NSMapTable *data;
 }
 
-+ newParent:(Environment *)par Data:(NSMutableDictionary *)entries;
++ newParent:(Environment *)par Data:(NSMapTable *)entries;
-- initParent:(Environment *)par Data:(NSMutableDictionary *)entries;
+- initParent:(Environment *)par Data:(NSMapTable *)entries;
 
 - (int)chainLength;
 
-- (NSMutableDictionary *)lookup:(NSString *)sym;
+- (NSMapTable *)lookup:(NSString *)sym;
 
 - (Environment *)parent;
-- (NSMutableDictionary *)data;
+- (NSMapTable *)data;
 
 - setMarkToCurrent;
 
@@ -294,11 +281,16 @@ typedef enum {
 
 @interface ByteCodes : SCMType
 {
-    NSMutableArray *data;
+    unsigned int capacity;
+    unsigned int length;
+    id *data;
+
+    BOOL root;
+    id source;
 }
 
 + new;
-- initWithMutableArray:(NSMutableArray *)theData;
+- init;
 
 
 - prependTriple:(Triple *)theTriple;
@@ -306,10 +298,17 @@ typedef enum {
 
 - appendByteCodes:(ByteCodes *)codes;
 
-- (NSMutableArray *)codes;
+- (id *)codes;
+- (unsigned int)length;
 
 - setMarkToCurrent;
 
+- (BOOL)root;
+- setRoot:(BOOL)rflag;
+
+- source;
+- setSource:(id)src;
+
 - (void)free;
 
 @end

SchemeTypes.m

@@ -1,42 +1,6 @@
 
 #import "SchemeTypes.h"
 
-@implementation NSMutableArray (Wrap)
-
-- (void)addObjWRP:(id)anObject
-{
-    [anObject retain];
-    [self addObject:anObject];
-    return;
-}
-
-- (void)replaceObjWRPAtIndex:(unsigned)index withObject:(id)anObject
-{
-    [anObject retain];
-    [self replaceObjectAtIndex:index withObject:anObject];
-    return;
-}
-
-- (void)prependObjWRP:(id)anObject
-{
-    [anObject retain];
-    [self insertObject:anObject atIndex:0];
-    return;
-}
-
-@end
-
-@implementation NSMutableDictionary (Wrap)
-
-- (void)setObjWRP:(id)anObject forKey:(id)aKey
-{
-    [anObject retain];
-    [self setObject:anObject forKey:aKey];
-    return;
-}
-
-@end
-
 @implementation SCMType
 
 static int allocatedAfterGC = 0;
@@ -233,11 +197,11 @@ static int totalAllocated = 0;
 
 - setMarkToCurrent
 {
-    if([self mark]==currentMark){
+    if(mark==currentMark){
         return;
     }
 
-    [super setMarkToCurrent];
+    mark = currentMark;
     if(MARKABLE(car)){
         [car setMarkToCurrent];
     }
@@ -309,11 +273,11 @@ static int totalAllocated = 0;
 {
     int index;
 
-    if([self mark]==currentMark){
+    if(mark==currentMark){
         return;
     }
 
-    [super setMarkToCurrent];
+    mark = currentMark;
 
     for(index=0; index<count; index++){
         id obj = data[index];
@@ -369,11 +333,11 @@ static int totalAllocated = 0;
 
 - setMarkToCurrent
 {
-    if([self mark]==currentMark){
+    if(mark==currentMark){
         return;
     }
 
-    [super setMarkToCurrent];
+    mark = currentMark;
     if(MARKABLE(args)){
         [args setMarkToCurrent];
     }
@@ -444,13 +408,13 @@ static int totalAllocated = 0;
 
 @implementation Environment
 
-+ newParent:(Environment *)par Data:(NSMutableDictionary *)entries
++ newParent:(Environment *)par Data:(NSMapTable *)entries
 {
     return [[super alloc]
                initParent:par Data:entries];
 }
 
-- initParent:(Environment *)par Data:(NSMutableDictionary *)entries
+- initParent:(Environment *)par Data:(NSMapTable *)entries
 {
     [super init];
 
@@ -458,7 +422,7 @@ static int totalAllocated = 0;
     [parent retain];
     
     data = entries; // [entries mutableCopy]; 
-    [data retain];
+    // [data retain];
 
     return self;
 }
@@ -468,13 +432,13 @@ static int totalAllocated = 0;
     return (parent==nil ? 1 : 1+[parent chainLength]);
 }
 
-- (NSMutableDictionary *)lookup:(NSString *)sym
+- (NSMapTable *)lookup:(NSString *)sym
 {
-    if([data objectForKey:sym]!=nil){
+    if(NSMapGet(data, sym)!=NULL){
         return data;
     }
 
-    return (parent==nil ? nil : [parent lookup:sym]);
+    return (parent==nil ? NULL : [parent lookup:sym]);
 }
 
 - (Environment *)parent
@@ -482,24 +446,27 @@ static int totalAllocated = 0;
     return parent;
 }
 
-- (NSMutableDictionary *)data
+- (NSMapTable *)data
 {
     return data;
 }
 
 - setMarkToCurrent
 {
-    NSEnumerator *enumerator = [data objectEnumerator];
+    NSMapEnumerator enumerator = NSEnumerateMapTable(data);
     id item;
   
-    if([self mark]==currentMark){
+    if(mark==currentMark){
         return;
     }
 
-    [super setMarkToCurrent];
+    mark = currentMark;
-    while((item = [enumerator nextObject])!=nil){
+
-        if(MARKABLE(item)){
+    id key, val;
-            [item setMarkToCurrent];
+    while(NSNextMapEnumeratorPair
+	  (&enumerator, (void**)&key, (void**)&val)){
+        if(MARKABLE(val)){
+            [val setMarkToCurrent];
         }
     }
     
@@ -510,28 +477,9 @@ static int totalAllocated = 0;
     return self;
 }
 
-#define GSI_MAP_NOCLEAN 1
-
-#include <base/GSIMap.h>
-
-@interface GSMutableDictionary : NSDictionary
-{
-@public
-  GSIMapTable_t map;
-}
-@end
-
-typedef struct { 
-    @defs(GSMutableDictionary)
-} *GSMDictPtr;
-
 - (void)free
 {
-    GSIMapEmptyMap(&(((GSMDictPtr)data)->map));
+    NSFreeMapTable(data);
-    while([data retainCount]>1){
-        [data release];
-    }
-
     [super free];
 }
 
@@ -549,7 +497,9 @@ typedef struct {
 
 + newTag:(int)tagval IntArg1:(int)arg1;
 {
-    NSNumber *num = [NSNumber numberWithInt:arg1];
+    // NSNumber *num = [NSNumber numberWithInt:arg1];
+    Int *num = [[Int alloc] initSCMInt:arg1];
+
     return [[super alloc] 
                initTag:tagval
                Arg1:num Arg2:nil Arg3:nil];
@@ -581,9 +531,20 @@ typedef struct {
 {
     tag = tagval;
 
-    items[0] = arg1; [arg1 retain];
+    items[0] = arg1; 
-    items[1] = arg2; [arg2 retain];
+    if(arg1!=nil){ 
-    items[2] = arg3; [arg3 retain];
+	[arg1 retain]; 
+    }
+
+    items[1] = arg2;
+    if(arg2!=nil){ 
+	[arg2 retain]; 
+    }
+
+    items[2] = arg3;
+    if(arg3!=nil){ 
+	[arg3 retain]; 
+    }
 
     return self;
 }
@@ -595,12 +556,14 @@ typedef struct {
 
 - (int)intarg1
 {
-    return [items[0] intValue];
+    return [items[0] intVal];
 }
 
 - setIntArg1:(int)val
 {
-    items[0] = [NSNumber numberWithInt:val];
+    // items[0] = [NSNumber numberWithInt:val];
+    items[0] = [[Int alloc] initSCMInt:val];
+    [items[0] retain];
     return self;
 }
     
@@ -621,11 +584,11 @@ typedef struct {
 
 - setMarkToCurrent
 {
-    if([self mark]==currentMark){
+    if(mark==currentMark){
         return;
     }
 
-    [super setMarkToCurrent];
+    mark = currentMark;
     if(MARKABLE(items[0])){
         [items[0] setMarkToCurrent];
     }
@@ -715,8 +678,10 @@ typedef struct {
 - initSCMSymbol:(char *)val
 {
     [super init];
+
     value = [NSString stringWithCString:val];
     [value retain];
+
     return self;
 }
 
@@ -735,7 +700,7 @@ typedef struct {
 
 @implementation String
 
-- initSCMString:(char *)val
+- initSCMStringLEX:(char *)val
 {
     char *cp, *buf, *from, *to;
     int len = strlen(val);
@@ -762,6 +727,16 @@ typedef struct {
     return self;
 }
 
+- initSCMString:(char *)val
+{
+    [super init];
+
+    value = [NSString stringWithCString:val];
+    [value retain];
+
+    return self;
+}
+
 - (NSString *)strVal
 {
     return value;
@@ -775,89 +750,143 @@ typedef struct {
 
 @end
 
+#define BASE_CAPACITY 16
+
 @implementation ByteCodes
 
 + new
 {
     id inst = [super alloc];
-    [inst initWithMutableArray:[NSMutableArray arrayWithCapacity:1]];
+    [inst init];
     return inst;
 }
 
-- initWithMutableArray:(NSMutableArray *)theData
+- init
 {
     [super init];
-    data = theData;
+
-    [data retain];
+    capacity = BASE_CAPACITY;
+    length = 0;
+    data = (id *)NSZoneMalloc(NSDefaultMallocZone(), capacity*sizeof(id));
+
+    root = NO;
+    source = nil;
 
     return self;
 }
 
 - prependTriple:(Triple *)theTriple
 {
-    [data prependObjWRP:theTriple];
+    if(length==capacity){
+	capacity *= 2;
+	data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
+    }
+
+    memmove(data+1, data, length*sizeof(id));
+    length++;
+
+    data[0] = theTriple;
+    [theTriple retain];
+
     return self;
 }
 
 - addTriple:(Triple *)theTriple
 {
-    [data addObjWRP:theTriple];
+    if(length==capacity){
+	capacity *= 2;
+	data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
+    }
+
+    data[length++] = theTriple;
+    [theTriple retain];
+
     return self;
 }
 
 - appendByteCodes:(ByteCodes *)codes
 {
-    [data addObjectsFromArray:[codes codes]];
+    unsigned int otherLength = [codes length];
+    id *otherData = [codes codes];
+
+    if(length+otherLength>capacity){
+	while(length+otherLength>capacity){
+	    capacity *= 2;
+	}
+	data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
+    }
+
+    unsigned int pos;
+    for(pos=0; pos<otherLength; pos++){
+	data[length] = otherData[pos]; 
+	[data[length] retain];
+	length++;
+    }
+
     return self;
 }
 
 
-- (NSMutableArray *)codes
+- (id *)codes
 {
     return data;
 }
 
+- (unsigned int)length
+{
+    return length;
+}
+
+
 - setMarkToCurrent
 {
-    int index, count = [data count];
+    if(mark==currentMark){
-
-    if([self mark]==currentMark){
         return;
     }
 
-    [super setMarkToCurrent];
+    mark = currentMark;
 
-    for(index=0; index<count; index++){
+    unsigned int index;
-        id obj = [data objectAtIndex:index];
+    for(index=0; index<length; index++){
+        id obj = data[index];
         if(MARKABLE(obj)){
             [obj setMarkToCurrent];
         }
     }
 
+    if(MARKABLE(source)){
+	[source setMarkToCurrent];
+    }
+
     return self;
 }
 
-@interface GSMutableArray : NSMutableArray
+- (BOOL)root
 {
-@public
+    return root;
-  id            *_contents_array;
-  unsigned      _count;
-  unsigned      _capacity;
-  int           _grow_factor;
 }
-@end
 
-typedef struct { 
+- setRoot:(BOOL)rflag
-    @defs(GSMutableArray)
+{
-} *GSMArrayPtr;
+    root = rflag;
+    return self;
+}
+
+- source
+{
+    return source;
+}
+
+- setSource:(id)src
+{
+    source = src;
+    [src retain];
+    return self;
+}
 
 - (void)free
 {
-    ((GSMArrayPtr)data)->_count = 0;
+    NSZoneFree(NSDefaultMallocZone(), data);
-    while([data retainCount]>1){
-        [data release];
-    }
-
     [super free];
 }
 

TestScheme.app/Resources/Info-gnustep.plist

@@ -1,6 +0,0 @@
-{
-  NOTE = "Automatically generated, do not edit!";
-  NSExecutable = "TestScheme";
-  NSMainNibFile = "";
-  NSPrincipalClass = "NSApplication";
-}

TestScheme.app/Resources/TestScheme.desktop

@@ -1,5 +0,0 @@
-[Desktop Entry]
-Encoding=UTF-8
-Type=Application
-Exec=openapp TestScheme.app
-#TryExec=TestScheme.app

TestScheme.app/TestScheme

@@ -1,218 +0,0 @@
-#!/bin/sh
-#
-# Copyright (C) 1999 Free Software Foundation, Inc.
-#
-# Author: Adam Fedor <fedor@gnu.org>
-# Date: May 1999
-# 
-# This file is part of the GNUstep Makefile Package.
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-# 
-# You should have received a copy of the GNU General Public
-# License along with this library; see the file COPYING.LIB.
-# If not, write to the Free Software Foundation,
-# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-# This is a shell script which attempts to find the GNUstep executable
-# of the same name based on the current host and library_combo.
-
-#--------------------------------------------------------------------------
-# Main body
-#--------------------------------------------------------------------------
-if [ -z "$EXEEXT" ]; then
-  EXEEXT=
-fi
-if [ -z "$LIBRARY_COMBO" ]; then
-  LIBRARY_COMBO=gnu-gnu-gnu
-fi
-
-# Process arguments
-app=$0
-show_available_platforms=0
-show_relative_path=0
-show_full_path=0
-while true
-do 
-  case $1 in
-
-    --script-help)
-	echo usage: `basename $0` [--library-combo=...]
-	echo "       [--available-platforms][--full-executable-path]"
-	echo "       [--relative-executable-path] [arguments...]"
-	echo
-	echo "   --library-combo=... specifies a GNUstep backend to use."
-	echo "   It overrides the default LIBRARY_COMBO environment variable."
-	echo
-	echo "   --available-platforms displays a list of valid exec hosts"
-	echo "   --full-executable-path displays full path to executable"
-	echo "   --relative-executable-path displays subdirectory path"
-	echo "   arguments... are the arguments to the application."
-	exit 0
-	;;
-    --library-combo=*)
-	LIBRARY_COMBO=`echo $1 | sed 's/--library-combo=//'`
-	shift
-	;;
-    --available-platforms)
-        show_available_platforms=1
-        exit 0
-	;;
-    --full-executable-path)
-	show_full_path=1
-        break
-	;;
-    --relative-executable-path)
-	show_relative_path=1
-        break
-	;;
-    *)
-        break;;
-    esac
-done
-
-if [ "$LIBRARY_COMBO" = nx ]; then
-  LIBRARY_COMBO=nx-nx-nx
-elif [ "$LIBRARY_COMBO" = gnu ]; then
-  LIBRARY_COMBO=gnu-gnu-gnu
-elif [ "$LIBRARY_COMBO" = fd ]; then
-  LIBRARY_COMBO=gnu-fd-gnu
-fi
-export LIBRARY_COMBO
-
-# Find path to ourself
-app=`echo $app | sed 's%/*$%%'`
-dir=`dirname $app`
-
-case $app in
-  /*)	# An absolute path.
-	full_appname=$dir;;
-  */*)	# A relative path
-	full_appname=`(cd $dir; pwd)`;;
-  *)	# A path that needs to be searched
-	if [ -n $GNUSTEP_PATHPREFIX_LIST ]; then
-	    SPATH=$GNUSTEP_PATHPREFIX_LIST
-	else
-	    SPATH=$PATH
-	fi
-	SPATH=.:$SPATH
-	IFS=:
-	for path_dir in $SPATH; do
-	  if [ -d $path_dir/$dir ]; then
-	    full_appname=`(cd $path_dir/$dir; pwd)`
-	    break;
-	  fi
-	  if [ -d $path_dir/Applications/$dir ]; then
-	    full_appname=`(cd $path_dir/Applications/$dir; pwd)`
-	    break;
-	  fi
-	done;;
-esac
-
-if [ -z "$full_appname" ]; then
-  echo "Can't find absolute path for $app! Please specify full path when"
-  echo "invoking executable"
-  exit 1
-fi
-
-#
-# get base app name
-#
-app=`echo $app | sed 's/\.[a-z]*$//'`
-app=`basename $app`
-appname=
-if [ -f "$full_appname/Resources/Info-gnustep.plist" ]; then
-# -n disable auto-print (for portability reasons)
-#   /^ *NSExecutable *=/ matches every line beginning with 
-#        zero or more spaces, followed by 'NSExecutable', followed by zero or
-#        more spaces, followed by '='
-#   to this line we apply the following commands:
-#   s/"//g; which deletes all " in the line.
-#   s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p;
-#     which replaces 'NSExecutable = Gorm; ' with 'Gorm', then, because
-#     of the 'p' at the end, prints out the result 
-#   q; which quits sed since we know there must be only a single line 
-#      to replace.
-  appname=`sed -n -e '/^ *NSExecutable *=/ \
-           {s/"//g; s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p; q;}' \
-                "$full_appname/Resources/Info-gnustep.plist"`
-fi
-if [ -z "$appname" ]; then
-  appname=$app
-fi
-
-appname="$appname$EXEEXT"
-
-if [ $show_available_platforms = 1 ]; then
-  cd $full_appname
-  #available_platforms
-  exit 0
-fi
-
-#
-# Determine the host information
-#
-if [ -z "$GNUSTEP_HOST" ]; then
-  GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.guess)`
-  GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.sub $GNUSTEP_HOST)`
-  export GNUSTEP_HOST
-fi
-if [ -z "$GNUSTEP_HOST_CPU" ]; then
-  GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/cpu.sh $GNUSTEP_HOST`
-  GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_cpu.sh $GNUSTEP_HOST_CPU`
-  export GNUSTEP_HOST_CPU
-fi
-if [ -z "$GNUSTEP_HOST_VENDOR" ]; then
-  GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/vendor.sh $GNUSTEP_HOST`
-  GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_vendor.sh $GNUSTEP_HOST_VENDOR`
-  export GNUSTEP_HOST_VENDOR
-fi
-if [ -z "$GNUSTEP_HOST_OS" ]; then
-  GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/os.sh $GNUSTEP_HOST`
-  GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_os.sh $GNUSTEP_HOST_OS`
-  export GNUSTEP_HOST_OS
-fi
-
-#
-# Make sure the executable is there
-#
-if [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname ]; then
-  relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname
-elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname ]; then
-  relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname
-elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$appname ]; then
-  relative_path=$GNUSTEP_HOST_CPU/$appname
-elif [ $appname != $app -a -x $full_appname/$appname ]; then
-  relative_path=$appname
-else
-  echo "$full_appname application does not have a binary for this kind of machine/operating system ($GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS)."
-  exit 1
-fi
-
-if [ $show_relative_path = 1 ]; then
-  echo $relative_path
-  exit 0
-fi
-if [ $show_full_path = 1 ]; then
-  echo $full_appname/$relative_path
-  exit 0
-fi
-
-if [ "$LIBRARY_COMBO" = nx-nx-nx -a $GNUSTEP_HOST_OS = nextstep4 ]; then
-  if [ -f "$full_appname/library_paths.openapp" ]; then
-    additional_library_paths="`cat $full_appname/library_paths.openapp`"
-  fi
-else
-  if [ -f "$full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp" ]; then
-    additional_library_paths="`cat $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp`"
-  fi
-fi
-
-# Load up LD_LIBRARY_PATH
-. $GNUSTEP_SYSTEM_ROOT/Makefiles/ld_lib_path.sh
-
-exec $full_appname/$relative_path "$@"
-

VScheme.h

@@ -7,15 +7,21 @@
 #define GSCHEME @"GScheme by Marko Riedel, mriedel@neuearbeit.de\n"
 
 typedef enum {
-    MODE_INTERACTIVE,
+    MODE_INTERACTIVE = 0,
     MODE_EVALUATE,
     MODE_LOAD
 } PROCESS_MODE;
 
 typedef enum {
-    DRAW_MOVE,
+    DRAW_MOVE = 0,
     DRAW_LINE,
-    DRAW_COLOR
+    DRAW_COLOR,
+    DRAW_CIRCLE,
+    FILL_CIRCLE,
+    DRAW_RECT,
+    FILL_RECT,
+    DRAW_FONT,
+    DRAW_STRING
 } DRAW_INST;
 
 typedef struct _DrawInst {
@@ -23,11 +29,16 @@ typedef struct _DrawInst {
     union {
         NSPoint coord;
         float color[3];
+	float radius;
+	NSFont *font;
+	NSString *string;
+	NSSize size;
     } data;
 } DrawInst;
 
 @interface VScheme : NSObject
 {
+    int errpos;
     BOOL errflag;
     NSString *errmsg;
 
@@ -36,10 +47,12 @@ typedef struct _DrawInst {
     NSMutableArray *argStack;
     NSMutableArray *envStack;
 
-    id curcodes;
+    id *curcodes;
     int curpc;
+    int curlength;
 
-    NSString *output;
+    BOOL hadOutput;
+    NSMutableString *output;
 
     int maxcode, maxpc, maxarg, maxenv;
 
@@ -47,16 +60,18 @@ typedef struct _DrawInst {
 
     BOOL atImgStart;
     NSPoint imgMin, imgMax;
+    NSPoint imgCur;
     NSMutableArray *imgCodes;
+    NSFont *imgFont;
 
-    long int curRecDepth, maxRecDepth;
+    BOOL interrupted;
 }
 
 + (NSString *)valToString:(id)item seen:(NSMutableSet *)mem;
 + (NSString *)valToString:(id)item;
 
 + printInstr:(Triple *)instr;
-+ printCodes:(NSMutableArray *)codes;
++ printCodes:(ByteCodes *)codes;
 
 - init;
 
@@ -77,6 +92,7 @@ typedef struct _DrawInst {
 - (NSString *)output;
 - clearOutput;
 
+- (NSSize)stringAtCurrentFont:(NSString *)str;
 - recordImgInst:(DrawInst)inst;
 - clearImage;
 - produceImage;
@@ -86,12 +102,15 @@ typedef struct _DrawInst {
 - (NSMutableArray *)codeStack;
 
 - (BOOL)errflag;
+- (int)errpos;
 - (NSString *)errmsg;
 
 - args2list:(int)lower;
 
-- pushCodes:(NSMutableArray *)codes;
+- pushByteCodes:(ByteCodes *)bcodes;
-- (BOOL)run:(ByteCodes *)prog;
+
+- interrupt:(id)sender;
+- (BOOL)run:(ByteCodes *)prog mode:(PROCESS_MODE)pmode;
 
 - special:(id)data output:(ByteCodes *)codes popenv:(int)ec;
 - sequence:(id)data output:(ByteCodes *)codes popenv:(int)ec;
@@ -99,6 +118,7 @@ typedef struct _DrawInst {
 
 - (BOOL)compile:(id)data output:(ByteCodes *)codes;
 
+- parse:(NSString *)scmText;
 - (BOOL)processString:(NSString *)data mode:(PROCESS_MODE)pmode;
 
 @end

examples/allocate1.scm

@@ -0,0 +1,6 @@
+
+(define print-it
+  (lambda ()
+    (display '(1 2 3))
+    (newline)
+    (print-it)))

examples/args1.scm

@@ -0,0 +1,6 @@
+
+;; not enough arguments
+
+(define p (lambda (x y) (+ x y)))
+(p 6)
+

examples/args2.scm

@@ -0,0 +1,6 @@
+
+;; too many arguments
+
+(define p (lambda (x y) (+ x y)))
+(p 6 7 8)
+

examples/browse.scm

@@ -7,7 +7,6 @@
 
 (reduce + 0 '(2 3 4))
 
-
 (define factit
   (lambda (n)
     (letrec

examples/eval.scm

@@ -0,0 +1,33 @@
+(define primes
+ (eval
+  ;;; check for composite numbers by testing the
+  ;;; most probable divisors first
+  '(let* ((start (list 2))
+         (end start))
+    (letrec
+	((composite?
+	  (lambda (v l)
+	    (let ((d (car l)))
+	      (if (> (* d d) v) #f
+		  (if (zero? (remainder v d)) #t
+		      (composite? v (cdr l)))))))
+	 (findnext
+	  (lambda (v)
+	    (if (composite? v start)
+		(findnext (+ v 1)) v))))
+      (lambda ()
+	(let* ((current (car end))
+	       (next (findnext (+ current 1)))
+	       (p (cons next '())))
+	  (set-cdr! end p)
+	  (set! end p)
+	  current))))))
+
+(define displayprimes
+  (lambda (n)
+    (if (not (zero? n))
+	(begin
+	  (display (primes)) (newline)
+	  (displayprimes (- n 1))))))
+
+(displayprimes 14)

examples/eval1.scm

@@ -0,0 +1,56 @@
+
+(define pi (* 2 (acos 0)))
+
+(define res 200)
+
+(define data
+  (letrec 
+      ((delta (/ (* 2 pi) res))
+       (vect (make-vector res))
+       (iter
+        (lambda (q)
+          (if (< q res)
+              (begin
+                (vector-set! 
+                 vect q
+                 (cons (cos (* q delta)) 
+                       (sin (* q delta))))
+                (let ((ev (eval '(iter (+ 1 q)))))
+                  ev))))))
+    (iter 0)
+    vect))
+
+(define draw-circle
+  (lambda (radius)
+    (letrec
+        ((iter
+          (lambda (q)
+            (if (< q res)
+                (begin
+                  (draw-line
+                   (* radius (car (vector-ref data q)))
+                   (* radius (cdr (vector-ref data q))))
+                  (iter (+ 1 q)))))))
+      (draw-move radius 0)
+      (iter 0)
+      (draw-line radius 0))))
+
+(define steps 8)
+
+(define circles
+  (lambda (maxrad)
+    (letrec
+        ((iter
+          (lambda (q)
+            (if (< q maxrad)
+               (begin
+                 (draw-color 0 (/ (* 255.0 q) maxrad) 0)
+                 (draw-circle q)
+                 (iter (+ q steps)))))))
+      (iter 1))))
+
+(circles 100)
+
+
+
+

examples/library.scm

@@ -107,3 +107,6 @@
 		(map-over-single-list car lists))
 	 (apply for-each 
 		(cons proc (map-over-single-list cdr lists)))))))
+
+(define pow (lambda (x y) (exp (* y (log x)))))
+

examples/mandel.scm

@@ -0,0 +1,37 @@
+
+;; mandelbrot set
+
+(define mandel
+  (lambda (rmin rmax imin imax res)
+    (letrec
+	((rdelta (- rmax rmin)) (idelta (- imax imin))
+	 (rdelta1 (/ rdelta res)) (idelta1 (/ idelta res))
+	 (pcolor
+	  (lambda (re im cre cim n)
+	    (if (or (> n 200) (> (+ (* re re) (* im im)) 4.0))
+		(let
+		  ((c (* 8 (remainder n 8)))
+		   (x (* res (/ (- cre rmin) rdelta)))
+		   (y (* res (/ (- cim imin) idelta))))
+		  (draw-color
+		   (* 255 (remainder n 2))
+		   (* 255 (remainder (quotient n 2) 2))
+		   (* 255 (remainder (quotient n 4) 2)))
+		  (draw-move x y)
+		  (draw-line (+ x 1) (+ y 1)))
+		(pcolor
+		 (+ (- (* re re) (* im im)) cre)
+		 (+ (* 2 re im) cim)
+		 cre cim (+ 1 n)))))
+	 (iter
+	  (lambda (rep imp)
+	    (if (> rep rmax)
+		(if (> imp imax) '()
+		    (iter rmin (+ imp idelta1)))
+		(begin
+		  (pcolor 0 0 rep imp 0)
+		  (iter (+ rep rdelta1) imp))))))
+      (iter rmin imin))))
+
+(mandel -1.5 0.5 -1.0 1.0 25)
+

examples/parse-error.scm

@@ -0,0 +1,8 @@
+
+;; missing parenthesis
+
+(define adder
+  (lambda (a)
+    (lambda (b)
+      (+ a b)))
+

examples/parse-error1.scm

@@ -0,0 +1,55 @@
+
+(define pi (* 2 (acos 0)))
+
+(define res 200)
+
+(define data
+  (letrec 
+      ((delta (/ (* 2 pi) res))
+       (vect (make-vector res))
+       (iter extra-sym
+        (lambda (q)
+          (if (< q res)
+              (begin
+                (vector-set! 
+                 vect q
+                 (cons (cos (* q delta)) 
+                       (sin (* q delta))))
+                (iter (+ 1 q)))))))
+    (iter 0)
+    vect))
+
+(define draw-circle
+  (lambda (radius)
+    (letrec
+        ((iter
+          (lambda (q)
+            (if (< q res)
+                (begin
+                  (draw-line
+                   (* radius (car (vector-ref data q)))
+                   (* radius (cdr (vector-ref data q))))
+                  (iter (+ 1 q)))))))
+      (draw-move radius 0)
+      (iter 0)
+      (draw-line radius 0))))
+
+(define steps 8)
+
+(define circles
+  (lambda (maxrad)
+    (letrec
+        ((iter
+          (lambda (q)
+            (if (< q maxrad)
+               (begin
+                 (draw-color 0 (/ (* 255.0 q) maxrad) 0)
+                 (draw-circle q)
+                 (iter (+ q steps)))))))
+      (iter 1))))
+
+(circles 100)
+
+
+
+

examples/parse-error2.scm

@@ -0,0 +1,28 @@
+(define koch
+  (let ((s (/ (sqrt 3) 2 3)))
+    (lambda (res depth)
+      (letrec
+	  ((iter
+	    (lambda (x1 y1 x2 y2 d)
+	      (if (zero? d) 
+		  (draw-line x2 y2)
+		  (let* ((dx (- x2 x1)) 
+			 (dy (- y2 y1))
+			 (^ test)
+			 (thx (+ x1 (/ dx 3))) 
+			 (thy (+ y1 (/ dy 3)))
+			 (thx2 (+ x1 (* 2 (/ dx 3)))) 
+			 (thy2 (+ y1 (* 2 (/ dy 3))))
+			 (mx (/ (+ x1 x2) 2)) 
+			 (my (/ (+ y1 y2) 2))
+			 (midx (+ mx (* (- dy) s))) 
+			 (midy (+ my (* dx s))))
+		    (iter x1 y1 thx thy (- d 1))
+		    (iter thx thy midx midy (- d 1))
+		    (iter midx midy thx2 thy2 (- d 1))
+		    (iter thx2 thy2 x2 y2 (- d 1)))))))
+	(draw-move 0 0)
+	(draw-color 0 255 0)
+	(iter 0 0 res 0 depth)))))
+
+(koch 200 4)

examples/parse-error3.scm

@@ -0,0 +1,6 @@
+(define testcond
+  (lambda (l)
+    (cond
+     ((assq 'a l) => (lambda (p) (set-car! p 'd)))
+     ((assq 'b l) extra-sym => (lambda (p) (set-car! p 'e)))
+     ((assq 'c l) => (lambda (p) (set-car! p 'f))))))

examples/parse-error4.scm

@@ -0,0 +1,6 @@
+
+;; an if with three alternatives
+
+(if (zero? 4) 'a 'b 'c)
+
+;; end

examples/plotfancy.scm

@@ -0,0 +1,49 @@
+(define plotter
+  (lambda (fx res x1 x2 y1 y2)
+    (let* ((dx (- x2 x1)) (dy (- y2 y1)) (delta (/ dx res))
+       (fstr (format "~a" fx))
+	   (f (eval (list 'lambda '(x) fx))))
+      (letrec
+	  ((scaled
+	    (lambda (f x y) 
+	      (f
+	       (* res (/ (- x x1) dx))
+	       (* res (/ (- y y1) dy)))))
+       (scaled-d
+	    (lambda (f x y xd yd) 
+	      (f
+	       (+ xd (* res (/ (- x x1) dx)))
+	       (+ yd (* res (/ (- y y1) dy))))))
+	   (plotit
+	    (lambda (x)
+	      (scaled draw-line x (f x))
+	      (if (< x x2) (plotit (+ x delta))))))
+	(draw-color 0 0 0)
+	(draw-font "Helvetica" 12)
+	(scaled draw-move 0 (* 1.1 y2)) (draw-string "y")
+	(scaled draw-move (* 1.1 x2) 0) (draw-string "x")
+	(draw-move 
+	  (- (/ res 2) 
+	     (/ (car (string-size fstr "Helvetica" 12)) 2))
+	  (+ 30 res)) 
+	(draw-string (format "~a" fstr))
+	(scaled draw-move 0 y1)
+	(scaled draw-line 0 y2)
+	(scaled-d draw-move 0 y2 -5 -7)
+	(scaled draw-line 0 y2)
+	(scaled-d draw-move 0 y2 +5 -7)
+	(scaled draw-line 0 y2)
+	(scaled draw-move x1 0)
+	(scaled draw-line x2 0)
+	(scaled-d draw-move x2 0 -7 -5)
+	(scaled draw-line x2 0)
+	(scaled-d draw-move x2 0 -7 +5)
+	(scaled draw-line x2 0)	
+	(draw-color 255 0 0)
+	(scaled draw-move x1 (f x1))
+	(plotit x1)))))
+
+(plotter '(* x x x) 70 -5.0 5.0 -50.0 50.0)
+(plotter '(sin x) 50 -5.0 5.0 -1.0 1.0)
+(plotter '(* x (sin x)) 100 -25.0 25.0 -25.0 25.0)
+(plotter '(+ (* x x) (* -5 x) 6) 80 -1.0 5.0 -3.0 10.0)

examples/qsort.scm

@@ -0,0 +1,143 @@
+
+(define allperms
+  (lambda (n)
+    (if (= n 1) '((1))
+	(letrec
+	    ((allpos (list-n n))
+	     (insert
+	      (lambda (pos el l)
+		(if (= pos 1)
+		    (cons el l)
+		    (cons (car l)
+			  (insert (- pos 1) el (cdr l))))))
+	     (result '()))
+	  (for-each
+	   (lambda (p)
+	     (for-each
+	      (lambda (pos)
+		(set! 
+		 result
+		 (cons
+		  (insert pos n p) result)))
+	      allpos))
+	   (allperms (- n 1)))
+	  result))))
+
+
+(define make-cmp
+  (lambda ()
+    (let ((count 0))
+      (lambda (what . args)
+	(case what
+	  ((count) count)
+	  ((cmp)
+	   (begin
+	     (set! count (+ 1 count))
+	     (< (car args) (cadr args)))))))))
+
+(define qsort
+  (lambda (perm compare)
+    (if (null? perm) '()
+	(if (null? (cdr perm)) perm
+	    (letrec
+		((pivot (car perm))
+		 (left '()) (leftend '())
+		 (right '()) (rightend '())
+		 (split
+		  (lambda (l)
+		    (if (compare 'cmp (car l) pivot)
+			(if (null? leftend)
+			    (begin
+			      (set! left (list (car l)))
+			      (set! leftend left))
+			    (begin
+			      (set-cdr! leftend (list (car l)))
+			      (set! leftend (cdr leftend))))
+			(if (null? rightend)
+			    (begin
+			      (set! right (list (car l)))
+			      (set! rightend right))
+			    (begin
+			      (set-cdr! rightend (list (car l)))
+			      (set! rightend (cdr rightend)))))
+		    (if (not (null? (cdr l))) (split (cdr l))))))
+	      (split (cdr perm))
+	      (append
+	       (qsort left compare)
+	       (list pivot)
+	       (qsort right compare)))))))
+
+(define qsort-stats
+  (lambda (n)
+    (map
+     (lambda (p)
+       (let ((c (make-cmp)))
+	 (qsort p c)
+	 (c 'count)))
+     (allperms n))))
+
+(define ints2hist
+  (lambda (l)
+    (let* ((minv (apply min l))
+	   (maxv (apply max l))
+	   (v (make-vector (+ 1 (- maxv minv)) 0)))
+      (letrec
+	  ((iter
+	    (lambda (l)
+	      (if (not (null? l))
+		  (begin
+		    (vector-set! 
+		     v (- (car l) minv) 
+		     (+ 1 (vector-ref v (- (car l) minv))))
+		    (iter (cdr l)))))))
+	(iter l)
+	(map
+	 (lambda (pos)
+	   (cons pos (vector-ref v (- pos minv))))
+	 (make-range minv maxv))))))
+
+(define drawhist
+  (lambda (h)
+    (letrec 
+	((len (length h)) (total (* 1.0 (apply + (map cdr h))))
+	 (mx (apply max (map cdr h))) (scale 400)
+	 (colors
+	  (list->vector
+	   '((0 0 255) (0 255 0) (0 255 255)
+	     (255 0 0) (255 0 255) (255 255 0))))
+	 (bars
+	  (lambda (pos h)
+	    (let ((frac (/ (cdar h) total)))
+	      (apply draw-color (vector-ref colors (remainder pos 6)))
+	      (draw-move (* pos 40) 0)
+	      (fill-rect 30 (* scale frac))
+	      (if (not (null? (cdr h)))
+		  (bars (+ 1 pos) (cdr h))))))
+	 (labels
+	  (lambda (pos h)
+	    (draw-move (* pos 40) -20)
+	    (draw-string (format "~a" (caar h)))
+	    (if (not (null? (cdr h)))
+		(labels (+ 1 pos) (cdr h)))))
+	 (values
+	  (lambda (pos h)
+	    (let ((frac (/ (cdar h) total)))
+	      (draw-move (* pos 40) (+ 10 (* scale frac)))
+	      (draw-string (format "~a" (cdar h)))
+	      (if (not (null? (cdr h)))
+		  (values (+ 1 pos) (cdr h)))))))
+      (bars 0 h)
+      (draw-color 0 0 0)
+      (labels 0 h)
+      (values 0 h)
+      (draw-move -40 0) (draw-line (* (+ 1 len) 40) 0)
+      (draw-move -20 -20) (draw-line -20 (* scale (/ mx total))))))
+
+(define qhist
+  (lambda (n)
+    (drawhist (ints2hist (qsort-stats n)))))
+
+(qhist 6)
+
+
+

examples/qsort1.scm

@@ -0,0 +1,181 @@
+
+(define fact
+  (lambda (n)
+    (if (zero? n) 1
+	(* n (fact (- n 1))))))
+
+(define allperms
+  (lambda (n)
+    (let ((f (fact n))
+	  (res '()) (rm -1) (perm '()))
+      (letrec
+	  ((remove
+	    (lambda (l pos)
+	      (if (zero? pos)
+		  (begin
+		    (set! rm (car l))
+		    (remove (cdr l) (- pos 1)))
+		  (if (null? l) l
+		      (cons (car l) (remove (cdr l) (- pos 1)))))))
+	   (process
+	    (lambda (v m dst src)
+	      (if (zero? m)
+		  (set! perm dst)
+		  (let ((src1 (remove src (remainder v m))))
+		    (process
+		     (quotient v m)
+		     (- m 1)
+		     src1
+		     (cons dst rm))))))
+	   (iter
+	    (lambda (v)
+	      (if (< v f)
+		  (begin
+		    (process v n '() (make-range 1 n))
+		    (set! res (cons perm res))
+		    (iter (+ v 1)))))))
+	(iter 0) res))))
+
+
+(define allperms
+  (lambda (n)
+    (if (= n 1) '((1))
+	(letrec
+	    ((allpos (list-n n))
+	     (insert
+	      (lambda (pos el l)
+		(if (= pos 1)
+		    (cons el l)
+		    (cons (car l)
+			  (insert (- pos 1) el (cdr l))))))
+	     (result '()))
+	  (for-each
+	   (lambda (p)
+	     (for-each
+	      (lambda (pos)
+		(set! 
+		 result
+		 (cons
+		  (insert pos n p) result)))
+	      allpos))
+	   (allperms (- n 1)))
+	  result))))
+
+
+(define make-cmp
+  (lambda ()
+    (let ((count 0))
+      (lambda (what . args)
+	(case what
+	  ((count) count)
+	  ((cmp)
+	   (begin
+	     (set! count (+ 1 count))
+	     (< (car args) (cadr args)))))))))
+
+(define qsort
+  (lambda (perm compare)
+    (if (null? perm) '()
+	(if (null? (cdr perm)) perm
+	    (letrec
+		((pivot (car perm))
+		 (left '()) (leftend '())
+		 (right '()) (rightend '())
+		 (split
+		  (lambda (l)
+		    (if (compare 'cmp (car l) pivot)
+			(if (null? leftend)
+			    (begin
+			      (set! left (list (car l)))
+			      (set! leftend left))
+			    (begin
+			      (set-cdr! leftend (list (car l)))
+			      (set! leftend (cdr leftend))))
+			(if (null? rightend)
+			    (begin
+			      (set! right (list (car l)))
+			      (set! rightend right))
+			    (begin
+			      (set-cdr! rightend (list (car l)))
+			      (set! rightend (cdr rightend)))))
+		    (if (not (null? (cdr l))) (split (cdr l))))))
+	      (split (cdr perm))
+	      (append
+	       (qsort left compare)
+	       (list pivot)
+	       (qsort right compare)))))))
+
+(define qsort-stats
+  (lambda (n)
+    (map
+     (lambda (p)
+       (let ((c (make-cmp)))
+	 (qsort p c)
+	 (c 'count)))
+     (allperms n))))
+
+(define ints2hist
+  (lambda (l)
+    (let* ((minv (apply min l))
+	   (maxv (apply max l))
+	   (v (make-vector (+ 1 (- maxv minv)) 0)))
+      (letrec
+	  ((iter
+	    (lambda (l)
+	      (if (not (null? l))
+		  (begin
+		    (vector-set! 
+		     v (- (car l) minv) 
+		     (+ 1 (vector-ref v (- (car l) minv))))
+		    (iter (cdr l)))))))
+	(iter l)
+	(map
+	 (lambda (pos)
+	   (cons pos (vector-ref v (- pos minv))))
+	 (make-range minv maxv))))))
+
+(define drawhist
+  (lambda (h)
+    (letrec 
+	((len (length h)) (total (* 1.0 (apply + (map cdr h))))
+	 (mx (apply max (map cdr h))) (scale 400)
+	 (colors
+	  (list->vector
+	   '((0 0 255) (0 255 0) (0 255 255)
+	     (255 0 0) (255 0 255) (255 255 0))))
+	 (bars
+	  (lambda (pos h)
+	    (let ((frac (/ (cdar h) total)))
+	      (apply draw-color (vector-ref colors (remainder pos 6)))
+	      (draw-move (* pos 40) 0)
+	      (fill-rect 30 (* scale frac))
+	      (if (not (null? (cdr h)))
+		  (bars (+ 1 pos) (cdr h))))))
+	 (labels
+	  (lambda (pos h)
+	    (draw-move (* pos 40) -20)
+	    (draw-string (format "~a" (caar h)))
+	    (if (not (null? (cdr h)))
+		(labels (+ 1 pos) (cdr h)))))
+	 (values
+	  (lambda (pos h)
+	    (let ((frac (/ (cdar h) total)))
+	      (draw-move (* pos 40) (+ 10 (* scale frac)))
+	      (draw-string (format "~a" (cdar h)))
+	      (if (not (null? (cdr h)))
+		  (values (+ 1 pos) (cdr h)))))))
+      (bars 0 h)
+      (draw-color 0 0 0)
+      (labels 0 h)
+      (values 0 h)
+      (draw-move -40 0) (draw-line (* (+ 1 len) 40) 0)
+      (draw-move -20 -20) (draw-line -20 (* scale (/ mx total))))))
+
+(define qhist
+  (lambda (n)
+    (drawhist (ints2hist (qsort-stats n)))))
+
+(qhist 6)
+
+
+

examples/queenspic.scm

@@ -0,0 +1,98 @@
+
+(define allqueens
+  (lambda (n doneproc)
+    (letrec
+        ((diag1
+          (lambda (board col)
+            (if (null? board) '()
+                (cons (+ col (car board)) 
+                      (diag1 (cdr board) (+ col 1))))))
+         (diag2
+          (lambda (board col)
+            (if (null? board) '()
+                (cons (- col (car board)) 
+                      (diag2 (cdr board) (+ col 1))))))
+         (consistent?
+          (lambda (board col new)
+            (not
+             (or (member new board)
+                 (member (+ col new) 
+                         (diag1 board 1))
+                 (member (- col new)
+                         (diag2 board 1))))))
+         (check
+          (lambda (board col)
+            (if (> col n) (doneproc board)
+                (for-each 
+                 (lambda (row)
+                   (if (consistent? board col row)
+                       (check (append board (list row))
+                              (+ 1 col))))
+                 (list-n n))))))
+      (check '() 1))))
+
+(define queens
+  (lambda (n)
+    (letrec
+	((y-reflect reverse)
+	 (rotate
+	  (lambda (board)
+	    (map
+	     (lambda (row)
+	       (- (+ 1 n) (length (member row board))))
+	     (list-n n))))
+	 (symmetries
+	  (lambda (board)
+	    (list
+	     board 
+	     (rotate board)
+	     (rotate (rotate board))
+	     (rotate (rotate (rotate board)))
+	     (y-reflect board)
+	     (rotate (y-reflect board))
+	     (rotate (rotate (y-reflect board)))
+	     (rotate (rotate (rotate (y-reflect board)))))))
+	 (result '())
+	 (new?
+	  (lambda (rlist sol)
+	    (if (null? rlist) #t
+		(if (member sol (car rlist)) #f
+		    (new? (cdr rlist) sol))))))
+      (allqueens 
+       n
+       (lambda (sol)
+         (if (new? result sol)
+             (set! result (cons (symmetries sol) result)))))
+      (map car result))))
+
+(define queenspic
+  (lambda (n)
+    (let* ((scale 30) (radius (/ scale 3)))
+      (for-each
+       (lambda (sol)
+	 (letrec
+	     ((drawqueens
+	       (lambda (pos sol)
+		 (if (not (null? sol))
+		     (begin
+		       (draw-move pos (- (* (car sol) scale) (/ scale 2)))
+		       (fill-circle radius)
+		       (drawqueens (+ pos scale) (cdr sol))))))
+	      (drawlines
+	       (lambda (m)
+		 (draw-move 0 (* m scale))
+		 (draw-line (* n scale) (* m scale))
+		 (draw-move (* m scale) 0)
+		 (draw-line (* m scale) (* n scale))
+		 (if (not (zero? m))
+		     (drawlines (- m 1))))))
+	   (draw-color 255 0 0)
+	   (drawqueens 15 sol)
+	   (draw-color 0 0 0)
+	   (drawlines n)
+	   (draw-show)))
+       (queens n)))))
+
+(queenspic 5)
+
+

examples/randcircles.scm

@@ -0,0 +1,17 @@
+
+(define randcircles
+  (lambda (n rmax lmax)
+    (let
+      ((x (random lmax)) (y (random lmax))
+       (fill (random 2))
+       (radius (+ (/ rmax 2) (random (/ rmax 2)))))
+      (draw-color 
+        (random 256)
+        (random 256)
+        (random 256))
+      (draw-move x y)
+      ((if (zero? fill) draw-circle fill-circle) radius)
+      (if (not (zero? n))
+        (randcircles (- n 1) rmax lmax)))))
+        
+(randcircles 25 30 250)

examples/random.scm

@@ -0,0 +1,28 @@
+
+(define randpoints
+  (lambda (count)
+    (letrec
+      ((scale 20)
+       (points
+        (lambda (n)
+          (draw-move 
+            (* (- count n) scale) 
+            (* scale (random count)))
+          (fill-circle (/ scale 2))
+          (if (not (zero? n))
+            (points (- n 1)))))
+       (grid
+         (lambda (n)
+           (draw-move 0 (* scale n))
+           (draw-line (* scale count) (* scale n))
+           (if (not (zero? n))
+             (grid (- n 1))))))
+      (grid count)
+      (draw-move 0 0)
+      (draw-color 255 255 0)
+      (points count))))
+      
+      
+(randpoints 15)
+(randpoints 15.0)
+

examples/randrects.scm

@@ -0,0 +1,18 @@
+
+(define randrects
+  (lambda (n rmax lmax)
+    (let
+      ((x (random lmax)) (y (random lmax))
+       (fill (random 2))
+       (a (+ (/ rmax 2) (random (/ rmax 2))))
+       (b (+ (/ rmax 2) (random (/ rmax 2)))))
+      (draw-color 
+        (random 256)
+        (random 256)
+        (random 256))
+      (draw-move x y)
+      ((if (zero? fill) draw-rect fill-rect) a b)
+      (if (not (zero? n))
+        (randrects (- n 1) rmax lmax)))))
+        
+(randrects 25 60 250)

examples/strings.scm

@@ -0,0 +1,119 @@
+
+(integer->char -20)
+(integer->char 270)
+
+(char->integer #\N)
+(char->integer #\+)
+(char->integer #\#)
+
+(define table
+  (lambda (n)
+    (if (< n 128)
+        (begin
+          (display n) (display " ")
+          (display (integer->char n)) (display " ")
+          (display (char->integer (integer->char n)))
+          (newline)
+          (table (+ n 1))))))
+
+(table 32)
+
+(list->string '())
+(list->string '(#\a #\b #\c))
+(list->string '(#\a #\b . #\c))
+
+(define test1
+  (lambda (n)
+    (let ((str
+           (list->string
+            (map
+             (lambda (pos)
+               (integer->char
+                (+ (char->integer #\A) pos -1)))
+             (reverse (list-n n))))))
+      (map
+       (lambda (pos)
+         (string-ref str (- pos 1)))
+       (reverse (list-n n))))))
+
+(test1 5)
+(test1 10)
+(test1 20)
+
+(define randletters
+  (lambda (n)
+    (if (zero? n) '()
+        (cons
+         (integer->char
+          (+ (char->integer #\A) (random 26)))
+         (randletters (- n 1))))))
+
+(define test2
+ (lambda (len)
+   (let* ((r (randletters len))
+          (s (list->string r)))
+     (display r) (display " ")
+     (display s) (display " ")
+     (display (string->list s)) (newline))))
+
+(test2 5)
+(test2 10)
+(test2 20)
+
+(string-append)
+(apply string-append 
+ (map symbol->string '(one two three four five)))
+(make-string 0)
+
+(string->list (make-string 5))
+(string->list (make-string 15))
+
+(define test3
+  (lambda (len)
+    (if (zero? len) ""
+        (string-append
+         (make-string len)
+         (make-string
+          len
+          (integer->char
+           (+ (char->integer #\a) len -1)))
+         (test3 (- len 1))))))
+
+(test3 1)
+(test3 5)
+(test3 7)
+
+
+(number->string 123.456e7)
+(number->string 678.456)
+(map number->string (list-n 30))
+
+(define test4
+  (lambda (base)
+    (map
+     (lambda (n)
+       (number->string n base))
+     (reverse (list-n 30)))))
+
+(test4 2)
+(test4 3)
+(test4 8)
+(test4 10)
+(test4 12)
+(test4 16)
+
+(define test5
+  (lambda (base)
+    (map
+     (lambda (n)
+       (number->string (+ (- n) 1) base))
+     (reverse (list-n 30)))))
+
+(test5 2)
+(test5 3)
+(test5 8)
+(test5 10)
+(test5 12)
+(test5 16)
+
+

examples/text.scm

@@ -0,0 +1,31 @@
+
+;; show some text
+
+(define text
+  (lambda (fsclist)
+    (for-each
+     (lambda (fsc)
+       (let
+	   ((font (car fsc))
+	    (size (cadr fsc))
+	    (color (caddr fsc))
+	    (pos 0))
+	 (apply draw-color color)
+	 (draw-font font size)
+	 (for-each
+	  (lambda (word)
+	    (let ((dim (string-size word font size)))
+	      (draw-move (- (/ (car dim) 2.0)) (* pos (cdr dim)))
+	      (draw-string word)
+	      (set! pos (- pos 1))))
+	  (map 
+	   symbol->string
+	   '(The quick brown fox jumps over the lazy dog)))
+	 (draw-show))) fsclist)))
+
+(text
+ '(("Courier" 36 (255 0 0))
+   ("Helvetica-Bold" 24 (0 255 0))
+   ("Lucida-Italic-Sans" 18 (0 0 255))))
+
+	    

scheme.flex

@@ -180,7 +180,7 @@ STRING       "\""([^\n\"\\]|"\\\\"|"\\\"")*"\""
 }
 
 {STRING} {
-    yylval = [[String alloc] initSCMString:yytext];
+    yylval = [[String alloc] initSCMStringLEX:yytext];
     yysofar += yyleng; return STRING;
 }
 

scheme.lex.m

@@ -996,7 +996,7 @@ case 29:
 YY_RULE_SETUP
 #line 182 "scheme.flex"
 {
-    yylval = [[String alloc] initSCMString:yytext];
+    yylval = [[String alloc] initSCMStringLEX:yytext];
     yysofar += yyleng; return STRING;
 }
 	YY_BREAK

scheme.y

@@ -5,9 +5,10 @@
 
 YYSTYPE yyresult;
 int yyinputitem;
+id yyresultform;
 
 extern int yysofar;
-extern NSMutableArray *positions;
+extern NSMutableArray *positionStack;
 %}
 
 %token LPAREN
@@ -53,12 +54,13 @@ extern NSMutableArray *positions;
 %% 
 
 top: /* empty */ {
-    yyresult = 
+    $$ = [NSNull null];
-        $$ = [NSNull null];
+    yyresultform = $$;
 }
 | topitem top {
-    yyresult = 
+    $$ = [Triple newTag:FORM_TOP Arg1:$1 Arg2:$2];
-        $$ = [Triple newTag:FORM_TOP Arg1:$1 Arg2:$2];
+    yyresultform = $$;
+    
     yyinputitem++;
 }
 ;
@@ -69,7 +71,7 @@ topitem: LPAREN DEFINE SYMBOL form RPAREN {
 
     $$ = [Triple newTag:FORM_DEFINE1 Arg1:$3 Arg2:$4];
 
-    [positions addObject:entry];
+    [[positionStack lastObject] addObject:entry];
 }
 |  LPAREN DEFINE nonemptysymlist sequence RPAREN { 
     NSValue *entry = 
@@ -77,7 +79,7 @@ topitem: LPAREN DEFINE SYMBOL form RPAREN {
 
     $$ = [Triple newTag:FORM_DEFINE2 Arg1:$3 Arg2:$4];
 
-    [positions addObject:entry];
+    [[positionStack lastObject] addObject:entry];
 } 
 |  form {
     NSValue *entry = 
@@ -85,7 +87,7 @@ topitem: LPAREN DEFINE SYMBOL form RPAREN {
 
     $$ = $1;
 
-    [positions addObject:entry];
+    [[positionStack lastObject] addObject:entry];
 }
 ;
 
@@ -105,6 +107,87 @@ revsequence: form {
 }
 ;
 
+qform: INTEGER {
+    $$ = $1;
+}
+| CHAR {
+    $$ = $1;
+}
+| BOOLEAN {
+    $$ = $1;
+}
+| DOUBLE {
+    $$ = $1;
+}
+| SYMBOL {
+    $$ = $1;
+}
+| STRING {
+    $$ = $1;
+}
+| qlist {
+    $$ = $1;
+}
+| qvector {
+    $$ = $1;
+}
+| QUOTECHAR qform {
+    $$ = [Pair newCar:[[Symbol alloc] initSCMSymbol:"quote"]
+	       Cdr:[Pair newCar:$2 Cdr:[NSNull null]]];
+}
+| ARROW {
+    $$ = [[Symbol alloc] initSCMSymbol:"=>"];
+}
+| QUOTE {
+    $$ = [[Symbol alloc] initSCMSymbol:"quote"];
+}
+| CALLCC {
+    $$ = [[Symbol alloc] initSCMSymbol:"call-with-current-continuation"];
+}
+| APPLY {
+    $$ = [[Symbol alloc] initSCMSymbol:"apply"];
+}
+| DEFINE {
+    $$ = [[Symbol alloc] initSCMSymbol:"define"];
+}
+| SET {
+    $$ = [[Symbol alloc] initSCMSymbol:"set!"];
+}
+| LAMBDA {
+    $$ = [[Symbol alloc] initSCMSymbol:"lambda"];
+}
+| IF {
+    $$ = [[Symbol alloc] initSCMSymbol:"if"];
+}
+| BEGINTOK {
+    $$ = [[Symbol alloc] initSCMSymbol:"begin"];
+}
+| AND {
+    $$ = [[Symbol alloc] initSCMSymbol:"and"];
+}
+| OR {
+    $$ = [[Symbol alloc] initSCMSymbol:"or"];
+}
+| CASE {
+    $$ = [[Symbol alloc] initSCMSymbol:"case"];
+}
+| COND {
+    $$ = [[Symbol alloc] initSCMSymbol:"cond"];
+}
+| ELSE {
+    $$ = [[Symbol alloc] initSCMSymbol:"else"];
+}
+| LET {
+    $$ = [[Symbol alloc] initSCMSymbol:"let"];
+}
+| LETSTAR {
+    $$ = [[Symbol alloc] initSCMSymbol:"let*"];
+}
+| LETREC {
+    $$ = [[Symbol alloc] initSCMSymbol:"letrec"];
+}
+;
+
 form: INTEGER {
     $$ = $1;
 }
@@ -171,14 +254,17 @@ form: INTEGER {
 | callcc {
     $$ = $1;
 }
+;
 
 callcc: LPAREN CALLCC form RPAREN {
     $$ = [Triple newTag:FORM_CALLCC Arg1:$3];
 }
+;
 
 singlecase: LPAREN LPAREN sequence RPAREN sequence RPAREN {
     $$ = [Pair newCar:$3 Cdr:$5];
 }
+;
 
 singlecond: LPAREN form RPAREN {
     $$ = [Triple newTag:FORM_SCOND1 Arg1:$2];
@@ -189,10 +275,12 @@ singlecond: LPAREN form RPAREN {
 | LPAREN form ARROW form RPAREN {
     $$ = [Triple newTag:FORM_SCOND3 Arg1:$2 Arg2:$4];
 }
+;
 
 elsecasecond:  LPAREN ELSE sequence RPAREN {
     $$ = [Pair newCar:[NSNull null] Cdr:$3];
 }
+;
 
 cases: singlecase {
     $$ = [Pair newCar:$1 Cdr:[NSNull null]];
@@ -217,6 +305,7 @@ case: LPAREN CASE form cases RPAREN {
     $$ = [Triple newTag:FORM_CASE Arg1:$3 
                  Arg2:[Pair newCar:$5 Cdr:$4]];
 }
+;
 
 cond: LPAREN COND conditions RPAREN {
     $$ = [Triple newTag:FORM_COND Arg1:$3];
@@ -224,6 +313,7 @@ cond: LPAREN COND conditions RPAREN {
 |  LPAREN COND conditions elsecasecond RPAREN {
     $$ = [Triple newTag:FORM_COND Arg1:[Pair newCar:$4 Cdr:$3]];
 }
+;
 
 and: LPAREN AND revsequence RPAREN { 
     $$ = [Triple newTag:FORM_AND Arg1:$3];
@@ -231,6 +321,7 @@ and: LPAREN AND revsequence RPAREN {
 | LPAREN AND RPAREN { 
     $$ = [Triple newTag:FORM_AND Arg1:[NSNull null]];
 }
+;
 
 or: LPAREN OR revsequence RPAREN { 
     $$ = [Triple newTag:FORM_OR Arg1:$3];
@@ -238,18 +329,22 @@ or: LPAREN OR revsequence RPAREN {
 | LPAREN OR RPAREN { 
     $$ = [Triple newTag:FORM_OR Arg1:[NSNull null]];
 }
+;
 
 begin: LPAREN BEGINTOK sequence RPAREN { 
     $$ = [Triple newTag:FORM_BEGIN Arg1:$3];
 }
+;
 
 set: LPAREN SET SYMBOL form RPAREN { 
     $$ = [Triple newTag:FORM_SET Arg1:$3 Arg2:$4];
 }
+;
 
 apply: LPAREN APPLY form form RPAREN {
     $$ = [Triple newTag:FORM_APPLY Arg1:$3 Arg2:$4];
 }
+;
 
 if: LPAREN IF form form RPAREN {
     $$ = [Triple newTag:FORM_IF1 Arg1:$3 Arg2:$4];
@@ -257,6 +352,7 @@ if: LPAREN IF form form RPAREN {
 | LPAREN IF form form form RPAREN {
     $$ = [Triple newTag:FORM_IF2 Arg1:$3 Arg2:$4 Arg3:$5];
 } 
+;
 
 lambda: LPAREN LAMBDA SYMBOL sequence RPAREN {
     $$ = [Triple newTag:FORM_LAMBDA1 Arg1:$3 Arg2:$4];
@@ -264,18 +360,20 @@ lambda: LPAREN LAMBDA SYMBOL sequence RPAREN {
 | LPAREN LAMBDA symlist sequence RPAREN {
     $$ = [Triple newTag:FORM_LAMBDA2 Arg1:$3 Arg2:$4];
 } 
+;
 
-quote: QUOTECHAR form {
+quote: QUOTECHAR qform {
     $$ = [Triple newTag:FORM_QUOTE Arg1:$2];
 }
-| LPAREN QUOTE form RPAREN {
+| LPAREN QUOTE qform RPAREN {
     $$ = [Triple newTag:FORM_QUOTE Arg1:$3];
 }
-
+;
 
 singlebinding: LPAREN SYMBOL form RPAREN {
     $$ = [Triple newTag:FORM_BINDING Arg1:$2 Arg2:$3];
 }
+;
 
 listofbindings: singlebinding {
     $$ = [Pair newCar:$1 Cdr:[NSNull null]];
@@ -283,18 +381,22 @@ listofbindings: singlebinding {
 | singlebinding listofbindings {
     $$ = [Pair newCar:$1 Cdr:$2];
 }
+;
 
 let: LPAREN LET LPAREN listofbindings RPAREN sequence RPAREN {
     $$ = [Triple newTag:FORM_LET Arg1:$4 Arg2:$6];
 }
+;
 
 letstar: LPAREN LETSTAR LPAREN listofbindings RPAREN sequence RPAREN {
     $$ = [Triple newTag:FORM_LETSTAR Arg1:$4 Arg2:$6];
 }
+;
 
 letrec: LPAREN LETREC LPAREN listofbindings RPAREN sequence RPAREN {
     $$ = [Triple newTag:FORM_LETREC Arg1:$4 Arg2:$6];
 }
+;
 
 emptylist: LPAREN RPAREN { 
     $$ = [NSNull null];
@@ -312,6 +414,17 @@ nonemptylistdata:  form {
 }
 ;
 
+qnonemptylistdata:  qform {
+    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
+}
+| qform DOT qform {
+    $$ = [Pair newCar:$1 Cdr:$3];
+}
+| qform qnonemptylistdata {
+    $$ = [Pair newCar:$1 Cdr:$2];
+}
+;
+
 nonemptyvectdata:  form {
     $$ = [Pair newCar:$1 Cdr:[NSNull null]];
 }
@@ -320,11 +433,24 @@ nonemptyvectdata:  form {
 }
 ;
 
+qnonemptyvectdata:  qform {
+    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
+}
+| qform qnonemptyvectdata {
+    $$ = [Pair newCar:$1 Cdr:$2];
+}
+;
+
 nonemptylist: LPAREN nonemptylistdata RPAREN {
     $$ = $2;
 }
 ;
 
+qnonemptylist: LPAREN qnonemptylistdata RPAREN {
+    $$ = $2;
+}
+;
+
 list: nonemptylist {
     $$ = $1;
 }
@@ -333,6 +459,14 @@ list: nonemptylist {
 }
 ;
 
+qlist: qnonemptylist {
+    $$ = $1;
+}
+| emptylist {
+    $$ = $1;
+}
+;
+
 vector: LVECTPAREN nonemptyvectdata RPAREN {
     $$ = [Vector newFromList:$2];
 }
@@ -341,6 +475,14 @@ vector: LVECTPAREN nonemptyvectdata RPAREN {
 }
 ;
 
+qvector: LVECTPAREN qnonemptyvectdata RPAREN {
+    $$ = [Vector newFromList:$2];
+}
+| LVECTPAREN RPAREN {
+    $$ = [Vector newFromList:(Pair *)[NSNull null]];
+}
+;
+
 nonemptysymlistdata: SYMBOL {
     $$ = [Pair newCar:$1 Cdr:[NSNull null]];
 }