v08i058: Elk (Extension Language Toolkit) part 10 of 14

Brandon S. Allbery - comp.sources.misc allbery at uunet.UU.NET
Sun Sep 24 07:43:06 AEST 1989


Posting-number: Volume 8, Issue 58
Submitted-by: net at tub.UUCP (Oliver Laumann)
Archive-name: elk/part10

[Let this be a lesson to submitters:  this was submitted as uuencoded,
compressed files.  I lost the source information while unpacking it; this
is the best approximation I could come up with.  ++bsa]

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 10 (of 14)."
# Contents:  lib/xlib/Makefile lib/xlib/display.c lib/xlib/xlib.h
#   lib/xlib/color.c lib/xlib/window.c lib/xlib/BUGS lib/xlib/event.c
#   lib/xlib/gcontext.c lib/xlib/graphics.c lib/xaw lib/xaw/form.d
#   lib/xaw/command.d
# Wrapped by net at tub on Sun Sep 17 17:32:34 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f lib/xlib/Makefile -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/Makefile\"
else
echo shar: Extracting \"lib/xlib/Makefile\" \(1062 characters\)
sed "s/^X//" >lib/xlib/Makefile <<'END_OF_lib/xlib/Makefile'
XH=	../../src/config.h\
X	../../src/object.h\
X	../../src/extern.h\
X	../../src/macros.h\
X	../util/symbol.h\
X	../util/string.h\
X	../util/objects.h\
X	xlib.h
X
XC=	color.c\
X	colormap.c\
X	cursor.c\
X	display.c\
X	error.c\
X	event.c\
X	font.c\
X	gcontext.c\
X	graphics.c\
X	key.c\
X	objects.c\
X	pixel.c\
X	pixmap.c\
X	pointer.c\
X	property.c\
X	text.c\
X	type.c\
X	window.c\
X	wm.c
X
XO=	color.o\
X	colormap.o\
X	cursor.o\
X	display.o\
X	error.o\
X	event.o\
X	font.o\
X	gcontext.o\
X	graphics.o\
X	key.o\
X	objects.o\
X	pixel.o\
X	pixmap.o\
X	pointer.o\
X	property.o\
X	text.o\
X	type.o\
X	window.o\
X	wm.o\
X	../util/symbol.o\
X	../util/objects.o
X
X../xlib.o:	$(O)
X	ld -r -x $(O) -lX11; mv a.out ../xlib.o; chmod 644 ../xlib.o
X
Xcolor.o:	$(H)
Xcolormap.o:	$(H)
Xcursor.o:	$(H)
Xdisplay.o:	$(H)
Xerror.o:	$(H)
Xevent.o:	$(H)
Xfont.o:		$(H)
Xgcontext.o:	$(H)
Xgraphics.o:	$(H)
Xkey.o:		$(H)
Xobjects.o:	$(H)
Xpixel.o:	$(H)
Xpixmap.o:	$(H)
Xpointer.o:	$(H)
Xproperty.o:	$(H)
Xtext.o:		$(H)
Xtype.o:		$(H)
Xwindow.o:	$(H)
Xwm.o:		$(H)
X
Xlint:
X	lint $(LINTFLAGS) -abxh $(C) | egrep -v '\?\?\?'
X
Xclean:
X	rm -f *.o core a.out ../xlib.o
END_OF_lib/xlib/Makefile
if test 1062 -ne `wc -c <lib/xlib/Makefile`; then
    echo shar: \"lib/xlib/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/display.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/display.c\"
else
echo shar: Extracting \"lib/xlib/display.c\" \(4805 characters\)
sed "s/^X//" >lib/xlib/display.c <<'END_OF_lib/xlib/display.c'
X#include "xlib.h"
X
XObject Sym_Pointer_Root;
X
Xstatic Display_Visit (dp, f) Object *dp; int (*f)(); {
X    (*f)(&DISPLAY(*dp)->after);
X}
X
XGeneric_Predicate (Display);
X
XGeneric_Equal (Display, DISPLAY, dpy);
X
Xstatic Display_Print (d, port, raw, depth, length) Object d, port; {
X    Printf (port, "#[display %u %s]", (unsigned)DISPLAY(d)->dpy,
X	DisplayString (DISPLAY(d)->dpy));
X}
X
XObject Make_Display (finalize, dpy) Display *dpy; {
X    char *p;
X    Object d;
X
X    d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj);
X    if (Nullp (d)) {
X	p = Get_Bytes (sizeof (struct S_Display));
X	SET (d, T_Display, (struct S_Display *)p);
X	DISPLAY(d)->dpy = dpy;
X	DISPLAY(d)->free = 0;
X	DISPLAY(d)->after = False;
X	Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display :
X	    (PFO)0, 1);
X    }
X    return d;
X}
X
Xstatic Object P_Open_Display (argc, argv) Object *argv; {
X    register char *s;
X    Object name;
X    Display *dpy;
X
X    if (argc == 1) {
X	name = argv[0];
X	Make_C_String (name, s);
X	if ((dpy = XOpenDisplay (s)) == 0)
X	    Primitive_Error ("cannot open display ~s", name);
X    } else if ((dpy = XOpenDisplay ((char *)0)) == 0)
X	Primitive_Error ("cannot open display");
X    return Make_Display (1, dpy);
X}
X
XObject P_Close_Display (d) Object d; {
X    register struct S_Display *p;
X
X    Check_Type (d, T_Display);
X    p = DISPLAY(d);
X    if (!p->free) {
X	Terminate_Group ((GENERIC)p->dpy);
X	XCloseDisplay (p->dpy);
X    }
X    Deregister_Object (d);
X    p->free = 1;
X    return Void;
X}
X
Xstatic Object P_Display_Root_Window (d) Object d; {
X    Check_Type (d, T_Display);
X    return Make_Window (0, DISPLAY(d)->dpy,
X	DefaultRootWindow (DISPLAY(d)->dpy));
X}
X
Xstatic Object P_Display_Colormap (d) Object d; {
X    register Display *dpy;
X
X    Check_Type (d, T_Display);
X    dpy = DISPLAY(d)->dpy;
X    return Make_Colormap (0, dpy, DefaultColormap (dpy, DefaultScreen (dpy)));
X}
X
Xstatic Object P_Display_Default_Gcontext (d) Object d; {
X    register Display *dpy;
X
X    Check_Type (d, T_Display);
X    dpy = DISPLAY(d)->dpy;
X    return Make_Gc (0, dpy, DefaultGC (dpy, DefaultScreen (dpy)));
X}
X
Xstatic Object P_Display_Width (d) Object d; {
X    Check_Type (d, T_Display);
X    return Make_Fixnum (DisplayWidth (DISPLAY(d)->dpy,
X	DefaultScreen (DISPLAY(d)->dpy)));
X}
X
Xstatic Object P_Display_Height (d) Object d; {
X    Check_Type (d, T_Display);
X    return Make_Fixnum (DisplayHeight (DISPLAY(d)->dpy,
X	DefaultScreen (DISPLAY(d)->dpy)));
X}
X
Xstatic Object P_Display_Flush_Output (d) Object d; {
X    Check_Type (d, T_Display);
X    XFlush (DISPLAY(d)->dpy);
X    return Void;
X}
X
Xstatic Object P_Display_Wait_Output (d, discard) Object d, discard; {
X    Check_Type (d, T_Display);
X    Check_Type (discard, T_Boolean);
X    XSync (DISPLAY(d)->dpy, EQ(discard, True));
X    return Void;
X}
X
Xstatic Object P_Set_Input_Focus (d, win, revert_to, time) Object d, win,
X    revert_to, time; {
X    Window focus = PointerRoot;
X
X    Check_Type (d, T_Display);
X    if (!EQ(win, Sym_Pointer_Root))
X	focus = Get_Window (win);
X    XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0,
X	Revert_Syms), Get_Time (time));
X    return Void;
X}
X
Xstatic Object P_Input_Focus (d) Object d; {
X    Window win;
X    int revert_to;
X    Object ret, x;
X    GC_Node;
X
X    Check_Type (d, T_Display);
X    XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to);
X    ret = Cons (Null, Null);
X    GC_Link (ret);
X    x = Make_Window (0, DISPLAY(d)->dpy, win);
X    Car (ret) = x;
X    x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms);
X    Cdr (ret) = x;
X    GC_Unlink;
X    return ret;
X}
X
Xinit_xlib_display () {
X    Define_Symbol (&Sym_Pointer_Root, "pointer-root");
X    T_Display = Define_Type (0, "display", NOFUNC, sizeof (struct S_Display),
X	Display_Equal, Display_Equal, Display_Print, Display_Visit);
X    Define_Primitive (P_Displayp,        "display?",        1, 1, EVAL);
X    Define_Primitive (P_Open_Display,    "open-display",    0, 1, VARARGS);
X    Define_Primitive (P_Close_Display,   "close-display",   1, 1, EVAL);
X    Define_Primitive (P_Display_Root_Window,     "display-root-window",
X							    1, 1, EVAL);
X    Define_Primitive (P_Display_Colormap,        "display-colormap",
X							    1, 1, EVAL);
X    Define_Primitive (P_Display_Default_Gcontext,"display-default-gcontext",
X							    1, 1, EVAL);
X    Define_Primitive (P_Display_Width,   "display-width",   1, 1, EVAL);
X    Define_Primitive (P_Display_Height,  "display-height",  1, 1, EVAL);
X    Define_Primitive (P_Display_Flush_Output,    "display-flush-output",
X							    1, 1, EVAL);
X    Define_Primitive (P_Display_Wait_Output,     "display-wait-output",
X							    2, 2, EVAL);
X    Define_Primitive (P_Set_Input_Focus,  "set-input-focus",4, 4, EVAL);
X    Define_Primitive (P_Input_Focus,      "input-focus",    1, 1, EVAL);
X    P_Provide (Intern ("xlib.o"));
X}
END_OF_lib/xlib/display.c
if test 4805 -ne `wc -c <lib/xlib/display.c`; then
    echo shar: \"lib/xlib/display.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/xlib.h -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/xlib.h\"
