🚀 go-pugleaf

[Xlisp 2.0 Partial Sources]

These are partial sources to XLISP 2.0.

Josh

--
Josh Hodas    (hodas@eniac.seas.upenn.edu)
4223 Pine Street
Philadelphia, PA 19104

(215) 222-7112   (home)
(215) 898-9515   (school office)

---
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	macfun.c
#	macint.c
#	macstuff.c
#	osdefs.h
#	osptrs.h
#	xlisp.r
# This archive created: Mon Jul 25 07:46:59 1988
# By:	Roger L. Long (bytebug@dhw68k.cts.com)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'macfun.c'" '(5908 characters)'
if test -f 'macfun.c'
then
	echo shar: will not over-write existing file "'macfun.c'"
else
sed 's/^X//' << \SHAR_EOF > 'macfun.c'
X/* macfun.c - macintosh user interface functions for xlisp */
X
X#include <Quickdraw.h>
X#include <WindowMgr.h>
X#include <MemoryMgr.h>
X#include "xlisp.h"
X
X/* external variables */
Xextern GrafPtr cwindow,gwindow;
X
X/* forward declarations */
XFORWARD LVAL do_0();
XFORWARD LVAL do_1();
XFORWARD LVAL do_2();
X
X/* xptsize - set the command window point size */
XLVAL xptsize()
X{
X    LVAL val;
X    val = xlgafixnum();
X    xllastarg();
X    TextSize((int)getfixnum(val));
X    InvalRect(&cwindow->portRect);
X    SetupScreen();
X    return (NIL);
X}
X
X/* xhidepen - hide the pen */
XLVAL xhidepen()
X{
X    return (do_0('H'));
X}
X
X/* xshowpen - show the pen */
XLVAL xshowpen()
X{
X    return (do_0('S'));
X}
X
X/* xgetpen - get the pen position */
XLVAL xgetpen()
X{
X    LVAL val;
X    Point p;
X    xllastarg();
X    SetPort(gwindow);
X    GetPen(&p);
X    SetPort(cwindow);
X    xlsave1(val);
X    val = consa(NIL);
X    rplaca(val,cvfixnum((FIXTYPE)p.h));
X    rplacd(val,cvfixnum((FIXTYPE)p.v));
X    xlpop();
X    return (val);
X}
X
X/* xpenmode - set the pen mode */
XLVAL xpenmode()
X{
X    return (do_1('M'));
X}
X
X/* xpensize - set the pen size */
XLVAL xpensize()
X{
X    return (do_2('S'));
X}
X
X/* xpenpat - set the pen pattern */
XLVAL xpenpat()
X{
X    LVAL plist;
X    char pat[8],i;
X    plist = xlgalist();
X    xllastarg();
X    for (i = 0; i < 8 && consp(plist); ++i, plist = cdr(plist))
X	if (fixp(car(plist)))
X	    pat[i] = getfixnum(car(plist));
X    SetPort(gwindow);
X    PenPat(pat);
X    SetPort(cwindow);
X    return (NIL);
X}
X
X/* xpennormal - set the pen to normal */
XLVAL xpennormal()
X{
X    xllastarg();
X    SetPort(gwindow);
X    PenNormal();
X    SetPort(cwindow);
X    return (NIL);
X}
X
X/* xmoveto - Move to a screen location */
XLVAL xmoveto()
X{
X    return (do_2('m'));
X}
X
X/* xmove - Move in a specified direction */
XLVAL xmove()
X{
X    return (do_2('M'));
X}
X
X/* xlineto - draw a Line to a screen location */
XLVAL xlineto()
X{
X    return (do_2('l'));
X}
X
X/* xline - draw a Line in a specified direction */
XLVAL xline()
X{
X    return (do_2('L'));
X}
X
X/* xshowgraphics - show the graphics window */
XLVAL xshowgraphics()
X{
X    xllastarg();
X    scrsplit(1);
X    return (NIL);
X}
X
X/* xhidegraphics - hide the graphics window */
XLVAL xhidegraphics()
X{
X    xllastarg();
X    scrsplit(0);
X    return (NIL);
X}
X
X/* xcleargraphics - clear the graphics window */
XLVAL xcleargraphics()
X{
X    xllastarg();
X    SetPort(gwindow);
X    EraseRect(&gwindow->portRect);
X    SetPort(cwindow);
X    return (NIL);
X}
X
X/* do_0 - Handle commands that require no arguments */
XLOCAL LVAL do_0(fcn)
X  int fcn;
X{
X    xllastarg();
X    SetPort(gwindow);
X    switch (fcn) {
X    case 'H':	HidePen(); break;
X    case 'S':	ShowPen(); break;
X    }
X    SetPort(cwindow);
X    return (NIL);
X}
X
X/* do_1 - Handle commands that require one integer argument */
XLOCAL LVAL do_1(fcn)
X  int fcn;
X{
X    int x;
X    x = getnumber();
X    xllastarg();
X    SetPort(gwindow);
X    switch (fcn) {
X    case 'M':	PenMode(x); break;
X    }
X    SetPort(cwindow);
X    return (NIL);
X}
X
X/* do_2 - Handle commands that require two integer arguments */
XLOCAL LVAL do_2(fcn)
X  int fcn;
X{
X    int h,v;
X    h = getnumber();
X    v = getnumber();
X    xllastarg();
X    SetPort(gwindow);
X    switch (fcn) {
X    case 'l':	LineTo(h,v); break;
X    case 'L':	Line(h,v);   break;
X    case 'm':   MoveTo(h,v); break;
X    case 'M':	Move(h,v);   break;
X    case 'S':	PenSize(h,v);break;
X    }
X    SetPort(cwindow);
X    return (NIL);
X}
X
X/* getnumber - get an integer parameter */
XLOCAL int getnumber()
X{
X    LVAL num;
X    num = xlgafixnum();
X    return ((int)getfixnum(num));
X}
X
X/* xtool - call the toolbox */
XLVAL xtool()
X{
X    LVAL val;
X    int trap;
X
X    trap = getnumber();
X/*
X
X    asm {
X	move.l	args(A6),D0
X	beq	L2
XL1:	move.l	D0,A0
X	move.l	2(A0),A1
X	move.w	4(A1),-(A7)
X	move.l	6(A0),D0
X	bne	L1
XL2:	lea	L3,A0
X	move.w	trap(A6),(A0)
XL3:	dc.w	0xA000
X	clr.l	val(A6)
X    }
X*/
X
X    return (val);
X}
X
X/* xtool16 - call the toolbox with a 16 bit result */
XLVAL xtool16()
X{
X    int trap,val;
X
X    trap = getnumber();
X/*
X
X    asm {
X	clr.w	-(A7)
X	move.l	args(A6),D0
X	beq	L2
XL1:	move.l	D0,A0
X	move.l	2(A0),A1
X	move.w	4(A1),-(A7)
X	move.l	6(A0),D0
X	bne	L1
XL2:	lea	L3,A0
X	move.w	trap(A6),(A0)
XL3:	dc.w	0xA000
X	move.w	(A7)+,val(A6)
X    }
X*/
X
X    return (cvfixnum((FIXTYPE)val));
X}
X
X/* xtool32 - call the toolbox with a 32 bit result */
XLVAL xtool32()
X{
X    int trap;
X    long val;
X
X    trap = getnumber();
X/*
X
X    asm {
X	clr.l	-(A7)
X	move.l	args(A6),D0
X	beq	L2
XL1:	move.l	D0,A0
X	move.l	2(A0),A1
X	move.w	4(A1),-(A7)
X	move.l	6(A0),D0
X	bne	L1
XL2:	lea	L3,A0
X	move.w	trap(A6),(A0)
XL3:	dc.w	0xA000
X	move.l	(A7)+,val(A6)
X    }
X*/
X
X    return (cvfixnum((FIXTYPE)val));
X}
X
X/* xnewhandle - allocate a new handle */
XLVAL xnewhandle()
X{
X    LVAL num;
X    long size;
X    num = xlgafixnum(); size = getfixnum(num);
X    xllastarg();
X    return (cvfixnum((FIXTYPE)NewHandle(size)));
X}
X
X/* xnewptr - allocate memory */
XLVAL xnewptr()
X{
X    LVAL num;
X    long size;
X    num = xlgafixnum(); size = getfixnum(num);
X    xllastarg();
X    return (cvfixnum((FIXTYPE)NewPtr(size)));
X}
X    
X/* xhiword - return the high order 16 bits of an integer */
XLVAL xhiword()
X{
X    unsigned int val;
X    val = (unsigned int)(getnumber() >> 16);
X    xllastarg();
X    return (cvfixnum((FIXTYPE)val));
X}
X
X/* xloword - return the low order 16 bits of an integer */
XLVAL xloword()
X{
X    unsigned int val;
X    val = (unsigned int)getnumber();
X    xllastarg();
X    return (cvfixnum((FIXTYPE)val));
X}
X
X/* xrdnohang - get the next character in the look-ahead buffer */
XLVAL xrdnohang()
X{
X    int ch;
X    xllastarg();
X    if ((ch = scrnextc()) == EOF)
X	return (NIL);
X    return (cvfixnum((FIXTYPE)ch));
X}
X
X/* ossymbols - enter important symbols */
Xossymbols()
X{
X    LVAL sym;
X
X    /* setup globals for the window handles */
X    sym = xlenter("*COMMAND-WINDOW*");
X    setvalue(sym,cvfixnum((FIXTYPE)cwindow));
X    sym = xlenter("*GRAPHICS-WINDOW*");
X    setvalue(sym,cvfixnum((FIXTYPE)gwindow));
X}
SHAR_EOF
if test 5908 -ne "`wc -c < 'macfun.c'`"
then
	echo shar: error transmitting "'macfun.c'" '(should have been 5908 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'macint.c'" '(13207 characters)'
