Import Upstream version 5d2upstream/5d2

1 files changed, 2114 insertions, 0 deletions

diff --git a/x.c b/x.c
new file mode 100644
index 0000000..6070ef2
--- /dev/null
+++ b/x.c
@@ -0,0 +1,2114 @@
+/* Copyright (C) 1999 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.
+ */
+
+/* "x.c" SCM interface to Xlib.
+ * Authors: Aubrey Jaffer (I have rewritten nearly all of it) and:
+ *
+ * Modified by Shigenobu Kimura (skimu@izanagi.phys.s.u-tokyo.ac.jp)
+ * Author: Larry Campbell (campbell@world.std.com)
+ *
+ * Copyright 1992 by The Boston Software Works, Inc.
+ * Permission to use for any purpose whatsoever granted, as long
+ * as this copyright notice remains intact.  Please send bug fixes
+ * or enhancements to the above email address.
+ *
+ * Generic X and Xlib functions for scm.
+ * These functions do not depend on any toolkit.
+ */
+
+#include <stdio.h>
+#include <X11/X.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+
+#include "scm.h"
+
+/* These structs are mallocated for use in SMOBS. */
+
+struct xs_Display {
+  SCM after;
+  int screen_count;
+  Display *dpy;
+};
+
+/* An array of struct xs_screen (following xs_Display) holds the
+   root-windows and default colormaps. */
+
+struct xs_screen {
+  SCM root_window;
+  SCM default_gcontext;
+  SCM default_visual;
+  SCM default_colormap;
+};
+
+struct xs_Window {
+  SCM display;
+  int screen_number;
+  Display *dpy;
+  union {
+    Window win;
+    Pixmap pm;
+    Drawable drbl;
+  } p;
+};
+
+struct xs_GContext {
+  SCM display;
+  int screen_number;
+  Display *dpy;
+  GC gc;
+  SCM font;
+  SCM tile;
+  SCM stipple;
+  SCM clipmask;
+};
+
+struct xs_Cursor {
+  SCM display;
+  Cursor cursor;
+};
+
+struct xs_Font {
+  SCM display;
+  Font font;
+  SCM name;
+};
+
+struct xs_Colormap {
+  SCM display;
+  Display *dpy;
+  Colormap cm;
+};
+
+/* These structs are for returning multiple values when processing
+   procedure arguments. */
+
+struct display_screen{
+  SCM display;
+  Display *dpy;
+  int screen_number;
+};
+
+/* The cproto program fills x.h with ANSI-C prototypes of the
+   functions in x.c. */
+
+#include "x.h"
+
+	       /* Macros for accessing these structs */
+
+#define DISPLAY(x)	((struct xs_Display *)	CDR(x))
+#define WINDOW(x)	((struct xs_Window *)	CDR(x))
+#define CURSOR(x)	((struct xs_Cursor *)	CDR(x))
+#define FONT(x)		((struct xs_Font *)	CDR(x))
+#define COLORMAP(x)	((struct xs_Colormap *)	CDR(x))
+#define GCONTEXT(x)	((struct xs_GContext *)	CDR(x))
+
+#define XDISPLAY(x)	(DISPLAY(x)->dpy)
+#define XWINDOW(x)	(WINDOW(x)->p.win)
+#define XWINDISPLAY(x)	(WINDOW(x)->dpy)
+#define XCURSOR(x)	(CURSOR(x)->cursor)
+#define XFONT(x)	(FONT(x)->font)
+#define XGCONTEXT(x)	(GCONTEXT(x)->gc)
+#define XCOLORMAP(x)	(COLORMAP(x)->cm)
+#define XGCONDISPLAY(x)	(GCONTEXT(x)->dpy)
+
+/* Notice that types Visual and XEvent don't have struct wrappers. */
+
+#define XVISUAL(x)	((Visual *)		CDR(x))
+#define XEVENT(x)	((XEvent *)		CDR(x))
+
+			/* Type predicates */
+
+#define DISPLAYP(x)	(TYP16(x)==tc16_xdisplay)
+#define OPDISPLAYP(x)	(((0xffff | OPN) & (int)CAR(x))==(tc16_xdisplay | OPN))
+#define WINDOWP(x)	(TYP16(x)==tc16_xwindow)
+#define OPWINDOWP(x)	(((0xffff | OPN) & (int)CAR(x))==(tc16_xwindow | OPN))
+#define COLORMAPP(x)	(TYP16(x)==tc16_xcolormap)
+#define GCONTEXTP(x)	(TYP16(x)==tc16_xgcontext)
+#define CURSORP(x)	(TYP16(x)==tc16_xcursor)
+#define FONTP(x)	(TYP16(x)==tc16_xfont)
+#define VISUALP(x)	(TYP16(x)==tc16_xvisual)
+#define XEVENTP(x)	(TYP16(x)==tc16_xevent)
+
+		     /* Scheme Procedure Names */
+
+static char s_x_open_display[]		= "x:open-display";
+static char s_x_close[]			= "x:close";
+static char s_x_display_debug[]		= "x:display-debug";
+static char s_x_default_screen[]	= "x:default-screen";
+static char s_x_root_window[]		= "x:root-window";
+static char s_x_default_gcontext[]	= "x:default-gc";
+static char s_x_default_visual[]	= "x:default-visual";
+static char s_x_default_colormap[]	= "x:default-colormap";
+static char s_x_create_window[]		= "x:create-window";
+static char s_x_window_set[]		= "x:window-set!";
+/*  static char s_x_window_ref[]		= "x:window-ref"; */
+static char s_x_create_pixmap[]		= "x:create-pixmap";
+
+static char s_x_map_window[]		= "x:map-window";
+static char s_x_map_raised[]		= "x:map-raised";
+static char s_x_map_subwindows[]	= "x:map-subwindows";
+static char s_x_unmap_window[]		= "x:unmap-window";
+static char s_x_unmap_subwindows[]	= "x:unmap-subwindows";
+
+static char s_x_create_gc[]		= "x:create-gc";
+static char s_x_gc_set[]		= "x:gc-set!";
+static char s_x_gc_ref[]		= "x:gc-ref";
+static char s_x_copy_gc[]		= "x:copy-gc-fields!";
+
+static char s_x_create_cursor[]		= "x:create-cursor";
+
+static char s_x_load_font[]		= "x:load-font";
+
+static char s_x_protocol_version[]	= "x:protocol-version";
+static char s_x_vendor_release[]	= "x:vendor-release";
+static char s_x_server_vendor[]		= "x:server-vendor";
+static char s_x_next_event[]		= "x:next-event";
+static char s_x_peek_event[]		= "x:peek-event";
+static char s_x_events_queued[]		= "x:events-queued";
+static char s_x_q_length[]		= "x:q-length";
+static char s_x_pending[]		= "x:pending";
+static char s_x_screen_count[]		= "x:screen-count";
+static char s_x_screen_cells[]		= "x:screen-cells";
+static char s_x_screen_depths[]		= "x:screen-depths";
+static char s_x_screen_depth[]		= "x:screen-depth";
+static char s_x_screen_size[]		= "x:screen-size";
+static char s_x_screen_dimm[]		= "x:screen-dimensions";
+static char s_x_screen_white[]		= "x:screen-white";
+static char s_x_screen_black[]		= "x:screen-black";
+static char s_x_make_visual[]		= "x:make-visual";
+static char s_x_window_geometry[]	= "x:window-geometry";
+
+static char s_x_create_colormap[]	= "x:create-colormap";
+static char s_x_recreate_colormap[]	= "x:copy-colormap-and-free";
+static char s_x_alloc_color_cells[]	= "x:alloc-colormap-cells";
+static char s_x_free_color_cells[]	= "x:free-colormap-cells";
+static char s_x_find_color[]		= "x:colormap-find-color";
+static char s_x_color_set[]		= "x:colormap-set!";
+static char s_x_color_ref[]		= "x:colormap-ref";
+static char s_x_install_colormap[]	= "x:install-colormap";
+
+static char s_x_clear_area[]		= "x:clear-area";
+static char s_x_fill_rectangle[]	= "x:fill-rectangle";
+/*  static char s_x_copy_area[]		= "x:copy-area"; */
+static char s_x_draw_points[]		= "x:draw-points";
+static char s_x_draw_segments[]		= "x:draw-segments";
+static char s_x_draw_lines[]		= "x:draw-lines";
+static char s_x_fill_poly[]		= "x:fill-polygon";
+static char s_x_draw_string[]		= "x:draw-string";
+static char s_x_image_string[]		= "x:image-string";
+
+static char s_x_flush[]			= "x:flush";
+static char s_x_event_ref[]		= "x:event-ref";
+
+		       /* Type-name strings */
+
+static char s_gc[]	= "graphics-context";
+#define s_display  (&s_x_open_display[7])
+#define s_window   (&s_x_root_window[7])
+#define s_cursor   (&s_x_create_cursor[9])
+#define s_font     (&s_x_load_font[7])
+#define s_colormap (&s_x_create_colormap[9])
+
+	   /* Scheme (SMOB) types defined in this module */
+
+long tc16_xdisplay;
+long tc16_xgcontext;
+long tc16_xcolormap;
+long tc16_xwindow;
+long tc16_xcursor;
+long tc16_xfont;
+long tc16_xvisual;
+long tc16_xevent;
+
+/* We use OPN (which is already defined and used for PTOB ports) to
+   keep track of whether objects of types Display and Window are open.
+   The type xs_Window includes screen root-windows and pixmaps.  The
+   SMOB (CAR) header bits SCROOT and PXMP keep track of which type of
+   window the SMOB is. */
+
+/*  #define OPN		(1L<<16) */
+/*  #define RDNG		(2L<<16) */
+/*  #define WRTNG		(4L<<16) */
+#define SCROOT		(8L<<16)
+#define PXMP		(16L<<16)
+
+/* Utility routines for creating SCM-wrapped X structs and the SMOB
+   routines for collecting them. */
+
+SCM make_xwindow(display, screen_number, win, pxmp, rootp)
+     SCM display;
+     int screen_number;
+     Drawable win;
+     char pxmp, rootp;
+{
+  SCM z;
+  struct xs_Window *xsw;
+  DEFER_INTS;
+  z = must_malloc_cell((long)sizeof(struct xs_Window),
+		       (SCM)(tc16_xwindow | OPN
+			     | (pxmp ? PXMP : 0L)
+			     | (rootp ? SCROOT : 0L)),
+		       s_window);
+  xsw = WINDOW(z);
+  xsw->display = display;
+  xsw->dpy = XDISPLAY(display);
+  xsw->screen_number = screen_number;
+  if (pxmp) xsw->p.pm = (Pixmap)win;
+  else xsw->p.win = (Window)win;
+  ALLOW_INTS;
+  return z;
+}
+static SCM mark_xwindow(ptr)
+     SCM ptr;
+{
+  if CLOSEDP(ptr) return BOOL_F;
+  return WINDOW(ptr)->display;
+}
+static sizet free_xwindow(ptr)
+     CELLPTR ptr;
+{
+  SCM td = CAR((SCM)ptr);
+  if (!(td & OPN)) return 0;
+  if (!(td & SCROOT)) {
+    struct xs_Window *xsw = WINDOW((SCM)ptr);
+    SCM sd = xsw->display;
+    if (NIMP(sd) && OPDISPLAYP(sd)) {
+      if (td & PXMP) XFreePixmap(xsw->dpy, xsw->p.pm);
+      else XDestroyWindow(xsw->dpy, xsw->p.win);
+    }
+  }
+  must_free((char *)CDR((SCM)ptr), sizeof(struct xs_Window));
+  CAR((SCM)ptr) = td & ~OPN;
+  return sizeof(struct xs_Window);
+}
+
+SCM make_xcolormap(sdpy, cmp)
+     SCM sdpy;
+     Colormap cmp;
+{
+  SCM z;
+  struct xs_Colormap *xcm;
+  DEFER_INTS;
+  z = must_malloc_cell((long)sizeof(struct xs_Colormap),
+		       (SCM)tc16_xcolormap,
+		       s_colormap);
+  xcm = COLORMAP(z);
+  xcm->display = sdpy;
+  xcm->dpy = DISPLAY(xcm->display)->dpy;
+  xcm->cm = cmp;
+  ALLOW_INTS;
+  return z;
+}
+static SCM mark_xcolormap(ptr)
+     SCM ptr;
+{
+  if CLOSEDP(ptr) return BOOL_F;
+  return COLORMAP(ptr)->display;
+}
+static sizet free_xcolormap(ptr)
+     CELLPTR ptr;
+{
+  struct xs_Colormap *xcmp = COLORMAP((SCM)ptr);
+  SCM sdpy = xcmp->display;
+  if (NIMP(sdpy) && OPDISPLAYP(sdpy))
+    XFreeColormap(xcmp->dpy, xcmp->cm);
+  must_free((char *)CDR((SCM)ptr), sizeof(struct xs_Colormap));
+  return sizeof(struct xs_Colormap);
+}
+
+SCM make_xdisplay(d)
+     Display *d;
+{
+  SCM z;
+  struct xs_screen *scrns;
+  struct xs_Display *xsd;
+  int idx = ScreenCount(d);
+  DEFER_INTS;
+  z = must_malloc_cell((long)sizeof(struct xs_Display)
+		       + idx * sizeof(struct xs_screen),
+		       (SCM)tc16_xdisplay | OPN,
+		       s_display);
+  xsd = DISPLAY(z);
+  xsd->after = BOOL_F;
+  xsd->screen_count = idx;
+  xsd->dpy = d;
+  scrns = (struct xs_screen *)(xsd + 1);
+  while (idx--) {
+    scrns[idx].root_window = BOOL_F;
+    scrns[idx].default_gcontext = BOOL_F;
+    scrns[idx].default_visual = BOOL_F;
+    scrns[idx].default_colormap = BOOL_F;
+  }
+  ALLOW_INTS;
+  idx = xsd->screen_count;
+  while (idx--) {
+    scrns[idx].root_window =
+      make_xwindow(z, idx, RootWindow(d, idx), (char) 0, (char) 1);
+    scrns[idx].default_gcontext =
+      make_xgcontext(z, idx, XDefaultGC(d, idx), !0);
+    scrns[idx].default_colormap =
+      make_xcolormap(z, DefaultColormap(d, idx));
+    scrns[idx].default_visual =
+      make_xvisual(DefaultVisual(d, idx));
+  }
+  return z;
+}
+static SCM mark_xdisplay(ptr)
+     SCM ptr;
+{
+  if CLOSEDP(ptr) return BOOL_F;
+  {
+    struct xs_Display *xsd = DISPLAY((SCM)ptr);
+    struct xs_screen *scrns = (struct xs_screen *)(xsd + 1);
+    int idx = xsd->screen_count;
+    while (--idx) {
+      gc_mark(scrns[idx].root_window);
+      gc_mark(scrns[idx].default_gcontext);
+      gc_mark(scrns[idx].default_visual);
+      gc_mark(scrns[idx].default_colormap);
+    }
+    gc_mark(scrns[idx].root_window);
+    gc_mark(scrns[idx].default_gcontext);
+    gc_mark(scrns[idx].default_visual);
+    return scrns[idx].default_colormap;
+  }
+}
+static sizet free_xdisplay(ptr)
+     CELLPTR ptr;
+{
+  SCM td = CAR((SCM)ptr);
+  if (!(td & OPN)) return 0;
+  {
+    struct xs_Display *xsd = DISPLAY((SCM)ptr);
+    sizet len = sizeof(struct xs_Display) +
+      xsd->screen_count * sizeof(struct xs_screen);
+    XCloseDisplay(xsd->dpy);
+    must_free((char *)xsd, len);
+    CAR((SCM)ptr) = td & ~OPN;
+    return len;
+  }
+}
+
+SCM make_xgcontext(d, screen_number, gc, rootp)
+     SCM d;
+     int screen_number;
+     GC gc;
+     int rootp;
+{
+  SCM z;
+  struct xs_GContext *xgc;
+  DEFER_INTS;
+  z = must_malloc_cell((long)sizeof(struct xs_GContext),
+		       (SCM)tc16_xgcontext | (rootp ? SCROOT : 0L),
+		       s_gc);
+  xgc = GCONTEXT(z);
+  xgc->display = d;
+  xgc->screen_number = screen_number;
+  xgc->dpy = XDISPLAY(d);
+  xgc->gc = gc;
+  xgc->font = BOOL_F;
+  xgc->tile = BOOL_F;
+  xgc->stipple = BOOL_F;
+  xgc->clipmask = BOOL_F;
+  ALLOW_INTS;
+  return z;
+}
+static SCM mark_xgcontext(ptr)
+     SCM ptr;
+{
+  struct xs_GContext *xgc = GCONTEXT(ptr);
+  gc_mark(xgc->font);
+  gc_mark(xgc->tile);
+  gc_mark(xgc->stipple);
+  gc_mark(xgc->clipmask);
+  return xgc->display;
+}
+static sizet free_xgcontext(ptr)
+     CELLPTR ptr;
+{
+  SCM td = CAR((SCM)ptr);
+  if (!(td & OPN)) return 0;
+  if (!(td & SCROOT)) {
+    struct xs_GContext *xgc = GCONTEXT((SCM)ptr);
+    SCM sd = xgc->display;
+    if (NIMP(sd) && OPDISPLAYP(sd)) XFreeGC(xgc->dpy, xgc->gc);
+  }
+  must_free((char *)CDR((SCM)ptr), sizeof(struct xs_GContext));
+  return sizeof(struct xs_GContext);
+}
+
+SCM make_xcursor(display, cursor)
+     SCM display;
+     Cursor cursor;
+{
+  SCM z;
+  struct xs_Cursor *xcsr;
+  DEFER_INTS;
+  z = must_malloc_cell((long)sizeof(struct xs_Cursor),
+		       (SCM)tc16_xcursor,
+		       s_cursor);
+  xcsr = CURSOR(z);
+  xcsr->display = display;
+  xcsr->cursor = cursor;
+  ALLOW_INTS;
+  return z;
+}
+static SCM mark_xcursor(ptr)
+     SCM ptr;
+{
+  if CLOSEDP(ptr) return BOOL_F;
+  return CURSOR(ptr)->display;
+}
+static sizet free_xcursor(ptr)
+     CELLPTR ptr;
+{
+  struct xs_Cursor *xcsr = CURSOR((SCM)ptr);
+  SCM sdpy = xcsr->display;
+  if (NIMP(sdpy) && OPDISPLAYP(sdpy)) {
+    struct xs_Display *xdp = DISPLAY(sdpy);
+    XFreeCursor(xdp->dpy, xcsr->cursor);
+  }
+  must_free((char *)CDR((SCM)ptr), sizeof(struct xs_Cursor));
+  return sizeof(struct xs_Cursor);
+}
+SCM make_xfont(display, font, name)
+     SCM display;
+     Font font;
+     SCM name;
+{
+  SCM z;
+  struct xs_Font *xfnt;
+  DEFER_INTS;
+  z = must_malloc_cell((long)sizeof(struct xs_Font),
+		       (SCM)tc16_xfont,
+		       s_font);
+  xfnt = FONT(z);
+  xfnt->display = display;
+  xfnt->font = font;
+  xfnt->name = name;
+  ALLOW_INTS;
+  return z;
+}
+static SCM mark_xfont(ptr)
+     SCM ptr;
+{
+  struct xs_Font *xfn = FONT(ptr);
+  gc_mark(xfn->name);
+  return xfn->display;
+}
+static sizet free_xfont(ptr)
+     CELLPTR ptr;
+{
+  struct xs_Font *xfnt = FONT((SCM)ptr);
+  SCM sdpy = xfnt->display;
+  if (NIMP(sdpy) && OPDISPLAYP(sdpy)) {
+    struct xs_Display *xdp = DISPLAY(sdpy);
+    XUnloadFont(xdp->dpy, xfnt->font);
+  }
+  must_free((char *)CDR((SCM)ptr), sizeof(struct xs_Font));
+  return sizeof(struct xs_Font);
+}
+
+SCM make_xvisual(vsl)
+     Visual *vsl;
+{
+  SCM s_vsl;
+  NEWCELL(s_vsl);
+  DEFER_INTS;
+  CAR(s_vsl) = tc16_xvisual;
+  SETCDR(s_vsl, vsl);
+  ALLOW_INTS;
+  return s_vsl;
+}
+
+SCM make_xevent(e)
+XEvent *e;
+{
+  SCM w;
+  XEvent *ec;
+
+  ec = (XEvent *) must_malloc(sizeof(XEvent), "X event");
+  (void)memcpy(ec, e, sizeof(XEvent));
+  NEWCELL(w);
+  DEFER_INTS;
+  CAR(w) = tc16_xevent;
+  SETCDR(w,ec);
+  ALLOW_INTS;
+  return w;
+}
+sizet x_free_xevent(ptr)
+     CELLPTR ptr;
+{
+  must_free(CHARS(ptr), sizeof(XEvent));
+  return sizeof(XEvent);
+}
+
+/* Utility macro and functions for checking and coercing SCM arguments. */
+
+#define GET_NEXT_INT(result, args, err, rtn) \
+	ASSERT(NIMP(args) && CONSP(args) && INUMP(CAR(args)), args, err, rtn); \
+	result = INUM(CAR(args)); \
+	args = CDR(args);
+
+void scm2XPoint(signp, dat, ipr, pos, s_caller)
+     int signp;
+     SCM dat;
+     XPoint *ipr;
+     char *pos, *s_caller;
+{
+  SCM x, y;
+  if IMP(dat) badarg: wta(dat, pos, s_caller);
+  if CONSP(dat) {
+    if INUMP(CDR(dat)) {
+      x = CAR(dat);
+      y = CDR(dat);
+    }
+    else {
+      ASRTGO(2==ilength(dat), badarg);
+      x = CAR(dat);
+      y = CAR(CDR(dat));
+    }
+  }
+  else switch TYP7(dat) {
+  default: goto badarg;
+  case tc7_vector:
+    ASRTGO(2==LENGTH(dat), badarg);
+    x = VELTS(dat)[0];
+    y = VELTS(dat)[1];
+    break;
+  case tc7_uvect: case tc7_ivect:
+    ASRTGO(2==LENGTH(dat), badarg);
+    x = MAKINUM(((long *)VELTS(dat))[0]);
+    y = MAKINUM(((long *)VELTS(dat))[1]);
+    break;
+  case tc7_svect:
+    ASRTGO(2==LENGTH(dat), badarg);
+    x = MAKINUM(((short *)VELTS(dat))[0]);
+    y = MAKINUM(((short *)VELTS(dat))[1]);
+    break;
+  case tc7_smob:
+    ASRTGO(ARRAYP(dat) && 1==ARRAY_NDIM(dat) &&
+	   0==ARRAY_DIMS(dat)[0].lbnd && 1==ARRAY_DIMS(dat)[0].ubnd,
+	   badarg);
+      x = aref(dat, MAKINUM(0));
+      y = aref(dat, MAKINUM(1));
+      break;
+  }
+  ASRTGO(INUMP(x) && INUMP(y), badarg);
+  ipr->x = INUM(x);
+  ipr->y = INUM(y);
+  ASRTGO((ipr->x==INUM(x)) && (ipr->y==INUM(y))
+	 && (signp ? !0 : ((x >= 0) && (y >= 0))), badarg);
+}
+int scm2XColor(s_dat, xclr)
+     SCM s_dat;
+     XColor *xclr;
+{
+  SCM dat = s_dat;
+  unsigned int ura[3];
+  int idx;
+/*    if INUMP(dat) { */
+/*      xclr->red   = (dat>>16 & 0x00ff) * 0x0101; */
+/*      xclr->green = (dat>>8  & 0x00ff) * 0x0101; */
+/*      xclr->blue  = (dat     & 0x00ff) * 0x0101; */
+/*    } */
+/*    else */
+  if IMP(dat) return 0;
+  else if (3==ilength(dat))
+    for (idx = 0; idx < 3; idx++) {
+      SCM clr = CAR(dat);
+      if (!INUMP(clr)) return 0;
+      ura[idx] = INUM(clr);
+      dat = CDR(dat);
+    }
+  else if (VECTORP(dat) && (3==LENGTH(dat)))
+    for (idx = 0; idx < 3; idx++) {
+      if (!INUMP(VELTS(dat)[idx])) return 0;
+      ura[idx] = INUM(VELTS(dat)[idx]);
+    }
+  else return 0;
+  xclr->red = ura[0];
+  xclr->green = ura[1];
+  xclr->blue = ura[2];
+  return !0;
+}
+int scm2xpointslen(sara, s_caller)
+     SCM sara;
+     char *s_caller;
+{
+  array_dim *adm;
+  int len;
+  if (!(NIMP(sara) && ARRAYP(sara) && 2==ARRAY_NDIM(sara))) return -1;
+  adm = ARRAY_DIMS(sara);
+  if (!((1==(adm[1].ubnd - adm[1].lbnd))
+	&& (1==adm[1].inc)
+	&& ARRAY_CONTP(sara)
+	&& (tc7_svect==TYP7(ARRAY_V(sara))))) return -1;
+  len = adm[0].ubnd - adm[0].lbnd;
+  if (len < 0) return 0;
+  return len;
+}
+void scm2display_screen(dat, optidx, dspscn, s_caller)
+     SCM dat;
+     SCM optidx;
+     struct display_screen *dspscn;
+     char *s_caller;
+{
+  ASRTGO(NIMP(dat), badarg);
+  if OPDISPLAYP(dat) {
+    dspscn->display = dat;
+    dspscn->dpy = XDISPLAY(dat);
+    if UNBNDP(optidx) dspscn->screen_number = DefaultScreen(dspscn->dpy);
+    else if (INUMP(optidx) && (INUM(optidx) < DISPLAY(dat)->screen_count))
+      dspscn->screen_number = INUM(optidx);
+    else wta(optidx, (char *)ARG2, s_caller);
+  }
+  else if OPWINDOWP(dat) {
+    struct xs_Window *xsw = WINDOW(dat);
+    dspscn->display = xsw->display;
+    dspscn->dpy = xsw->dpy;
+    dspscn->screen_number = xsw->screen_number;
+    ASRTGO(UNBNDP(optidx), badarg);
+  }
+  else badarg: wta(dat, (char *)ARG1, s_caller);
+}
+
+#define OpPxmpMask (0xffff | OPN | PXMP)
+#define OpPxmp (tc16_xwindow | OPN | PXMP)
+
+SCM thevalue(obj)
+     SCM obj;
+{
+  if (NIMP(obj) && SYMBOLP(obj))
+    return ceval(obj, (SCM)EOL);
+  else return obj;
+}
+
+Pixmap thepxmap(obj, s_caller)
+     SCM obj;
+     char *s_caller;
+{
+  if (FALSEP(obj) || (INUM0==obj)) return 0L;
+  ASSERT(NIMP(obj) && ((OpPxmpMask & (int)CAR(obj))==OpPxmp),
+	 obj, ARGn, s_caller);
+  return WINDOW(obj)->p.pm;
+}
+Font thefont(obj, s_caller)
+     SCM obj;
+     char *s_caller;
+{
+  ASSERT(NIMP(obj) && FONTP(obj), obj, ARGn, s_caller);
+  return FONT(obj)->font;
+}
+Colormap thecmap(obj, s_caller)
+     SCM obj;
+     char *s_caller;
+{
+  if (FALSEP(obj) || (INUM0==obj)) return 0L;
+  ASSERT(NIMP(obj) && COLORMAPP(obj), obj, ARGn, s_caller);
+  return COLORMAP(obj)->cm;
+}
+Cursor thecsr(obj, s_caller)
+     SCM obj;
+     char *s_caller;
+{
+  if (FALSEP(obj) || (INUM0==obj)) return 0L;
+  ASSERT(NIMP(obj) && CURSORP(obj), obj, ARGn, s_caller);
+  return CURSOR(obj)->cursor;
+}
+Bool thebool(obj, s_caller)
+     SCM obj;
+     char *s_caller;
+{
+  SCM val = thevalue(obj);
+  ASSERT(BOOL_F==val || BOOL_T==val, obj, ARGn, s_caller);
+  return NFALSEP(val);
+}
+int theint(obj, s_caller)
+     SCM obj;
+     char *s_caller;
+{
+  SCM val = thevalue(obj);
+  ASSERT(INUMP(val), obj, ARGn, s_caller);
+  return INUM(val);
+}
+int theuint(obj, s_caller)
+     SCM obj;
+     char *s_caller;
+{
+  SCM val = thevalue(obj);
+  ASSERT(INUMP(val) && (0 <= INUM(val)), obj, ARGn, s_caller);
+  return INUM(val);
+}
+
+static int args2xgcvalmask(oargs)
+     SCM oargs;
+{
+  SCM args = oargs;
+  int attr, len, attr_mask = 0;
+  if (!(len = ilength(args))) return 0;
+  while (len) {
+    ASSERT(NIMP(args), oargs, WNA, s_gc);
+    attr = theint(CAR(args), s_gc); args = CDR(args);
+    attr_mask |= attr;
+    len -= 1;
+  }
+  return attr_mask;
+}
+static int args2xgcvalues(sgc, vlu, oargs)
+     SCM sgc;
+     XGCValues *vlu;
+     SCM oargs;
+{
+  struct xs_GContext *xgc = GCONTEXT(sgc);
+  SCM sval, args = oargs;
+  int attr, len, attr_mask = 0;
+/*    (void)memset((char *)vlu, 0, sizeof(XGCValues)); */
+  if (!(len = ilength(args))) return 0;
+  ASSERT(len > 0 && (! (len & 1)), oargs, WNA, s_gc);
+  while (len) {
+    ASSERT(NIMP(args), oargs, WNA, s_gc);
+    attr = theint(CAR(args), s_gc); args = CDR(args);
+    ASSERT(NIMP(args), oargs, WNA, s_gc);
+    sval = CAR(args); args = CDR(args);
+    attr_mask |= attr;
+    switch (attr) {
+
+    case GCFunction:	vlu->function	=  theint(sval, s_gc); break;
+    case GCPlaneMask:	vlu->plane_mask	= theuint(sval, s_gc); break;
+    case GCForeground:	vlu->foreground	= theuint(sval, s_gc); break;
+    case GCBackground:	vlu->background	= theuint(sval, s_gc); break;
+    case GCLineWidth:	vlu->line_width	=  theint(sval, s_gc); break;
+    case GCLineStyle:	vlu->line_style	=  theint(sval, s_gc); break;
+    case GCCapStyle:	vlu->cap_style	=  theint(sval, s_gc); break;
+    case GCJoinStyle:	vlu->join_style	=  theint(sval, s_gc); break;
+    case GCFillStyle:	vlu->fill_style	=  theint(sval, s_gc); break;
+    case GCFillRule:	vlu->fill_rule	=  theint(sval, s_gc); break;
+    case GCTile:	vlu->tile	= thepxmap(sval, s_gc);
+      xgc->tile = sval;
+      break;
+    case GCStipple:	vlu->stipple	= thepxmap(sval, s_gc);
+      xgc->stipple = sval;
+      break;
+    case GCTileStipXOrigin: vlu->ts_x_origin = theint(sval, s_gc); break;
+    case GCTileStipYOrigin: vlu->ts_y_origin = theint(sval, s_gc); break;
+    case (GCTileStipXOrigin | GCTileStipYOrigin): {
+      XPoint position;
+      scm2XPoint(!0, sval, &position, (char *)ARGn, s_gc);
+      vlu->ts_x_origin = position.x;
+      vlu->ts_y_origin = position.y;
+    } break;
+    case GCFont:	vlu->font	= thefont(sval, s_gc);
+      xgc->font = sval;
+      break;
+    case GCSubwindowMode: vlu->subwindow_mode = theint(sval, s_gc); break;
+    case GCGraphicsExposures: vlu->graphics_exposures = thebool(sval, s_gc); break;
+    case GCClipXOrigin:	vlu->clip_x_origin = theint(sval, s_gc); break;
+    case GCClipYOrigin:	vlu->clip_y_origin = theint(sval, s_gc); break;
+    case (GCClipXOrigin | GCClipYOrigin): {
+      XPoint position;
+      scm2XPoint(!0, sval, &position, (char *)ARGn, s_gc);
+      vlu->clip_x_origin = position.x;
+      vlu->clip_y_origin = position.y;
+    } break;
+    case GCClipMask:	vlu->clip_mask	= thepxmap(sval, s_gc);
+      xgc->clipmask = sval;
+      break;
+    case GCDashOffset:	vlu->dash_offset = theint(sval, s_gc); break;
+    case GCDashList:	vlu->dashes	= (char)theint(sval, s_gc); break;
+    case GCArcMode:	vlu->arc_mode	= theint(sval, s_gc); break;
+
+    default: ASSERT(0, MAKINUM(attr), ARGn, s_gc);
+    }
+    len -= 2;
+  }
+  return attr_mask;
+}
+static int args2winattribs(vlu, oargs)
+     XSetWindowAttributes *vlu;
+     SCM oargs;
+{
+  SCM sval, args = oargs;
+  int attr, len, attr_mask = 0;
+  /* (void)memset((char *)vlu, 0, sizeof(XSetWindowAttributes)); */
+  if (!(len = ilength(args))) return 0;
+  ASSERT(len > 0 && (! (len & 1)), oargs, WNA, s_window);
+  while (len) {
+    ASSERT(NIMP(args), oargs, WNA, s_window);
+    attr = theint(CAR(args), s_window); args = CDR(args);
+    ASSERT(NIMP(args), oargs, WNA, s_window);
+    sval = CAR(args); args = CDR(args);
+    attr_mask |= attr;
+    switch (attr) {
+
+    case CWBackPixmap:	vlu->background_pixmap=thepxmap(sval, s_window); break;
+    case CWBackPixel:	vlu->background_pixel = theuint(sval, s_window); break;
+    case CWBorderPixmap:vlu->border_pixmap    =thepxmap(sval, s_window); break;
+    case CWBorderPixel:	vlu->border_pixel     = theuint(sval, s_window); break;
+    case CWBitGravity:	vlu->bit_gravity      =  theint(sval, s_window); break;
+    case CWWinGravity:	vlu->win_gravity      =  theint(sval, s_window); break;
+    case CWBackingStore:vlu->backing_store    =  theint(sval, s_window); break;
+    case CWBackingPlanes:vlu->backing_planes  = theuint(sval, s_window); break;
+    case CWBackingPixel:vlu->backing_pixel    = theuint(sval, s_window); break;
+    case CWOverrideRedirect:vlu->override_redirect =
+						thebool(sval, s_window); break;
+    case CWSaveUnder:	vlu->save_under	      = thebool(sval, s_window); break;
+    case CWEventMask:	vlu->event_mask	      =  theint(sval, s_window); break;
+    case CWDontPropagate:vlu->do_not_propagate_mask =
+						thebool(sval, s_window); break;
+    case CWColormap:	vlu->colormap	      = thecmap(sval, s_window); break;
+    case CWCursor:	vlu->cursor	      =  thecsr(sval, s_window); break;
+
+    default: ASSERT(0, MAKINUM(attr), ARGn, s_window);
+    }
+    len -= 2;
+  }
+  return attr_mask;
+}
+
+		   /* Scheme-visible procedures */
+
+SCM x_open_display(dpy_name)
+     SCM dpy_name;
+{
+  Display *display;
+  if FALSEP(dpy_name) dpy_name = nullstr;
+  ASSERT(NIMP(dpy_name) && STRINGP(dpy_name), dpy_name, ARG1, s_x_open_display);
+  display = XOpenDisplay(CHARS(dpy_name));
+  return (display ? make_xdisplay(display) : BOOL_F);
+}
+SCM x_display_debug(sd, si)
+     SCM sd, si;
+{
+  int (*previous_after_function)();
+  struct display_screen dspscn;
+  scm2display_screen(sd, UNDEFINED, &dspscn, s_x_display_debug);
+  previous_after_function =
+    XSynchronize(dspscn.dpy, thebool(si, s_x_display_debug));
+  return UNSPECIFIED;
+}
+SCM x_default_screen(sdpy)
+     SCM sdpy;
+{
+  ASSERT(NIMP(sdpy) && OPDISPLAYP(sdpy), sdpy, ARG1, s_x_default_screen);
+  return MAKINUM(DefaultScreen(XDISPLAY(sdpy)));
+}
+
+SCM x_create_window(swin, spos, sargs)
+     SCM swin, spos, sargs;
+{
+  XPoint position, size;
+  unsigned int border_width;
+  Window window;
+  int len = ilength(sargs);
+
+  ASSERT(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_create_window);
+  scm2XPoint(!0, spos, &position, (char *)ARG2, s_x_create_window);
+  scm2XPoint(0, CAR(sargs), &size, (char *)ARG3, s_x_create_window);
+  sargs = CDR(sargs);
+  GET_NEXT_INT(border_width, sargs, ARG4, s_x_create_window);
+  if (4==len) {
+    unsigned long border;
+    unsigned long background;
+    GET_NEXT_INT(border, sargs, ARG5, s_x_create_window);
+    GET_NEXT_INT(background, sargs, ARGn, s_x_create_window);
+    window = XCreateSimpleWindow(XWINDISPLAY(swin), XWINDOW(swin),
+				 position.x, position.y, /* initial placement */
+				 size.x, size.y,
+				 border_width,
+				 border, background); /* pixel values */
+  } else {
+    int depth;
+    unsigned int class;
+    SCM svis;
+    unsigned long valuemask;
+    XSetWindowAttributes attributes;
+    ASSERT(5 <= len, sargs, WNA, s_x_create_window);
+    GET_NEXT_INT(depth, sargs, ARG5, s_x_create_window);
+    GET_NEXT_INT(class, sargs, ARGn, s_x_create_window);
+    svis = CAR(sargs); sargs = CDR(sargs);
+    ASSERT(NIMP(svis) && VISUALP(svis), svis, ARGn, s_x_create_window);
+    valuemask = args2winattribs(&attributes, sargs);
+    window = XCreateWindow(XWINDISPLAY(swin), XWINDOW(swin),
+			   position.x, position.y, /* initial placement */
+			   size.x, size.y,
+			   border_width,
+			   depth,
+			   class,
+			   XVISUAL(svis),
+			   valuemask,
+			   &attributes);
+  }
+  return window ? make_xwindow(WINDOW(swin)->display,
+			       WINDOW(swin)->screen_number,
+			       window, (char) 0, (char) 0)
+    : BOOL_F;
+}
+SCM x_create_pixmap(obj, s_size, s_depth)
+     SCM obj, s_size, s_depth;
+{
+  unsigned int depth = INUM(s_depth);
+  SCM display;
+  Display *dpy;
+  int scn;
+  Drawable drawable;
+  Pixmap p;
+  XPoint size;
+  if IMP(obj) badarg1: wta(obj, (char *)ARG1, s_x_create_pixmap);
+  if OPDISPLAYP(obj) {
+    display = obj;
+    dpy = XDISPLAY(display);
+    scn = DefaultScreen(dpy);
+    drawable = RootWindow(dpy, scn);
+  }
+  else if OPWINDOWP(obj) {
+    display = WINDOW(obj)->display;
+    dpy = XDISPLAY(display);
+    scn = WINDOW(obj)->screen_number;
+    drawable = WINDOW(obj)->p.drbl;
+  }
+  else goto badarg1;
+  scm2XPoint(0, s_size, &size, (char *)ARG2, s_x_create_pixmap);
+  ASSERT(INUMP(s_depth) && depth >= 0, s_depth, ARG3, s_x_create_pixmap);
+  p = XCreatePixmap(dpy, drawable, size.x, size.y, depth);
+  return make_xwindow(display, scn, p, (char) 1, (char) 0);
+}
+SCM x_window_set(args)
+     SCM args;
+{
+  SCM swn;
+  struct xs_Window *xwn;
+  XSetWindowAttributes vlu;
+  unsigned long mask;
+
+  ASSERT(NIMP(args), args, WNA, s_x_window_set);
+  swn = CAR(args); args = CDR(args);
+  ASSERT(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_set);
+  xwn = WINDOW(swn);
+  mask = args2winattribs(&vlu, args);
+  XChangeWindowAttributes(xwn->dpy, xwn->p.win, mask, &vlu);
+  return UNSPECIFIED;
+}
+
+SCM x_window_geometry(swin)
+     SCM swin;
+{
+  struct xs_Window *sxw;
+  Window root;
+  Status sts;
+  int x, y;
+  unsigned int w, h, border_width, depth;
+
+  ASSERT(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_window_geometry);
+  sxw = WINDOW(swin);
+  sts = XGetGeometry(sxw->dpy, sxw->p.drbl, &root, &x, &y,
+		     &w, &h, &border_width, &depth);
+  if (!sts) return BOOL_F;
+  return cons2(cons2(MAKINUM(x), MAKINUM(y), EOL),
+	       cons2(MAKINUM(w), MAKINUM(h), EOL),
+	       cons2(MAKINUM(border_width), MAKINUM(depth), EOL));
+}
+
+SCM x_close(obj)
+     SCM obj;
+{
+  ASSERT(NIMP(obj), obj, ARG1, s_x_close);
+  if WINDOWP(obj) {
+    Display *dpy;
+    ASSERT(!(CAR((SCM)obj) & SCROOT), obj, ARG1, s_x_close);
+    if CLOSEDP(obj) return UNSPECIFIED;
+    DEFER_INTS;
+    dpy = XWINDISPLAY(obj);
+    free_xwindow((CELLPTR)obj);
+    XFlush(dpy);
+    ALLOW_INTS;
+  } else {
+    ASSERT(DISPLAYP(obj), obj, ARG1, s_x_close);
+    DEFER_INTS;
+    free_xdisplay((CELLPTR)obj);
+    ALLOW_INTS;
+  }
+  return UNSPECIFIED;
+}
+SCM x_flush(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  if (NIMP(sd) && UNBNDP(si) && GCONTEXTP(sd)) {
+    dspscn.dpy = XGCONDISPLAY(sd);
+    XFlushGC(dspscn.dpy, XGCONTEXT(sd));
+  } else {
+    scm2display_screen(sd, si, &dspscn, s_x_flush);
+    XFlush(dspscn.dpy);
+  }
+  return UNSPECIFIED;
+}
+			   /* Colormaps */
+
+SCM x_create_colormap(swin, s_vis, s_alloc)
+     SCM swin, s_vis, s_alloc;
+{
+  SCM alloc;
+  int allo;
+  struct xs_Window *sxw;
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_create_colormap);
+  sxw = WINDOW(swin);
+  ASSERT(NIMP(s_vis) && VISUALP(s_vis), s_vis, ARG2, s_x_create_colormap);
+  alloc = thevalue(s_alloc);
+  allo = INUM(alloc);
+  ASSERT(INUMP(alloc) && (allo==AllocNone || allo==AllocAll),
+	 s_alloc, ARG3, s_x_create_colormap);
+  return make_xcolormap(sxw->display,
+			XCreateColormap(sxw->dpy, sxw->p.win,
+					XVISUAL(s_vis), allo));
+}
+SCM x_recreate_colormap(s_cm)
+     SCM s_cm;
+{
+  struct xs_Colormap *sxw;
+  ASSERT(NIMP(s_cm) && COLORMAPP(s_cm), s_cm, ARG1, s_x_recreate_colormap);
+  sxw = COLORMAP(s_cm);
+  return make_xcolormap(sxw->display,
+			XCopyColormapAndFree(XDISPLAY(sxw->display), sxw->cm));
+}
+SCM x_install_colormap(s_cm, s_flg)
+     SCM s_cm, s_flg;
+{
+  struct xs_Colormap *xcm;
+  ASSERT(NIMP(s_cm) && COLORMAPP(s_cm), s_cm, ARG1, s_x_install_colormap);
+  if UNBNDP(s_flg) s_flg = BOOL_T;
+  xcm = COLORMAP(s_cm);
+  if FALSEP(s_flg) XUninstallColormap(XDISPLAY(xcm->display), xcm->cm);
+  XInstallColormap(XDISPLAY(xcm->display), xcm->cm);
+  return UNSPECIFIED;
+}
+		       /* Colors in Colormap */
+
+SCM x_alloc_color_cells(scmap, spxls, sargs)
+     SCM scmap, spxls, sargs;
+{
+  XColor xclr;
+  Status sts;
+  struct xs_Colormap *xcm;
+  Bool contig = 0;
+  SCM pxra, plra;
+  unsigned int npixels, nplanes;
+  ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_alloc_color_cells);
+  xcm = COLORMAP(scmap);
+  npixels = INUM(spxls);
+  ASSERT(INUMP(spxls) && npixels > 0, spxls, ARG2, s_x_alloc_color_cells);
+  pxra = make_uve(npixels, MOST_POSITIVE_FIXNUM); /* Uniform vector of long */
+  switch (ilength(sargs) + 2) {
+  default: wta(sargs, (char *)WNA, s_x_alloc_color_cells);
+  case 3: case 4:
+    if (scm2XColor(CAR(sargs), &xclr)) {
+      unsigned long rmask_return, gmask_return, bmask_return;
+      sargs = CDR(sargs);
+      if NNULLP(sargs) contig = thebool(CAR(sargs), s_x_alloc_color_cells);
+      sts = XAllocColorPlanes(xcm->dpy, xcm->cm, contig,
+			      VELTS(pxra), npixels,
+			      xclr.red, xclr.green, xclr.blue,
+			      &rmask_return, &gmask_return, &bmask_return);
+      if (!sts) return BOOL_F;
+      return cons2(pxra, MAKINUM(rmask_return),
+		   cons2(MAKINUM(gmask_return),
+			 MAKINUM(bmask_return), EOL));
+    }
+    nplanes = theuint(CAR(sargs), s_x_alloc_color_cells);
+    sargs = CDR(sargs);
+    if NNULLP(sargs) contig = thebool(CAR(sargs), s_x_alloc_color_cells);
+    plra = make_uve(nplanes, MOST_POSITIVE_FIXNUM); /* Uniform vector of long */
+    sts = XAllocColorCells(xcm->dpy, xcm->cm, contig,
+			   VELTS(plra), nplanes, VELTS(pxra), npixels);
+    if (!sts) return BOOL_F;
+    return cons2(pxra, plra, EOL);
+  }
+}
+SCM x_free_color_cells(scmap, spxls, sargs)
+     SCM scmap, spxls, sargs;
+{
+  struct xs_Colormap *xcm;
+  unsigned int planes = 0;
+  ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_free_color_cells);
+  xcm = COLORMAP(scmap);
+  ASSERT(NIMP(spxls) && (TYP7(spxls)==tc7_uvect), spxls, ARG2,
+	 s_x_free_color_cells);
+  switch (ilength(sargs) + 2) {
+  default: wta(sargs, (char *)WNA, s_x_free_color_cells);
+  case 4:
+    planes = theuint(CAR(sargs), s_x_free_color_cells);
+  case 3:
+    XFreeColors(xcm->dpy, xcm->cm, VELTS(spxls), INUM(spxls), planes);
+    return UNSPECIFIED;
+  }
+}
+
+SCM x_find_color(scmap, dat)
+     SCM scmap, dat;
+{
+  XColor xclr;
+  struct xs_Colormap *xcm;
+  (void)memset((char *)&xclr, 0, sizeof(xclr));
+  ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_find_color);
+  xcm = COLORMAP(scmap);
+  if (!scm2XColor(dat, &xclr)) {
+    ASSERT(NIMP(dat) && STRINGP(dat), dat, (char*)ARG2, s_x_find_color);
+    if (XAllocNamedColor(xcm->dpy, xcm->cm, CHARS(dat), &xclr, &xclr))
+      return MAKINUM(xclr.pixel);
+    else return BOOL_F;
+  }
+  if (XAllocColor(xcm->dpy, xcm->cm, &xclr))
+    return MAKINUM(xclr.pixel);
+  else return BOOL_F;
+}
+SCM x_color_set(scmap, s_pix, dat)
+     SCM scmap, s_pix, dat;
+{
+  XColor xclr;
+  struct xs_Colormap *xcm;
+  (void)memset((char *)&xclr, 0, sizeof(xclr));
+  ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_color_set);
+  ASSERT(INUMP(s_pix), s_pix, ARG2, s_x_color_set);
+  xcm = COLORMAP(scmap);
+  xclr.pixel = INUM(s_pix);
+  xclr.flags = DoRed | DoGreen | DoBlue;
+  if (!scm2XColor(dat, &xclr)) {
+    ASSERT(NIMP(dat) && STRINGP(dat), dat, (char*)ARG3, s_x_color_set);
+    XStoreNamedColor(xcm->dpy, xcm->cm, CHARS(dat), xclr.pixel, xclr.flags);
+  }
+  else XStoreColor(xcm->dpy, xcm->cm, &xclr);
+  return UNSPECIFIED;
+}
+SCM x_color_ref(scmap, sidx)
+     SCM scmap, sidx;
+{
+  XColor xclr;
+  struct xs_Colormap *xcm;
+  (void)memset((char *)&xclr, 0, sizeof(xclr));
+  ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_color_ref);
+  xcm = COLORMAP(scmap);
+  ASSERT(INUMP(sidx), sidx, (char*)ARG2, s_x_color_ref);
+  xclr.pixel = INUM(sidx);
+  XQueryColor(xcm->dpy, xcm->cm, &xclr);
+  if (xclr.flags==(DoRed | DoGreen | DoBlue))
+    return cons2(MAKINUM(xclr.red), MAKINUM(xclr.green),
+		 cons(MAKINUM(xclr.blue), EOL));
+  else return BOOL_F;
+}
+
+			 /* Window Mapping */
+
+SCM x_map_window(swin)
+     SCM swin;
+{
+  struct xs_Window *w;
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window);
+  w = WINDOW(swin);
+  XMapWindow(w->dpy, w->p.win);
+  return UNSPECIFIED;
+}
+SCM x_map_raised(swin)
+     SCM swin;
+{
+  struct xs_Window *w;
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_raised);
+  w = WINDOW(swin);
+  XMapRaised(w->dpy, w->p.win);
+  return UNSPECIFIED;
+}
+SCM x_map_subwindows(swin)
+     SCM swin;
+{
+  struct xs_Window *w;
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_subwindows);
+  w = WINDOW(swin);
+  XMapSubwindows(w->dpy, w->p.win);
+  return UNSPECIFIED;
+}
+SCM x_unmap_window(swin)
+     SCM swin;
+{
+  struct xs_Window *w;
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_unmap_window);
+  w = WINDOW(swin);
+  XUnmapWindow(w->dpy, w->p.win);
+  return UNSPECIFIED;
+}
+SCM x_unmap_subwindows(swin)
+     SCM swin;
+{
+  struct xs_Window *w;
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_unmap_subwindows);
+  w = WINDOW(swin);
+  XUnmapSubwindows(w->dpy, w->p.win);
+  return UNSPECIFIED;
+}
+
+SCM x_create_gc(args)
+     SCM args;
+{
+  SCM swin;
+  struct xs_Window *xsw;
+  struct xs_GContext *xgc;
+  XGCValues v;
+  unsigned long mask;
+  SCM ans;
+
+  ASSERT(NIMP(args), args, WNA, s_x_create_gc);
+  swin = CAR(args); args = CDR(args);
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_create_gc);
+  xsw = WINDOW(swin);
+  ans = make_xgcontext(xsw->display, xsw->screen_number,
+		       XCreateGC(xsw->dpy, xsw->p.drbl, 0L, &v), 0);
+  xgc = GCONTEXT(ans);
+  mask = args2xgcvalues(ans, &v, args);
+  XChangeGC(xgc->dpy, xgc->gc, mask, &v);
+  return ans;
+}
+SCM x_gc_set(args)
+     SCM args;
+{
+  SCM sgc;
+  struct xs_GContext *xgc;
+  XGCValues v;
+  unsigned long mask;
+
+  ASSERT(NIMP(args), args, WNA, s_x_gc_set);
+  sgc = CAR(args); args = CDR(args);
+  ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG1, s_x_gc_set);
+  xgc = GCONTEXT(sgc);
+  mask = args2xgcvalues(sgc, &v, args);
+  XChangeGC(xgc->dpy, xgc->gc, mask, &v);
+  return UNSPECIFIED;
+}
+SCM x_copy_gc(dst, src, args)
+     SCM dst;
+     SCM src;
+     SCM args;
+{
+  struct xs_GContext *dgc, *sgc;
+  unsigned long mask;
+
+  ASSERT(NIMP(dst) && GCONTEXTP(dst), dst, ARG1, s_x_copy_gc);
+  ASSERT(NIMP(src) && GCONTEXTP(src), src, ARG2, s_x_copy_gc);
+  dgc = GCONTEXT(dst);
+  sgc = GCONTEXT(src);
+  mask = args2xgcvalmask(args);
+  XCopyGC(dgc->dpy, sgc->gc, mask, dgc->gc);
+  return UNSPECIFIED;
+}
+SCM x_gc_ref(oargs)
+     SCM oargs;
+{
+  SCM sgc, args = oargs, sval = BOOL_F;
+  SCM vals = cons(BOOL_T, EOL), valend = vals;
+  struct xs_GContext *xgc;
+  unsigned long valuemask;
+  XGCValues vlu;
+  int attr, len = ilength(args);
+/*    (void)memset((char *)&vlu, 0, sizeof(XGCValues)); */
+  ASSERT(len > 0, oargs, WNA, s_x_gc_ref);
+  if (1==len--) return EOL;
+  sgc = CAR(args); args = CDR(args);
+  xgc = GCONTEXT(sgc);
+  valuemask = args2xgcvalmask(args);
+/*    printf("valuemask = %lx\n", valuemask); */
+  valuemask &= (GCFunction | GCPlaneMask | GCForeground | GCBackground |
+		GCLineWidth | GCLineStyle | GCCapStyle | GCJoinStyle |
+		GCFillStyle | GCFillRule |
+		GCTileStipXOrigin | GCTileStipYOrigin |
+		GCSubwindowMode | GCGraphicsExposures |
+		GCClipXOrigin | GCClipYOrigin | GCDashOffset | GCArcMode);
+  if (!XGetGCValues(xgc->dpy, xgc->gc, valuemask, &vlu)) return BOOL_F;
+  while (len) {
+    attr = theint(CAR(args), s_gc); args = CDR(args);
+    switch (attr) {
+
+    case GCFunction:	sval = MAKINUM(vlu.function  ); break;
+    case GCPlaneMask:	sval = MAKINUM(vlu.plane_mask); break;
+    case GCForeground:	sval = MAKINUM(vlu.foreground); break;
+    case GCBackground:	sval = MAKINUM(vlu.background); break;
+    case GCLineWidth:	sval = MAKINUM(vlu.line_width); break;
+    case GCLineStyle:	sval = MAKINUM(vlu.line_style); break;
+    case GCCapStyle:	sval = MAKINUM(vlu.cap_style ); break;
+    case GCJoinStyle:	sval = MAKINUM(vlu.join_style); break;
+    case GCFillStyle:	sval = MAKINUM(vlu.fill_style); break;
+    case GCFillRule:	sval = MAKINUM(vlu.fill_rule ); break;
+    case GCTile:	sval = xgc->tile; break;
+    case GCStipple:	sval = xgc->stipple; break;
+    case GCTileStipXOrigin: sval = MAKINUM(vlu.ts_x_origin); break;
+    case GCTileStipYOrigin: sval = MAKINUM(vlu.ts_y_origin); break;
+    case (GCTileStipXOrigin | GCTileStipYOrigin):
+      sval = cons2(MAKINUM(vlu.ts_x_origin), MAKINUM(vlu.ts_y_origin), EOL);
+      break;
+    case GCFont:	sval = xgc->font; break;
+    case GCSubwindowMode: sval = MAKINUM(vlu.subwindow_mode); break;
+    case GCGraphicsExposures:
+      sval = x_make_bool(vlu.graphics_exposures); break;
+    case GCClipXOrigin:	sval = MAKINUM(vlu.clip_x_origin); break;
+    case GCClipYOrigin:	sval = MAKINUM(vlu.clip_y_origin); break;
+    case (GCClipXOrigin | GCClipYOrigin):
+      sval = cons2(MAKINUM(vlu.clip_x_origin),
+		    MAKINUM(vlu.clip_y_origin), EOL);
+      break;
+    case GCClipMask:	sval = xgc->clipmask; break;
+    case GCDashOffset:	sval = MAKINUM(vlu.dash_offset); break;
+    case GCDashList:	sval = MAKINUM(vlu.dashes); break;
+    case GCArcMode:	sval = MAKINUM(vlu.arc_mode); break;
+
+    default: ASSERT(0, MAKINUM(attr), ARGn, s_x_gc_ref);
+    }
+    CAR(valend) = sval;
+    CDR(valend) = cons(BOOL_T, EOL);
+    valend = CDR(valend);
+    len -= 1;
+  }
+  return vals;
+}
+
+SCM x_create_cursor(sdpy, scsr, sargs)
+     SCM sdpy, scsr, sargs;
+{
+  Cursor cursor;
+
+  switch (ilength(sargs)) {
+  default: ASSERT(0, sargs, WNA, s_x_create_cursor);
+  case 0: {
+    SCM shape;
+    ASSERT(NIMP(sdpy) && DISPLAYP(sdpy), sdpy, ARG1, s_x_create_cursor);
+    shape = thevalue(scsr);
+    ASSERT(INUMP(shape) && 0 <= INUM(shape), scsr, ARG2, s_x_create_cursor);
+    cursor = XCreateFontCursor(XDISPLAY(sdpy), INUM(shape));
+    return make_xcursor(sdpy, cursor);
+  }
+  case 3: {
+    XColor foreground_color, background_color;
+    XPoint origin;
+    int sts;
+    ASSERT(NIMP(sdpy) && WINDOWP(sdpy), sdpy, ARG1, s_x_create_cursor);
+    ASSERT(FALSEP(scsr) || (NIMP(scsr) && WINDOWP(scsr)), scsr, ARG2,
+	   s_x_create_cursor);
+    sts = scm2XColor(CAR(sargs), &foreground_color);
+    ASSERT(sts, CAR(sargs), ARG3, s_x_create_cursor);
+    sargs = CDR(sargs);
+    sts = scm2XColor(CAR(sargs), &background_color);
+    ASSERT(sts, CAR(sargs), ARG4, s_x_create_cursor);
+    sargs = CDR(sargs);
+    scm2XPoint(0, CAR(sargs), &origin, (char*)ARG5, s_x_create_cursor);
+    cursor = XCreatePixmapCursor(XWINDISPLAY(sdpy), XWINDOW(sdpy),
+				 FALSEP(scsr) ? 0L : XWINDOW(scsr),
+				 &foreground_color, &background_color,
+				 origin.x, origin.y);
+    return make_xcursor(WINDOW(sdpy)->display, cursor);
+  }
+  case 4: {
+    XColor foreground_color, background_color;
+    Font source_font, mask_font = 0;
+    unsigned int source_char, mask_char = 0;
+    int sts;
+    source_font = thefont(sdpy, s_x_create_cursor);
+    GET_NEXT_INT(source_char, sargs, ARG2, s_x_create_cursor);
+    if FALSEP(CAR(sargs)) {
+      sargs = CDR(sargs);
+      ASSERT(FALSEP(CAR(sargs)), sargs, ARG4, s_x_create_cursor);
+      sargs = CDR(sargs);
+    } else {
+      mask_font = thefont(CAR(sargs), s_x_create_cursor);
+      sargs = CDR(sargs);
+      GET_NEXT_INT(mask_char, sargs, ARG4, s_x_create_cursor);
+    }
+    sts = scm2XColor(CAR(sargs), &foreground_color);
+    ASSERT(sts, CAR(sargs), ARG5, s_x_create_cursor);
+    sargs = CDR(sargs);
+    sts = scm2XColor(CAR(sargs), &background_color);
+    ASSERT(sts, CAR(sargs), ARGn, s_x_create_cursor);
+    cursor = XCreateGlyphCursor(XWINDISPLAY(sdpy),
+				source_font, mask_font, source_char, mask_char,
+				&foreground_color, &background_color);
+    return make_xcursor(FONT(sdpy)->display, cursor);
+  }}
+}
+
+SCM x_load_font(sdpy, fntnam)
+     SCM sdpy, fntnam;
+{
+  Font font;
+
+  ASSERT(NIMP(sdpy) && DISPLAYP(sdpy), sdpy, ARG1, s_x_load_font);
+  ASSERT(NIMP(fntnam) && STRINGP(fntnam), fntnam, ARG2, s_x_load_font);
+  font = XLoadFont(XDISPLAY(sdpy), CHARS(fntnam));
+  return make_xfont(sdpy, font, fntnam);
+}
+
+		  /* Xlib information functions. */
+
+SCM x_protocol_version(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_protocol_version);
+  return cons(MAKINUM(ProtocolVersion(dspscn.dpy)),
+	      MAKINUM(ProtocolRevision(dspscn.dpy)));
+}
+SCM x_server_vendor(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_server_vendor);
+  return makfrom0str(ServerVendor(dspscn.dpy));
+}
+SCM x_vendor_release(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_vendor_release);
+  return MAKINUM(VendorRelease(dspscn.dpy));
+}
+int x_scm_error_handler(display, xee)
+     Display *display;
+     XErrorEvent *xee;
+{
+  char buffer_return[1024];
+  fflush(stdout);
+  XGetErrorText(display, xee->error_code, buffer_return, sizeof buffer_return);
+  *loc_errobj = MAKINUM((xee->request_code<<8) + xee->minor_code);
+  fputs(buffer_return, stderr);
+  fputc('\n', stderr);
+  fflush(stderr);
+  return 0;
+}
+SCM x_q_length(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_q_length);
+  return MAKINUM(QLength(dspscn.dpy));
+}
+SCM x_pending(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_pending);
+  return MAKINUM(XPending(dspscn.dpy));
+}
+SCM x_events_queued(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_events_queued);
+  return MAKINUM(XEventsQueued(dspscn.dpy, QueuedAfterReading));
+}
+SCM x_next_event(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  XEvent event_return;
+  scm2display_screen(sd, si, &dspscn, s_x_next_event);
+  XNextEvent(dspscn.dpy, &event_return);
+  return make_xevent(&event_return);
+}
+SCM x_peek_event(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  XEvent event_return;
+  scm2display_screen(sd, si, &dspscn, s_x_peek_event);
+  XPeekEvent(dspscn.dpy, &event_return);
+  return make_xevent(&event_return);
+}
+		  /* Screen information functions */
+
+SCM x_screen_count(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_count);
+  return MAKINUM(ScreenCount(dspscn.dpy));
+}
+SCM x_screen_cells(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_cells);
+  return MAKINUM(DisplayCells(dspscn.dpy, dspscn.screen_number));
+}
+SCM x_screen_depth(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_depth);
+  return MAKINUM(DisplayPlanes(dspscn.dpy, dspscn.screen_number));
+}
+SCM x_screen_depths(sd, si)
+     SCM sd, si;
+{
+  int count_return = 0;
+  int *depths;
+  SCM depra;
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_depths);
+  depths = XListDepths(dspscn.dpy, dspscn.screen_number, &count_return);
+  if (!depths) return BOOL_F;
+  depra = make_uve(count_return, MOST_POSITIVE_FIXNUM); /* Uniform vector of long */
+  for (;count_return--;) VELTS(depra)[count_return] = depths[count_return];
+  XFree(depths);
+  return depra;
+}
+SCM x_screen_size(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_size);
+  return cons2(MAKINUM(DisplayWidth(dspscn.dpy, dspscn.screen_number)),
+	       MAKINUM(DisplayHeight(dspscn.dpy, dspscn.screen_number)),
+	       EOL);
+}
+SCM x_screen_dimm(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_dimm);
+  return cons2(MAKINUM(DisplayWidthMM(dspscn.dpy, dspscn.screen_number)),
+	       MAKINUM(DisplayHeightMM(dspscn.dpy, dspscn.screen_number)),
+	       EOL);
+}
+SCM x_screen_black(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  Screen *scn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_black);
+  scn = ScreenOfDisplay(dspscn.dpy, dspscn.screen_number);
+  return ulong2num(BlackPixelOfScreen(scn));
+}
+SCM x_screen_white(sd, si)
+     SCM sd, si;
+{
+  struct display_screen dspscn;
+  Screen *scn;
+  scm2display_screen(sd, si, &dspscn, s_x_screen_white);
+  scn = ScreenOfDisplay(dspscn.dpy, dspscn.screen_number);
+  return ulong2num(WhitePixelOfScreen(scn));
+}
+
+SCM x_make_visual(sd, sdepth, sclass)
+     SCM sd, sdepth, sclass;
+{
+  struct display_screen dspscn;
+  XVisualInfo vis;
+  Status sts;
+  scm2display_screen(sd, UNDEFINED, &dspscn, s_x_make_visual);
+  sts = XMatchVisualInfo(dspscn.dpy, dspscn.screen_number,
+			 theuint(sdepth, s_x_make_visual),
+			 theuint(sclass, s_x_make_visual),
+			 &vis);
+  if (!sts) return BOOL_F;
+  return make_xvisual(vis.visual);
+}
+SCM x_root_window(sdpy, sscr)
+     SCM sdpy, sscr;
+{
+  struct display_screen dspscn;
+  struct xs_Display *xsd;
+  struct xs_screen *scrns;
+  scm2display_screen(sdpy, sscr, &dspscn, s_x_root_window);
+  xsd = DISPLAY(dspscn.display);
+  scrns = (struct xs_screen *)(xsd + 1);
+  return scrns[dspscn.screen_number].root_window;
+}
+SCM x_default_colormap(sdpy, sscr)
+     SCM sdpy, sscr;
+{
+  struct display_screen dspscn;
+  struct xs_Display *xsd;
+  struct xs_screen *scrns;
+  scm2display_screen(sdpy, sscr, &dspscn, s_x_default_colormap);
+  xsd = DISPLAY(dspscn.display);
+  scrns = (struct xs_screen *)(xsd + 1);
+  return scrns[dspscn.screen_number].default_colormap;
+}
+SCM x_default_gcontext(sdpy, sscr)
+     SCM sdpy, sscr;
+{
+  struct display_screen dspscn;
+  struct xs_Display *xsd;
+  struct xs_screen *scrns;
+  scm2display_screen(sdpy, sscr, &dspscn, s_x_default_gcontext);
+  xsd = DISPLAY(dspscn.display);
+  scrns = (struct xs_screen *)(xsd + 1);
+  return scrns[dspscn.screen_number].default_gcontext;
+}
+SCM x_default_visual(sdpy, sscr)
+     SCM sdpy, sscr;
+{
+  struct display_screen dspscn;
+  struct xs_Display *xsd;
+  struct xs_screen *scrns;
+  scm2display_screen(sdpy, sscr, &dspscn, s_x_default_visual);
+  xsd = DISPLAY(dspscn.display);
+  scrns = (struct xs_screen *)(xsd + 1);
+  return scrns[dspscn.screen_number].default_visual;
+}
+
+			   /* Rendering */
+
+SCM x_clear_area(swin, spos, sargs)
+     SCM swin, spos, sargs;
+{
+  XPoint position, size;
+  ASSERT(2==ilength(sargs), sargs, WNA, s_x_clear_area);
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_clear_area);
+  scm2XPoint(!0, spos, &position, (char *)ARG2, s_x_clear_area);
+  scm2XPoint(0, CAR(sargs), &size, (char *)ARG3, s_x_clear_area);
+  sargs = CDR(sargs);
+  XClearArea(XWINDISPLAY(swin), XWINDOW(swin),
+	     position.x, position.y, size.x, size.y,
+	     NFALSEP(CAR(sargs)));
+  return UNSPECIFIED;
+}
+SCM x_fill_rectangle(swin, sgc, sargs)
+     SCM swin, sgc, sargs;
+{
+  XPoint position, size;
+  ASSERT(2==ilength(sargs), sargs, WNA, s_x_fill_rectangle);
+  ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_fill_rectangle);
+  ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_x_fill_rectangle);
+  scm2XPoint(!0, CAR(sargs), &position, (char *)ARG3, s_x_fill_rectangle);
+  sargs = CDR(sargs);
+  scm2XPoint(0, CAR(sargs), &size, (char *)ARG4, s_x_fill_rectangle);
+  XFillRectangle(XWINDISPLAY(swin), XWINDOW(swin), XGCONTEXT(sgc),
+		 position.x, position.y, size.x, size.y);
+  return UNSPECIFIED;
+}
+
+void xldraw_string(sdbl, sgc, sargs, proc, s_caller)
+     SCM sdbl, sgc, sargs;
+     int (*proc)();
+     char *s_caller;
+{
+  XPoint position;
+  ASSERT(2==ilength(sargs), sargs, WNA, s_caller);
+  ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_caller);
+  ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_caller);
+  scm2XPoint(!0, CAR(sargs), &position, (char *)ARG3, s_caller);
+  sargs = CDR(sargs);
+  sargs = CAR(sargs);
+  ASSERT(NIMP(sargs) && STRINGP(sargs), sargs, ARG4, s_caller);
+  proc(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+       position.x, position.y, CHARS(sargs), LENGTH(sargs));
+}
+SCM x_draw_string(sdbl, sgc, sargs)
+     SCM sdbl, sgc, sargs;
+{
+  xldraw_string(sdbl, sgc, sargs, &XDrawString, s_x_draw_string);
+  return UNSPECIFIED;
+}
+SCM x_image_string(sdbl, sgc, sargs)
+     SCM sdbl, sgc, sargs;
+{
+  xldraw_string(sdbl, sgc, sargs, &XDrawImageString, s_x_image_string);
+  return UNSPECIFIED;
+}
+
+SCM x_draw_points(sdbl, sgc, sargs)
+     SCM sdbl, sgc, sargs;
+{
+  XPoint pos[1];
+  int len;
+  SCM sarg;
+  ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_x_draw_points);
+  ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_x_draw_points);
+ loop:
+  if NULLP(sargs) return UNSPECIFIED;
+  sarg = CAR(sargs); sargs = CDR(sargs);
+  if (INUMP(sarg)) {
+    ASSERT(NNULLP(sargs), sargs, WNA, s_x_draw_points);
+    pos[0].x = INUM(sarg);
+    GET_NEXT_INT(pos[0].y, sargs, ARGn, s_x_draw_points);
+    goto drawshort;
+  }
+  len = scm2xpointslen(sarg, s_x_draw_points);
+  if (len < 0) {
+    scm2XPoint(!0, sarg, &(pos[0]), (char *)ARG3, s_x_draw_points);
+  drawshort:
+    XDrawPoints(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+		&(pos[0]), 1, CoordModeOrigin);
+    goto loop;
+  } else {
+    ASSERT(NULLP(sargs), sargs, WNA, s_x_draw_points);
+    XDrawPoints(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+		(XPoint *)scm_base_addr(sarg, s_x_draw_points), len,
+		CoordModeOrigin);
+    return UNSPECIFIED;
+  }
+}
+SCM xldraw_lines(sdbl, sgc, sargs, funcod, s_caller)
+     SCM sdbl, sgc, sargs;
+     int funcod;
+     char *s_caller;
+{
+  XPoint pos[2];
+  int len;
+  SCM sarg;
+  ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_caller);
+  ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_caller);
+ loop:
+  if NULLP(sargs) return UNSPECIFIED;
+  sarg = CAR(sargs); sargs = CDR(sargs);
+  if (INUMP(sarg)) {
+    ASSERT(NNULLP(sargs), sargs, WNA, s_caller);
+    pos[0].x = INUM(sarg);
+    GET_NEXT_INT(pos[0].y, sargs, ARGn, s_caller);
+    GET_NEXT_INT(pos[1].x, sargs, ARGn, s_caller);
+    GET_NEXT_INT(pos[1].y, sargs, ARGn, s_caller);
+    goto drawshort;
+  }
+  len = scm2xpointslen(sarg, s_caller);
+  if (len < 0) {
+    scm2XPoint(!0, sarg, &(pos[0]), (char *)ARG3, s_caller);
+    scm2XPoint(!0, sarg, &(pos[1]), (char *)ARG4, s_caller);
+  drawshort:
+    switch (funcod) {
+    default: wna: wta(sargs, (char *)WNA, s_caller);
+    case 0:
+      XDrawSegments(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+		    (XSegment *) &(pos[0]), 1);
+      goto loop;
+    case 1:
+      XDrawLines(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+		 &(pos[0]), 2, CoordModeOrigin);
+      goto loop;
+    }
+  } else {
+    unsigned long rabase;
+    ASRTGO(NULLP(sargs), wna);
+    rabase = scm_base_addr(sarg, s_caller);
+    switch (funcod) {
+    default: goto wna;
+    case 0:
+      XDrawSegments(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+		    (XSegment *)rabase, len/2);
+      return UNSPECIFIED;
+    case 1:
+      XDrawLines(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+		 (XPoint *)rabase, len, CoordModeOrigin);
+      return UNSPECIFIED;
+    case 2:
+      XFillPolygon(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc),
+		   (XPoint *)rabase, len, Complex, CoordModeOrigin);
+      return UNSPECIFIED;
+    }
+  }
+}
+
+SCM x_draw_segments(sdbl, sgc, sargs)
+     SCM sdbl, sgc, sargs;
+{
+  return xldraw_lines(sdbl, sgc, sargs, 0, s_x_draw_segments);
+}
+SCM x_draw_lines(sdbl, sgc, sargs)
+     SCM sdbl, sgc, sargs;
+{
+  return xldraw_lines(sdbl, sgc, sargs, 1, s_x_draw_lines);
+}
+SCM x_fill_poly(sdbl, sgc, sargs)
+     SCM sdbl, sgc, sargs;
+{
+  return xldraw_lines(sdbl, sgc, sargs, 2, s_x_fill_poly);
+}
+
+			    /* XEvents */
+
+/* x_make_bool() is used in xevent.h */
+SCM x_make_bool(f)
+     Bool f;
+{
+  return f ? BOOL_F : BOOL_T;
+}
+
+SCM x_event_ref(sevent, sfield)
+     SCM sevent, sfield;
+{
+  void *x;
+  ASSERT(NIMP(sevent) && XEVENTP(sevent), sevent, ARG1, s_x_event_ref);
+  ASSERT(INUMP(sfield), sfield, ARG2, s_x_event_ref);
+  x = (void *) CHARS(sevent);
+  switch (((((XEvent*)x)->type)<<8)+INUM(sfield)) {
+    default: wta(sevent, "Incompatible field for", s_x_event_ref);
+#define SCM_EVENT_FIELDS
+#include "xevent.h"
+  }
+}
+
+static struct {
+  int type;
+  char *name;
+} event_names[] = {
+#undef SCM_EVENT_FIELDS
+#include "xevent.h"
+};
+
+static char *x__event_name(type)
+     int type;
+{
+  int i;
+  for (i = 0; i < sizeof(event_names) / sizeof(event_names[0]); i++)
+    if (type==event_names[i].type) return event_names[i].name;
+  return "unknown";
+}
+		      /* SMOB print routines */
+
+static int print_xevent(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  lputs("#<X event: ", f);
+  lputs(x__event_name(XEVENT(exp)->type), f);
+  lputc('>', f);
+  return 1;
+}
+static int print_xdisplay(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  if CLOSEDP(exp) lputs("#<closed-X display>", f);
+  else {
+    lputs("#<X display \"", f);
+    lputs(DisplayString(XDISPLAY(exp)), f);
+    lputs("\">", f);
+  }
+  return 1;
+}
+static int print_xwindow(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  lputs(CLOSEDP(exp) ? "#<closed-X " : "#<X ", f);
+  lputs((CAR(exp) & PXMP) ? "pixmap #x" : "window #x", f);
+  intprint((long) XWINDOW(exp), 16, f);
+  lputc('>', f);
+  return 1;
+}
+static int print_xcursor(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  lputs("#<X cursor #x", f);
+  intprint((long) XCURSOR(exp), 16, f);
+  lputc('>', f);
+  return 1;
+}
+static int print_xfont(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  lputs("#<X font \"", f);
+  lputs(CHARS((FONT(exp))->name), f);
+  lputs("\">", f);
+  return 1;
+}
+static int print_xcolormap(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  lputs("#<X colormap ID #x", f);
+  intprint((long) XCOLORMAP(exp), 16, f);
+  lputc('>', f);
+  return 1;
+}
+static int print_xgcontext(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  lputs("#<X graphics context, ID #x", f);
+  /*  intprint((long) GCONTEXT(exp)->gid, 16, f); skimu */
+  intprint((long) XGContextFromGC(XGCONTEXT(exp)), 16, f);
+  lputc('>', f);
+  return 1;
+}
+static int print_xvisual(exp, f, writing)
+     SCM exp;
+     SCM f;
+     int writing;
+{
+  lputs("#<X visual #x", f);
+  intprint((long) XVisualIDFromVisual(XVISUAL(exp)), 16, f);
+  lputc('>', f);
+  return 1;
+}
+
+static smobfuns smob_xdisplay	= {mark_xdisplay, free_xdisplay, print_xdisplay, 0};
+static smobfuns smob_xwindow	= {mark_xwindow, free_xwindow, print_xwindow, 0};
+static smobfuns smob_xcursor	= {mark_xcursor, free_xcursor, print_xcursor, 0};
+static smobfuns smob_xfont	= {mark_xfont, free_xfont, print_xfont, 0};
+static smobfuns smob_xgcontext	= {mark_xgcontext, free_xgcontext, print_xgcontext, 0};
+static smobfuns smob_xcolormap	= {mark_xcolormap, free_xcolormap, print_xcolormap, 0};
+static smobfuns smob_xvisual	= {mark0, free0, print_xvisual, 0};
+static smobfuns smob_xevent	= {mark0, x_free_xevent, print_xevent, 0};
+
+static iproc x_subr3s[] = {
+  {s_x_make_visual,		x_make_visual},
+  {s_x_create_pixmap,		x_create_pixmap},
+  {s_x_create_colormap,		x_create_colormap},
+  {s_x_color_set,		x_color_set},
+  {0, 0}
+};
+
+static iproc x_lsubr2s[] = {
+  {s_x_create_window,		x_create_window},
+  {s_x_create_cursor,		x_create_cursor},
+  {s_x_alloc_color_cells,	x_alloc_color_cells},
+  {s_x_free_color_cells,	x_free_color_cells},
+  {s_x_clear_area,		x_clear_area},
+  {s_x_fill_rectangle,		x_fill_rectangle},
+  {s_x_draw_string,		x_draw_string},
+  {s_x_image_string,		x_image_string},
+  {s_x_draw_points,		x_draw_points},
+  {s_x_draw_segments,		x_draw_segments},
+  {s_x_draw_lines,		x_draw_lines},
+  {s_x_fill_poly,		x_fill_poly},
+  {0, 0}
+};
+
+static iproc x_lsubrs[] = {
+  {s_x_create_gc,		x_create_gc},
+  {s_x_gc_set,			x_gc_set},
+  {s_x_gc_ref,			x_gc_ref},
+  {s_x_copy_gc,			x_copy_gc},
+  {s_x_window_set,		x_window_set},
+/*    {s_x_window_ref,		x_window_ref}, */
+  {0, 0}
+};
+
+static iproc x_subr2s[] = {
+  {s_x_event_ref,		x_event_ref},
+  {s_x_find_color,		x_find_color},
+  {s_x_color_ref,		x_color_ref},
+  {s_x_load_font,		x_load_font},
+  {0, 0}
+};
+
+static iproc x_subr2os[] = {
+  {s_x_display_debug,		x_display_debug},
+  {s_x_screen_cells,		x_screen_cells},
+  {s_x_screen_depth,		x_screen_depth},
+  {s_x_screen_depths,		x_screen_depths},
+  {s_x_screen_size,		x_screen_size},
+  {s_x_screen_dimm,		x_screen_dimm},
+  {s_x_screen_black,		x_screen_black},
+  {s_x_screen_white,		x_screen_white},
+  {s_x_protocol_version,	x_protocol_version},
+  {s_x_vendor_release,		x_vendor_release},
+  {s_x_server_vendor,		x_server_vendor},
+  {s_x_screen_count,		x_screen_count},
+  {s_x_events_queued,		x_events_queued},
+  {s_x_next_event,		x_next_event},
+  {s_x_peek_event,		x_peek_event},
+  {s_x_pending,			x_pending},
+  {s_x_q_length,		x_q_length},
+  {s_x_root_window,		x_root_window},
+  {s_x_default_gcontext,	x_default_gcontext},
+  {s_x_default_visual,		x_default_visual},
+  {s_x_default_colormap,	x_default_colormap},
+  {s_x_install_colormap,	x_install_colormap},
+  {s_x_flush,			x_flush},
+  {0, 0}
+};
+
+static iproc x_subr1s[] = {
+  {s_x_open_display,		x_open_display},
+  {s_x_close,			x_close},
+  {s_x_default_screen,		x_default_screen},
+  {s_x_window_geometry,		x_window_geometry},
+  {s_x_map_window,		x_map_window},
+  {s_x_map_raised,		x_map_raised},
+  {s_x_map_subwindows,		x_map_subwindows},
+  {s_x_unmap_window,		x_unmap_window},
+  {s_x_unmap_subwindows,	x_unmap_subwindows},
+  {s_x_recreate_colormap,	x_recreate_colormap},
+  {0, 0}
+};
+
+int (*x_scm_prev_error_handler)() = 0;
+void x_scm_final()
+{
+  if (x_scm_prev_error_handler) XSetErrorHandler(x_scm_prev_error_handler);
+  x_scm_prev_error_handler = 0;
+}
+
+void init_x()
+{
+  init_iprocs(x_subr3s, tc7_subr_3);
+  init_iprocs(x_lsubr2s, tc7_lsubr_2);
+  init_iprocs(x_lsubrs, tc7_lsubr);
+  init_iprocs(x_subr2s, tc7_subr_2);
+  init_iprocs(x_subr2os, tc7_subr_2o);
+  init_iprocs(x_subr1s, tc7_subr_1);
+
+  tc16_xdisplay = newsmob(&smob_xdisplay);
+  tc16_xwindow = newsmob(&smob_xwindow);
+  tc16_xcursor = newsmob(&smob_xcursor);
+  tc16_xfont = newsmob(&smob_xfont);
+  tc16_xcolormap = newsmob(&smob_xcolormap);
+  tc16_xgcontext = newsmob(&smob_xgcontext);
+  tc16_xvisual = newsmob(&smob_xvisual);
+  tc16_xevent = newsmob(&smob_xevent);
+
+  scm_ldprog("x11.scm");
+  scm_ldprog("xevent.scm");
+	scm_ldstr("\
+(define x:GC-Clip-Origin (logior x:GC-Clip-X-Origin x:GC-Clip-Y-Origin))\n\
+(define x:GC-Tile-Stip-Origin \n\
+        (logior x:GC-Tile-Stip-X-Origin x:GC-Tile-Stip-Y-Origin))\n\
+");
+  add_feature("xlib");
+
+  add_final(x_scm_final);
+  XSetErrorHandler(x_scm_error_handler);
+}