allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (09/24/89)
Posting-number: Volume 8, Issue 59
Submitted-by: net@tub.UUCP (Oliver Laumann)
Archive-name: elk/part11
[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 11 (of 14)."
# Contents: lib/xlib/type.c lib/xlib/error.c lib/xlib/text.c
# lib/xlib/font.c lib/xlib/pixmap.c lib/xlib/objects.c
# lib/xlib/colormap.c lib/xlib/cursor.c lib/xlib/key.c
# lib/xaw/label.d
# Wrapped by net@tub on Sun Sep 17 17:32:36 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f lib/xlib/type.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/type.c\"
else
echo shar: Extracting \"lib/xlib/type.c\" \(26200 characters\)
sed "s/^X//" >lib/xlib/type.c <<'END_OF_lib/xlib/type.c'
X#include "xlib.h"
X
Xstatic Object Set_Attr_Slots;
Xstatic Object Conf_Slots;
Xstatic Object GC_Slots;
Xstatic Object Geometry_Slots;
Xstatic Object Win_Attr_Slots;
Xstatic Object Font_Info_Slots;
Xstatic Object Char_Info_Slots;
Xstatic Object Wm_Hints_Slots;
Xstatic Object Size_Hints_Slots;
Xstatic Object Icon_Size_Slots;
X
XXSetWindowAttributes SWA;
XRECORD Set_Attr_Rec[] = {
X { (char *)&SWA.background_pixmap, "background-pixmap", T_PIXMAP,
X 0, CWBackPixmap },
X { (char *)&SWA.background_pixel, "background-pixel", T_PIXEL,
X 0, CWBackPixel },
X { (char *)&SWA.border_pixmap, "border-pixmap", T_PIXMAP,
X 0, CWBorderPixmap },
X { (char *)&SWA.border_pixel, "border-pixel", T_PIXEL,
X 0, CWBorderPixel },
X { (char *)&SWA.bit_gravity, "bit-gravity", T_SYM,
X Bit_Grav_Syms, CWBitGravity },
X { (char *)&SWA.win_gravity, "gravity", T_SYM,
X Grav_Syms, CWWinGravity },
X { (char *)&SWA.backing_store, "backing-store", T_SYM,
X Backing_Store_Syms, CWBackingStore },
X { (char *)&SWA.backing_planes, "backing-planes", T_PIXEL,
X 0, CWBackingPlanes },
X { (char *)&SWA.backing_pixel, "backing-pixel", T_PIXEL,
X 0, CWBackingPixel },
X { (char *)&SWA.save_under, "save-under", T_BOOL,
X 0, CWSaveUnder },
X { (char *)&SWA.event_mask, "event-mask", T_MASK,
X Event_Syms, CWEventMask },
X { (char *)&SWA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK,
X Event_Syms, CWDontPropagate },
X { (char *)&SWA.override_redirect, "override-redirect", T_BOOL,
X 0, CWOverrideRedirect },
X { (char *)&SWA.colormap, "colormap", T_COLORMAP,
X 0, CWColormap },
X { (char *)&SWA.cursor, "cursor", T_CURSOR,
X 0, CWCursor },
X { 0, 0, T_NONE, 0, 0 }
X};
Xint Set_Attr_Size = sizeof Set_Attr_Rec / sizeof (RECORD);
X
XXWindowChanges WC;
XRECORD Conf_Rec[] = {
X { (char *)&WC.x, "x", T_INT, 0, CWX },
X { (char *)&WC.y, "y", T_INT, 0, CWY },
X { (char *)&WC.width, "width", T_INT, 0, CWWidth },
X { (char *)&WC.height, "height", T_INT, 0, CWHeight },
X { (char *)&WC.border_width, "border-width", T_INT, 0, CWBorderWidth },
X { (char *)&WC.sibling, "sibling", T_WINDOW, 0, CWSibling },
X { (char *)&WC.stack_mode, "stack-mode", T_SYM, Stack_Mode_Syms,
X CWStackMode },
X { 0, 0, T_NONE, 0, 0 }
X};
Xint Conf_Size = sizeof Conf_Rec / sizeof (RECORD);
X
XXGCValues GCV;
XRECORD GC_Rec[] = {
X { (char *)&GCV.function, "function", T_SYM,
X Func_Syms, GCFunction },
X { (char *)&GCV.plane_mask, "plane-mask", T_PIXEL,
X 0, GCPlaneMask },
X { (char *)&GCV.foreground, "foreground", T_PIXEL,
X 0, GCForeground },
X { (char *)&GCV.background, "background", T_PIXEL,
X 0, GCBackground },
X { (char *)&GCV.line_width, "line-width", T_INT,
X 0, GCLineWidth },
X { (char *)&GCV.line_style, "line-style", T_SYM,
X Line_Style_Syms, GCLineStyle },
X { (char *)&GCV.cap_style, "cap-style", T_SYM,
X Cap_Style_Syms, GCCapStyle },
X { (char *)&GCV.join_style, "join-style", T_SYM,
X Join_Style_Syms, GCJoinStyle },
X { (char *)&GCV.fill_style, "fill-style", T_SYM,
X Fill_Style_Syms, GCFillStyle },
X { (char *)&GCV.fill_rule, "fill-rule", T_SYM,
X Fill_Rule_Syms, GCFillRule },
X { (char *)&GCV.arc_mode, "arc-mode", T_SYM,
X Arc_Mode_Syms, GCArcMode },
X { (char *)&GCV.tile, "tile", T_PIXMAP,
X 0, GCTile },
X { (char *)&GCV.stipple, "stipple", T_PIXMAP,
X 0, GCStipple },
X { (char *)&GCV.ts_x_origin, "ts-x", T_INT,
X 0, GCTileStipXOrigin },
X { (char *)&GCV.ts_y_origin, "ts-y", T_INT,
X 0, GCTileStipYOrigin },
X { (char *)&GCV.font, "font", T_FONT,
X 0, GCFont },
X { (char *)&GCV.subwindow_mode, "subwindow-mode", T_SYM,
X Subwin_Mode_Syms, GCSubwindowMode },
X { (char *)&GCV.graphics_exposures, "exposures", T_BOOL,
X 0, GCGraphicsExposures },
X { (char *)&GCV.clip_x_origin, "clip-x", T_INT,
X 0, GCClipXOrigin },
X { (char *)&GCV.clip_y_origin, "clip-y", T_INT,
X 0, GCClipYOrigin },
X { (char *)&GCV.clip_mask, "clip-mask", T_PIXMAP,
X 0, GCClipMask },
X { (char *)&GCV.dash_offset, "dash-offset", T_INT,
X 0, GCDashOffset },
X { (char *)&GCV.dashes, "dashes", T_INT,
X 0, GCDashList },
X {0, 0, T_NONE, 0, 0 }
X};
Xint GC_Size = sizeof GC_Rec / sizeof (RECORD);
X
XGEOMETRY GEO;
XRECORD Geometry_Rec[] = {
X { (char *)&GEO.root, "root", T_WINDOW, 0, 0 },
X { (char *)&GEO.x, "x", T_INT, 0, 0 },
X { (char *)&GEO.y, "y", T_INT, 0, 0 },
X { (char *)&GEO.width, "width", T_INT, 0, 0 },
X { (char *)&GEO.height, "height", T_INT, 0, 0 },
X { (char *)&GEO.border_width, "border-width", T_INT, 0, 0 },
X { (char *)&GEO.depth, "depth", T_INT, 0, 0 },
X {0, 0, T_NONE, 0, 0 }
X};
Xint Geometry_Size = sizeof Geometry_Rec / sizeof (RECORD);
X
XXWindowAttributes WA;
XRECORD Win_Attr_Rec[] = {
X { (char *)&WA.x, "x", T_INT,
X 0, 0 },
X { (char *)&WA.y, "y", T_INT,
X 0, 0 },
X { (char *)&WA.width, "width", T_INT,
X 0, 0 },
X { (char *)&WA.height, "height", T_INT,
X 0, 0 },
X { (char *)&WA.border_width, "border-width", T_INT,
X 0, 0 },
X { (char *)&WA.depth, "depth", T_INT,
X 0, 0 },
X { (char *)&WA.visual, "visual", T_NONE,
X 0, 0 },
X { (char *)&WA.root, "root", T_WINDOW,
X 0, 0 },
X { (char *)&WA.class, "class", T_SYM,
X Class_Syms, 0 },
X { (char *)&WA.bit_gravity, "bit-gravity", T_SYM,
X Bit_Grav_Syms, 0 },
X { (char *)&WA.win_gravity, "gravity", T_SYM,
X Grav_Syms, 0 },
X { (char *)&WA.backing_store, "backing-store", T_SYM,
X Backing_Store_Syms, 0 },
X { (char *)&WA.backing_planes, "backing-planes", T_PIXEL,
X 0, 0 },
X { (char *)&WA.backing_pixel, "backing-pixel", T_PIXEL,
X 0, 0 },
X { (char *)&WA.save_under, "save-under", T_BOOL,
X 0, 0 },
X { (char *)&WA.colormap , "colormap", T_COLORMAP,
X 0, 0 },
X { (char *)&WA.map_installed, "map-installed", T_BOOL,
X 0, 0 },
X { (char *)&WA.map_state, "map-state", T_SYM,
X Map_State_Syms, 0 },
X { (char *)&WA.all_event_masks, "all-event-masks", T_MASK,
X Event_Syms, 0 },
X { (char *)&WA.your_event_mask, "your-event-mask", T_MASK,
X Event_Syms, 0 },
X { (char *)&WA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK,
X Event_Syms, 0 },
X { (char *)&WA.override_redirect, "override-redirect", T_BOOL,
X 0, 0 },
X { (char *)&WA.screen, "screen", T_NONE,
X 0, 0 },
X {0, 0, T_NONE, 0, 0 }
X};
Xint Win_Attr_Size = sizeof Win_Attr_Rec / sizeof (RECORD);
X
XXFontStruct FI;
XRECORD Font_Info_Rec[] = {
X { (char *)&FI.direction, "direction", T_SYM,
X Direction_Syms, 0 },
X { (char *)&FI.min_char_or_byte2, "min-byte2", T_INT,
X 0, 0 },
X { (char *)&FI.max_char_or_byte2, "max-byte2", T_INT,
X 0, 0 },
X { (char *)&FI.min_byte1, "min-byte1", T_INT,
X 0, 0 },
X { (char *)&FI.max_byte1, "max-byte1", T_INT,
X 0, 0 },
X { (char *)&FI.all_chars_exist, "all-chars-exist?", T_BOOL,
X 0, 0 },
X { (char *)&FI.default_char, "default-char", T_INT,
X 0, 0 },
X { (char *)&FI.ascent, "ascent", T_INT,
X 0, 0 },
X { (char *)&FI.descent, "descent", T_INT,
X 0, 0 },
X {0, 0, T_NONE, 0, 0 }
X};
Xint Font_Info_Size = sizeof Font_Info_Rec / sizeof (RECORD);
X
XXCharStruct CI;
XRECORD Char_Info_Rec[] = {
X { (char *)&CI.lbearing, "lbearing", T_SHORT, 0, 0 },
X { (char *)&CI.rbearing, "rbearing", T_SHORT, 0, 0 },
X { (char *)&CI.width, "width", T_SHORT, 0, 0 },
X { (char *)&CI.ascent, "ascent", T_SHORT, 0, 0 },
X { (char *)&CI.descent, "descent", T_SHORT, 0, 0 },
X { (char *)&CI.attributes, "attributes", T_SHORT, 0, 0 },
X {0, 0, T_NONE, 0, 0 }
X};
Xint Char_Info_Size = sizeof Char_Info_Rec / sizeof (RECORD);
X
XXWMHints WMH;
XRECORD Wm_Hints_Rec[] = {
X { (char *)&WMH.input, "input?", T_BOOL,
X 0, InputHint },
X { (char *)&WMH.initial_state, "initial-state", T_SYM,
X Initial_State_Syms, StateHint },
X { (char *)&WMH.icon_pixmap, "icon-pixmap", T_PIXMAP,
X 0, IconPixmapHint },
X { (char *)&WMH.icon_window, "icon-window", T_WINDOW,
X 0, IconWindowHint },
X { (char *)&WMH.icon_x, "icon-x", T_INT,
X 0, IconPositionHint },
X { (char *)&WMH.icon_y, "icon-y", T_INT,
X 0, IconPositionHint },
X { (char *)&WMH.icon_mask, "icon-mask", T_PIXMAP,
X 0, IconMaskHint },
X { (char *)&WMH.window_group, "window-group", T_WINDOW,
X 0, WindowGroupHint },
X {0, 0, T_NONE, 0, 0 }
X};
Xint Wm_Hints_Size = sizeof Wm_Hints_Rec / sizeof (RECORD);
X
XXSizeHints SZH;
XRECORD Size_Hints_Rec[] = {
X { (char *)&SZH.x, "x", T_INT, 0, USPosition },
X { (char *)&SZH.y, "y", T_INT, 0, USPosition },
X { (char *)&SZH.width, "width", T_INT, 0, USSize },
X { (char *)&SZH.height, "height", T_INT, 0, USSize },
X { (char *)&SZH.x, "x", T_INT, 0, PPosition },
X { (char *)&SZH.y, "y", T_INT, 0, PPosition },
X { (char *)&SZH.width, "width", T_INT, 0, PSize },
X { (char *)&SZH.height, "height", T_INT, 0, PSize },
X { (char *)&SZH.min_width, "min-width", T_INT, 0, PMinSize },
X { (char *)&SZH.min_height, "min-height", T_INT, 0, PMinSize },
X { (char *)&SZH.max_width, "max-width", T_INT, 0, PMaxSize },
X { (char *)&SZH.max_height, "max-height", T_INT, 0, PMaxSize },
X { (char *)&SZH.width_inc, "width-inc", T_INT, 0, PResizeInc },
X { (char *)&SZH.height_inc, "height-inc", T_INT, 0, PResizeInc },
X { (char *)&SZH.min_aspect.x, "min-aspect-x", T_INT, 0, PAspect },
X { (char *)&SZH.min_aspect.y, "min-aspect-y", T_INT, 0, PAspect },
X { (char *)&SZH.max_aspect.x, "max-aspect-x", T_INT, 0, PAspect },
X { (char *)&SZH.max_aspect.y, "max-aspect-y", T_INT, 0, PAspect },
X {0, 0, T_NONE, 0, 0 }
X};
Xint Size_Hints_Size = sizeof Size_Hints_Rec / sizeof (RECORD);
X
XXIconSize ISZ;
XRECORD Icon_Size_Rec[] = {
X { (char *)&ISZ.min_width, "min-width", T_INT, 0, 0 },
X { (char *)&ISZ.min_height, "min-height", T_INT, 0, 0 },
X { (char *)&ISZ.max_width, "max-width", T_INT, 0, 0 },
X { (char *)&ISZ.max_height, "max-height", T_INT, 0, 0 },
X { (char *)&ISZ.width_inc, "width-inc", T_INT, 0, 0 },
X { (char *)&ISZ.height_inc, "height-inc", T_INT, 0, 0 },
X {0, 0, T_NONE, 0, 0 }
X};
Xint Icon_Size_Size = sizeof Icon_Size_Rec / sizeof (RECORD);
X
Xunsigned long Vector_To_Record (v, len, sym, rp) Object v, sym;
X register RECORD *rp; {
X register Object *p;
X unsigned long mask = 0;
X
X Check_Type (v, T_Vector);
X p = VECTOR(v)->data;
X if (VECTOR(v)->size != len && !EQ(p[0], sym))
X Primitive_Error ("invalid argument");
X for ( ; rp->slot; rp++) {
X ++p;
X if (rp->type == T_NONE || Nullp (*p))
X continue;
X switch (rp->type) {
X case T_INT:
X *(int *)rp->slot = Get_Integer (*p); break;
X case T_SHORT:
X *(short *)rp->slot = Get_Integer (*p); break;
X case T_LONG:
X break;
X case T_ULONG:
X break;
X case T_PIXEL:
X *(unsigned long *)rp->slot = Get_Pixel (*p); break;
X case T_PIXMAP:
X *(Pixmap *)rp->slot = Get_Pixmap (*p); break;
X case T_BOOL:
X Check_Type (*p, T_Boolean);
X *(Bool *)rp->slot = (Bool)(FIXNUM(*p));
X break;
X case T_FONT:
X *(Font *)rp->slot = Get_Font (*p);
X break;
X case T_COLORMAP:
X *(Colormap *)rp->slot = Get_Colormap (*p); break;
X case T_CURSOR:
X *(Cursor *)rp->slot = Get_Cursor (*p);
X break;
X case T_WINDOW:
X break;
X case T_MASK:
X *(unsigned long *)rp->slot = Symbols_To_Bits (*p, 1, rp->syms);
X break;
X case T_SYM:
X *(unsigned long *)rp->slot = Symbols_To_Bits (*p, 0, rp->syms);
X break;
X }
X mask |= rp->mask;
X }
X return mask;
X}
X
XObject Record_To_Vector (rp, len, sym, dpy, flags) Object sym;
X register RECORD *rp; Display *dpy; unsigned long flags; {
X register i;
X Object v, x;
X GC_Node2;
X
X v = Null;
X GC_Link2 (sym, v);
X v = Make_Vector (len, Null);
X VECTOR(v)->data[0] = sym;
X for (i = 1; rp->slot; i++, rp++) {
X if (rp->type == T_NONE)
X continue;
X if (rp->mask && !(flags & rp->mask))
X continue;
X x = Null;
X switch (rp->type) {
X case T_INT:
X x = Make_Fixnum (*(int *)rp->slot); break;
X case T_SHORT:
X x = Make_Fixnum (*(short *)rp->slot); break;
X case T_LONG:
X break;
X case T_ULONG:
X break;
X case T_PIXEL:
X x = Make_Pixel (*(unsigned long *)rp->slot); break;
X case T_PIXMAP:
X break;
X case T_BOOL:
X x = *(Bool *)rp->slot ? True : False; break;
X case T_COLORMAP:
X x = Make_Colormap (0, dpy, *(Colormap *)rp->slot); break;
X case T_WINDOW:
X x = Make_Window (0, dpy, *(Window *)rp->slot); break;
X case T_MASK:
X x = Bits_To_Symbols (*(unsigned long *)rp->slot, 1, rp->syms);
X break;
X case T_SYM:
X x = Bits_To_Symbols (*(unsigned long *)rp->slot, 0, rp->syms);
X break;
X }
X VECTOR(v)->data[i] = x;
X }
X GC_Unlink;
X return v;
X}
X
XSYMDESCR Func_Syms[] = {
X { "clear", GXclear },
X { "and", GXand },
X { "and-reverse", GXandReverse },
X { "copy", GXcopy },
X { "and-inverted", GXandInverted },
X { "no-op", GXnoop },
X { "xor", GXxor },
X { "or", GXor },
X { "nor", GXnor },
X { "equiv", GXequiv },
X { "invert", GXinvert },
X { "or-reverse", GXorReverse },
X { "copy-inverted", GXcopyInverted },
X { "or-inverted", GXorInverted },
X { "nand", GXnand },
X { "set", GXset },
X { 0, 0 }
X};
X
XSYMDESCR Bit_Grav_Syms[] = {
X { "forget", ForgetGravity },
X { "north-west", NorthWestGravity },
X { "north", NorthGravity },
X { "north-east", NorthEastGravity },
X { "west", WestGravity },
X { "center", CenterGravity },
X { "east", EastGravity },
X { "south-west", SouthWestGravity },
X { "south", SouthGravity },
X { "south-east", SouthEastGravity },
X { "static", StaticGravity },
X { 0, 0 }
X};
X
XSYMDESCR Grav_Syms[] = {
X { "unmap", UnmapGravity },
X { "north-west", NorthWestGravity },
X { "north", NorthGravity },
X { "north-east", NorthEastGravity },
X { "west", WestGravity },
X { "center", CenterGravity },
X { "east", EastGravity },
X { "south-west", SouthWestGravity },
X { "south", SouthGravity },
X { "south-east", SouthEastGravity },
X { "static", StaticGravity },
X { 0, 0 }
X};
X
XSYMDESCR Backing_Store_Syms[] = {
X { "not-useful", NotUseful },
X { "when-mapped", WhenMapped },
X { "always", Always },
X { 0, 0 }
X};
X
XSYMDESCR Stack_Mode_Syms[] = {
X { "above", Above },
X { "below", Below },
X { "top-if", TopIf },
X { "bottom-if", BottomIf },
X { "opposite", Opposite },
X { 0, 0 }
X};
X
XSYMDESCR Line_Style_Syms[] = {
X { "solid", LineSolid },
X { "dash", LineOnOffDash },
X { "double-dash", LineDoubleDash },
X { 0, 0 }
X};
X
XSYMDESCR Cap_Style_Syms[] = {
X { "not-last", CapNotLast },
X { "butt", CapButt },
X { "round", CapRound },
X { "projecting", CapProjecting },
X { 0, 0 }
X};
X
XSYMDESCR Join_Style_Syms[] = {
X { "miter", JoinMiter },
X { "round", JoinRound },
X { "bevel", JoinBevel },
X { 0, 0 }
X};
X
XSYMDESCR Fill_Style_Syms[] = {
X { "solid", FillSolid },
X { "tiled", FillTiled },
X { "stippled", FillStippled },
X { "opaque-stippled", FillOpaqueStippled },
X { 0, 0 }
X};
X
XSYMDESCR Fill_Rule_Syms[] = {
X { "even-odd", EvenOddRule },
X { "winding", WindingRule },
X { 0, 0 }
X};
X
XSYMDESCR Arc_Mode_Syms[] = {
X { "chord", ArcChord },
X { "pie-slice", ArcPieSlice },
X { 0, 0 }
X};
X
XSYMDESCR Subwin_Mode_Syms[] = {
X { "clip-by-children", ClipByChildren },
X { "include-inferiors", IncludeInferiors },
X { 0, 0 }
X};
X
XSYMDESCR Class_Syms[] = {
X { "input-output", InputOutput },
X { "input-only", InputOnly },
X { 0, 0 }
X};
X
XSYMDESCR Map_State_Syms[] = {
X { "unmapped", IsUnmapped },
X { "unviewable", IsUnviewable },
X { "viewable", IsViewable },
X { 0, 0 }
X};
X
XSYMDESCR State_Syms[] = {
X { "shift", ShiftMask },
X { "lock", LockMask },
X { "control", ControlMask },
X { "mod1", Mod1Mask },
X { "mod2", Mod2Mask },
X { "mod3", Mod3Mask },
X { "mod4", Mod4Mask },
X { "mod5", Mod5Mask },
X { "button1", Button1Mask },
X { "button2", Button2Mask },
X { "button3", Button3Mask },
X { "button4", Button4Mask },
X { "button5", Button5Mask },
X { "any-modifier", AnyModifier },
X { 0, 0 }
X};
X
XSYMDESCR Button_Syms[] = {
X { "any-button", AnyButton },
X { "button1", Button1 },
X { "button2", Button2 },
X { "button3", Button3 },
X { "button4", Button4 },
X { "button5", Button5 },
X { 0, 0 }
X};
X
XSYMDESCR Cross_Mode_Syms[] = {
X { "normal", NotifyNormal },
X { "grab", NotifyGrab },
X { "ungrab", NotifyUngrab },
X { 0, 0 }
X};
X
XSYMDESCR Cross_Detail_Syms[] = {
X { "ancestor", NotifyAncestor },
X { "virtual", NotifyVirtual },
X { "inferior", NotifyInferior },
X { "nonlinear", NotifyNonlinear },
X { "nonlinear-virtual", NotifyNonlinearVirtual },
X { 0, 0 }
X};
X
XSYMDESCR Focus_Detail_Syms[] = {
X { "ancestor", NotifyAncestor },
X { "virtual", NotifyVirtual },
X { "inferior", NotifyInferior },
X { "nonlinear", NotifyNonlinear },
X { "nonlinear-virtual", NotifyNonlinearVirtual },
X { "pointer", NotifyPointer },
X { "pointer-root", NotifyPointerRoot },
X { "none", NotifyDetailNone },
X { 0, 0 }
X};
X
XSYMDESCR Visibility_Syms[] = {
X { "unobscured", VisibilityUnobscured },
X { "partially-obscured", VisibilityPartiallyObscured },
X { "fully-obscured", VisibilityFullyObscured },
X { 0, 0 }
X};
X
XSYMDESCR Place_Syms[] = {
X { "top", PlaceOnTop },
X { "bottom", PlaceOnBottom },
X { 0, 0 }
X};
X
XSYMDESCR Prop_Syms[] = {
X { "new-value", PropertyNewValue },
X { "deleted", PropertyDelete },
X { 0, 0 }
X};
X
XSYMDESCR Mapping_Syms[] = {
X { "modifier", MappingModifier },
X { "keyboard", MappingKeyboard },
X { "pointer", MappingPointer },
X { 0, 0 }
X};
X
XSYMDESCR Direction_Syms[] = {
X { "left-to-right", FontLeftToRight },
X { "right-to-left", FontRightToLeft },
X { 0, 0 }
X};
X
XSYMDESCR Polyshape_Syms[] = {
X { "complex", Complex },
X { "non-convex", Nonconvex },
X { "convex", Convex },
X { 0, 0 }
X};
X
XSYMDESCR Propmode_Syms[] = {
X { "replace", PropModeReplace },
X { "prepend", PropModePrepend },
X { "append", PropModeAppend },
X { 0, 0 }
X};
X
XSYMDESCR Grabstatus_Syms[] = {
X { "success", Success },
X { "not-viewable", GrabNotViewable },
X { "already-grabbed", AlreadyGrabbed },
X { "frozen", GrabFrozen },
X { "invalid-time", GrabInvalidTime },
X { 0, 0 }
X};
X
XSYMDESCR Bitmapstatus_Syms[] = {
X { "success", BitmapSuccess },
X { "open-failed", BitmapOpenFailed },
X { "file-invalid", BitmapFileInvalid },
X { "no-memory", BitmapNoMemory },
X { 0, 0 }
X};
X
XSYMDESCR Allow_Events_Syms[] = {
X { "async-pointer", AsyncPointer },
X { "sync-pointer", SyncPointer },
X { "replay-pointer", ReplayPointer },
X { "async-keyboard", AsyncKeyboard },
X { "sync-keyboard", SyncKeyboard },
X { "replay-keyboard", ReplayKeyboard },
X { "async-both", AsyncBoth },
X { "sync-both", SyncBoth },
X { 0, 0 }
X};
X
XSYMDESCR Revert_Syms[] = {
X { "none", RevertToNone },
X { "pointer-root", RevertToPointerRoot },
X { "parent", RevertToParent },
X { 0, 0 }
X};
X
XSYMDESCR Shape_Syms[] = {
X { "cursor", CursorShape },
X { "tile", TileShape },
X { "stipple", StippleShape },
X { 0, 0 }
X};
X
XSYMDESCR Initial_State_Syms[] = {
X { "dont-care", DontCareState },
X { "normal", NormalState },
X { "zoom", ZoomState },
X { "iconic", IconicState },
X { "inactive", InactiveState },
X { 0, 0 }
X};
X
XSYMDESCR Event_Syms[] = {
X { "key-press", KeyPressMask },
X { "key-release", KeyReleaseMask },
X { "button-press", ButtonPressMask },
X { "button-release", ButtonReleaseMask },
X { "enter-window", EnterWindowMask },
X { "leave-window", LeaveWindowMask },
X { "pointer-motion", PointerMotionMask },
X { "pointer-motion-hint", PointerMotionHintMask },
X { "button-1-motion", Button1MotionMask },
X { "button-2-motion", Button2MotionMask },
X { "button-3-motion", Button3MotionMask },
X { "button-4-motion", Button4MotionMask },
X { "button-5-motion", Button5MotionMask },
X { "button-motion", ButtonMotionMask },
X { "keymap-state", KeymapStateMask },
X { "exposure", ExposureMask },
X { "visibility-change", VisibilityChangeMask },
X { "structure-notify", StructureNotifyMask },
X { "resize-redirect", ResizeRedirectMask },
X { "substructure-notify", SubstructureNotifyMask },
X { "substructure-redirect", SubstructureRedirectMask },
X { "focus-change", FocusChangeMask },
X { "property-change", PropertyChangeMask },
X { "colormap-change", ColormapChangeMask },
X { "owner-grab-button", OwnerGrabButtonMask },
X { "all-events", ~0 },
X { 0, 0 }
X};
X
XSYMDESCR Error_Syms[] = {
X { "bad-request", BadRequest },
X { "bad-value", BadValue },
X { "bad-window", BadWindow },
X { "bad-pixmap", BadPixmap },
X { "bad-atom", BadAtom },
X { "bad-cursor", BadCursor },
X { "bad-font", BadFont },
X { "bad-match", BadMatch },
X { "bad-drawable", BadDrawable },
X { "bad-access", BadAccess },
X { "bad-alloc", BadAlloc },
X { "bad-color", BadColor },
X { "bad-gcontext", BadGC },
X { "bad-id-choice", BadIDChoice },
X { "bad-name", BadName },
X { "bad-length", BadLength },
X { "bad-implementation", BadImplementation },
X { 0, 0 }
X};
X
Xstatic Init_Record (rec, size, name, var) RECORD *rec; char *name;
X Object *var; {
X Object list, tail, cell;
X register i;
X char buf[128];
X GC_Node2;
X
X GC_Link2 (list, tail);
X for (list = tail = Null, i = 1; i < size; tail = cell, i++, rec++) {
X cell = Intern (rec->name);
X cell = Cons (cell, Make_Fixnum (i));
X cell = Cons (cell, Null);
X if (Nullp (list))
X list = cell;
X else
X P_Setcdr (tail, cell);
X }
X sprintf (buf, "%s-slots", name);
X Define_Variable (var, buf, list);
X GC_Unlink;
X}
X
Xinit_xlib_type () {
X Init_Record (Set_Attr_Rec, Set_Attr_Size, "set-window-attributes",
X &Set_Attr_Slots);
X Init_Record (Conf_Rec, Conf_Size, "window-configuration", &Conf_Slots);
X Init_Record (GC_Rec, GC_Size, "gcontext", &GC_Slots);
X Init_Record (Geometry_Rec, Geometry_Size, "geometry", &Geometry_Slots);
X Init_Record (Win_Attr_Rec, Win_Attr_Size, "get-window-attributes",
X &Win_Attr_Slots);
X Init_Record (Font_Info_Rec, Font_Info_Size, "font-info", &Font_Info_Slots);
X Init_Record (Char_Info_Rec, Char_Info_Size, "char-info", &Char_Info_Slots);
X Init_Record (Wm_Hints_Rec, Wm_Hints_Size, "wm-hints", &Wm_Hints_Slots);
X Init_Record (Size_Hints_Rec, Size_Hints_Size, "size-hints",
X &Size_Hints_Slots);
X Init_Record (Icon_Size_Rec, Icon_Size_Size, "icon-size", &Icon_Size_Slots);
X}
END_OF_lib/xlib/type.c
if test 26200 -ne `wc -c <lib/xlib/type.c`; then
echo shar: \"lib/xlib/type.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/error.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/error.c\"
else
echo shar: Extracting \"lib/xlib/error.c\" \(2477 characters\)
sed "s/^X//" >lib/xlib/error.c <<'END_OF_lib/xlib/error.c'
X#include "xlib.h"
X
Xstatic Object V_X_Error_Handler, V_X_Fatal_Error_Handler;
X
Xextern int _XIOError(); /* Default error handlers of the Xlib */
Xextern int _XDefaultError();
X
Xstatic X_Fatal_Error (d) Display *d; {
X Object args, fun;
X GC_Node;
X
X Reset_IO (0);
X args = Make_Display (0, d);
X GC_Link (args);
X args = Cons (args, Null);
X GC_Unlink;
X fun = Val (V_X_Fatal_Error_Handler);
X if (TYPE(fun) == T_Compound)
X (void)Funcall (fun, args, 0);
X _XIOError (d);
X Reset (); /* In case the default handler doesn't exit() */
X /*NOTREACHED*/
X}
X
Xstatic X_Error (d, ep) Display *d; XErrorEvent *ep; {
X Object args, a, fun;
X GC_Node;
X
X Reset_IO (0);
X args = Make_Unsigned ((unsigned)ep->resourceid);
X GC_Link (args);
X args = Cons (args, Null);
X a = Make_Integer (ep->minor_code);
X args = Cons (a, args);
X a = Make_Integer (ep->request_code);
X args = Cons (a, args);
X a = Bits_To_Symbols ((unsigned long)ep->error_code, 0, Error_Syms);
X if (Nullp (a))
X a = Make_Integer (ep->error_code);
X args = Cons (a, args);
X a = Make_Integer (ep->serial);
X args = Cons (a, args);
X a = Make_Display (0, ep->display);
X args = Cons (a, args);
X GC_Unlink;
X fun = Val (V_X_Error_Handler);
X if (TYPE(fun) == T_Compound)
X (void)Funcall (fun, args, 0);
X else
X _XDefaultError (d, ep);
X}
X
Xstatic X_After_Function (d) Display *d; {
X Object args;
X GC_Node;
X
X args = Make_Display (0, d);
X GC_Link (args);
X args = Cons (args, Null);
X GC_Unlink;
X (void)Funcall (DISPLAY(Car (args))->after, args, 0);
X}
X
Xstatic Object P_Set_After_Function (d, f) Object d, f; {
X Object old;
X
X Check_Type (d, T_Display);
X if (EQ(f, False)) {
X (void)XSetAfterFunction (DISPLAY(d)->dpy, (int (*)())0);
X } else {
X Check_Procedure (f);
X (void)XSetAfterFunction (DISPLAY(d)->dpy, X_After_Function);
X }
X old = DISPLAY(d)->after;
X DISPLAY(d)->after = f;
X return old;
X}
X
Xstatic Object P_After_Function (d) Object d; {
X Check_Type (d, T_Display);
X return DISPLAY(d)->after;
X}
X
Xinit_xlib_error () {
X Define_Variable (&V_X_Fatal_Error_Handler, "x-fatal-error-handler", Null);
X Define_Variable (&V_X_Error_Handler, "x-error-handler", Null);
X XSetIOErrorHandler (X_Fatal_Error);
X XSetErrorHandler (X_Error);
X Define_Primitive (P_Set_After_Function, "set-after-function!", 2, 2, EVAL);
X Define_Primitive (P_After_Function, "after-function", 1, 1, EVAL);
X}
END_OF_lib/xlib/error.c
if test 2477 -ne `wc -c <lib/xlib/error.c`; then
echo shar: \"lib/xlib/error.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/text.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/text.c\"
else
echo shar: Extracting \"lib/xlib/text.c\" \(4729 characters\)
sed "s/^X//" >lib/xlib/text.c <<'END_OF_lib/xlib/text.c'
X#include "xlib.h"
X
Xextern XDrawText(), XDrawText16();
X
Xstatic Object Sym_1_Byte, Sym_2_Byte;
X
Xstatic Two_Byte (format) Object format; {
X Check_Type (format, T_Symbol);
X if (EQ(format, Sym_1_Byte))
X return 0;
X else if (EQ(format, Sym_2_Byte))
X return 1;
X Primitive_Error ("index format must be '1-byte or '2-byte");
X /*NOTREACHED*/
X}
X
Xstatic Get_1_Byte_Char (x) Object x; {
X register c = Get_Integer (x);
X if (c < 0 || c > 255)
X Range_Error (x);
X return c;
X}
X
Xstatic Get_2_Byte_Char (x) Object x; {
X register c = Get_Integer (x);
X if (c < 0 || c > 65535)
X Range_Error (x);
X return c;
X}
X
X/* Calculation of text widths and extents should not be done using
X * the Xlib functions. For instance, the values returned by
X * XTextExtents() are only shorts and can therefore overflow for
X * long strings.
X */
X
Xstatic Object P_Text_Width (font, t, f) Object font, t, f; {
X return Internal_Text_Metrics (font, t, f, 1);
X}
X
Xstatic Object P_Text_Extents (font, t, f) Object font, t, f; {
X return Internal_Text_Metrics (font, t, f, 0);
X}
X
Xstatic Object Internal_Text_Metrics (font, t, f, width) Object font, t, f; {
X char *s;
X XChar2b *s2;
X XFontStruct *info;
X Object *data;
X register i, n;
X int dir, fasc, fdesc;
X
X Check_Type (font, T_Font);
X info = FONT(font)->info;
X Check_Type (t, T_Vector);
X n = VECTOR(t)->size;
X data = VECTOR(t)->data;
X if (Two_Byte (f)) {
X s2 = (XChar2b *)alloca (n * sizeof (XChar2b));
X for (i = 0; i < n; i++) {
X register c = Get_2_Byte_Char (data[i]);
X s2[i].byte1 = (c >> 8) & 0xff;
X s2[i].byte2 = c & 0xff;
X }
X if (width)
X i = XTextWidth16 (info, s2, n);
X else
X XTextExtents16 (info, s2, n, &dir, &fasc, &fdesc, &CI);
X } else {
X s = alloca (n);
X for (i = 0; i < n; i++)
X s[i] = Get_1_Byte_Char (data[i]);
X if (width)
X i = XTextWidth (info, s, n);
X else
X XTextExtents (info, s, n, &dir, &fasc, &fdesc, &CI);
X }
X return width ? Make_Integer (i) : Record_To_Vector (Char_Info_Rec,
X Char_Info_Size, Sym_Char_Info, FONT(font)->dpy, ~0L);
X}
X
Xstatic Object P_Draw_Image_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
X Display *dpy;
X Drawable dr = Get_Drawable (d, &dpy);
X Object *data;
X register i, n;
X char *s;
X XChar2b *s2;
X
X Check_Type (gc, T_Gc);
X Check_Type (t, T_Vector);
X n = VECTOR(t)->size;
X data = VECTOR(t)->data;
X if (Two_Byte (f)) {
X s2 = (XChar2b *)alloca (n * sizeof (XChar2b));
X for (i = 0; i < n; i++) {
X register c = Get_2_Byte_Char (data[i]);
X s2[i].byte1 = (c >> 8) & 0xff;
X s2[i].byte2 = c & 0xff;
X }
X XDrawImageString16 (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
X Get_Integer (y), s2, n);
X } else {
X s = alloca (n);
X for (i = 0; i < n; i++)
X s[i] = Get_1_Byte_Char (data[i]);
X XDrawImageString (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
X Get_Integer (y), s, n);
X }
X return Void;
X}
X
Xstatic Object P_Draw_Poly_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
X Display *dpy;
X Drawable dr = Get_Drawable (d, &dpy);
X Object *data;
X register i, n, j, k;
X int twobyte, nitems;
X XTextItem *items;
X int (*func)();
X
X Check_Type (gc, T_Gc);
X twobyte = Two_Byte (f);
X func = twobyte ? XDrawText16 : XDrawText;
X Check_Type (t, T_Vector);
X if ((n = VECTOR(t)->size) == 0)
X return Void;
X for (data = VECTOR(t)->data, i = 0, nitems = 1; i < n; i++)
X if (TYPE(data[i]) == T_Font) nitems++;
X items = (XTextItem *)alloca (nitems * sizeof (XTextItem));
X items[0].delta = 0;
X items[0].font = None;
X for (j = k = i = 0; i <= n; i++) {
X if (i == n || TYPE(data[i]) == T_Font) {
X items[j].nchars = i-k;
X if (twobyte) {
X register XChar2b *p;
X p = ((XTextItem16 *)items)[j].chars = (XChar2b *)alloca
X ((i-k) * sizeof (XChar2b));
X for ( ; k < i; k++, p++) {
X register c = Get_2_Byte_Char (data[k]);
X p->byte1 = (c >> 8) & 0xff;
X p->byte2 = c & 0xff;
X }
X } else {
X register char *p;
X p = items[j].chars = alloca (i-k);
X for ( ; k < i; k++)
X *p++ = Get_1_Byte_Char (data[k]);
X }
X k++;
X j++;
X if (i < n) {
X items[j].delta = 0;
X Open_Font_Maybe (data[i]);
X items[j].font = FONT(data[i])->id;
X }
X }
X }
X (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y),
X items, nitems);
X return Void;
X}
X
Xinit_xlib_text () {
X Define_Symbol (&Sym_1_Byte, "1-byte");
X Define_Symbol (&Sym_2_Byte, "2-byte");
X Define_Primitive (P_Text_Width, "text-width", 3, 3, EVAL);
X Define_Primitive (P_Text_Extents, "text-extents", 3, 3, EVAL);
X Define_Primitive (P_Draw_Image_Text, "draw-image-text", 6, 6, EVAL);
X Define_Primitive (P_Draw_Poly_Text, "draw-poly-text", 6, 6, EVAL);
X}
END_OF_lib/xlib/text.c
if test 4729 -ne `wc -c <lib/xlib/text.c`; then
echo shar: \"lib/xlib/text.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/font.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/font.c\"
else
echo shar: Extracting \"lib/xlib/font.c\" \(7580 characters\)
sed "s/^X//" >lib/xlib/font.c <<'END_OF_lib/xlib/font.c'
X#include "xlib.h"
X
XObject Sym_Char_Info;
Xstatic Object Sym_Font_Info;
X
XGeneric_Predicate (Font);
X
Xstatic Font_Equal (x, y) Object x, y; {
X Font id1 = FONT(x)->id, id2 = FONT(y)->id;
X if (id1 && id2)
X return (id1 == id2 && FONT(x)->dpy == FONT(y)->dpy) ? True : False;
X else
X return False;
X}
X
XGeneric_Print (Font, "#[font %u]", FONT(x)->id ? FONT(x)->id : POINTER(x));
X
Xstatic Font_Visit (fp, f) Object *fp; int (*f)(); {
X (*f)(&FONT(*fp)->name);
X}
X
XGeneric_Get_Display (Font, FONT);
X
XObject Make_Font (dpy, name, id, info) Display *dpy; Object name;
X Font id; XFontStruct *info; {
X register char *p;
X Object f;
X GC_Node;
X
X GC_Link (name);
X p = Get_Bytes (sizeof (struct S_Font));
X SET (f, T_Font, (struct S_Font *)p);
X FONT(f)->dpy = dpy;
X FONT(f)->name = name;
X FONT(f)->id = id;
X FONT(f)->info = info;
X if (id)
X Register_Object (f, (GENERIC)dpy, P_Close_Font, 0);
X GC_Unlink;
X return f;
X}
X
XFont Get_Font (f) Object f; {
X Check_Type (f, T_Font);
X Open_Font_Maybe (f);
X return FONT(f)->id;
X}
X
Xstatic XFontStruct *Internal_Open_Font (d, name) Display *d; Object name; {
X register char *s;
X XFontStruct *p;
X
X Make_C_String (name, s);
X Disable_Interrupts;
X if ((p = XLoadQueryFont (d, s)) == 0)
X Primitive_Error ("cannot open font: ~s", name);
X Enable_Interrupts;
X return p;
X}
X
Xstatic Object P_Open_Font (d, name) Object d, name; {
X XFontStruct *p;
X
X Check_Type (d, T_Display)
X p = Internal_Open_Font (DISPLAY(d)->dpy, name);
X return Make_Font (DISPLAY(d)->dpy, name, p->fid, p);
X}
X
XOpen_Font_Maybe (f) Object f; {
X Object name = FONT(f)->name;
X XFontStruct *p;
X
X if (!Truep (name))
X Primitive_Error ("invalid font");
X if (FONT(f)->id == 0) {
X p = Internal_Open_Font (FONT(f)->dpy, name);
X FONT(f)->id = p->fid;
X FONT(f)->info = p;
X Register_Object (f, (GENERIC)(FONT(f)->dpy), P_Close_Font, 0);
X }
X}
X
XObject P_Close_Font (f) Object f; {
X Check_Type (f, T_Font);
X if (FONT(f)->id)
X XUnloadFont (FONT(f)->dpy, FONT(f)->id);
X FONT(f)->id = 0;
X Deregister_Object (f);
X return Void;
X}
X
Xstatic Object P_Font_Name (f) Object f; {
X Check_Type (f, T_Font);
X return FONT(f)->name;
X}
X
Xstatic Object P_Gcontext_Font (g) Object g; {
X register struct S_Gc *p;
X register XFontStruct *info;
X
X Check_Type (g, T_Gc);
X p = GCONTEXT(g);
X Disable_Interrupts;
X info = XQueryFont (p->dpy, XGContextFromGC (p->gc));
X Enable_Interrupts;
X return Make_Font (p->dpy, False, (Font)0, info);
X}
X
Xstatic Object P_List_Font_Names (d, pat) Object d, pat; {
X return Internal_List_Fonts (d, pat, 0);
X}
X
Xstatic Object P_List_Fonts (d, pat) Object d, pat; {
X return Internal_List_Fonts (d, pat, 1);
X}
X
Xstatic Object Internal_List_Fonts (d, pat, with_info) Object d, pat; {
X char *s, **ret;
X int n;
X XFontStruct *iret;
X register i;
X Object f, v;
X Display *dpy;
X GC_Node2;
X
X Check_Type (d, T_Display);
X dpy = DISPLAY(d)->dpy;
X Make_C_String (pat, s);
X Disable_Interrupts;
X if (with_info)
X ret = XListFontsWithInfo (dpy, s, 65535, &n, &iret);
X else
X ret = XListFonts (dpy, s, 65535, &n);
X Enable_Interrupts;
X v = Make_Vector (n, Null);
X f = Null;
X GC_Link2 (f, v);
X for (i = 0; i < n; i++) {
X f = Make_String (ret[i], strlen (ret[i]));
X if (with_info)
X f = Make_Font (dpy, f, (Font)0, &iret[i]);
X VECTOR(v)->data[i] = f;
X }
X GC_Unlink;
X if (with_info)
X XFreeFontInfo (ret, (XFontStruct *)0, 0);
X else
X XFreeFontNames (ret);
X return v;
X}
X
Xstatic Object P_Font_Info (f) Object f; {
X Check_Type (f, T_Font);
X FI = *FONT(f)->info;
X return Record_To_Vector (Font_Info_Rec, Font_Info_Size,
X Sym_Font_Info, FONT(f)->dpy, ~0L);
X}
X
Xstatic Object P_Char_Info (f, index) Object f, index; {
X register t = TYPE(index);
X register unsigned i;
X register XCharStruct *cp;
X register XFontStruct *p;
X char *msg = "argument must be integer, character, 'min, or 'max";
X
X Check_Type (f, T_Font);
X Open_Font_Maybe (f);
X p = FONT(f)->info;
X cp = &p->max_bounds;
X if (t == T_Symbol) {
X if (EQ(index, Intern ("min")))
X cp = &p->min_bounds;
X else if (!EQ(index, Intern ("max")))
X Primitive_Error (msg);
X } else {
X if (t == T_Character)
X i = CHAR(index);
X else if (t == T_Fixnum || t == T_Bignum)
X i = (unsigned)Get_Integer (index);
X else
X Primitive_Error (msg);
X if (!p->min_byte1 && !p->max_byte1) {
X if (i < p->min_char_or_byte2 || i > p->max_char_or_byte2)
X Range_Error (index);
X i -= p->min_char_or_byte2;
X } else {
X register unsigned b1 = i & 0xff, b2 = (i >> 8) & 0xff;
X if (b1 < p->min_byte1 || b1 > p->max_byte1 ||
X b2 < p->min_char_or_byte2 || b2 > p->max_char_or_byte2)
X Range_Error (index);
X b1 -= p->min_byte1;
X b2 -= p->min_char_or_byte2;
X i = b1 * (p->max_char_or_byte2 - p->min_char_or_byte2 + 1) + b2;
X }
X if (p->per_char)
X cp = p->per_char + i;
X }
X CI = *cp;
X return Record_To_Vector (Char_Info_Rec, Char_Info_Size,
X Sym_Char_Info, FONT(f)->dpy, ~0L);
X}
X
Xstatic Object P_Font_Properties (f) Object f; {
X register i, n;
X Object v, a, val, x;
X GC_Node4;
X
X Check_Type (f, T_Font);
X n = FONT(f)->info->n_properties;
X v = Make_Vector (n, Null);
X a = val = Null;
X GC_Link4 (v, a, val, f);
X for (i = 0; i < n; i++) {
X register XFontProp *p = FONT(f)->info->properties+i;
X a = Make_Atom (p->name);
X val = Make_Unsigned ((unsigned)p->card32);
X x = Cons (a, val);
X VECTOR(v)->data[i] = x;
X }
X GC_Unlink;
X return v;
X}
X
Xstatic Object P_Font_Path (d) Object d; {
X Object v;
X int i, n;
X char **ret;
X GC_Node;
X
X Check_Type (d, T_Display);
X Disable_Interrupts;
X ret = XGetFontPath (DISPLAY(d)->dpy, &n);
X Enable_Interrupts;
X v = Make_Vector (n, Null);
X GC_Link (v);
X for (i = 0; i < n; i++) {
X Object x = Make_String (ret[i], strlen (ret[i]));
X VECTOR(v)->data[i] = x;
X }
X GC_Unlink;
X XFreeFontPath (ret);
X return P_Vector_To_List (v);
X}
X
Xstatic Object P_Set_Font_Path (d, p) Object d, p; {
X register char **path;
X register i, n;
X Object c;
X
X Check_Type (d, T_Display);
X Check_List (p);
X n = Internal_Length (p);
X path = (char **)alloca (n * sizeof (char *));
X for (i = 0; i < n; i++, p = Cdr (p)) {
X c = Car (p);
X Make_C_String (c, path[i]);
X }
X XSetFontPath (DISPLAY(d)->dpy, path, n);
X return Void;
X}
X
Xinit_xlib_font () {
X Define_Symbol (&Sym_Font_Info, "font-info");
X Define_Symbol (&Sym_Char_Info, "char-info");
X T_Font = Define_Type (0, "font", NOFUNC, sizeof (struct S_Font),
X Font_Equal, Font_Equal, Font_Print, Font_Visit);
X Define_Primitive (P_Fontp, "font?", 1, 1, EVAL);
X Define_Primitive (P_Font_Display, "font-display", 1, 1, EVAL);
X Define_Primitive (P_Open_Font, "open-font", 2, 2, EVAL);
X Define_Primitive (P_Close_Font, "close-font", 1, 1, EVAL);
X Define_Primitive (P_Font_Name, "font-name", 1, 1, EVAL);
X Define_Primitive (P_Gcontext_Font, "gcontext-font", 1, 1, EVAL);
X Define_Primitive (P_List_Font_Names, "list-font-names", 2, 2, EVAL);
X Define_Primitive (P_List_Fonts, "list-fonts", 2, 2, EVAL);
X Define_Primitive (P_Font_Info, "font-info", 1, 1, EVAL);
X Define_Primitive (P_Char_Info, "char-info", 2, 2, EVAL);
X Define_Primitive (P_Font_Properties, "font-properties", 1, 1, EVAL);
X Define_Primitive (P_Font_Path, "font-path", 1, 1, EVAL);
X Define_Primitive (P_Set_Font_Path, "set-font-path!", 2, 2, EVAL);
X}
END_OF_lib/xlib/font.c
if test 7580 -ne `wc -c <lib/xlib/font.c`; then
echo shar: \"lib/xlib/font.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/pixmap.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/pixmap.c\"
else
echo shar: Extracting \"lib/xlib/pixmap.c\" \(2690 characters\)
sed "s/^X//" >lib/xlib/pixmap.c <<'END_OF_lib/xlib/pixmap.c'
X#include "xlib.h"
X
XGeneric_Predicate (Pixmap);
X
XGeneric_Equal_Dpy (Pixmap, PIXMAP, pm);
X
XGeneric_Print (Pixmap, "#[pixmap %u]", PIXMAP(x)->pm);
X
XGeneric_Get_Display (Pixmap, PIXMAP);
X
XObject Make_Pixmap (dpy, pix) Display *dpy; Pixmap pix; {
X register char *p;
X Object pm;
X
X if (pix == None)
X return Sym_None;
X pm = Find_Object (T_Pixmap, (GENERIC)dpy, Match_X_Obj, pix);
X if (Nullp (pm)) {
X p = Get_Bytes (sizeof (struct S_Pixmap));
X SET (pm, T_Pixmap, (struct S_Pixmap *)p);
X PIXMAP(pm)->tag = Null;
X PIXMAP(pm)->pm = pix;
X PIXMAP(pm)->dpy = dpy;
X PIXMAP(pm)->free = 0;
X Register_Object (pm, (GENERIC)dpy, P_Free_Pixmap, 0);
X }
X return pm;
X}
X
XPixmap Get_Pixmap (p) Object p; {
X Check_Type (p, T_Pixmap);
X return PIXMAP(p)->pm;
X}
X
XObject P_Free_Pixmap (p) Object p; {
X Check_Type (p, T_Pixmap);
X if (!PIXMAP(p)->free)
X XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm);
X Deregister_Object (p);
X PIXMAP(p)->free = 1;
X return Void;
X}
X
Xstatic Object P_Create_Pixmap (d, w, h, depth) Object d, w, h, depth; {
X Display *dpy;
X Drawable dr = Get_Drawable (d, &dpy);
X
X return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, Get_Integer (w),
X Get_Integer (h), Get_Integer (depth)));
X}
X
Xstatic Object P_Create_Bitmap_Data (win, data, pw, ph)
X Object win, data, pw, ph; {
X register w, h;
X
X Check_Type (win, T_Window);
X Check_Type (data, T_String);
X w = Get_Integer (pw);
X h = Get_Integer (ph);
X if (w * h > 8 * STRING(data)->size)
X Primitive_Error ("bitmap too small");
X return Make_Pixmap (WINDOW(win)->dpy,
X XCreateBitmapFromData (WINDOW(win)->dpy, WINDOW(win)->win,
X STRING(data)->data, w, h));
X}
X
Xstatic Object P_Write_Bitmap_File (argc, argv) Object *argv; {
X Object file;
X Pixmap pm;
X char *s;
X int xhot = -1, yhot = -1;
X
X file = argv[0];
X Make_C_String (file, s);
X pm = Get_Pixmap (argv[1]);
X if (argc == 5)
X Primitive_Error ("both x-hot and y-hot must be specified");
X if (argc == 6) {
X xhot = Get_Integer (argv[4]);
X yhot = Get_Integer (argv[5]);
X }
X return Bits_To_Symbols ((unsigned long)XWriteBitmapFile
X (PIXMAP(argv[1])->dpy, s, pm,
X Get_Integer (argv[2]), Get_Integer (argv[3]), xhot, yhot),
X 0, Bitmapstatus_Syms);
X}
X
Xinit_xlib_pixmap () {
X Generic_Define (Pixmap, "pixmap", "pixmap?");
X Define_Primitive (P_Pixmap_Display,"pixmap-display", 1, 1, EVAL);
X Define_Primitive (P_Free_Pixmap, "free-pixmap", 1, 1, EVAL);
X Define_Primitive (P_Create_Pixmap, "create-pixmap", 4, 4, EVAL);
X Define_Primitive (P_Create_Bitmap_Data, "create-bitmap-from-data",
X 4, 4, EVAL);
X Define_Primitive (P_Write_Bitmap_File, "write-bitmap-file",
X 4, 6, VARARGS);
X}
END_OF_lib/xlib/pixmap.c
if test 2690 -ne `wc -c <lib/xlib/pixmap.c`; then
echo shar: \"lib/xlib/pixmap.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/objects.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/objects.c\"
else
echo shar: Extracting \"lib/xlib/objects.c\" \(1359 characters\)
sed "s/^X//" >lib/xlib/objects.c <<'END_OF_lib/xlib/objects.c'
X#include <varargs.h>
X
X#include "xlib.h"
X
XObject Sym_None;
X
XMatch_X_Obj (x, v) Object x; va_list v; {
X register type = TYPE(x);
X
X if (type == T_Display) {
X return 1;
X } else if (type == T_Gc) {
X return va_arg (v, GC) == GCONTEXT(x)->gc;
X } else if (type == T_Pixel) {
X return va_arg (v, unsigned long) == PIXEL(x)->pix;
X } else if (type == T_Pixmap) {
X return va_arg (v, Pixmap) == PIXMAP(x)->pm;
X } else if (type == T_Window) {
X return va_arg (v, Window) == WINDOW(x)->win;
X } else if (type == T_Font) {
X return va_arg (v, Font) == FONT(x)->id;
X } else if (type == T_Colormap) {
X return va_arg (v, Colormap) == COLORMAP(x)->cm;
X } else if (type == T_Color) {
X return va_arg (v, unsigned int) == COLOR(x)->c.red
X && va_arg (v, unsigned int) == COLOR(x)->c.green
X && va_arg (v, unsigned int) == COLOR(x)->c.blue;
X } else if (type == T_Cursor) {
X return va_arg (v, Cursor) == CURSOR(x)->cursor;
X } else if (type == T_Atom) {
X return va_arg (v, Atom) == ATOM(x)->atom;
X } else Panic ("Match_X_Obj");
X return 0;
X}
X
XObject P_Window_Unique_Id (w) Object w; {
X register id;
X
X Check_Type (w, T_Window);
X id = Unique_Id (w);
X return id > 0 ? Make_Fixnum (id) : False;
X}
X
Xinit_xlib_objects () {
X Define_Symbol (&Sym_None, "none");
X Define_Primitive (P_Window_Unique_Id, "window-unique-id", 1, 1, EVAL);
X}
END_OF_lib/xlib/objects.c
if test 1359 -ne `wc -c <lib/xlib/objects.c`; then
echo shar: \"lib/xlib/objects.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/colormap.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/colormap.c\"
else
echo shar: Extracting \"lib/xlib/colormap.c\" \(1302 characters\)
sed "s/^X//" >lib/xlib/colormap.c <<'END_OF_lib/xlib/colormap.c'
X#include "xlib.h"
X
XGeneric_Predicate (Colormap);
X
XGeneric_Equal_Dpy (Colormap, COLORMAP, cm);
X
XGeneric_Print (Colormap, "#[colormap %u]", COLORMAP(x)->cm);
X
XGeneric_Get_Display (Colormap, COLORMAP);
X
XObject Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
X register char *p;
X Object cm;
X
X if (cmap == None)
X return Sym_None;
X cm = Find_Object (T_Colormap, (GENERIC)dpy, Match_X_Obj, cmap);
X if (Nullp (cm)) {
X p = Get_Bytes (sizeof (struct S_Colormap));
X SET (cm, T_Colormap, (struct S_Colormap *)p);
X COLORMAP(cm)->tag = Null;
X COLORMAP(cm)->cm = cmap;
X COLORMAP(cm)->dpy = dpy;
X COLORMAP(cm)->free = 0;
X Register_Object (cm, (GENERIC)dpy, finalize ? P_Free_Colormap :
X (PFO)0, 0);
X }
X return cm;
X}
X
XColormap Get_Colormap (c) Object c; {
X Check_Type (c, T_Colormap);
X return COLORMAP(c)->cm;
X}
X
XObject P_Free_Colormap (c) Object c; {
X Check_Type (c, T_Colormap);
X if (!COLORMAP(c)->free)
X XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
X Deregister_Object (c);
X COLORMAP(c)->free = 1;
X return Void;
X}
X
Xinit_xlib_colormap () {
X Generic_Define (Colormap, "colormap", "colormap?");
X Define_Primitive (P_Colormap_Display, "colormap-display", 1, 1, EVAL);
X Define_Primitive (P_Free_Colormap, "free-colormap", 1, 1, EVAL);
X}
END_OF_lib/xlib/colormap.c
if test 1302 -ne `wc -c <lib/xlib/colormap.c`; then
echo shar: \"lib/xlib/colormap.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/cursor.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/cursor.c\"
else
echo shar: Extracting \"lib/xlib/cursor.c\" \(2422 characters\)
sed "s/^X//" >lib/xlib/cursor.c <<'END_OF_lib/xlib/cursor.c'
X#include "xlib.h"
X
XGeneric_Predicate (Cursor);
X
XGeneric_Equal_Dpy (Cursor, CURSOR, cursor);
X
XGeneric_Print (Cursor, "#[cursor %u]", CURSOR(x)->cursor);
X
XGeneric_Get_Display (Cursor, CURSOR);
X
XObject Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; {
X register char *p;
X Object c;
X
X if (cursor == None)
X return Sym_None;
X c = Find_Object (T_Cursor, (GENERIC)dpy, Match_X_Obj, cursor);
X if (Nullp (c)) {
X p = Get_Bytes (sizeof (struct S_Cursor));
X SET (c, T_Cursor, (struct S_Cursor *)p);
X CURSOR(c)->tag = Null;
X CURSOR(c)->cursor = cursor;
X CURSOR(c)->dpy = dpy;
X CURSOR(c)->free = 0;
X Register_Object (c, (GENERIC)dpy, P_Free_Cursor, 0);
X }
X return c;
X}
X
XCursor Get_Cursor (c) Object c; {
X if (EQ(c, Sym_None))
X return None;
X Check_Type (c, T_Cursor);
X return CURSOR(c)->cursor;
X}
X
XObject P_Free_Cursor (c) Object c; {
X Check_Type (c, T_Cursor);
X if (!CURSOR(c)->free)
X XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor);
X Deregister_Object (c);
X CURSOR(c)->free = 1;
X return Void;
X}
X
Xstatic Object P_Create_Cursor (srcp, maskp, x, y, f, b)
X Object srcp, maskp, x, y, f, b; {
X Pixmap sp = Get_Pixmap (srcp), mp;
X Display *d = PIXMAP(srcp)->dpy;
X
X mp = EQ(maskp, Sym_None) ? None : Get_Pixmap (maskp);
X return Make_Cursor (d, XCreatePixmapCursor (d, sp, mp,
X Get_Color (f), Get_Color (b), Get_Integer (x), Get_Integer (y)));
X}
X
Xstatic Object P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b)
X Object srcf, srcc, maskf, maskc, f, b; {
X Font sf = Get_Font (srcf), mf;
X Display *d = FONT(srcf)->dpy;
X
X mf = EQ(maskf, Sym_None) ? None : Get_Font (maskf);
X return Make_Cursor (d, XCreateGlyphCursor (d, sf, mf,
X Get_Integer (srcc), mf == None ? 0 : Get_Integer (maskc),
X Get_Color (f), Get_Color (b)));
X}
X
Xstatic Object P_Recolor_Cursor (c, f, b) Object c, f, b; {
X Check_Type (c, T_Cursor);
X XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f),
X Get_Color (b));
X return Void;
X}
X
Xinit_xlib_cursor () {
X Generic_Define (Cursor, "cursor", "cursor?");
X Define_Primitive (P_Cursor_Display, "cursor-display", 1, 1, EVAL);
X Define_Primitive (P_Free_Cursor, "free-cursor", 1, 1, EVAL);
X Define_Primitive (P_Create_Cursor, "create-cursor", 6, 6, EVAL);
X Define_Primitive (P_Create_Glyph_Cursor, "create-glyph-cursor",
X 6, 6, EVAL);
X Define_Primitive (P_Recolor_Cursor, "recolor-cursor", 3, 3, EVAL);
X}
END_OF_lib/xlib/cursor.c
if test 2422 -ne `wc -c <lib/xlib/cursor.c`; then
echo shar: \"lib/xlib/cursor.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/key.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/key.c\"
else
echo shar: Extracting \"lib/xlib/key.c\" \(2714 characters\)
sed "s/^X//" >lib/xlib/key.c <<'END_OF_lib/xlib/key.c'
X#include "xlib.h"
X
Xstatic Object P_Display_Min_Keycode (d) Object d; {
X Check_Type (d, T_Display);
X return Make_Integer (DISPLAY(d)->dpy->min_keycode);
X}
X
Xstatic Object P_Display_Max_Keycode (d) Object d; {
X Check_Type (d, T_Display);
X return Make_Integer (DISPLAY(d)->dpy->max_keycode);
X}
X
Xstatic Object P_Display_Keysyms_Per_Keycode (d) Object d; {
X Check_Type (d, T_Display);
X /* Force initialization: */
X Disable_Interrupts;
X (void)XKeycodeToKeysym (DISPLAY(d)->dpy, DISPLAY(d)->dpy->min_keycode, 0);
X Enable_Interrupts;
X return Make_Integer (DISPLAY(d)->dpy->keysyms_per_keycode);
X}
X
Xstatic Object P_String_To_Keysym (s) Object s; {
X register char *str;
X KeySym k;
X
X Make_C_String (s, str);
X k = XStringToKeysym (str);
X return k == NoSymbol ? False : Make_Unsigned ((unsigned)k);
X}
X
Xstatic Object P_Keysym_To_String (k) Object k; {
X register char *s;
X
X s = XKeysymToString (Get_Integer (k));
X return s ? Make_String (s, strlen (s)) : False;
X}
X
Xstatic Object P_Keycode_To_Keysym (d, k, index) Object d, k, index; {
X Object ret;
X
X Check_Type (d, T_Display);
X Disable_Interrupts;
X ret = Make_Integer (XKeycodeToKeysym (DISPLAY(d)->dpy, Get_Integer (k),
X Get_Integer (index)));
X Enable_Interrupts;
X return ret;
X}
X
Xstatic Object P_Keysym_To_Keycode (d, k) Object d, k; {
X Object ret;
X
X Check_Type (d, T_Display);
X Disable_Interrupts;
X ret = Make_Integer (XKeysymToKeycode (DISPLAY(d)->dpy, Get_Integer (k)));
X Enable_Interrupts;
X return ret;
X}
X
Xstatic Object P_Lookup_String (d, k, mask) Object d, k, mask; {
X XKeyEvent e;
X char buf[1024];
X register len;
X KeySym keysym_return;
X XComposeStatus status_return;
X
X Check_Type (d, T_Display);
X e.display = DISPLAY(d)->dpy;
X e.keycode = Get_Integer (k);
X e.state = Symbols_To_Bits (mask, 1, State_Syms);
X Disable_Interrupts;
X len = XLookupString (&e, buf, 1024, &keysym_return, &status_return);
X Enable_Interrupts;
X return Make_String (buf, len);
X}
X
Xinit_xlib_key () {
X Define_Primitive (P_Display_Min_Keycode, "display-min-keycode",
X 1, 1, EVAL);
X Define_Primitive (P_Display_Max_Keycode, "display-max-keycode",
X 1, 1, EVAL);
X Define_Primitive (P_Display_Keysyms_Per_Keycode,
X "display-keysyms-per-keycode", 1, 1, EVAL);
X Define_Primitive (P_String_To_Keysym, "string->keysym", 1, 1, EVAL);
X Define_Primitive (P_Keysym_To_String, "keysym->string", 1, 1, EVAL);
X Define_Primitive (P_Keycode_To_Keysym, "keycode->keysym", 3, 3, EVAL);
X Define_Primitive (P_Keysym_To_Keycode, "keysym->keycode", 2, 2, EVAL);
X Define_Primitive (P_Lookup_String, "lookup-string", 3, 3, EVAL);
X}
END_OF_lib/xlib/key.c
if test 2714 -ne `wc -c <lib/xlib/key.c`; then
echo shar: \"lib/xlib/key.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/label.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/label.d\"
else
echo shar: Extracting \"lib/xaw/label.d\" \(104 characters\)
sed "s/^X//" >lib/xaw/label.d <<'END_OF_lib/xaw/label.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'label "Label.h")
X
X(define-widget-class 'label 'labelWidgetClass)
END_OF_lib/xaw/label.d
if test 104 -ne `wc -c <lib/xaw/label.d`; then
echo shar: \"lib/xaw/label.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 11 \(of 14\).
cp /dev/null ark11isdone
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