if test -f 'macint.c'
then
	echo shar: will not over-write existing file "'macint.c'"
else
sed 's/^X//' << \SHAR_EOF > 'macint.c'
X/* macint.c - macintosh interface routines for xlisp */
X
X#include <MacTypes.h>
X#include <Quickdraw.h>  
X#include <WindowMgr.h>
X#include <EventMgr.h>
X#include <DialogMgr.h>
X#include <MenuMgr.h>
X#include <PackageMgr.h>
X#include <StdFilePkg.h>
X#include <MemoryMgr.h>
X#include <DeskMgr.h>
X#include <FontMgr.h>
X#include <ControlMgr.h>
X#include <SegmentLdr.h>
X#include <FileMgr.h>
X
X/* program limits */
X#define SCRH		40	/* maximum screen height */
X#define SCRW		100	/* maximum screen width */
X#define CHARMAX 	100	/* maximum number of buffered characters */
X#define TIMEON		40	/* cursor on time */
X#define TIMEOFF		20	/* cursor off time */
X
X/* useful definitions */
X#define MenuBarHeight	20
X#define TitleBarHeight	20
X#define SBarWidth	16
X#define MinWidth	80
X#define MinHeight	40
X#define ScreenMargin	2
X#define TextMargin	4
X#define GHeight		232
X
X/* menu id's */
X#define appleID		1
X#define fileID		256
X#define editID		257
X#define controlID	258
X
X/* externals */
Xextern char *s_unbound;
Xextern char *PtoCstr();
X
X/* screen dimensions */
Xint screenWidth;
Xint screenHeight;
X
X/* command window (normal screen) */
Xint nHorizontal,nVertical,nWidth,nHeight;
X
X/* command window (split screen) */
Xint sHorizontal,sVertical,sWidth,sHeight;
X
X/* graphics window */
Xint gHorizontal,gVertical,gWidth,gHeight;
X
X/* menu handles */
XMenuHandle appleMenu;
XMenuHandle fileMenu;
XMenuHandle editMenu;
XMenuHandle controlMenu;
X
X/* misc variables */
XOSType filetypes[] = { 'TEXT' };
X
X/* font information */
Xint tmargin,lmargin;
Xint xinc,yinc;
X
X/* command window */
XWindowRecord cwrecord;
XWindowPtr cwindow;
X
X/* graphics window */
XWindowRecord gwrecord;
XWindowPtr gwindow;
X
X/* window mode */
Xint splitmode;
X
X/* cursor variables */
Xlong cursortime;
Xint cursorstate;
Xint x,y;
X
X/* screen buffer */
Xchar screen[SCRH*SCRW],*topline,*curline;
Xint scrh,scrw;
X
X/* type ahead buffer */
Xchar charbuf[CHARMAX],*inptr,*outptr;
Xint charcnt;
X
Xmacinit()
X{
X    /* initialize the toolbox */
X    InitGraf(&thePort);
X    InitFonts();
X    InitWindows();
X    InitMenus();
X    TEInit();
X    InitDialogs(0L);
X    InitCursor();
X
X    /* setup the menu bar */
X    SetupMenus();
X
X    /* get the size of the screen */
X    screenWidth  = screenBits.bounds.right  - screenBits.bounds.left;
X    screenHeight = screenBits.bounds.bottom - screenBits.bounds.top;
X
X    /* Create the graphics and control windows */
X    gwindow = GetNewWindow(129,&gwrecord,-1L);
X    cwindow = GetNewWindow(128,&cwrecord,-1L);
X
X    /* establish the command window as the current port */
X    SetPort(cwindow);
X
X    /* compute the size of the normal command window */
X    nHorizontal = ScreenMargin;
X    nVertical = MenuBarHeight + TitleBarHeight + ScreenMargin - 2;
X    nWidth = screenWidth - (ScreenMargin * 2) - 1;
X    nHeight = screenHeight - MenuBarHeight - TitleBarHeight - (ScreenMargin * 2);
X
X    /* compute the size of the split command window */
X    sHorizontal = nHorizontal;
X    sVertical = nVertical + GHeight + 1;
X    sWidth = nWidth;
X    sHeight = nHeight - GHeight - 1;
X
X    /* compute the size of the graphics window */
X    gHorizontal = nHorizontal;
X    gVertical = MenuBarHeight + ScreenMargin;
X    gWidth = screenWidth - (ScreenMargin * 2);
X    gHeight = GHeight;
X
X    /* move and size the graphics window */
X    MoveWindow(gwindow,gHorizontal,gVertical,0);
X    SizeWindow(gwindow,gWidth,gHeight,0);
X
X    /* setup the font, size and writing mode for the command window */
X    TextFont(monaco); TextSize(9); TextMode(srcCopy);
X
X    /* setup command mode */
X    scrsplit(FALSE);
X
X    /* disable the Cursor */
X    cursorstate = -1;
X
X    /* setup the input ring buffer */
X    inptr = outptr = charbuf;
X    charcnt = 0;
X    
X    /* lock the font in memory */
X    SetFontLock(-1);
X}
X
XSetupMenus()
X{
X    appleMenu = GetMenu(appleID);	/* setup the apple menu */
X    AddResMenu(appleMenu,'DRVR');
X    InsertMenu(appleMenu,0);
X    fileMenu = GetMenu(fileID);		/* setup the file menu */
X    InsertMenu(fileMenu,0);
X    editMenu = GetMenu(editID);		/* setup the edit menu */
X    InsertMenu(editMenu,0);
X    controlMenu = GetMenu(controlID);	/* setup the control menu */
X    InsertMenu(controlMenu,0);
X    DrawMenuBar();
X}
X
Xint scrgetc()
X{
X    CursorOn();
X    while (charcnt == 0)
X	DoEvent();
X    CursorOff();
X    return (scrnextc());
X}
X
Xint scrnextc()
X{
X    int ch;
X    if (charcnt > 0) {
X	ch = *outptr++; charcnt--;
X	if (outptr >= &charbuf[CHARMAX])
X	    outptr = charbuf;
X    }
X    else {
X	charcnt = 0;
X	ch = -1;
X    }
X    return (ch);
X}
X
Xscrputc(ch)
X  int ch;
X{
X    switch (ch) {
X    case '\r':
X	x = 0;
X	break;
X    case '\n':
X	nextline(&curline);
X	if (++y >= scrh) {
X	    y = scrh - 1;
X	    scrollup();
X	}
X	break;
X    case '\t':
X	do { scrputc(' '); } while (x & 7);
X	break;
X    case '\010':
X	if (x) x--;
X	break;
X    default:
X	if (ch >= 0x20 && ch < 0x7F) {
X	    scrposition(x,y);
X	    DrawChar(ch);
X	    curline[x] = ch;
X	    if (++x >= scrw) {
X		nextline(&curline);
X		if (++y >= scrh) {
X		    y = scrh - 1;
X		    scrollup();
X		}
X		x = 0;
X	    }
X	}
X	break;
X    }
X}
X
Xscrdelete()
X{
X    scrputc('\010');
X    scrputc(' ');
X    scrputc('\010');
X}
X
Xscrclear()
X{
X    curline = screen;
X    for (y = 0; y < SCRH; y++)
X	for (x = 0; x < SCRW; x++)
X	    *curline++ = ' ';
X    topline = curline = screen;
X    x = y = 0;
X}
X
Xscrflush()
X{
X    inptr = outptr = charbuf;
X    charcnt = -1;
X    osflush();
X}
X
Xscrposition(x,y)
X  int x,y;
X{
X    MoveTo((x * xinc) + lmargin,(y * yinc) + tmargin);
X}
X
XDoEvent()
X{
X    EventRecord myEvent;
X    
X    SystemTask();
X    CursorUpdate();
X
X    while (GetNextEvent(everyEvent,&myEvent))
X	switch (myEvent.what) {
X	    case mouseDown:
X		DoMouseDown(&myEvent);
X		break;
X	    case keyDown:
X	    case autoKey:
X		DoKeyPress(&myEvent);
X		break;
X	    case activateEvt:
X		DoActivate(&myEvent);
X		break;
X	    case updateEvt:
X		DoUpdate(&myEvent);
X		break;
X	    }
X}
X
XDoMouseDown(myEvent)
X  EventRecord *myEvent;
X{
X    WindowPtr whichWindow;
X
X    switch (FindWindow(myEvent->where,&whichWindow)) {
X    case inMenuBar:
X	DoMenuClick(myEvent);
X	break;
X    case inSysWindow:
X	SystemClick(myEvent,whichWindow);
X	break;
X    case inDrag:
X	DoDrag(myEvent,whichWindow);
X	break;
X    case inGoAway:
X	DoGoAway(myEvent,whichWindow);
X	break;
X    case inGrow:
X	DoGrow(myEvent,whichWindow);
X	break;
X    case inContent:
X	DoContent(myEvent,whichWindow);
X	break;
X    }
X}
X
XDoMenuClick(myEvent)
X  EventRecord *myEvent;
X{
X    long choice;
X    if (choice = MenuSelect(myEvent->where))
X	DoCommand(choice);
X}
X
XDoDrag(myEvent,whichWindow)
X  EventRecord *myEvent;
X  WindowPtr whichWindow;
X{
X    Rect dragRect;
X    SetRect(&dragRect,0,MenuBarHeight,screenWidth,screenHeight);
X    InsetRect(&dragRect,ScreenMargin,ScreenMargin);
X    DragWindow(whichWindow,myEvent->where,&dragRect);
X}
X
XDoGoAway(myEvent,whichWindow)
X  EventRecord *myEvent;
X  WindowPtr whichWindow;
X{
X    if (TrackGoAway(whichWindow,myEvent->where))
X	wrapup();
X}
X
XDoGrow(myEvent,whichWindow)
X  EventRecord *myEvent;
X  WindowPtr whichWindow;
X{
X    Rect sizeRect;
X    long newSize;
X    if (whichWindow != FrontWindow() && whichWindow != gwindow)
X	SelectWindow(whichWindow);
X    else {
X	SetRect(&sizeRect,MinWidth,MinHeight,screenWidth,screenHeight-MenuBarHeight);
X	newSize = GrowWindow(whichWindow,myEvent->where,&sizeRect);
X	if (newSize) {
X	    EraseRect(&whichWindow->portRect);
X	    SizeWindow(whichWindow,LoWord(newSize),HiWord(newSize),-1);
X	    InvalRect(&whichWindow->portRect);
X	    SetupScreen();
X	    scrflush();
X	}
X    }
X}
X
XDoContent(myEvent,whichWindow)
X  EventRecord *myEvent;
X  WindowPtr whichWindow;
X{
X    if (whichWindow != FrontWindow() && whichWindow != gwindow)
X	SelectWindow(whichWindow);
X}
X
XDoKeyPress(myEvent)
X  EventRecord *myEvent;
X{
X    long choice;
X    
X    if (FrontWindow() == cwindow) {
X	if (myEvent->modifiers & 0x100) {
X	    if (choice = MenuKey((char)myEvent->message))
X		DoCommand(choice);
X	}
X	else {
X	    if (charcnt < CHARMAX) {
X		*inptr++ = myEvent->message & 0xFF; charcnt++;
X		if (inptr >= &charbuf[CHARMAX])
X		    inptr = charbuf;
X	    }
X	}
X    }
X}
X
XDoActivate(myEvent)
X  EventRecord *myEvent;
X{
X    WindowPtr whichWindow;
X    whichWindow = (WindowPtr)myEvent->message;
X    SetPort(whichWindow);
X    if (whichWindow == cwindow)
X	DrawGrowIcon(whichWindow);
X}
X
XDoUpdate(myEvent)
X  EventRecord *myEvent;
X{
X    WindowPtr whichWindow;
X    GrafPtr savePort;
X    GetPort(&savePort);
X    whichWindow = (WindowPtr)myEvent->message;
X    SetPort(whichWindow);
X    BeginUpdate(whichWindow);
X    EraseRect(&whichWindow->portRect);
X    if (whichWindow == cwindow) {
X	DrawGrowIcon(whichWindow);
X	RedrawScreen();
X    }
X    EndUpdate(whichWindow);
X    SetPort(savePort);
X}
X
XDoCommand(choice)
X  long choice;
X{
X    int theMenu,theItem;
X    
X    /* decode the menu choice */
X    theMenu = HiWord(choice);
X    theItem = LoWord(choice);
X    
X    CursorOff();
X    HiliteMenu(theMenu);
X    switch (theMenu) {
X    case appleID:
X	DoAppleMenu(theItem);
X	break;
X    case fileID:
X	DoFileMenu(theItem);
X	break;
X    case editID:
X	DoEditMenu(theItem);
X	break;
X    case controlID:
X	DoControlMenu(theItem);
X	break;
X    }
X    HiliteMenu(0);
X    CursorOn();
X}
X
Xpascal aboutfilter(theDialog,theEvent,itemHit)
X  DialogPtr theDialog; EventRecord *theEvent; int *itemHit;
X{
X    return (theEvent->what == mouseDown ? -1 : 0);
X}
X
XDoAppleMenu(theItem)
X  int theItem;
X{
X    DialogRecord mydialog;
X    char name[256];
X    GrafPtr gp;
X    int n;
X
X    switch (theItem) {
X    case 1:
X	GetNewDialog(129,&mydialog,-1L);
X	ModalDialog(aboutfilter,&n);
X	CloseDialog(&mydialog);
X	break;
X    default:
X	GetItem(appleMenu,theItem,name);
X	GetPort(&gp);
X	OpenDeskAcc(name);
X	SetPort(gp);
X	break;
X    }
X}
X
Xpascal int filefilter(pblock)
X  ParmBlkPtr pblock;
X{
X    unsigned char *p; int len;
X    p = pblock->fileParam.ioNamePtr; len = *p++ &0xFF;
X    return (len >= 4 && strncmp(p+len-4,".lsp",4) == 0 ? 0 : -1);
X}
X
XDoFileMenu(theItem)
X  int theItem;
X{
X    SFReply loadfile;
X    Point p;
X
X    switch (theItem) {
X    case 1:	/* load */
X    case 2:	/* load noisily */
X	p.h = 100; p.v = 100;
X	SFGetFile(p,"\P",filefilter,-1,filetypes,0L,&loadfile);
X	if (loadfile.good) {
X	    HiliteMenu(0);
X	    SetVol(0L,loadfile.vRefNum);
X	    if (xlload(PtoCstr(loadfile.fName),1,(theItem == 1 ? 0 : 1)))
X		scrflush();
X	    else
X		xlabort("load error");
X	}
X	break;
X    case 4:	/* quit */
X	wrapup();
X    }
X}
X
XDoEditMenu(theItem)
X  int theItem;
X{
X    switch (theItem) {
X    case 1:	/* undo */
X    case 3:	/* cut */
X    case 4:	/* copy */
X    case 5:	/* paste */
X    case 6:	/* clear */
X	SystemEdit(theItem-1);
X	break;
X    }
X}
X
XDoControlMenu(theItem)
X  int theItem;
X{
X    scrflush();
X    HiliteMenu(0);
X    switch (theItem) {
X    case 1:	/* break */
X	xlbreak("user break",s_unbound);
X	break;
X    case 2:	/* continue */
X	xlcontinue();
X	break;
X    case 3:	/* clean-up error */
X	xlcleanup();
X	break;
X    case 4:	/* Cancel input */
X	xlabort("input canceled");
X	break;
X    case 5:	/* Top Level */
X	xltoplevel();
X	break;
X    case 7:	/* split screen */
X	scrsplit(splitmode ? FALSE : TRUE);
X	break;
X    }
X}
X
Xscrsplit(split)
X  int split;
X{
X    ShowHide(cwindow,0);
X    if (split) {
X	CheckItem(controlMenu,7,-1);
X	ShowHide(gwindow,-1);
X	MoveWindow(cwindow,sHorizontal,sVertical,-1);
X	SizeWindow(cwindow,sWidth,sHeight,-1);
X	InvalRect(&cwindow->portRect);
X	SetupScreen();
X    }
X    else {
X	CheckItem(controlMenu,7,0);
X	ShowHide(gwindow,0);
X	MoveWindow(cwindow,nHorizontal,nVertical,-1);
X	SizeWindow(cwindow,nWidth,nHeight,-1);
X	InvalRect(&cwindow->portRect);
X	SetupScreen();
X    }
X    ShowHide(cwindow,-1);
X    splitmode = split;
X}
X
XSetupScreen()
X{
X    FontInfo info;
X    Rect *pRect;
X
X    /* get font information */
X    GetFontInfo(&info);
X
X    /* compute the top and bottom margins */
X    tmargin = TextMargin + info.ascent;
X    lmargin = TextMargin;
X
X    /* compute the x and y increments */
X    xinc = info.widMax;
X    yinc = info.ascent + info.descent + info.leading;
X
X    /* compute the character dimensions of the screen */
X    pRect = &cwindow->portRect;
X    scrh = (pRect->bottom - (2 * TextMargin) - (SBarWidth - 1)) / yinc;
X    if (scrh > SCRH) scrh = SCRH;
X    scrw = (pRect->right - (2 * TextMargin) - (SBarWidth - 1)) / xinc;
X    if (scrw > SCRW) scrw = SCRW;
X    
X    /* clear the screen */
X    scrclear();
X}
X
XCursorUpdate()
X{
X    if (cursorstate != -1)
X	if (cursortime < TickCount()) {
X	    scrposition(x,y);
X	    if (cursorstate) {
X		DrawChar(' ');
X		cursortime = TickCount() + TIMEOFF;
X		cursorstate = 0;
X	    }
X	    else {
X		DrawChar('_');
X		cursortime = TickCount() + TIMEON;
X		cursorstate = 1;
X	    }
X	}
X}
X
XCursorOn()
X{
X    cursortime = TickCount();
X    cursorstate = 0;
X}
X
XCursorOff()
X{
X    if (cursorstate == 1) {
X	scrposition(x,y);
X	DrawChar(' ');
X    }
X    cursorstate = -1;
X}
X
XRedrawScreen()
X{
X    char *Line; int y;
X    Line = topline;
X    for (y = 0; y < scrh; y++) {
X	scrposition(0,y);
X	DrawText(Line,0,scrw);
X	nextline(&Line);
X    }
X}
X
Xnextline(pline)
X  char **pline;
X{
X    if ((*pline += SCRW) >= &screen[SCRH*SCRW])
X	*pline = screen;
X}
X
Xscrollup()
X{
X    RgnHandle updateRgn;
X    Rect rect;
X    int x;
X    updateRgn = NewRgn();
X    rect = cwindow->portRect;
X    rect.bottom -= SBarWidth - 1;
X    rect.right -= SBarWidth - 1;
X    ScrollRect(&rect,0,-yinc,updateRgn);
X    DisposeRgn(updateRgn);
X    for (x = 0; x < SCRW; x++)
X	topline[x] = ' ';
X    nextline(&topline);
X}
SHAR_EOF
if test 13207 -ne "`wc -c < 'macint.c'`"
then
	echo shar: error transmitting "'macint.c'" '(should have been 13207 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'macstuff.c'" '(2425 characters)'
