Usenet 1994 October

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume8 / elk / part10 < prev next >

Wrap

Text File | 1989-09-23 | 57.8 KB | 1,870 lines

Newsgroups: comp.sources.misc From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Subject: v08i058: Elk (Extension Language Toolkit) part 10 of 14 Reply-To: net@tub.UUCP (Oliver Laumann) Posting-number: Volume 8, Issue 58 Submitted-by: net@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@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