else
echo shar: Extracting \"lib/xlib/xlib.h\" \(6659 characters\)
sed "s/^X//" >lib/xlib/xlib.h <<'END_OF_lib/xlib/xlib.h'
X#include <X11/X.h>
X#include <X11/Xlib.h>
X#include <X11/Xutil.h>
X#include <signal.h>
X
X#define X_True True
X#undef True
X#define X_False False
X#undef False
X
X#include <scheme.h>
X
X#include "../util/symbol.h"
X#include "../util/string.h"
X#include "../util/objects.h"
X
Xint T_Display;
Xint T_Gc;
Xint T_Pixel;
Xint T_Pixmap;
Xint T_Window;
Xint T_Font;
Xint T_Colormap;
Xint T_Color;
Xint T_Cursor;
Xint T_Atom;
X
X#define DISPLAY(x)   ((struct S_Display *)POINTER(x))
X#define GCONTEXT(x)  ((struct S_Gc *)POINTER(x))
X#define PIXEL(x)     ((struct S_Pixel *)POINTER(x))
X#define PIXMAP(x)    ((struct S_Pixmap *)POINTER(x))
X#define WINDOW(x)    ((struct S_Window *)POINTER(x))
X#define FONT(x)      ((struct S_Font *)POINTER(x))
X#define COLORMAP(x)  ((struct S_Colormap *)POINTER(x))
X#define COLOR(x)     ((struct S_Color *)POINTER(x))
X#define CURSOR(x)    ((struct S_Cursor *)POINTER(x))
X#define ATOM(x)      ((struct S_Atom *)POINTER(x))
X
Xstruct S_Display {
X    Object after;
X    Display *dpy;
X    char free;
X};
X
Xstruct S_Gc {
X    Object tag;
X    GC gc;
X    Display *dpy;
X    char free;
X};
X
Xstruct S_Pixel {
X    Object tag;
X    unsigned long pix;
X};
X
Xstruct S_Pixmap {
X    Object tag;
X    Pixmap pm;
X    Display *dpy;
X    char free;
X};
X
Xstruct S_Window {
X    Object tag;
X    Window win;
X    Display *dpy;
X    char free;
X    char finalize;
X};
X
Xstruct S_Font {
X    Object name;
X    Font id;
X    XFontStruct *info;
X    Display *dpy;
X};
X
Xstruct S_Colormap {
X    Object tag;
X    Colormap cm;
X    Display *dpy;
X    char free;
X};
X
Xstruct S_Color {
X    Object tag;
X    XColor c;
X};
X
Xstruct S_Cursor {
X    Object tag;
X    Cursor cursor;
X    Display *dpy;
X    char free;
X};
X
Xstruct S_Atom {
X    Object tag;
X    Atom atom;
X};
X
Xextern unsigned long Encode_Event_Mask();
Xextern unsigned long Get_Pixel();
Xextern Pixmap Get_Pixmap();
Xextern Font Get_Font();
Xextern XColor *Get_Color();
Xextern Colormap Get_Colormap();
Xextern Cursor Get_Cursor();
Xextern Window Get_Window();
Xextern Drawable Get_Drawable();
Xextern Object Get_Event_Args(), Make_Cursor(), Make_Pixmap();
Xextern Object Make_Display(), Make_Window(), Make_Colormap(), Make_Atom();
Xextern Object Make_Font(), Make_Pixel(), Make_Gc(), P_Destroy_Window();
Xextern Object P_Close_Display(), P_Free_Gc(), P_Close_Font(), P_Free_Pixmap();
Xextern Object P_Free_Colormap(), P_Free_Cursor();
Xextern Time Get_Time();
Xextern Match_X_Obj();
X
Xenum Type {
X    T_NONE,
X    T_INT, T_LONG, T_ULONG, T_PIXEL, T_PIXMAP, T_BOOL, T_FONT,
X    T_COLORMAP, T_CURSOR, T_WINDOW, T_MASK, T_SYM, T_SHORT,
X};
X
Xtypedef struct {
X    char *slot;
X    char *name;
X    enum Type type;
X    SYMDESCR *syms;
X    int mask;
X} RECORD;
X
Xtypedef struct {
X    Window root;
X    int x, y, width, height, border_width, depth;
X} GEOMETRY;
X
Xextern XSetWindowAttributes SWA;
Xextern XWindowChanges WC;
Xextern XGCValues GCV;
Xextern GEOMETRY GEO;
Xextern XWindowAttributes WA;
Xextern XFontStruct FI;
Xextern XCharStruct CI;
Xextern XWMHints WMH;
Xextern XSizeHints SZH;
Xextern XIconSize ISZ;
X
Xextern Set_Attr_Size, Conf_Size, GC_Size, Geometry_Size, Win_Attr_Size,
X    Font_Info_Size, Char_Info_Size, Wm_Hints_Size, Size_Hints_Size,
X    Icon_Size_Size;
Xextern RECORD Set_Attr_Rec[], Conf_Rec[], GC_Rec[], Geometry_Rec[],
X    Win_Attr_Rec[], Font_Info_Rec[], Char_Info_Rec[], Wm_Hints_Rec[],
X    Size_Hints_Rec[], Icon_Size_Rec[];
X
Xextern unsigned long Vector_To_Record();
Xextern Object Record_To_Vector();
X
Xextern SYMDESCR Func_Syms[], Bit_Grav_Syms[], Event_Syms[], Error_Syms[],
X    Grav_Syms[], Backing_Store_Syms[], Class_Syms[], Stack_Mode_Syms[],
X    Line_Style_Syms[], State_Syms[], Cap_Style_Syms[], Join_Style_Syms[],
X    Map_State_Syms[], Fill_Style_Syms[], Fill_Rule_Syms[], Arc_Mode_Syms[],
X    Subwin_Mode_Syms[], Button_Syms[], Cross_Mode_Syms[], Cross_Detail_Syms[],
X    Focus_Detail_Syms[], Place_Syms[], Visibility_Syms[], Prop_Syms[],
X    Mapping_Syms[], Direction_Syms[], Shape_Syms[], Propmode_Syms[],
X    Grabstatus_Syms[], Allow_Events_Syms[], Revert_Syms[], Polyshape_Syms[],
X    Initial_State_Syms[], Bitmapstatus_Syms[];
X
Xextern Object Sym_None, Sym_Now, Sym_Char_Info, Sym_Pointer_Root;
X
X
X#ifdef __STDC__
X#define conc(a,b) a##b
X#define conc3(a,b,c) a##b##c
X#else
X#define ident(x) x
X#define conc(a,b) ident(a)b
X#define conc3(a,b,c) conc(conc(a,b),c)
X#endif
X
X
X/* Generic_Predicate (Pixmap) generates:
X *
X *    static Object P_Pixmapp (x) Object x; {
X *        return TYPE(x) == T_Pixmap ? True : False;
X *   }
X */
X#define Generic_Predicate(type) static Object conc3(P_,type,p) (x) Object x; {\
X    return TYPE(x) == conc(T_,type) ? True : False;\
X}
X
X/* Generic_Equal (Pixmap, PIXMAP, pm) generates:
X *
X *    static Pixmap_Equal (x, y) Object x, y; {
X *        return PIXMAP(x)->pm == PIXMAP(y)->field
X *            && !PIXMAP(x)->free && !PIXMAP(y)->free;
X *    }
X */
X#define Generic_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
X	Object x, y; {\
X    return cast(x)->field == cast(y)->field\
X	&& !cast(x)->free && !cast(y)->free;\
X}
X
X/* Same as above, but doesn't check for ->free:
X */
X#define Generic_Simple_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
X	Object x, y; {\
X    return cast(x)->field == cast(y)->field;\
X}
X
X/* Same as above, but also checks ->dpy
X */
X#define Generic_Equal_Dpy(type,cast,field) static Object conc(type,_Equal)\
X	    (x, y)\
X	Object x, y; {\
X    return cast(x)->field == cast(y)->field && cast(x)->dpy == cast(y)->dpy\
X	&& !cast(x)->free && !cast(y)->free;\
X}
X
X/* Generic_Print (Pixmap, "#[pixmap %u]", PIXMAP(x)->pm) generates:
X *
X *    static Pixmap_Print (x, port, raw, depth, len) Object x, port; {
X *        Printf (port, "#[pixmap %u]", PIXMAP(x)->pm);
X *    }
X */
X#define Generic_Print(type,fmt,how) static conc(type,_Print)\
X	(x, port, raw, depth, len) Object x, port; {\
X    Printf (port, fmt, (unsigned)how);\
X}
X
X/* Generic_Define (Pixmap, "pixmap", "pixmap?") generates:
X *
X *    T_Pixmap = Define_Type (0, "pixmap", NOFUNC, sizeof (struct S_Pixmap),
X *        Pixmap_Equal, Pixmap_Equal, Pixmap_Print, NOFUNC);
X *    Define_Primitive (P_Pixmapp, "pixmap?", 1, 1, EVAL);
X */
X#define Generic_Define(type,name,pred) conc(T_,type) =\
X    Define_Type (0, name, NOFUNC, sizeof (struct conc(S_,type)),\
X	conc(type,_Equal), conc(type,_Equal), conc(type,_Print), NOFUNC);\
X    Define_Primitive (conc3(P_,type,p), pred, 1, 1, EVAL);
X
X/* Generic_Get_Display (Pixmap, PIXMAP) generates:
X *
X *    static Object P_Pixmap_Display (x) Object x; {
X *        Check_Type (x, T_Pixmap);
X *        return Make_Display (PIXMAP(x)->dpy);
X *    }
X */
X#define Generic_Get_Display(type,cast) static Object conc3(P_,type,_Display)\
X	(x) Object x; {\
X    Check_Type (x, conc(T_,type));\
X    return Make_Display (0, cast(x)->dpy);\
X}
END_OF_lib/xlib/xlib.h
if test 6659 -ne `wc -c <lib/xlib/xlib.h`; then
    echo shar: \"lib/xlib/xlib.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/color.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/color.c\"