if test -f 'macstuff.c'
then
	echo shar: will not over-write existing file "'macstuff.c'"
else
sed 's/^X//' << \SHAR_EOF > 'macstuff.c'
X/* macstuff.c - macintosh interface routines for xlisp */
X
X#include <stdio.h>
X
X/* program limits */
X#define LINEMAX 	200	/* maximum line length */
X
X/* externals */
Xextern FILE *tfp;
Xextern int x;
X
X/* local variables */
Xstatic char linebuf[LINEMAX+1],*lineptr;
Xstatic int linepos[LINEMAX],linelen;
Xstatic long rseed = 1L;
X
Xosinit(name)
X  char *name;
X{
X    /* initialize the mac interface routines */
X    macinit();
X
X    /* initialize the line editor */
X    linelen = 0;
X}
X
Xosfinish()
X{
X}
X
Xoserror(msg)
X{
X    char line[100],*p;
X    sprintf(line,"error: %s\n",msg);
X    for (p = line; *p != '\0'; ++p)
X	ostputc(*p);
X}
X
Xint osrand(n)
X  int n;
X{
X    long k1;
X    
X    /* make sure we don't get stuck at zero */
X    if (rseed == 0L) rseed = 1L;
X    
X    /* algorithm taken from Dr. Dobbs Journal, November 1985, Page 91 */
X    k1 = rseed / 127773L;
X    if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
X	rseed += 2147483647L;
X	
X    /* return a random number between 0 and n-1 */
X    return ((int)(rseed % (long)n));
X}
X
XFILE *osaopen(name,mode)
X  char *name,*mode;
X{
X    return (fopen(name,mode));
X}
X
XFILE *osbopen(name,mode)
X  char *name,*mode;
X{
X    char nmode[4];
X    strcpy(nmode,mode); strcat(nmode,"b");
X    return (fopen(name,nmode));
X}
X
Xint osclose(fp)
X  FILE *fp;
X{
X    return (fclose(fp));
X}
X
Xint osagetc(fp)
X  FILE *fp;
X{
X    return (getc(fp));
X}
X
Xint osbgetc(fp)
X  FILE *fp;
X{
X    return (getc(fp));
X}
X
Xint osaputc(ch,fp)
X  int ch; FILE *fp;
X{
X    return (putc(ch,fp));
X}
X
Xint osbputc(ch,fp)
X  int ch; FILE *fp;
X{
X    return (putc(ch,fp));
X}
X
Xint ostgetc()
X{
X    int ch,i;
X
X    if (linelen--) return (*lineptr++);
X    linelen = 0;
X    while ((ch = scrgetc()) != '\r')
X	switch (ch) {
X	case EOF:
X	    return (ostgetc());
X	case '\010':
X	    if (linelen > 0) {
X		linelen--;
X		while (x > linepos[linelen])
X		    scrdelete();
X	    }
X	    break;
X	default:
X	    if (linelen < LINEMAX) {
X	        linebuf[linelen] = ch;
X		linepos[linelen] = x;
X		linelen++;
X	    }
X	    scrputc(ch);
X	    break;
X	}
X    linebuf[linelen++] = '\n';
X    scrputc('\r'); scrputc('\n');
X    if (tfp)
X	for (i = 0; i < linelen; ++i)
X	    osaputc(linebuf[i],tfp);
X    lineptr = linebuf; linelen--;
X    return (*lineptr++);
X}
X
Xint ostputc(ch)
X  int ch;
X{
X    if (ch == '\n')
X	scrputc('\r');
X    scrputc(ch);
X    if (tfp)
X	osaputc(ch,tfp);
X    return (1);
X}
X
Xosflush()
X{
X    lineptr = linebuf;
X    linelen = 0;
X}
X
Xoscheck()
X{
X    DoEvent();
X}
X
SHAR_EOF
if test 2425 -ne "`wc -c < 'macstuff.c'`"
then
	echo shar: error transmitting "'macstuff.c'" '(should have been 2425 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'osdefs.h'" '(306 characters)'