else
echo shar: Extracting \"lib/xlib/color.c\" \(3568 characters\)
sed "s/^X//" >lib/xlib/color.c <<'END_OF_lib/xlib/color.c'
X#include "xlib.h"
X
XGeneric_Predicate (Color);
X
Xstatic Color_Equal (x, y) Object x, y; {
X    register XColor *p = &COLOR(x)->c, *q = &COLOR(y)->c;
X    return p->red == q->red && p->green == q->green && p->blue == q->blue;
X}
X
XGeneric_Print (Color, "#[color %u]", POINTER(x));
X
XObject Make_Color (r, g, b) unsigned short r, g, b; {
X    register char *p;
X    Object c;
X
X    c = Find_Object (T_Color, (GENERIC)0, Match_X_Obj, r, g, b);
X    if (Nullp (c)) {
X	p = Get_Bytes (sizeof (struct S_Color));
X	SET (c, T_Color, (struct S_Color *)p);
X	COLOR(c)->tag = Null;
X	COLOR(c)->c.red = r;
X	COLOR(c)->c.green = g;
X	COLOR(c)->c.blue = b;
X	Register_Object (c, (GENERIC)0, (PFO)0, 0);
X    }
X    return c;
X}
X
XXColor *Get_Color (c) Object c; {
X    Check_Type (c, T_Color);
X    return &COLOR(c)->c;
X}
X
Xstatic unsigned short Get_RGB_Value (x) Object x; {
X    double d;
X
X    d = Get_Double (x);
X    if (d < 0.0 || d > 1.0)
X	Primitive_Error ("bad RGB value: ~s", x);
X    return (unsigned short)(d * 65535);
X}
X
Xstatic Object P_Make_Color (r, g, b) Object r, g, b; {
X    return Make_Color (Get_RGB_Value (r), Get_RGB_Value (g), Get_RGB_Value (b));
X}
X
Xstatic Object P_Color_Rgb_Values (c) Object c; {
X    Object ret, t, x;
X    GC_Node3;
X
X    Check_Type (c, T_Color);
X    ret = t = Null;
X    GC_Link3 (c, ret, t);
X    t = ret = P_Make_List (Make_Fixnum (3), Null);
X    GC_Unlink;
X    x = Make_Reduced_Flonum (COLOR(c)->c.red / 65535.0);
X    Car (t) = x; t = Cdr (t);
X    x = Make_Reduced_Flonum (COLOR(c)->c.green / 65535.0);
X    Car (t) = x; t = Cdr (t);
X    x = Make_Reduced_Flonum (COLOR(c)->c.blue / 65535.0);
X    Car (t) = x;
X    return ret;
X}
X
Xstatic Object P_Query_Color (cmap, p) Object cmap, p; {
X    XColor c;
X    Colormap cm = Get_Colormap (cmap);
X
X    c.pixel = Get_Pixel (p);
X    Disable_Interrupts;
X    XQueryColor (COLORMAP(cmap)->dpy, cm, &c);
X    Enable_Interrupts;
X    return Make_Color (c.red, c.green, c.blue);
X}
X
Xstatic Object P_Query_Colors (cmap, v) Object cmap, v; {
X    Colormap cm = Get_Colormap (cmap);
X    register i, n;
X    Object ret;
X    register XColor *p;
X    GC_Node;
X
X    Check_Type (v, T_Vector);
X    n = VECTOR(v)->size;
X    p = (XColor *)alloca (n * sizeof (XColor));
X    for (i = 0; i < n; i++)
X	p[i].pixel = Get_Pixel (VECTOR(v)->data[i]);
X    Disable_Interrupts;
X    XQueryColors (COLORMAP(cmap)->dpy, cm, p, n);
X    Enable_Interrupts;
X    ret = Make_Vector (n, Null);
X    GC_Link (ret);
X    for (i = 0; i < n; i++, p++) {
X	Object x = Make_Color (p->red, p->green, p->blue);
X	VECTOR(ret)->data[i] = x;
X    }
X    GC_Unlink;
X    return ret;
X}
X
Xstatic Object P_Lookup_Color (cmap, name) Object cmap, name; {
X    register char *s;
X    XColor visual, exact;
X    Colormap cm = Get_Colormap (cmap);
X    Object ret, x;
X    GC_Node;
X
X    Make_C_String (name, s);
X    if (!XLookupColor (COLORMAP(cmap)->dpy, cm, s, &visual, &exact))
X	Primitive_Error ("no such color: ~s", name);
X    ret = Cons (Null, Null);
X    GC_Link (ret);
X    x = Make_Color (visual.red, visual.green, visual.blue);
X    Car (ret) = x;
X    x = Make_Color (exact.red, exact.green, exact.blue);
X    Cdr (ret) = x;
X    GC_Unlink;
X    return ret;
X}
X
Xinit_xlib_color () {
X    Generic_Define (Color, "color", "color?");
X    Define_Primitive (P_Make_Color,       "make-color",       3, 3, EVAL);
X    Define_Primitive (P_Color_Rgb_Values, "color-rgb-values", 1, 1, EVAL);
X    Define_Primitive (P_Query_Color,      "query-color",      2, 2, EVAL);
X    Define_Primitive (P_Query_Colors,     "query-colors",     2, 2, EVAL);
X    Define_Primitive (P_Lookup_Color,     "lookup-color",     2, 2, EVAL);
X}
END_OF_lib/xlib/color.c
if test 3568 -ne `wc -c <lib/xlib/color.c`; then
    echo shar: \"lib/xlib/color.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/window.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/window.c\"
else
echo shar: Extracting \"lib/xlib/window.c\" \(7144 characters\)
sed "s/^X//" >lib/xlib/window.c <<'END_OF_lib/xlib/window.c'
X#include "xlib.h"
X
Xstatic Object Sym_Set_Attr, Sym_Get_Attr, Sym_Conf, Sym_Geo;
X
XGeneric_Predicate (Window);
X
XGeneric_Equal_Dpy (Window, WINDOW, win);
X
XGeneric_Print (Window, "#[window %u]", WINDOW(x)->win);
X
XGeneric_Get_Display (Window, WINDOW);
X
XObject Make_Window (finalize, dpy, win) Display *dpy; Window win; {
X    register char *p;
X    Object w;
X
X    if (win == None)
X	return Sym_None;
X    if (win == PointerRoot)
X	return Sym_Pointer_Root;
X    w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win);
X    if (Nullp (w)) {
X	p = Get_Bytes (sizeof (struct S_Window));
X	SET (w, T_Window, (struct S_Window *)p);
X	WINDOW(w)->tag = Null;
X	WINDOW(w)->win = win;
X	WINDOW(w)->dpy = dpy;
X	WINDOW(w)->free = 0;
X	WINDOW(w)->finalize = finalize;
X	Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window :
X	    (PFO)0, 0);
X    }
X    return w;
X}
X
XWindow Get_Window (w) Object w; {
X    if (EQ(w, Sym_None))
X	return None;
X    Check_Type (w, T_Window);
X    return WINDOW(w)->win;
X}
X
XDrawable Get_Drawable (d, dpyp) Object d; Display **dpyp; {
X    if (TYPE(d) == T_Window) {
X	*dpyp = WINDOW(d)->dpy;
X	return (Drawable)WINDOW(d)->win;
X    } else if (TYPE(d) == T_Pixmap) {
X	*dpyp = PIXMAP(d)->dpy;
X	return (Drawable)PIXMAP(d)->pm;
X    }
X    Wrong_Type_Combination (d, "drawable");
X    /*NOTREACHED*/
X}
X
Xstatic Object P_Create_Window (parent, x, y, width, height, border_width, attr)
X	Object parent, x, y, width, height, border_width, attr; {
X    unsigned long mask;
X    Window win;
X    
X    Check_Type (parent, T_Window);
X    mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
X    if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win,
X	    Get_Integer (x), Get_Integer (y), Get_Integer (width),
X	    Get_Integer (height), Get_Integer (border_width),
X	    CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0)
X	Primitive_Error ("cannot create window");
X    return Make_Window (1, WINDOW(parent)->dpy, win);
X}
X
Xstatic Object P_Configure_Window (w, conf) Object w, conf; {
X    unsigned mask;
X
X    Check_Type (w, T_Window);
X    mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec);
X    XConfigureWindow (WINDOW(w)->dpy, WINDOW(w)->win, mask, &WC);
X    return Void;
X}
X
Xstatic Object P_Change_Window_Attributes (w, attr) Object w, attr; {
X    unsigned long mask;
X
X    Check_Type (w, T_Window);
X    mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
X    XChangeWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, mask, &SWA);
X    return Void;
X}
X
Xstatic Object P_Get_Window_Attributes (w) Object w; {
X    Check_Type (w, T_Window);
X    XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA);
X    return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr,
X	WINDOW(w)->dpy, ~0L);
X}
X
Xstatic Object P_Get_Geometry (d) Object d; {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X
X    XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, &GEO.width,
X	&GEO.height, &GEO.border_width, &GEO.depth);
X    return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L);
X}
X
Xstatic Object P_Map_Window (w) Object w; {
X    Check_Type (w, T_Window);
X    XMapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
X    return Void;
X}
X
Xstatic Object P_Unmap_Window (w) Object w; {
X    Check_Type (w, T_Window);
X    XUnmapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
X    return Void;
X}
X
XObject P_Destroy_Window (w) Object w; {
X    Check_Type (w, T_Window);
X    if (!WINDOW(w)->free)
X	XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win);
X    Deregister_Object (w);
X    WINDOW(w)->free = 1;
X    return Void;
X}
X
Xstatic Object P_Destroy_Subwindows (w) Object w; {
X    Check_Type (w, T_Window);
X    XDestroySubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
X    return Void;
X}
X
Xstatic Object P_Map_Subwindows (w) Object w; {
X    Check_Type (w, T_Window);
X    XMapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
X    return Void;
X}
X
Xstatic Object P_Unmap_Subwindows (w) Object w; {
X    Check_Type (w, T_Window);
X    XUnmapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
X    return Void;
X}
X
Xstatic Object P_Reparent_Window (w, parent, x, y) Object w, parent, x, y; {
X    Check_Type (w, T_Window);
X    Check_Type (parent, T_Window);
X    XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win,
X	Get_Integer (x), Get_Integer (y));
X    return Void;
X}
X
Xstatic Object P_Query_Tree (w) Object w; {
X    Window root, parent, *children;
X    Display *dpy;
X    int i, n;
X    Object v, ret;
X    GC_Node2;
X
X    Check_Type (w, T_Window);
X    dpy = WINDOW(w)->dpy;
X    Disable_Interrupts;
X    XQueryTree (dpy, WINDOW(w)->win, &root, &parent, &children, &n);
X    Enable_Interrupts;
X    v = ret = Null;
X    GC_Link2 (v, ret);
X    v = Make_Window (0, dpy, root);
X    ret = Cons (v, Null);
X    v = Make_Window (0, dpy, parent);
X    ret = Cons (v, ret);
X    v = Make_Vector (n, Null);
X    for (i = 0; i < n; i++) {
X	Object x = Make_Window (0, dpy, children[i]);
X	VECTOR(v)->data[i] = x;
X    }
X    ret = Cons (v, ret);
X    GC_Unlink;
X    return ret;
X}
X
Xstatic Object P_Translate_Coordinates (src, x, y, dst) Object src, x, y, dst; {
X    int rx, ry;
X    Window child;
X    Object l, t, z;
X    GC_Node3;
X
X    Check_Type (src, T_Window);
X    Check_Type (dst, T_Window);
X    if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win,
X	    WINDOW(dst)->win, Get_Integer (x), Get_Integer (y), &rx, &ry,
X	    &child))
X	return False;
X    l = t = P_Make_List (Make_Fixnum (3), Null);
X    GC_Link3 (l, t, dst);
X    Car (t) = Make_Fixnum (rx); t = Cdr (t);
X    Car (t) = Make_Fixnum (ry), t = Cdr (t);
X    z = Make_Window (0, WINDOW(dst)->dpy, child);
X    Car (t) = z;
X    GC_Unlink;
X    return l;
X}
X
Xinit_xlib_window () {
X    Define_Symbol (&Sym_Set_Attr, "set-window-attributes");
X    Define_Symbol (&Sym_Get_Attr, "get-window-attributes");
X    Define_Symbol (&Sym_Conf, "window-configuration");
X    Define_Symbol (&Sym_Geo, "geometry");
X    Generic_Define (Window, "window", "window?");
X    Define_Primitive (P_Window_Display,   "window-display",   1, 1, EVAL);
X    Define_Primitive (P_Create_Window,    "create-window",    7, 7, EVAL);
X    Define_Primitive (P_Configure_Window, "configure-window",
X							      2, 2, EVAL);
X    Define_Primitive (P_Change_Window_Attributes, "change-window-attributes",
X							      2, 2, EVAL);
X    Define_Primitive (P_Get_Window_Attributes, "get-window-attributes",
X							      1, 1, EVAL);
X    Define_Primitive (P_Get_Geometry,     "get-geometry",     1, 1, EVAL);
X    Define_Primitive (P_Map_Window,       "map-window",       1, 1, EVAL);
X    Define_Primitive (P_Unmap_Window,     "unmap-window",     1, 1, EVAL);
X    Define_Primitive (P_Destroy_Window,   "destroy-window",   1, 1, EVAL);
X    Define_Primitive (P_Destroy_Subwindows, "destroy-subwindows",
X							      1, 1, EVAL);
X    Define_Primitive (P_Map_Subwindows,   "map-subwindows",   1, 1, EVAL);
X    Define_Primitive (P_Unmap_Subwindows, "unmap-subwindows", 1, 1, EVAL);
X    Define_Primitive (P_Reparent_Window,  "reparent-window",  4, 4, EVAL);
X    Define_Primitive (P_Query_Tree,       "query-tree",       1, 1, EVAL);
X    Define_Primitive (P_Translate_Coordinates, "translate-coordinates",
X							      4, 4, EVAL);
X}
END_OF_lib/xlib/window.c
if test 7144 -ne `wc -c <lib/xlib/window.c`; then
    echo shar: \"lib/xlib/window.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/BUGS -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/BUGS\"