if test -f 'osdefs.h'
then
	echo shar: will not over-write existing file "'osdefs.h'"
else
sed 's/^X//' << \SHAR_EOF > 'osdefs.h'
Xextern LVAL xptsize(),
X	    xhidepen(),xshowpen(),xgetpen(),xpensize(),xpenmode(),
X            xpenpat(),xpennormal(),xmoveto(),xmove(),xlineto(),xline(),
X	    xshowgraphics(),xhidegraphics(),xcleargraphics(),
X	    xtool(),xtool16(),xtool32(),xnewhandle(),xnewptr(),
X	    xhiword(),xloword(),xrdnohang();
X
SHAR_EOF
if test 306 -ne "`wc -c < 'osdefs.h'`"
then
	echo shar: error transmitting "'osdefs.h'" '(should have been 306 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'osptrs.h'" '(977 characters)'
if test -f 'osptrs.h'
then
	echo shar: will not over-write existing file "'osptrs.h'"
else
sed 's/^X//' << \SHAR_EOF > 'osptrs.h'
X{	"HIDEPEN",			S, xhidepen		}, /* 300 */
X{	"SHOWPEN",			S, xshowpen		}, /* 301 */
X{	"GETPEN",			S, xgetpen		}, /* 302 */
X{	"PENSIZE",			S, xpensize		}, /* 303 */
X{	"PENMODE",			S, xpenmode		}, /* 304 */
X{	"PENPAT",			S, xpenpat		}, /* 305 */
X{	"PENNORMAL",			S, xpennormal		}, /* 306 */
X{	"MOVETO",			S, xmoveto		}, /* 307 */
X{	"MOVE",				S, xmove		}, /* 308 */
X{	"LINETO",			S, xlineto		}, /* 309 */
X{	"LINE",				S, xline		}, /* 310 */
X{	"SHOW-GRAPHICS",		S, xshowgraphics	}, /* 311 */
X{	"HIDE-GRAPHICS",		S, xhidegraphics	}, /* 312 */
X{	"CLEAR-GRAPHICS",		S, xcleargraphics	}, /* 313 */
X{	"TOOLBOX",			S, xtool		}, /* 314 */
X{	"TOOLBOX-16",			S, xtool16		}, /* 315 */
X{	"TOOLBOX-32",			S, xtool32		}, /* 316 */
X{	"NEWHANDLE",			S, xnewhandle		}, /* 317 */
X{	"NEWPTR",			S, xnewptr		}, /* 318 */
X{	"HIWORD",			S, xhiword		}, /* 319 */
X{	"LOWORD",			S, xloword		}, /* 320 */
X{	"READ-CHAR-NO-HANG",		S, xrdnohang		}, /* 321 */
X{	"COMMAND-POINT-SIZE",		S, xptsize		}, /* 322 */
X
SHAR_EOF
if test 977 -ne "`wc -c < 'osptrs.h'`"
then
	echo shar: error transmitting "'osptrs.h'" '(should have been 977 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'xlisp.r'" '(956 characters)'