else
echo shar: Extracting \"lib/xlib/BUGS\" \(737 characters\)
sed "s/^X//" >lib/xlib/BUGS <<'END_OF_lib/xlib/BUGS'
Xbackground-pixmap, border-pixmap can also be 'none or a symbol
X
Xset-gcontext-clip-rectangles! not implemented
X
XNeed a general keyword wrapper for
X  1) functions like create-window that receive a vector
X  2) functions with many arguments in general
X
XHigh-level interface for wm-hints/size-hints not implemented
X
Xx-io-errors should not be handled in Scheme (client must exit
Xafter fatal error)
X
XP_Copy_Area, P_Copy_Plane:  initialization of dpy is broken
X
XP_Get_Property:  replace Make_Integer by Make_Unsigned?  Where else?
X
Xfont-name can return a symbol as well as a string
X
Xextents-attributes, max-char-attributes, and min-char-attributes
Xare bogus and should be removed
X
Xthere is currently no support for different screens and visuals
END_OF_lib/xlib/BUGS
if test 737 -ne `wc -c <lib/xlib/BUGS`; then
    echo shar: \"lib/xlib/BUGS\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/event.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/event.c\"
else
echo shar: Extracting \"lib/xlib/event.c\" \(15403 characters\)
sed "s/^X//" >lib/xlib/event.c <<'END_OF_lib/xlib/event.c'
X#include "xlib.h"
X
X#define MAX_ARGS 14
X
Xstatic Object Sym_Else;
Xstatic Object Argl, Argv;
X
Xstatic struct event_desc {
X    char *name;
X    int argc;
X} Event_Table[] = {
X    { "event-0", 	     1 },
X    { "event-1",             1 },
X    { "key-press",          12 },
X    { "key-release",        12 },
X    { "button-press",       12 },
X    { "button-release",     12 },
X    { "motion-notify",      12 },
X    { "enter-notify",       14 },
X    { "leave-notify",       14 },
X    { "focus-in",            4 },
X    { "focus-out",           4 },
X    { "keymap-notify",       3 },
X    { "expose",              7 },
X    { "graphics-expose",     9 },
X    { "no-expose",           4 },
X    { "visibility-notify",   3 },
X    { "create-notify",       9 },
X    { "destroy-notify",      3 },
X    { "unmap-notify",        4 },
X    { "map-notify",          4 },
X    { "map-request",         3 },
X    { "reparent-notify",     7 },
X    { "configure-notify",   10 },
X    { "configure-request",  11 },
X    { "gravity-notify",      5 },
X    { "resize-request",      4 },
X    { "circulate-notify",    4 },
X    { "circulate-request",   4 },
X    { "property-notify",     5 },
X    { "selection-clear",     4 },
X    { "selection-request",   7 },
X    { "selection-notify",    6 },
X    { "colormap-notify",     5 },
X    { "client-message",      1 },
X    { "mapping-notify",      4 },
X    { 0,                     0 }
X};
X
X/* (handle-events display clause...)
X * clause = (event function) or ((event...) function) or (else function)
X * loops/blocks until a function returns x != #f, then returns x.
X */
X
Xstatic Object P_Handle_Events (argl) Object argl; {
X    Object disp, clause, func, ret, funcs[LASTEvent], args;
X    register i;
X    Display *dpy;
X    Window win = None;
X    XEvent e;
X    char *errmsg = "event occurs more than once";
X    GC_Node3; struct gcnode gcv;
X    TC_Prolog;
X
X    TC_Disable;
X    clause = args = Null;
X    GC_Link3 (argl, clause, args);
X    disp = Eval (Car (argl));
X    if (TYPE(disp) == T_Display) {
X	dpy = DISPLAY(disp)->dpy;
X    } else if (TYPE(disp) == T_Window) {
X	dpy = WINDOW(disp)->dpy;
X	win = WINDOW(disp)->win;
X    } else Wrong_Type_Combination (disp, "display or window");
X    for (i = 0; i < 32; i++)
X	funcs[i] = Null;
X    gcv.gclen = 1 + 32; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv;
X    for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) {
X	clause = Car (argl);
X	Check_List (clause);
X	if (Internal_Length (clause) != 2)
X	    Primitive_Error ("badly formed event clause");
X	func = Eval (Car (Cdr (clause)));
X	Check_Procedure (func);
X	clause = Car (clause);
X	if (EQ(clause, Sym_Else)) {
X	    for (i = 0; i < 32; i++)
X		if (Nullp (funcs[i])) funcs[i] = func;
X	} else {
X	    if (TYPE(clause) == T_Pair) {
X		for (; !Nullp (clause); clause = Cdr (clause)) {
X		    i = Encode_Event (Car (clause));
X		    if (!Nullp (funcs[i]))
X			Primitive_Error (errmsg);
X		    funcs[i] = func;
X		}
X	    } else {
X		i = Encode_Event (clause);
X		if (!Nullp (funcs[i]))
X		    Primitive_Error (errmsg);
X		funcs[i] = func;
X	    }
X	}
X    }
X    ret = False;
X    while (!Truep (ret)) {
X	if (win == None)
X	    XNextEvent (dpy, &e);
X	else
X	    XWindowEvent (dpy, win, ~0L, &e);
X	if ((i = e.type) < LASTEvent && !Nullp (funcs[i])) {
X	    args = Get_Event_Args (&e);
X	    ret = Funcall (funcs[i], args, 0);
X	    /*
X	     * The argument vector is cleared to destroy all references
X	     * to the arguments (so that a GC can throw away the objects):
X	     */
X	    Destroy_Event_Args (args);
X	}
X    }
X    GC_Unlink;
X    TC_Enable;
X    return ret;
X}
X
XObject Process_Event (ep, argl) XEvent *ep; Object argl; {
X    Object disp, clause, func, ret, funcs[LASTEvent], args;
X    register i;
X    Display *dpy;
X    Window win = None;
X    char *errmsg = "event occurs more than once";
X    GC_Node3; struct gcnode gcv;
X    TC_Prolog;
X
X    TC_Disable;
X    clause = args = Null;
X    GC_Link3 (argl, clause, args);
X    disp = Eval (Car (argl));
X    if (TYPE(disp) == T_Display) {
X	dpy = DISPLAY(disp)->dpy;
X    } else if (TYPE(disp) == T_Window) {
X	dpy = WINDOW(disp)->dpy;
X	win = WINDOW(disp)->win;
X    } else Wrong_Type_Combination (disp, "display or window");
X    for (i = 0; i < 32; i++)
X	funcs[i] = Null;
X    gcv.gclen = 1 + 32; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv;
X    for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) {
X	clause = Car (argl);
X	Check_List (clause);
X	if (Internal_Length (clause) != 2)
X	    Primitive_Error ("badly formed event clause");
X	func = Eval (Car (Cdr (clause)));
X	Check_Procedure (func);
X	clause = Car (clause);
X	if (EQ(clause, Sym_Else)) {
X	    for (i = 0; i < 32; i++)
X		if (Nullp (funcs[i])) funcs[i] = func;
X	} else {
X	    if (TYPE(clause) == T_Pair) {
X		for (; !Nullp (clause); clause = Cdr (clause)) {
X		    i = Encode_Event (Car (clause));
X		    if (!Nullp (funcs[i]))
X			Primitive_Error (errmsg);
X		    funcs[i] = func;
X		}
X	    } else {
X		i = Encode_Event (clause);
X		if (!Nullp (funcs[i]))
X		    Primitive_Error (errmsg);
X		funcs[i] = func;
X	    }
X	}
X    }
X    ret = False;
X    if ((i = ep->type) < LASTEvent && !Nullp (funcs[i])) {
X	args = Get_Event_Args (ep);
X	ret = Funcall (funcs[i], args, 0);
X	/*
X	 * The argument vector is cleared to destroy all references
X	 * to the arguments (so that a GC can throw away the objects):
X	 */
X	Destroy_Event_Args (args);
X    }
X    GC_Unlink;
X    TC_Enable;
X    return ret;
X}
X
Xstatic Object Get_Time_Arg (t) Time t; {
X    return t == CurrentTime ? Sym_Now : Make_Unsigned ((unsigned)t);
X}
X
XObject Get_Event_Args (ep) XEvent *ep; {
X    Object tmpargs[MAX_ARGS];
X    register e, i;
X    register Object *a, *vp;
X    struct gcnode gcv;
X    Object dummy;
X    GC_Node;
X
X    e = ep->type;
X    dummy = Null;
X    a = tmpargs;
X    for (i = 0; i < MAX_ARGS; i++)
X	a[i] = Null;
X    GC_Link (dummy);
X    gcv.gclen = 1 + MAX_ARGS; gcv.gcobj = a; gcv.next = &gc1; GC_List = &gcv;
X    switch (e) {
X    case KeyPress: case KeyRelease:
X    case ButtonPress: case ButtonRelease:
X    case MotionNotify:
X    case EnterNotify: case LeaveNotify: {
X	register XKeyEvent *p = (XKeyEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Make_Window (0, p->display, p->root);
X	a[3] = Make_Window (0, p->display, p->subwindow);
X	a[4] = Get_Time_Arg (p->time);
X	a[5] = Make_Fixnum (p->x);
X	a[6] = Make_Fixnum (p->y);
X	a[7] = Make_Fixnum (p->x_root);
X	a[8] = Make_Fixnum (p->y_root);
X	if (e == KeyPress || e == KeyRelease) {
X	    a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms);
X	    a[10] = Make_Fixnum (p->keycode);
X	    a[11] = p->same_screen ? True : False;
X	} else if (e == ButtonPress || e == ButtonRelease) {
X	    register XButtonEvent *q = (XButtonEvent *)ep;
X	    a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
X	    a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms);
X	    a[11] = q->same_screen ? True : False;
X	} else if (e == MotionNotify) {
X	    register XMotionEvent *q = (XMotionEvent *)ep;
X	    a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
X	    a[10] = q->is_hint ? True : False;
X	    a[11] = q->same_screen ? True : False;
X	} else {
X	    register XCrossingEvent *q = (XCrossingEvent *)ep;
X	    a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms);
X	    a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0,
X		Cross_Detail_Syms);
X	    a[11] = q->same_screen ? True : False;
X	    a[12] = q->focus ? True : False;
X	    a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms);
X	}
X    } break;
X    case FocusIn: case FocusOut: {
X	register XFocusChangeEvent *p = (XFocusChangeEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Bits_To_Symbols ((unsigned long)p->mode, 0, Cross_Mode_Syms);
X	a[3] = Bits_To_Symbols ((unsigned long)p->detail, 0, Focus_Detail_Syms);
X    } break;
X    case KeymapNotify: {
X	register XKeymapEvent *p = (XKeymapEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Make_String (p->key_vector, 32);
X    } break;
X    case Expose: {
X	register XExposeEvent *p = (XExposeEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Make_Fixnum (p->x);
X	a[3] = Make_Fixnum (p->y);
X	a[4] = Make_Fixnum (p->width);
X	a[5] = Make_Fixnum (p->height);
X	a[6] = Make_Fixnum (p->count);
X    } break;
X    case GraphicsExpose: {
X	register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->drawable);
X	a[2] = Make_Fixnum (p->x);
X	a[3] = Make_Fixnum (p->y);
X	a[4] = Make_Fixnum (p->width);
X	a[5] = Make_Fixnum (p->height);
X	a[6] = Make_Fixnum (p->count);
X	a[7] = Make_Fixnum (p->major_code);
X	a[8] = Make_Fixnum (p->minor_code);
X    } break;
X    case NoExpose: {
X	register XNoExposeEvent *p = (XNoExposeEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->drawable);
X	a[2] = Make_Fixnum (p->major_code);
X	a[3] = Make_Fixnum (p->minor_code);
X    } break;
X    case VisibilityNotify: {
X	register XVisibilityEvent *p = (XVisibilityEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Bits_To_Symbols ((unsigned long)p->state, 0, Visibility_Syms);
X    } break;
X    case CreateNotify: {
X	register XCreateWindowEvent *p = (XCreateWindowEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->parent);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = Make_Fixnum (p->x);
X	a[4] = Make_Fixnum (p->y);
X	a[5] = Make_Fixnum (p->width);
X	a[6] = Make_Fixnum (p->height);
X	a[7] = Make_Fixnum (p->border_width);
X	a[8] = p->override_redirect ? True : False;
X    } break;
X    case DestroyNotify: {
X	register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->event);
X	a[2] = Make_Window (0, p->display, p->window);
X    } break;
X    case UnmapNotify: {
X	register XUnmapEvent *p = (XUnmapEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->event);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = p->from_configure ? True : False;
X    } break;
X    case MapNotify: {
X	register XMapEvent *p = (XMapEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->event);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = p->override_redirect ? True : False;
X    } break;
X    case MapRequest: {
X	register XMapRequestEvent *p = (XMapRequestEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->parent);
X	a[2] = Make_Window (0, p->display, p->window);
X    } break;
X    case ReparentNotify: {
X	register XReparentEvent *p = (XReparentEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->event);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = Make_Window (0, p->display, p->parent);
X	a[4] = Make_Fixnum (p->x);
X	a[5] = Make_Fixnum (p->y);
X	a[6] = p->override_redirect ? True : False;
X    } break;
X    case ConfigureNotify: {
X	register XConfigureEvent *p = (XConfigureEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->event);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = Make_Fixnum (p->x);
X	a[4] = Make_Fixnum (p->y);
X	a[5] = Make_Fixnum (p->width);
X	a[6] = Make_Fixnum (p->height);
X	a[7] = Make_Fixnum (p->border_width);
X	a[8] = Make_Window (0, p->display, p->above);
X	a[9] = p->override_redirect ? True : False;
X    } break;
X    case ConfigureRequest: {
X	register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->parent);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = Make_Fixnum (p->x);
X	a[4] = Make_Fixnum (p->y);
X	a[5] = Make_Fixnum (p->width);
X	a[6] = Make_Fixnum (p->height);
X	a[7] = Make_Fixnum (p->border_width);
X	a[8] = Make_Window (0, p->display, p->above);
X	a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms);
X	a[10] = Make_Unsigned ((unsigned)p->value_mask);
X    } break;
X    case GravityNotify: {
X	register XGravityEvent *p = (XGravityEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->event);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = Make_Fixnum (p->x);
X	a[4] = Make_Fixnum (p->y);
X    } break;
X    case ResizeRequest: {
X	register XResizeRequestEvent *p = (XResizeRequestEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Make_Fixnum (p->width);
X	a[3] = Make_Fixnum (p->height);
X    } break;
X    case CirculateNotify: {
X	register XCirculateEvent *p = (XCirculateEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->event);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms);
X    } break;
X    case CirculateRequest: {
X	register XCirculateRequestEvent *p = (XCirculateRequestEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->parent);
X	a[2] = Make_Window (0, p->display, p->window);
X	a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms);
X    } break;
X    case PropertyNotify: {
X	register XPropertyEvent *p = (XPropertyEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Make_Atom (p->atom);
X	a[3] = Get_Time_Arg (p->time);
X	a[4] = Bits_To_Symbols ((unsigned long)p->state, 0, Prop_Syms);
X    } break;
X    case SelectionClear: {
X	register XSelectionClearEvent *p = (XSelectionClearEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Make_Atom (p->selection);
X	a[3] = Get_Time_Arg (p->time);
X    } break;
X    case SelectionRequest: {
X	register XSelectionRequestEvent *p = (XSelectionRequestEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->owner);
X	a[2] = Make_Window (0, p->display, p->requestor);
X	a[3] = Make_Atom (p->selection);
X	a[4] = Make_Atom (p->target);
X	a[5] = Make_Atom (p->property);
X	a[6] = Get_Time_Arg (p->time);
X    } break;
X    case SelectionNotify: {
X	register XSelectionEvent *p = (XSelectionEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->requestor);
X	a[2] = Make_Atom (p->selection);
X	a[3] = Make_Atom (p->target);
X	a[4] = Make_Atom (p->property);
X	a[5] = Get_Time_Arg (p->time);
X    } break;
X    case ColormapNotify: {
X	register XColormapEvent *p = (XColormapEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Make_Colormap (0, p->display, p->colormap);
X	a[3] = p->new ? True : False;
X	a[4] = p->state == ColormapInstalled ? True : False;
X    } break;
X    case ClientMessage: {
X    } break;
X    case MappingNotify: {
X	register XMappingEvent *p = (XMappingEvent *)ep;
X	a[1] = Make_Window (0, p->display, p->window);
X	a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms);
X	a[3] = Make_Fixnum (p->first_keycode);
X	a[4] = Make_Fixnum (p->count);
X    } break;
X    }
X    a[0] = Intern (Event_Table[e].name);
X    for (vp = VECTOR(Argv)->data, i = 0; i < Event_Table[e].argc; i++) {
X	if (i) vp++;
X	Car (*vp) = a[i];
X	Cdr (*vp) = vp[1];
X    }
X    Cdr (*vp) = Null;
X    GC_Unlink;
X    return Argl;
X}
X
XDestroy_Event_Args (args) Object args; {
X    Object t;
X
X    for (t = args; !Nullp (t); t = Cdr (t))
X	Car (t) = Null;
X}
X
XEncode_Event (e) Object e; {
X    Object s;
X    register char *p;
X    register struct event_desc *ep;
X    register n;
X
X    Check_Type (e, T_Symbol);
X    s = SYMBOL(e)->name;
X    p = STRING(s)->data;
X    n = STRING(s)->size;
X    for (ep = Event_Table; ep->name; ep++)
X	if (n && strncmp (ep->name, p, n) == 0) break;
X    if (ep->name == 0)
X	Primitive_Error ("no such event: ~s", e);
X    return ep-Event_Table;
X}
X
Xinit_xlib_event () {
X    Object t;
X    register i;
X
X    Argl = P_Make_List (Make_Fixnum (MAX_ARGS), Null);
X    Global_GC_Link (Argl);
X    Argv = Make_Vector (MAX_ARGS, Null);
X    Global_GC_Link (Argv);
X    for (i = 0, t = Argl; i < MAX_ARGS; i++, t = Cdr (t))
X	VECTOR(Argv)->data[i] = t;
X    Define_Symbol (&Sym_Else, "else");
X    Define_Primitive (P_Handle_Events,   "handle-events",     2, MANY, NOEVAL);
X}
END_OF_lib/xlib/event.c
if test 15403 -ne `wc -c <lib/xlib/event.c`; then
    echo shar: \"lib/xlib/event.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/gcontext.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/gcontext.c\"
else
echo shar: Extracting \"lib/xlib/gcontext.c\" \(2623 characters\)
sed "s/^X//" >lib/xlib/gcontext.c <<'END_OF_lib/xlib/gcontext.c'
X#include "xlib.h"
X
Xstatic Object Sym_Gc;
X
XGeneric_Predicate (Gc);
X
XGeneric_Equal_Dpy (Gc, GCONTEXT, gc);
X
XGeneric_Print (Gc, "#[gcontext %u]", GCONTEXT(x)->gc->gid);
X
XGeneric_Get_Display (Gc, GCONTEXT);
X
XObject Make_Gc (finalize, dpy, g) Display *dpy; GC g; {
X    register char *p;
X    Object gc;
X
X    gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g);
X    if (Nullp (gc)) {
X	p = Get_Bytes (sizeof (struct S_Gc));
X	SET (gc, T_Gc, (struct S_Gc *)p);
X	GCONTEXT(gc)->tag = Null;
X	GCONTEXT(gc)->gc = g;
X	GCONTEXT(gc)->dpy = dpy;
X	GCONTEXT(gc)->free = 0;
X	Register_Object (gc, (GENERIC)gc, finalize ? P_Free_Gc :
X	    (PFO)0, 0);
X    }
X    return gc;
X}
X
Xstatic Object P_Create_Gc (w, g) Object w, g; {
X    unsigned long mask;
X
X    Check_Type (w, T_Window);
X    mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec);
X    return Make_Gc (1, WINDOW(w)->dpy,
X	XCreateGC (WINDOW(w)->dpy, WINDOW(w)->win, mask, &GCV));
X}
X
Xstatic Object P_Copy_Gc (gc, w) Object gc, w; {
X    GC dst;
X
X    Check_Type (gc, T_Gc);
X    Check_Type (w, T_Window);
X    dst = XCreateGC (WINDOW(w)->dpy, WINDOW(w)->win, 0L, &GCV);
X    XCopyGC (WINDOW(w)->dpy, GCONTEXT(gc)->gc, ~0L, dst);
X    return Make_Gc (1, WINDOW(w)->dpy, dst);
X}
X
Xstatic Object P_Change_Gc (gc, g) Object gc, g; {
X    unsigned long mask;
X
X    Check_Type (gc, T_Gc);
X    mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec);
X    XChangeGC (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV);
X    return Void;
X}
X
XObject P_Free_Gc (g) Object g; {
X    Check_Type (g, T_Gc);
X    if (!GCONTEXT(g)->free)
X	XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc);
X    Deregister_Object (g);
X    GCONTEXT(g)->free = 1;
X    return Void;
X}
X
Xstatic Object P_Query_Best_Size (d, w, h, shape) Object d, w, h, shape; {
X    unsigned int rw, rh;
X
X    Check_Type (d, T_Display);
X    if (!XQueryBestSize (DISPLAY(d)->dpy, Symbols_To_Bits (shape, 0,
X	    Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy),
X	    Get_Integer (w), Get_Integer (h), &rw, &rh))
X	Primitive_Error ("cannot query best shape");
X    return Cons (Make_Fixnum (rw), Make_Fixnum (rh));
X}
X
Xinit_xlib_gcontext () {
X    Define_Symbol (&Sym_Gc, "gcontext");
X    Generic_Define (Gc, "gcontext", "gcontext?");
X    Define_Primitive (P_Gc_Display,      "gcontext-display", 1, 1, EVAL);
X    Define_Primitive (P_Create_Gc,       "create-gcontext",  2, 2, EVAL);
X    Define_Primitive (P_Copy_Gc,         "copy-gcontext",    2, 2, EVAL);
X    Define_Primitive (P_Change_Gc,       "change-gcontext",  2, 2, EVAL);
X    Define_Primitive (P_Free_Gc,         "free-gcontext",    1, 1, EVAL);
X    Define_Primitive (P_Query_Best_Size, "query-best-size",  4, 4, EVAL);
X}
END_OF_lib/xlib/gcontext.c
if test 2623 -ne `wc -c <lib/xlib/gcontext.c`; then
    echo shar: \"lib/xlib/gcontext.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/graphics.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xlib/graphics.c\"