if test -f 'xlisp.r'
then
	echo shar: will not over-write existing file "'xlisp.r'"
else
sed 's/^X//' << \SHAR_EOF > 'xlisp.r'
XXLisp.Rsrc
X
XTYPE WIND
X  ,128
XXLISP version 2.0
X41 4 339 508
XInVisible GoAway
X0
X0
X
XTYPE WIND
X  ,129
XGraphics Window
X22 4 254 508
XInVisible NoGoAway
X2
X0
X
XTYPE DLOG
X  ,129
XAbout XLISP
X50 100 290 395
XVisible NoGoAway
X3
X0
X129
X
XTYPE DITL
X  ,129
X9
X
XstaticText
X20 20 40 275
XXLISP v2.0, February 6, 1988
X
XstaticText
X40 20 60 275
XCopyright (c) 1988, by David Betz
X
XstaticText
X60 20 80 275
XAll Rights Reserved
X
XstaticText
X90 20 110 275
XAuthor contact information:
X
XstaticText
X110 40 130 275
XDavid Betz
X
XstaticText
X130 40 150 275
X127 Taylor Road
X
XstaticText
X150 40 170 275
XPeterborough, NH  03458
X
XstaticText
X170 40 190 275
X(603) 924-6936
X
XstaticText
X200 20 220 275
XPortions Copyright Think Technologies
X
XTYPE MENU
X  ,1
X\14
XAbout XLISP
X(-
X
XTYPE MENU
X  ,256
XFile
XLoad.../L
XLoad Noisily.../N
X(-
XQuit/Q
X
XTYPE MENU
X  ,257
XEdit
XUndo/Z
X(-
XCut/X
XCopy/C
XPaste/V
XClear
X
XTYPE MENU
X  ,258
XControl
XBreak/B
XContinue/P
XClean Up Error/G
XCancel Input/U
XTop Level/T
X(-
XSplit Screen/S
X
SHAR_EOF
if test 956 -ne "`wc -c < 'xlisp.r'`"
then
	echo shar: error transmitting "'xlisp.r'" '(should have been 956 characters)'
fi
fi # end of overwriting check
#	End of shell archive
exit 0
---