else
echo shar: Extracting \"lib/xlib/graphics.c\" \(8849 characters\)
sed "s/^X//" >lib/xlib/graphics.c <<'END_OF_lib/xlib/graphics.c'
X#include "xlib.h"
X
Xextern XDrawPoints(), XDrawLines(), XDrawRectangle(), XFillRectangle();
Xextern XDrawRectangles(), XFillRectangles(), XDrawArc(), XFillArc();
Xextern XDrawArcs(), XFillArcs(), XFillPolygon();
X
Xstatic Object P_Clear_Area (win, x, y, w, h, e) Object win, x, y, w, h, e; {
X    Check_Type (win, T_Window);
X    Check_Type (e, T_Boolean);
X    XClearArea (WINDOW(win)->dpy, WINDOW(win)->win, Get_Integer (x),
X	Get_Integer (y), Get_Integer (w), Get_Integer (h), EQ(e, True));
X    return Void;
X}
X
Xstatic Object P_Copy_Area (src, gc, sx, sy, w, h, dst, dx, dy) Object src, gc,
X	sx, sy, w, h, dst, dx, dy; {
X    Display *dpy;
X    Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);
X
X    Check_Type (gc, T_Gc);
X    XCopyArea (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx),
X	Get_Integer (sy), Get_Integer (w), Get_Integer (h),
X	Get_Integer (dx), Get_Integer (dy));
X    return Void;
X}
X
Xstatic Object P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy)
X	Object src, gc, plane, sx, sy, w, h, dst, dx, dy; {
X    Display *dpy;
X    Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);
X    register unsigned long p;
X
X    Check_Type (gc, T_Gc);
X    p = (unsigned long)Get_Integer (plane);
X    if (p & (p-1))
X	Primitive_Error ("invalid plane: ~s", plane);
X    XCopyPlane (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx),
X	Get_Integer (sy), Get_Integer (w), Get_Integer (h),
X	Get_Integer (dx), Get_Integer (dy), p);
X    return Void;
X}
X
Xstatic Object P_Draw_Point (d, gc, x, y) Object d, gc, x, y; {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X
X    Check_Type (gc, T_Gc);
X    XDrawPoint (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y));
X    return Void;
X}
X
Xstatic Object Internal_Draw_Points (d, gc, v, relative, func, shape)
X	Object d, gc, v, relative, shape; int (*func)(); {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X    register XPoint *p;
X    register i, n;
X    int rel, sh;
X
X    Check_Type (gc, T_Gc);
X    Check_Type (relative, T_Boolean);
X    rel = EQ(relative, True) ? CoordModePrevious : CoordModeOrigin;
X    if (func == XFillPolygon)
X	sh = Symbols_To_Bits (shape, 0, Polyshape_Syms);
X    n = VECTOR(v)->size;
X    p = (XPoint *)alloca (n * sizeof (XPoint));
X    for (i = 0; i < n; i++) {
X	Object point = VECTOR(v)->data[i];
X	Check_Type (point, T_Pair);
X	p[i].x = Get_Integer (Car (point));
X	p[i].y = Get_Integer (Cdr (point));
X    }
X    if (func == XFillPolygon)
X	XFillPolygon (dpy, dr, GCONTEXT(gc)->gc, p, n, sh, rel);
X    else
X	(*func)(dpy, dr, GCONTEXT(gc)->gc, p, n, rel);
X    return Void;
X}
X
Xstatic Object P_Draw_Points (d, gc, v, relative) Object d, gc, v, relative; {
X    return Internal_Draw_Points (d, gc, v, relative, XDrawPoints, Null);
X}
X
Xstatic Object P_Draw_Line (d, gc, x1, y1, x2, y2)
X	Object d, gc, x1, y1, x2, y2; {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X
X    Check_Type (gc, T_Gc);
X    XDrawLine (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x1), Get_Integer (y1),
X	Get_Integer (x2), Get_Integer (y2));
X    return Void;
X}
X
Xstatic Object P_Draw_Lines (d, gc, v, relative) Object d, gc, v, relative; {
X    return Internal_Draw_Points (d, gc, v, relative, XDrawLines, Null);
X}
X
Xstatic Object P_Draw_Segments (d, gc, v) Object d, gc, v; {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X    register XSegment *p;
X    register i, n;
X
X    Check_Type (gc, T_Gc);
X    n = VECTOR(v)->size;
X    p = (XSegment *)alloca (n * sizeof (XSegment));
X    for (i = 0; i < n; i++) {
X	Object seg = VECTOR(v)->data[i];
X	Check_Type (seg, T_Pair);
X	if (Internal_Length (seg) != 4)
X	    Primitive_Error ("invalid segment: ~s", seg);
X	p[i].x1 = Get_Integer (Car (seg)); seg = Cdr (seg);
X	p[i].y1 = Get_Integer (Car (seg)); seg = Cdr (seg);
X	p[i].x2 = Get_Integer (Car (seg)); seg = Cdr (seg);
X	p[i].y2 = Get_Integer (Car (seg));
X    }
X    XDrawSegments (dpy, dr, GCONTEXT(gc)->gc, p, n);
X    return Void;
X}
X
Xstatic Object Internal_Draw_Rectangle (d, gc, x, y, w, h, func)
X	Object d, gc, x, y, w, h; int (*func)(); {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X
X    Check_Type (gc, T_Gc);
X    (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
X	Get_Integer (y), Get_Integer (w), Get_Integer (h));
X    return Void;
X}
X
Xstatic Object P_Draw_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; {
X    return Internal_Draw_Rectangle (d, gc, x, y, w, h, XDrawRectangle);
X}
X
Xstatic Object P_Fill_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; {
X    return Internal_Draw_Rectangle (d, gc, x, y, w, h, XFillRectangle);
X}
X
Xstatic Object Internal_Draw_Rectangles (d, gc, v, func)
X	Object d, gc, v; int (*func)(); {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X    register XRectangle *p;
X    register i, n;
X
X    Check_Type (gc, T_Gc);
X    n = VECTOR(v)->size;
X    p = (XRectangle *)alloca (n * sizeof (XRectangle));
X    for (i = 0; i < n; i++) {
X	Object rect = VECTOR(v)->data[i];
X	Check_Type (rect, T_Pair);
X	if (Internal_Length (rect) != 4)
X	    Primitive_Error ("invalid rectangle: ~s", rect);
X	p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect);
X	p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect);
X	p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect);
X	p[i].height = Get_Integer (Car (rect));
X    }
X    (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
X    return Void;
X}
X
Xstatic Object P_Draw_Rectangles (d, gc, v) Object d, gc, v; {
X    return Internal_Draw_Rectangles (d, gc, v, XDrawRectangles);
X}
X
Xstatic Object P_Fill_Rectangles (d, gc, v) Object d, gc, v; {
X    return Internal_Draw_Rectangles (d, gc, v, XFillRectangles);
X}
X
Xstatic Object Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, func)
X	Object d, gc, x, y, w, h, a1, a2; int (*func)(); {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X
X    Check_Type (gc, T_Gc);
X    (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y),
X	Get_Integer (w), Get_Integer (h), Get_Integer (a1), Get_Integer (a2));
X    return Void;
X}
X
Xstatic Object P_Draw_Arc (d, gc, x, y, w, h, a1, a2)
X	Object d, gc, x, y, w, h, a1, a2; {
X    return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XDrawArc);
X}
X
Xstatic Object P_Fill_Arc (d, gc, x, y, w, h, a1, a2)
X	Object d, gc, x, y, w, h, a1, a2; {
X    return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XFillArc);
X}
X
Xstatic Object Internal_Draw_Arcs (d, gc, v, func) Object d, gc, v;
X	int (*func)(); {
X    Display *dpy;
X    Drawable dr = Get_Drawable (d, &dpy);
X    register XArc *p;
X    register i, n;
X
X    Check_Type (gc, T_Gc);
X    n = VECTOR(v)->size;
X    p = (XArc *)alloca (n * sizeof (XArc));
X    for (i = 0; i < n; i++) {
X	Object arc = VECTOR(v)->data[i];
X	Check_Type (arc, T_Pair);
X	if (Internal_Length (arc) != 6)
X	    Primitive_Error ("invalid arc: ~s", arc);
X	p[i].x = Get_Integer (Car (arc)); arc = Cdr (arc);
X	p[i].y = Get_Integer (Car (arc)); arc = Cdr (arc);
X	p[i].width = Get_Integer (Car (arc)); arc = Cdr (arc);
X	p[i].height = Get_Integer (Car (arc)); arc = Cdr (arc);
X	p[i].angle1 = Get_Integer (Car (arc)); arc = Cdr (arc);
X	p[i].angle2 = Get_Integer (Car (arc));
X    }
X    (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
X    return Void;
X}
X
Xstatic Object P_Draw_Arcs (d, gc, v) Object d, gc, v; {
X    return Internal_Draw_Arcs (d, gc, v, XDrawArcs);
X}
X
Xstatic Object P_Fill_Arcs (d, gc, v) Object d, gc, v; {
X    return Internal_Draw_Arcs (d, gc, v, XFillArcs);
X}
X
Xstatic Object P_Fill_Polygon (d, gc, v, relative, shape)
X	Object d, gc, v, relative, shape; {
X    return Internal_Draw_Points (d, gc, v, relative, XFillPolygon, shape);
X}
X
Xinit_xlib_graphics () {
X    Define_Primitive (P_Clear_Area,        "clear-area",       6, 6, EVAL);
X    Define_Primitive (P_Copy_Area,         "copy-area",        9, 9, EVAL);
X    Define_Primitive (P_Copy_Plane,        "copy-plane",      10,10, EVAL);
X    Define_Primitive (P_Draw_Point,        "draw-point",       4, 4, EVAL);
X    Define_Primitive (P_Draw_Points,       "draw-points",      4, 4, EVAL);
X    Define_Primitive (P_Draw_Line,         "draw-line",        6, 6, EVAL);
X    Define_Primitive (P_Draw_Lines,        "draw-lines",       4, 4, EVAL);
X    Define_Primitive (P_Draw_Segments,     "draw-segments",    3, 3, EVAL);
X    Define_Primitive (P_Draw_Rectangle,    "draw-rectangle",   6, 6, EVAL);
X    Define_Primitive (P_Fill_Rectangle,    "fill-rectangle",   6, 6, EVAL);
X    Define_Primitive (P_Draw_Rectangles,   "draw-rectangles",  3, 3, EVAL);
X    Define_Primitive (P_Fill_Rectangles,   "fill-rectangles",  3, 3, EVAL);
X    Define_Primitive (P_Draw_Arc,          "draw-arc",         8, 8, EVAL);
X    Define_Primitive (P_Fill_Arc,          "fill-arc",         8, 8, EVAL);
X    Define_Primitive (P_Draw_Arcs,         "draw-arcs",        3, 3, EVAL);
X    Define_Primitive (P_Fill_Arcs,         "fill-arcs",        3, 3, EVAL);
X    Define_Primitive (P_Fill_Polygon,      "fill-polygon",     5, 5, EVAL);
X}
END_OF_lib/xlib/graphics.c
if test 8849 -ne `wc -c <lib/xlib/graphics.c`; then
    echo shar: \"lib/xlib/graphics.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d lib/xaw ; then
    echo shar: Creating directory \"lib/xaw\"
    mkdir lib/xaw
fi
if test -f lib/xaw/form.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xaw/form.d\"
else
echo shar: Extracting \"lib/xaw/form.d\" \(100 characters\)
sed "s/^X//" >lib/xaw/form.d <<'END_OF_lib/xaw/form.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'form "Form.h")
X
X(define-widget-class 'form 'formWidgetClass)
END_OF_lib/xaw/form.d
if test 100 -ne `wc -c <lib/xaw/form.d`; then
    echo shar: \"lib/xaw/form.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/command.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xaw/command.d\"
else
echo shar: Extracting \"lib/xaw/command.d\" \(153 characters\)
sed "s/^X//" >lib/xaw/command.d <<'END_OF_lib/xaw/command.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'command "Command.h")
X
X(define-widget-class 'command 'commandWidgetClass)
X
X(define-callback 'command 'callback #f)
END_OF_lib/xaw/command.d
if test 153 -ne `wc -c <lib/xaw/command.d`; then
    echo shar: \"lib/xaw/command.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 10 \(of 14\).
cp /dev/null ark10isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 14 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0



More information about the Comp.sources.misc mailing list