- fixed GC_PROTECT bugs

- replaced most of symbol or symbol list arguments by enumerated types,
  enum-sets and alists of enumerated types.
- reformed event representation. Every event has it's own record-type now.

Makefile

@@ -25,7 +25,7 @@ enough: $(SCX)
 ### The VM is scsh plus all new primitives from the c files
 
 OBJECTS = \
-	c/xlib/display.o c/xlib/window.o c/xlib/type.o c/xlib/color.o \
+	c/xlib/display.o c/xlib/window.o c/xlib/color.o \
 	c/xlib/colormap.o c/xlib/pixel.o c/xlib/gcontext.o c/xlib/event.o \
 	c/xlib/pixmap.o c/xlib/graphics.o c/xlib/font.o \
 	c/xlib/cursor.o c/xlib/text.o c/xlib/property.o c/xlib/wm.o \
@@ -34,14 +34,15 @@ OBJECTS = \
 	c/xlib/visual.o c/xlib/region.o \
 	c/libs/xpm.o
 
-SCM_FILES = scheme/xlib/atom-type.scm scheme/xlib/client.scm \
+SCM_FILES = scheme/xlib/types.scm \
+	scheme/xlib/atom-type.scm scheme/xlib/client.scm \
 	scheme/xlib/color-type.scm scheme/xlib/color.scm \
 	scheme/xlib/colormap-type.scm scheme/xlib/colormap.scm \
 	scheme/xlib/cursor-type.scm scheme/xlib/cursor.scm \
 	scheme/xlib/display-type.scm \
 	scheme/xlib/display.scm scheme/xlib/drawable-type.scm \
 	scheme/xlib/drawable.scm scheme/xlib/error.scm \
-	scheme/xlib/event-type.scm scheme/xlib/event.scm \
+	scheme/xlib/event-types.scm scheme/xlib/event.scm \
 	scheme/xlib/extension.scm scheme/xlib/font-type.scm \
 	scheme/xlib/font.scm scheme/xlib/gcontext-type.scm \
 	scheme/xlib/gcontext.scm scheme/xlib/grab.scm scheme/xlib/graphics.scm \
@@ -89,7 +90,6 @@ $(SCX_IMAGE): $(SCX_VM) $(SCM_FILES) $(SCM_CONFIG_FILES)
 	echo ",batch on"; \
 	echo ",config ,load $(SCM_CONFIG_FILES)"; \
 	echo ",load-package xlib"; \
-	echo ",load-package xlib-internals"; \
 	echo ",load-package xpm"; \
 	echo "(dump-scsh \"$(SCX_IMAGE)\")"; \
 	) | ./$(SCX_VM)

c/libs/xpm.c

@@ -7,37 +7,29 @@
 
 void Attribs_To_XpmAttributes(s48_value attribs,
 			      XpmAttributes* XA) {
-  int i; unsigned long mask = 0;
+  unsigned long mask = s48_extract_integer(S48_CAR(attribs));
-  for (i=0; i<9; i++) {
+  s48_value v = S48_CDR(attribs);
-    s48_value v = S48_VECTOR_REF(attribs, i);
+
-    if (S48_FALSE != v) {
+  if (mask & XpmVisual)
-      switch (i) {
-      case 0: mask |= XpmVisual;
     XA->visual = SCX_EXTRACT_VISUAL(v);
-	break;
+  if (mask & XpmColormap)
-      case 1: mask |= XpmColormap;
     XA->colormap = SCX_EXTRACT_COLORMAP(v);
-	break;
+  if (mask & XpmDepth)
-      case 2: mask |= XpmDepth;
     XA->depth = s48_extract_integer(v);
-	break;
+  if ((mask & XpmReturnPixels) && (S48_FALSE_P(v)))
-      case 3: break; /*mask |= XpmColorSymbols;
+    mask = mask & (~XpmReturnPixels);
-	ExtractColorsymbols(v, XA->colorsymbols, XA->numsymbols);
+  if (mask & XpmExactColors)
-	break;*/
-      case 4: mask |= XpmReturnPixels; break;
-      case 5: mask |= XpmExactColors; 
     XA->exactColors = s48_extract_integer(v);
-	break;
+  if ((mask & XpmReturnAllocPixels) && (S48_FALSE_P(v)))
-      case 6: mask |= XpmReturnAllocPixels; break;
+    mask = mask & (~XpmReturnAllocPixels);
-      case 7: mask |= XpmAllocCloseColors; 
+  if (mask & XpmAllocCloseColors)
     XA->alloc_close_colors = s48_extract_integer(v);
-	break;
+  if (mask & XpmBitmapFormat)
-      case 8: mask |= XpmBitmapFormat;
+    XA->bitmap_format = s48_extract_integer(v);
-	XA->bitmap_format = s48_extract_integer(v) ? XYBitmap : ZPixmap;
+
-	break;
+//  if (mask & XpmColorSymbols)
-      }
+//    XA->colorsyms = ExtractColorsymbols(v, XA->colorsymbols, XA->numsymbols);
-    }
+
-  }
   XA->valuemask = mask;
   return;
 }
@@ -50,11 +42,11 @@ s48_value Make_XPM_Result(Pixmap* pixmap, Pixmap* shapemask,
   S48_GC_PROTECT_1(res);
 
   S48_VECTOR_SET(res, 0, SCX_ENTER_PIXMAP(*pixmap));
-  S48_VECTOR_SET(res, 1, s48_cons(s48_enter_integer(XA->width), 
+  S48_VECTOR_SET(res, 1, s48_cons(s48_enter_fixnum(XA->width), 
-				  s48_enter_integer(XA->height)));
+				  s48_enter_fixnum(XA->height)));
   if (XA->valuemask & XpmHotspot != 0)
-    S48_VECTOR_SET(res, 2, s48_cons(s48_enter_integer(XA->x_hotspot), 
+    S48_VECTOR_SET(res, 2, s48_cons(s48_enter_fixnum(XA->x_hotspot), 
-				    s48_enter_integer(XA->y_hotspot)));
+				    s48_enter_fixnum(XA->y_hotspot)));
   S48_VECTOR_SET(res, 3, SCX_ENTER_PIXMAP(*shapemask));
 
   S48_GC_UNPROTECT();
@@ -80,8 +72,8 @@ s48_value scx_Create_Pixmap_From_Data(s48_value Xdisplay, s48_value Xdrawable,
 			       d,
 			       &pixmap, &shapemask,
 			       &XA );
-  if (r == XpmNoMemory) return s48_enter_integer(0);
+  if (r == XpmNoMemory) return s48_enter_fixnum(0);
-  else if (r == XpmFileInvalid) return s48_enter_integer(1);
+  else if (r == XpmFileInvalid) return s48_enter_fixnum(1);
   else if (r == XpmSuccess)
     return Make_XPM_Result(&pixmap, &shapemask, &XA);
 }
@@ -100,9 +92,9 @@ s48_value scx_Read_File_To_Pixmap(s48_value Xdisplay, s48_value Xdrawable,
 			   s48_extract_string(filename),
 			   &pixmap, &shapemask,
 			   &XA );
-  if (r == XpmNoMemory) return s48_enter_integer(0);
+  if (r == XpmNoMemory) return s48_enter_fixnum(0);
-  else if (r == XpmFileInvalid) return s48_enter_integer(1);
+  else if (r == XpmFileInvalid) return s48_enter_fixnum(1);
-  else if (r == XpmOpenFailed) return s48_enter_integer(2);
+  else if (r == XpmOpenFailed) return s48_enter_fixnum(2);
   else if (r == XpmSuccess)
     return Make_XPM_Result(&pixmap, &shapemask, &XA);
 }

c/main.c

@@ -4,7 +4,6 @@
 
 extern void scx_init_window();
 extern void scx_init_display();
-extern void scx_init_type();
 extern void scx_init_color();
 extern void scx_init_colormap();
 extern void scx_init_pixel();
@@ -37,8 +36,6 @@ int main(int argc, char **argv) {
 
   s48_add_external_init(scx_init_window);
   s48_add_external_init(scx_init_display); 
-  s48_add_external_init(scx_init_type);
-  s48_add_external_init(scx_init_color);
   s48_add_external_init(scx_init_color);
   s48_add_external_init(scx_init_colormap);
   s48_add_external_init(scx_init_pixel);

c/xlib/client.c

@@ -18,10 +18,14 @@ s48_value scx_Withdraw_Window (s48_value Xdisplay, s48_value w, s48_value scr) {
     return S48_UNSPECIFIC;
 }
 
+// defined in window.c
+extern unsigned long Changes_To_XWindowChanges(s48_value conf,
+					       XWindowChanges* WC);
+
 s48_value scx_Reconfigure_Wm_Window (s48_value dpy, s48_value w, s48_value scr,
 				     s48_value conf) {
   XWindowChanges WC;
-  unsigned long mask = 0;//AList_To_XWindowChanges(conf, &WC);
+  unsigned long mask = Changes_To_XWindowChanges(conf, &WC);
 
   if (!XReconfigureWMWindow (SCX_EXTRACT_DISPLAY(dpy),
 			     SCX_EXTRACT_WINDOW(w),
@@ -61,7 +65,7 @@ int String_Vector_To_Text_Property (s48_value x, XTextProperty* ret) {
 
   for (i = 0; i < n; i++) {
     t = S48_VECTOR_REF(x, i);
-    s[i] = S48_SYMBOL_P(t) ? s48_extract_symbol(t) : s48_extract_string(t);
+    s[i] = s48_extract_string(t);
   }
 
   return XStringListToTextProperty (s, n, ret);
@@ -223,22 +227,22 @@ s48_value scx_Wm_Hints (s48_value dpy, s48_value w) {
   p = XGetWMHints (SCX_EXTRACT_DISPLAY(dpy), 
 		   SCX_EXTRACT_WINDOW(w));
   //Enable_Interrupts;
-  res = s48_make_vector(9, S48_NULL);
+  res = s48_make_vector(9, S48_UNSPECIFIC);
   if (p) {
     S48_GC_PROTECT_1(res);
     
     if (p->flags && InputHint)
       S48_VECTOR_SET(res, 0, S48_ENTER_BOOLEAN(p->input));
     if (p->flags && StateHint)
-      S48_VECTOR_SET(res, 1, Bit_To_Symbol((unsigned long)p->initial_state, 
+      S48_VECTOR_SET(res, 1, 
-					   Initial_State_Syms));
+		     s48_enter_integer((unsigned long)p->initial_state));
     if (p->flags && IconPixmapHint)
       S48_VECTOR_SET(res, 2, SCX_ENTER_PIXMAP(p->icon_pixmap));
     if (p->flags && IconWindowHint)
       S48_VECTOR_SET(res, 3, SCX_ENTER_WINDOW(p->icon_window));
     if (p->flags && IconPositionHint)
-      S48_VECTOR_SET(res, 4, s48_cons(s48_enter_integer(p->icon_x),
+      S48_VECTOR_SET(res, 4, s48_cons(s48_enter_fixnum(p->icon_x),
-				      s48_enter_integer(p->icon_y)));
+				      s48_enter_fixnum(p->icon_y)));
     if (p->flags && IconMaskHint)
       S48_VECTOR_SET(res, 5, SCX_ENTER_PIXMAP(p->icon_mask));
     if (p->flags && WindowGroupHint)
@@ -247,6 +251,7 @@ s48_value scx_Wm_Hints (s48_value dpy, s48_value w) {
     S48_VECTOR_SET(res, 7, S48_ENTER_BOOLEAN(p->flags & XUrgencyHint));
     // XLib man-pages say this constant is called UrgencyHint !!
     
+    res = s48_cons(s48_enter_integer(p->flags), res);
     S48_GC_UNPROTECT();
   }
 
@@ -256,43 +261,30 @@ s48_value scx_Wm_Hints (s48_value dpy, s48_value w) {
 }
 
 s48_value scx_Set_Wm_Hints (s48_value dpy, s48_value w, s48_value hints) {
-  long mask = 0;
+  long mask = s48_extract_integer(S48_CAR(hints));
+  s48_value v = S48_CDR(hints);
   XWMHints WMH;
-  int i;
 
-  for (i=0; i<8; i++) {
+  if (mask & InputHint)
-    s48_value value = S48_VECTOR_REF(hints, i);
+    WMH.input = S48_EXTRACT_BOOLEAN(S48_VECTOR_REF(v, 0));
-    if (S48_FALSE != value) {
+  if (mask & StateHint)
-      switch (i) {
+    WMH.initial_state = s48_extract_integer(S48_VECTOR_REF(v, 1));
-      case 0: mask |= InputHint;
+  if (mask & IconPixmapHint)
-	WMH.input = (Bool)s48_extract_integer(value);
+    WMH.icon_pixmap = SCX_EXTRACT_PIXMAP(S48_VECTOR_REF(v, 2));
-	break;
+  if (mask & IconWindowHint)
-      case 1: mask |= StateHint;
+    WMH.icon_window = SCX_EXTRACT_WINDOW(S48_VECTOR_REF(v, 3));
-	WMH.initial_state = 
+  if (mask & IconPositionHint) {
-	  Symbol_To_Bit(value,
+    WMH.icon_x = (int)s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 4)));
-			Initial_State_Syms);
+    WMH.icon_y = (int)s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 4)));
-	break;
-      case 2: mask |= IconPixmapHint;
-	WMH.icon_pixmap = SCX_EXTRACT_PIXMAP(value);
-	break;
-      case 3: mask |= IconWindowHint;
-	WMH.icon_window = SCX_EXTRACT_WINDOW(value);
-	break;
-      case 4: mask |= IconPositionHint;
-	WMH.icon_x = (int)s48_extract_integer(S48_CAR(value));
-	WMH.icon_y = (int)s48_extract_integer(S48_CDR(value));
-	break;
-      case 5: mask |= IconMaskHint;
-	WMH.icon_mask = SCX_EXTRACT_PIXMAP(value);
-	break;
-      case 6: mask |= WindowGroupHint;
-	WMH.window_group = SCX_EXTRACT_WINDOW(value);
-	break;
-      case 7: mask |= s48_extract_integer(value) ? XUrgencyHint : 0;
-	// XLib man-pages say this constant is called UrgencyHint !!
-      }
-    }
   }
+  if (mask & IconMaskHint)
+    WMH.icon_mask = SCX_EXTRACT_PIXMAP(S48_VECTOR_REF(v, 5));
+  if (mask & WindowGroupHint)
+    WMH.window_group = SCX_EXTRACT_WINDOW(S48_VECTOR_REF(v, 6));
+  if (mask & XUrgencyHint)
+    if (S48_FALSE == S48_EXTRACT_BOOLEAN(S48_VECTOR_REF(v, 7)))
+      mask = mask & (~XUrgencyHint);
+
   WMH.flags = mask;
  
   XSetWMHints(SCX_EXTRACT_DISPLAY(dpy),
@@ -321,12 +313,12 @@ s48_value scx_Icon_Sizes (s48_value dpy, s48_value w) {
     s48_value t = s48_make_vector(6, S48_NULL);
     S48_VECTOR_SET(v, i, t);
 
-    S48_VECTOR_SET(t, 0, s48_enter_integer (q->min_width));
+    S48_VECTOR_SET(t, 0, s48_enter_fixnum(q->min_width));
-    S48_VECTOR_SET(t, 1, s48_enter_integer (q->min_height));
+    S48_VECTOR_SET(t, 1, s48_enter_fixnum(q->min_height));
-    S48_VECTOR_SET(t, 2, s48_enter_integer (q->max_width));
+    S48_VECTOR_SET(t, 2, s48_enter_fixnum(q->max_width));
-    S48_VECTOR_SET(t, 3, s48_enter_integer (q->max_height));
+    S48_VECTOR_SET(t, 3, s48_enter_fixnum(q->max_height));
-    S48_VECTOR_SET(t, 4, s48_enter_integer (q->width_inc));
+    S48_VECTOR_SET(t, 4, s48_enter_fixnum(q->width_inc));
-    S48_VECTOR_SET(t, 5, s48_enter_integer (q->height_inc));
+    S48_VECTOR_SET(t, 5, s48_enter_fixnum(q->height_inc));
   }
   S48_GC_UNPROTECT();
   if (n > 0)
@@ -391,12 +383,12 @@ s48_value scx_Wm_Normal_Hints(s48_value dpy, s48_value win) {
   S48_GC_PROTECT_1(v);
 
   if (((SH.flags & PPosition) != 0) || ((SH.flags & USPosition) != 0))
-    S48_VECTOR_SET(v, 2, s48_cons(s48_enter_integer(SH.x),
+    S48_VECTOR_SET(v, 2, s48_cons(s48_enter_fixnum(SH.x),
-				  s48_enter_integer(SH.y)));
+				  s48_enter_fixnum(SH.y)));
 
   if (((SH.flags & PSize) != 0) || ((SH.flags & USSize) != 0))
-    S48_VECTOR_SET(v, 3, s48_cons(s48_enter_integer(SH.width), 
+    S48_VECTOR_SET(v, 3, s48_cons(s48_enter_fixnum(SH.width), 
-				  s48_enter_integer(SH.height)));
+				  s48_enter_fixnum(SH.height)));
   
   if ((SH.flags & USPosition) != 0)
     S48_VECTOR_SET(v, 0, S48_VECTOR_REF(v, 2));
@@ -405,30 +397,32 @@ s48_value scx_Wm_Normal_Hints(s48_value dpy, s48_value win) {
     S48_VECTOR_SET(v, 1, S48_VECTOR_REF(v, 3));
   
   if ((SH.flags & PMinSize) != 0)
-    S48_VECTOR_SET(v, 4, s48_cons(s48_enter_integer(SH.min_width), 
+    S48_VECTOR_SET(v, 4, s48_cons(s48_enter_fixnum(SH.min_width), 
-				  s48_enter_integer(SH.min_height)));
+				  s48_enter_fixnum(SH.min_height)));
   
   if ((SH.flags & PMaxSize) != 0)
-    S48_VECTOR_SET(v, 5, s48_cons(s48_enter_integer(SH.max_width), 
+    S48_VECTOR_SET(v, 5, s48_cons(s48_enter_fixnum(SH.max_width), 
-				  s48_enter_integer(SH.max_height)));
+				  s48_enter_fixnum(SH.max_height)));
   
   if ((SH.flags & PResizeInc) != 0)
-    S48_VECTOR_SET(v, 6, s48_cons(s48_enter_integer(SH.width_inc), 
+    S48_VECTOR_SET(v, 6, s48_cons(s48_enter_fixnum(SH.width_inc), 
-				  s48_enter_integer(SH.height_inc)));
+				  s48_enter_fixnum(SH.height_inc)));
   
   if ((SH.flags & PAspect) != 0)
     S48_VECTOR_SET(v, 7, 
-		   s48_cons(s48_cons(s48_enter_integer(SH.min_aspect.x), 
+		   s48_cons(s48_cons(s48_enter_fixnum(SH.min_aspect.x), 
-				     s48_enter_integer(SH.min_aspect.y)),
+				     s48_enter_fixnum(SH.min_aspect.y)),
-			    s48_cons(s48_enter_integer(SH.max_aspect.x),
+			    s48_cons(s48_enter_fixnum(SH.max_aspect.x),
-				     s48_enter_integer(SH.max_aspect.y))));
+				     s48_enter_fixnum(SH.max_aspect.y))));
   
   if ((SH.flags & PBaseSize) != 0)
-    S48_VECTOR_SET(v, 8, s48_cons(s48_enter_integer(SH.base_width), 
+    S48_VECTOR_SET(v, 8, s48_cons(s48_enter_fixnum(SH.base_width), 
-				  s48_enter_integer(SH.base_height)));
+				  s48_enter_fixnum(SH.base_height)));
   
   if ((SH.flags & PWinGravity) != 0)
-    S48_VECTOR_SET(v, 18, Bit_To_Symbol(SH.win_gravity, Grav_Syms));
+    S48_VECTOR_SET(v, 18, s48_enter_integer(SH.win_gravity));
+
+  v = s48_cons(s48_enter_integer(SH.flags), v);
 
   S48_GC_UNPROTECT();
   return v;
@@ -437,55 +431,54 @@ s48_value scx_Wm_Normal_Hints(s48_value dpy, s48_value win) {
 s48_value scx_Set_Wm_Normal_Hints(s48_value dpy, s48_value win, 
 				  s48_value hints) {
   XSizeHints SH;
-  long mask = 0;
+  long mask = S48_CAR(hints);
-  int i;
+  s48_value v = S48_CDR(hints);
 
-  for (i=0; i<10; i++) {
+  if (mask & USPosition) {
-    s48_value v = S48_VECTOR_REF(hints, i);
+    SH.x = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 0)));
+    SH.y = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 0)));
+  }
+  if (mask & USSize) {
+    SH.width = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 1)));
+    SH.height = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 1)));
+  }
+  if (mask & PPosition) {
+    SH.x = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 2)));
+    SH.y = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 2)));
+  }
+  if (mask & PSize) {
+    SH.width = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 3)));
+    SH.height = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 3)));
+  }
+  if (mask & PMinSize) {
+    SH.min_width = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 4)));
+    SH.min_height = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 4)));
+  }
+  if (mask & PMaxSize) {
+    SH.max_width = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 5)));
+    SH.max_height = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 5)));
+  }
+  if (mask & PResizeInc) {
+    SH.width_inc = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 6)));
+    SH.height_inc = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 6)));
+  }
+  if (mask & PAspect) {
+    SH.min_aspect.x =
+      s48_extract_integer(S48_CAR(S48_CAR(S48_VECTOR_REF(v, 7))));
+    SH.min_aspect.y =
+      s48_extract_integer(S48_CDR(S48_CAR(S48_VECTOR_REF(v, 7))));
+    SH.max_aspect.x =
+      s48_extract_integer(S48_CAR(S48_CDR(S48_VECTOR_REF(v, 7))));
+    SH.max_aspect.y =
+      s48_extract_integer(S48_CDR(S48_CDR(S48_VECTOR_REF(v, 7))));
+  }
+  if (mask & PBaseSize) {
+    SH.base_width = s48_extract_integer(S48_CAR(S48_VECTOR_REF(v, 8)));
+    SH.base_height = s48_extract_integer(S48_CDR(S48_VECTOR_REF(v, 8)));
+  }
+  if (mask & PWinGravity)
+    SH.win_gravity = s48_extract_integer(S48_VECTOR_REF(v, 9));
 
-    switch (i) {
-    case 0: mask |= USPosition;
-      SH.x = s48_extract_integer(S48_CAR(v));
-      SH.y = s48_extract_integer(S48_CDR(v));
-      break;
-    case 1: mask |= USSize;
-      SH.width = s48_extract_integer(S48_CAR(v));
-      SH.height = s48_extract_integer(S48_CDR(v));
-      break;
-    case 2: mask |= PPosition;
-      SH.x = s48_extract_integer(S48_CAR(v));
-      SH.y = s48_extract_integer(S48_CDR(v));
-      break;
-    case 3: mask |= PSize;
-      SH.width = s48_extract_integer(S48_CAR(v));
-      SH.height = s48_extract_integer(S48_CDR(v));
-      break;
-    case 4: mask |= PMinSize;
-      SH.min_width = s48_extract_integer(S48_CAR(v));
-      SH.min_height = s48_extract_integer(S48_CDR(v));
-      break;
-    case 5: mask |= PMaxSize;
-      SH.max_width = s48_extract_integer(S48_CAR(v));
-      SH.max_height = s48_extract_integer(S48_CDR(v));
-      break;
-    case 6: mask |= PResizeInc;
-      SH.width_inc = s48_extract_integer(S48_CAR(v));
-      SH.height_inc = s48_extract_integer(S48_CDR(v));
-      break;
-    case 7: mask |= PAspect;
-      SH.min_aspect.x = s48_extract_integer(S48_CAR(S48_CAR(v)));
-      SH.min_aspect.y = s48_extract_integer(S48_CDR(S48_CAR(v)));
-      SH.max_aspect.x = s48_extract_integer(S48_CAR(S48_CDR(v)));
-      SH.max_aspect.y = s48_extract_integer(S48_CDR(S48_CDR(v)));
-      break;      
-    case 8: mask |= PBaseSize;
-      SH.base_width = s48_extract_integer(S48_CAR(v));
-      SH.base_height = s48_extract_integer(S48_CDR(v));
-      break;
-    case 9: mask |= PWinGravity;
-      SH.win_gravity = Symbol_To_Bit(v, Grav_Syms);
-    }
-  }
   SH.flags = mask;
   
   XSetWMNormalHints(SCX_EXTRACT_DISPLAY(dpy),

c/xlib/color.c

@@ -1,5 +1,4 @@
 #include "xlib.h"
-#include "scheme48.h"
 
 s48_value scx_Create_Color(s48_value r, s48_value g, s48_value b) {
   s48_value col = S48_MAKE_VALUE(XColor);
@@ -76,8 +75,8 @@ s48_value scx_Lookup_Color(s48_value Xcolormap, s48_value Xdisplay,
 		    SCX_EXTRACT_COLORMAP(Xcolormap), 
 		    s48_extract_string(color_name), &visual, &exact )) {
     S48_GC_PROTECT_1(res);
-    res = s48_cons( scx_Int_Extract_RGB_Values( visual ),
+    res = scx_Int_Extract_RGB_Values( visual );
-		    scx_Int_Extract_RGB_Values( exact ) );
+    res = s48_cons(res, scx_Int_Extract_RGB_Values( exact ) );
   }
 
   S48_GC_UNPROTECT();

c/xlib/colormap.c

@@ -112,7 +112,7 @@ s48_value scx_Store_Color(s48_value Xdisplay, s48_value Xcolormap,
   t.red = c->red;
   t.green = c->green;
   t.blue = c->blue;
-  t.flags = Symbols_To_Bits(flags, Color_Flags_Syms);
+  t.flags = s48_extract_integer(flags);
   
   XStoreColor(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_COLORMAP(Xcolormap),
 	      &t);
@@ -134,10 +134,11 @@ s48_value scx_Store_Colors(s48_value Xdisplay, s48_value Xcolormap,
     colors[i].red = c->red;
     colors[i].green = c->green;
     colors[i].blue = c->blue;
-    colors[i].flags = Symbols_To_Bits(S48_VECTOR_REF(def, 2), Color_Flags_Syms);
+    colors[i].flags = s48_extract_integer(S48_VECTOR_REF(def, 2));
   }
 
-  XStoreColors(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_COLORMAP(Xcolormap),
+  XStoreColors(SCX_EXTRACT_DISPLAY(Xdisplay),
+	       SCX_EXTRACT_COLORMAP(Xcolormap),
 	       colors, n);
 
   return S48_UNSPECIFIC;

c/xlib/display.c

@@ -77,11 +77,11 @@ s48_value scx_Display_Default_Gcontext(s48_value Xdisplay) {
 s48_value scx_Display_Default_Depth(s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
   int depth = DefaultDepth(dpy, DefaultScreen(dpy));
-  return s48_enter_integer(depth);
+  return s48_enter_fixnum(depth);
 }
 
 s48_value scx_Display_Default_Screen_Number(s48_value Xdisplay) {
-  return s48_enter_integer(DefaultScreen(SCX_EXTRACT_DISPLAY(Xdisplay)));
+  return s48_enter_fixnum(DefaultScreen(SCX_EXTRACT_DISPLAY(Xdisplay)));
 }
 
 s48_value scx_Display_Default_Visual(s48_value Xdisplay, s48_value scrnum) {
@@ -108,28 +108,40 @@ s48_value scx_Display_Vendor(s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
   char* s = ServerVendor(dpy);
   int i = VendorRelease(dpy);
-  return s48_cons( s48_enter_string(s),
+  s48_value t = S48_FALSE;
-		   s48_enter_integer(i) );
+  S48_DECLARE_GC_PROTECT(1);
+
+  S48_GC_PROTECT_1(t);
+  t = s48_enter_string(s);
+  t = s48_cons(t, s48_enter_integer(i));
+  S48_GC_UNPROTECT();
+  return t;
 }
 
 s48_value scx_Display_Protocol_Version(s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
   int maj = ProtocolVersion(dpy);
   int min = ProtocolRevision(dpy);
-  return s48_cons( s48_enter_integer(maj),
+  s48_value t = S48_FALSE;
-		   s48_enter_integer(min) );
+  S48_DECLARE_GC_PROTECT(1);
+  
+  S48_GC_PROTECT_1(t);
+  t = s48_enter_integer(maj);
+  t = s48_cons(t, s48_enter_integer(min));
+  S48_GC_UNPROTECT();
+
+  return t;
 }
 
 s48_value scx_Display_Screen_Count(s48_value Xdisplay) {
   int cnt = ScreenCount(SCX_EXTRACT_DISPLAY(Xdisplay));
-  return s48_enter_integer(cnt);
+  return s48_enter_fixnum(cnt);
 }
 
 
 s48_value scx_Display_Image_Byte_Order(s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return Bits_To_Symbols( (unsigned long)ImageByteOrder(dpy),
+  return s48_enter_integer((unsigned long)ImageByteOrder(dpy));
-			  Byte_Order_Syms );
 }
 
 s48_value scx_Display_Bitmap_Unit(s48_value Xdisplay) {
@@ -139,8 +151,7 @@ s48_value scx_Display_Bitmap_Unit(s48_value Xdisplay) {
 
 s48_value scx_Display_Bitmap_Bit_Order(s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return Bits_To_Symbols( (unsigned long)BitmapBitOrder(dpy),
+  return s48_enter_integer((unsigned long)BitmapBitOrder(dpy));
-			  Byte_Order_Syms );
 }
 
 s48_value scx_Display_Bitmap_Pad(s48_value Xdisplay) {
@@ -150,22 +161,22 @@ s48_value scx_Display_Bitmap_Pad(s48_value Xdisplay) {
 
 s48_value scx_Display_Width(s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_integer(DisplayWidth(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayWidth(dpy, DefaultScreen(dpy)));
 }
 
 s48_value scx_Display_Height(s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_integer(DisplayHeight(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayHeight(dpy, DefaultScreen(dpy)));
 }
 
 s48_value scx_Display_Width_Mm (s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_integer(DisplayWidthMM(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayWidthMM(dpy, DefaultScreen(dpy)));
 }
 
 s48_value scx_Display_Height_Mm (s48_value Xdisplay) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_integer(DisplayHeightMM(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayHeightMM(dpy, DefaultScreen(dpy)));
 }
 
 s48_value scx_Display_Motion_Buffer_Size(s48_value Xdisplay) {
@@ -200,7 +211,7 @@ s48_value scx_List_Depths (s48_value Xdisplay, s48_value scr) {
     S48_GC_PROTECT_1(ret);
     ret = s48_make_vector(num, S48_NULL);
     for (i = 0; i < num; i++)
-      S48_VECTOR_SET(ret, i, s48_enter_integer(p[i]));
+      S48_VECTOR_SET(ret, i, s48_enter_fixnum(p[i]));
     XFree((char *)p);
   }
 
@@ -220,9 +231,9 @@ s48_value scx_List_Pixmap_Formats (s48_value Xdisplay) {
     S48_GC_PROTECT_2(ret, t);
     ret = s48_make_vector (num, S48_FALSE);
     for (i = 0; i < num; i++) {
-      t = s48_cons(s48_enter_integer(p[i].depth),
+      t = s48_cons(s48_enter_fixnum(p[i].depth),
-		   s48_cons(s48_enter_integer(p[i].bits_per_pixel),
+		   s48_cons(s48_enter_fixnum(p[i].bits_per_pixel),
-			    s48_cons(s48_enter_integer(p[i].scanline_pad), 
+			    s48_cons(s48_enter_fixnum(p[i].scanline_pad), 
 				     S48_NULL)));
       S48_VECTOR_SET(ret, i, t);
     }
@@ -237,7 +248,7 @@ s48_value scx_Display_Select_Input(s48_value Xdisplay, s48_value Xwindow,
 				   s48_value event_mask) {
   XSelectInput(SCX_EXTRACT_DISPLAY(Xdisplay),
 	       SCX_EXTRACT_WINDOW(Xwindow),
-	       Symbols_To_Bits(event_mask, Event_Mask_Syms));
+	       s48_extract_integer(event_mask));
 }
 
 void scx_init_display(void) {

c/xlib/error.c

@@ -34,10 +34,7 @@ static X_Error(Display* d, XErrorEvent* ep) {
   S48_GC_PROTECT_2(args, a);
   S48_VECTOR_SET(args, 0, SCX_ENTER_DISPLAY(d));
   S48_VECTOR_SET(args, 1, s48_enter_integer(ep->serial));
-  a = Bit_To_Symbol ((unsigned long)ep->error_code, Error_Syms);
+  S48_VECTOR_SET(args, 2, s48_enter_integer(ep->error_code));
-  if (S48_NULL_P (a))
-    a = s48_enter_integer (ep->error_code);
-  S48_VECTOR_SET(args, 2, a);
   S48_VECTOR_SET(args, 3, s48_enter_integer(ep->request_code));
   S48_VECTOR_SET(args, 4, s48_enter_integer(ep->minor_code));
   S48_VECTOR_SET(args, 5, s48_enter_integer((unsigned long)ep->resourceid));

c/xlib/event.c

@@ -3,15 +3,15 @@
 
 #define ECAST(name, type) type* name = (type*)e
 #define sidx 4
-#define SET(i, v) temp2 = v; S48_VECTOR_SET(r, i, temp2)
+#define SET(i, v) S48_VECTOR_SET(r, i, v)
 #define SETSIZE(i) r = s48_make_vector(sidx+i, S48_FALSE)
 
 s48_value scx_enter_event(XEvent* e) {
   s48_value r = S48_FALSE;
   s48_value temp, temp2 = S48_FALSE;
   int i;
-  S48_DECLARE_GC_PROTECT(3);
+  S48_DECLARE_GC_PROTECT(2);
-  S48_GC_PROTECT_3(r, temp, temp2);
+  S48_GC_PROTECT_2(r, temp);
 
   switch (e->type) {
 
@@ -24,25 +24,25 @@ s48_value scx_enter_event(XEvent* e) {
     SET(sidx+0, SCX_ENTER_WINDOW(q->root));
     SET(sidx+1, SCX_ENTER_WINDOW(q->subwindow));
     SET(sidx+2, SCX_ENTER_TIME(q->time));
-    SET(sidx+3, s48_enter_integer(q->x));
+    SET(sidx+3, s48_enter_fixnum(q->x));
-    SET(sidx+4, s48_enter_integer(q->y));
+    SET(sidx+4, s48_enter_fixnum(q->y));
-    SET(sidx+5, s48_enter_integer(q->x_root));
+    SET(sidx+5, s48_enter_fixnum(q->x_root));
-    SET(sidx+6, s48_enter_integer(q->y_root));
+    SET(sidx+6, s48_enter_fixnum(q->y_root));
-    SET(sidx+7, Bits_To_Symbols(q->state, State_Syms));
+    SET(sidx+7, s48_enter_fixnum(q->state));
     // now they are different
     switch (e->type) {
     case KeyPress : case KeyRelease : {
-      SET(sidx+8, s48_enter_integer(q->keycode));
+      SET(sidx+8, s48_enter_fixnum(q->keycode));
       SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen));
     } break;
     case ButtonPress : case ButtonRelease : {
       ECAST(q, XButtonEvent);
-      SET(sidx+8, Bit_To_Symbol(q->button, Button_Syms));
+      SET(sidx+8, s48_enter_integer(q->button));
       SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen));
     } break;
     case MotionNotify : {
       ECAST(q, XMotionEvent);
-      SET(sidx+8, S48_ENTER_BOOLEAN(q->is_hint));
+      SET(sidx+8, s48_enter_fixnum(q->is_hint));
       SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen));
     } break;
     }
@@ -54,23 +54,23 @@ s48_value scx_enter_event(XEvent* e) {
     SET(sidx+0, SCX_ENTER_WINDOW(q->root));
     SET(sidx+1, SCX_ENTER_WINDOW(q->subwindow));
     SET(sidx+2, SCX_ENTER_TIME(q->time));
-    SET(sidx+3, s48_enter_integer(q->x));
+    SET(sidx+3, s48_enter_fixnum(q->x));
-    SET(sidx+4, s48_enter_integer(q->y));
+    SET(sidx+4, s48_enter_fixnum(q->y));
-    SET(sidx+5, s48_enter_integer(q->x_root));
+    SET(sidx+5, s48_enter_fixnum(q->x_root));
-    SET(sidx+6, s48_enter_integer(q->y_root));
+    SET(sidx+6, s48_enter_fixnum(q->y_root));
-    SET(sidx+7, Bit_To_Symbol(q->mode, Cross_Mode_Syms));
+    SET(sidx+7, s48_enter_integer(q->mode));
-    SET(sidx+8, Bit_To_Symbol(q->detail, Cross_Detail_Syms));
+    SET(sidx+8, s48_enter_integer(q->detail));
     SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen));
     SET(sidx+10, S48_ENTER_BOOLEAN(q->focus));
     // Elk does this; but why not State_Syms??
-    SET(sidx+11, Bit_To_Symbol(q->state, Button_Syms));
+    SET(sidx+11, s48_enter_integer(q->state));
   } break;
 
   case FocusIn : case FocusOut : {
     ECAST(q, XFocusChangeEvent);
     SETSIZE(2);
-    SET(sidx+0, Bit_To_Symbol(q->mode, Cross_Mode_Syms));
+    SET(sidx+0, s48_enter_integer(q->mode));
-    SET(sidx+1, Bit_To_Symbol(q->detail, Focus_Detail_Syms));
+    SET(sidx+1, s48_enter_integer(q->detail));
   } break;
 
   case KeymapNotify : {
@@ -85,22 +85,22 @@ s48_value scx_enter_event(XEvent* e) {
   case Expose : {
     ECAST(q, XExposeEvent);
     SETSIZE(5);
-    SET(sidx+0, s48_enter_integer(q->x));
+    SET(sidx+0, s48_enter_fixnum(q->x));
-    SET(sidx+1, s48_enter_integer(q->y));
+    SET(sidx+1, s48_enter_fixnum(q->y));
-    SET(sidx+2, s48_enter_integer(q->width));
+    SET(sidx+2, s48_enter_fixnum(q->width));
-    SET(sidx+3, s48_enter_integer(q->height));
+    SET(sidx+3, s48_enter_fixnum(q->height));
-    SET(sidx+4, s48_enter_integer(q->count));
+    SET(sidx+4, s48_enter_fixnum(q->count));
   } break;
     
   case GraphicsExpose : {
     ECAST(q, XGraphicsExposeEvent);
     SETSIZE(7);
     // the ->window member is only a drawable here! ??
-    SET(sidx+0, s48_enter_integer(q->x));
+    SET(sidx+0, s48_enter_fixnum(q->x));
-    SET(sidx+1, s48_enter_integer(q->y));
+    SET(sidx+1, s48_enter_fixnum(q->y));
-    SET(sidx+2, s48_enter_integer(q->width));
+    SET(sidx+2, s48_enter_fixnum(q->width));
-    SET(sidx+3, s48_enter_integer(q->height));
+    SET(sidx+3, s48_enter_fixnum(q->height));
-    SET(sidx+4, s48_enter_integer(q->count));
+    SET(sidx+4, s48_enter_fixnum(q->count));
     SET(sidx+5, s48_enter_integer(q->major_code));
     SET(sidx+6, s48_enter_integer(q->minor_code));
   } break;
@@ -115,18 +115,18 @@ s48_value scx_enter_event(XEvent* e) {
   case VisibilityNotify : {
     ECAST(q, XVisibilityEvent);
     SETSIZE(1);
-    SET(sidx+0, Bit_To_Symbol(q->state, Visibility_Syms));
+    SET(sidx+0, s48_enter_integer(q->state));
   } break;
 
   case CreateNotify : {
     ECAST(q, XCreateWindowEvent);
     SETSIZE(7);
     SET(sidx+0, SCX_ENTER_WINDOW(q->window));
-    SET(sidx+1, s48_enter_integer(q->x));
+    SET(sidx+1, s48_enter_fixnum(q->x));
-    SET(sidx+2, s48_enter_integer(q->y));
+    SET(sidx+2, s48_enter_fixnum(q->y));
-    SET(sidx+3, s48_enter_integer(q->width));
+    SET(sidx+3, s48_enter_fixnum(q->width));
-    SET(sidx+4, s48_enter_integer(q->height));
+    SET(sidx+4, s48_enter_fixnum(q->height));
-    SET(sidx+5, s48_enter_integer(q->border_width));
+    SET(sidx+5, s48_enter_fixnum(q->border_width));
     SET(sidx+6, S48_ENTER_BOOLEAN(q->override_redirect));
   } break;
 
@@ -161,8 +161,8 @@ s48_value scx_enter_event(XEvent* e) {
     SETSIZE(5);
     SET(sidx+0, SCX_ENTER_WINDOW(q->window));
     SET(sidx+1, SCX_ENTER_WINDOW(q->parent));
-    SET(sidx+2, s48_enter_integer(q->x));
+    SET(sidx+2, s48_enter_fixnum(q->x));
-    SET(sidx+3, s48_enter_integer(q->y));
+    SET(sidx+3, s48_enter_fixnum(q->y));
     SET(sidx+4, S48_ENTER_BOOLEAN(q->override_redirect));
   } break;
 
@@ -170,11 +170,11 @@ s48_value scx_enter_event(XEvent* e) {
     ECAST(q, XConfigureEvent);
     SETSIZE(8);
     SET(sidx+0, SCX_ENTER_WINDOW(q->window));
-    SET(sidx+1, s48_enter_integer(q->x));
+    SET(sidx+1, s48_enter_fixnum(q->x));
-    SET(sidx+2, s48_enter_integer(q->y));
+    SET(sidx+2, s48_enter_fixnum(q->y));
-    SET(sidx+3, s48_enter_integer(q->width));
+    SET(sidx+3, s48_enter_fixnum(q->width));
-    SET(sidx+4, s48_enter_integer(q->height));
+    SET(sidx+4, s48_enter_fixnum(q->height));
-    SET(sidx+5, s48_enter_integer(q->border_width));
+    SET(sidx+5, s48_enter_fixnum(q->border_width));
     SET(sidx+6, SCX_ENTER_WINDOW(q->above));
     SET(sidx+7, S48_ENTER_BOOLEAN(q->override_redirect));
   } break;
@@ -183,13 +183,13 @@ s48_value scx_enter_event(XEvent* e) {
     ECAST(q, XConfigureRequestEvent);
     SETSIZE(9);
     SET(sidx+0, SCX_ENTER_WINDOW(q->window));
-    SET(sidx+1, s48_enter_integer(q->x));
+    SET(sidx+1, s48_enter_fixnum(q->x));
-    SET(sidx+2, s48_enter_integer(q->y));
+    SET(sidx+2, s48_enter_fixnum(q->y));
-    SET(sidx+3, s48_enter_integer(q->width));
+    SET(sidx+3, s48_enter_fixnum(q->width));
-    SET(sidx+4, s48_enter_integer(q->height));
+    SET(sidx+4, s48_enter_fixnum(q->height));
-    SET(sidx+5, s48_enter_integer(q->border_width));
+    SET(sidx+5, s48_enter_fixnum(q->border_width));
     SET(sidx+6, SCX_ENTER_WINDOW(q->above));
-    SET(sidx+7, Bit_To_Symbol(q->detail, Stack_Mode_Syms));
+    SET(sidx+7, s48_enter_integer(q->detail));
     SET(sidx+8, s48_enter_integer(q->value_mask));
   } break;
 
@@ -197,22 +197,22 @@ s48_value scx_enter_event(XEvent* e) {
     ECAST(q, XGravityEvent);
     SETSIZE(3);
     SET(sidx+0, SCX_ENTER_WINDOW(q->window));
-    SET(sidx+1, s48_enter_integer(q->x));
+    SET(sidx+1, s48_enter_fixnum(q->x));
-    SET(sidx+2, s48_enter_integer(q->y));
+    SET(sidx+2, s48_enter_fixnum(q->y));
   } break;
     
   case ResizeRequest : {
     ECAST(q, XResizeRequestEvent);
     SETSIZE(2);
-    SET(sidx+0, s48_enter_integer(q->width));
+    SET(sidx+0, s48_enter_fixnum(q->width));
-    SET(sidx+1, s48_enter_integer(q->height));
+    SET(sidx+1, s48_enter_fixnum(q->height));
   } break;
 
   case CirculateRequest : {
     ECAST(q, XCirculateEvent);
     SETSIZE(2);
     SET(sidx+0, SCX_ENTER_WINDOW(q->window));
-    SET(sidx+1, Bit_To_Symbol(q->place, Place_Syms));
+    SET(sidx+1, s48_enter_integer(q->place));
   } break;
 
   case PropertyNotify : {
@@ -220,7 +220,7 @@ s48_value scx_enter_event(XEvent* e) {
     SETSIZE(3);
     SET(sidx+0, SCX_ENTER_ATOM(q->atom));
     SET(sidx+1, SCX_ENTER_TIME(q->time));
-    SET(sidx+2, Bit_To_Symbol(q->state, Prop_Syms));
+    SET(sidx+2, s48_enter_integer(q->state));
   } break;
 
   case SelectionClear : {
@@ -254,13 +254,14 @@ s48_value scx_enter_event(XEvent* e) {
     SETSIZE(3);
     SET(sidx+0, SCX_ENTER_COLORMAP(q->colormap));
     SET(sidx+1, S48_ENTER_BOOLEAN(q->new));
-    SET(sidx+2, q->state == ColormapInstalled ? S48_TRUE : S48_FALSE);
+    SET(sidx+2, s48_enter_integer(q->state));
   } break;
   
   case ClientMessage : {
     ECAST(q, XClientMessageEvent);
-    SETSIZE(2);
+    SETSIZE(3);
     SET(sidx+0, SCX_ENTER_ATOM(q->message_type));
+    SET(sidx+1, s48_enter_integer(q->format));
     switch (q->format) {
     case 8 : {
       temp = s48_make_string(20, (char)0);
@@ -270,7 +271,7 @@ s48_value scx_enter_event(XEvent* e) {
     case 16 : {
       temp = s48_make_vector(10, S48_FALSE);
       for (i=0; i < 10; i++)
-	S48_VECTOR_SET(temp, i, s48_enter_integer(q->data.s[i]));
+	S48_VECTOR_SET(temp, i, s48_enter_fixnum(q->data.s[i]));
     } break;
     case 32 : {
       temp = s48_make_vector(5, S48_FALSE);
@@ -286,9 +287,9 @@ s48_value scx_enter_event(XEvent* e) {
   case MappingNotify : {
     ECAST(q, XMappingEvent);
     SETSIZE(3);
-    SET(sidx+0, Bit_To_Symbol(q->request, Mapping_Syms));
+    SET(sidx+0, s48_enter_integer(q->request));
     SET(sidx+1, s48_enter_integer(q->first_keycode));
-    SET(sidx+2, s48_enter_integer(q->count));
+    SET(sidx+2, s48_enter_fixnum(q->count));
   } break;
 
   default: {
@@ -308,8 +309,8 @@ s48_value scx_enter_event(XEvent* e) {
   // more??
   
   // And the Event-Name
-  temp2 = Bit_To_Symbol(e->type, Event_Syms);
+  temp = s48_enter_integer(e->type);
-  r = s48_cons(temp2, r);
+  r = s48_cons(temp, r);
 
   S48_GC_UNPROTECT();
   return r;
@@ -345,8 +346,8 @@ s48_value scx_Get_Motion_Events(s48_value Xdisplay, s48_value Xwindow,
 
   S48_GC_PROTECT_3(v, l, t);
   for (i = 0; i < n; i++) {
-    t = s48_enter_integer(p[i].y);    l = s48_cons(t, S48_NULL);
+    t = s48_enter_fixnum(p[i].y);    l = s48_cons(t, S48_NULL);
-    t = s48_enter_integer(p[i].x);    l = s48_cons(t, l);
+    t = s48_enter_fixnum(p[i].x);    l = s48_cons(t, l);
     t = SCX_ENTER_TIME(p[i].time);   l = s48_cons(t, l);
 
     S48_VECTOR_SET(v, i, l);

c/xlib/font.c

@@ -107,21 +107,23 @@ s48_value scx_List_Fonts(s48_value Xdisplay, s48_value pattern) {
 }
 
 s48_value scx_Font_Properties(s48_value Xfontstruct) {
-  s48_value v = S48_FALSE;
+  s48_value v, t = S48_FALSE;
   int i,n;
   XFontStruct* fs = SCX_EXTRACT_FONTSTRUCT(Xfontstruct);
   XFontProp* p;
-  S48_DECLARE_GC_PROTECT(1);
+  S48_DECLARE_GC_PROTECT(2);
 
   n = fs->n_properties;
   v = s48_make_vector(n, S48_FALSE);
-  S48_GC_PROTECT_1(v);
+  S48_GC_PROTECT_2(v, t);
 
   for (i = 0; i < n; i++) {
     p = fs->properties+i;
-    S48_VECTOR_SET(v, i, s48_cons( SCX_ENTER_ATOM(p->name),
+    t = SCX_ENTER_ATOM(p->name);
-				   s48_enter_integer(p->card32) ));
+    t = s48_cons(t, s48_enter_integer(p->card32));
+    S48_VECTOR_SET(v, i, t);
   }
+
   S48_GC_UNPROTECT();
   return v;
 }
@@ -142,15 +144,15 @@ s48_value scx_Font_Info(s48_value Xfontstruct) {
   S48_DECLARE_GC_PROTECT(1);
   S48_GC_PROTECT_1(v);
   
-  S48_VECTOR_SET(v, 0, Bit_To_Symbol(fs->direction, Direction_Syms));
+  S48_VECTOR_SET(v, 0, s48_enter_fixnum(fs->direction));
-  S48_VECTOR_SET(v, 1, s48_enter_integer(fs->min_char_or_byte2));
+  S48_VECTOR_SET(v, 1, s48_enter_fixnum(fs->min_char_or_byte2));
-  S48_VECTOR_SET(v, 2, s48_enter_integer(fs->max_char_or_byte2));
+  S48_VECTOR_SET(v, 2, s48_enter_fixnum(fs->max_char_or_byte2));
-  S48_VECTOR_SET(v, 3, s48_enter_integer(fs->min_byte1));
+  S48_VECTOR_SET(v, 3, s48_enter_fixnum(fs->min_byte1));
-  S48_VECTOR_SET(v, 4, s48_enter_integer(fs->max_byte1));
+  S48_VECTOR_SET(v, 4, s48_enter_fixnum(fs->max_byte1));
   S48_VECTOR_SET(v, 5, S48_ENTER_BOOLEAN(fs->all_chars_exist));
-  S48_VECTOR_SET(v, 6, s48_enter_integer(fs->default_char));
+  S48_VECTOR_SET(v, 6, s48_enter_fixnum(fs->default_char));
-  S48_VECTOR_SET(v, 7, s48_enter_integer(fs->ascent));
+  S48_VECTOR_SET(v, 7, s48_enter_fixnum(fs->ascent));
-  S48_VECTOR_SET(v, 8, s48_enter_integer(fs->descent));
+  S48_VECTOR_SET(v, 8, s48_enter_fixnum(fs->descent));
 
   S48_GC_UNPROTECT();
   return v;
@@ -172,12 +174,13 @@ s48_value scx_Char_Info(s48_value Xfontstruct, s48_value index) {
   
   v = s48_make_vector(6, S48_FALSE);
   S48_GC_PROTECT_1(v);
-  S48_VECTOR_SET(v, 0, s48_enter_integer(cp->lbearing));
+
-  S48_VECTOR_SET(v, 1, s48_enter_integer(cp->rbearing));
+  S48_VECTOR_SET(v, 0, s48_enter_fixnum(cp->lbearing));
-  S48_VECTOR_SET(v, 2, s48_enter_integer(cp->width));
+  S48_VECTOR_SET(v, 1, s48_enter_fixnum(cp->rbearing));
-  S48_VECTOR_SET(v, 3, s48_enter_integer(cp->ascent));
+  S48_VECTOR_SET(v, 2, s48_enter_fixnum(cp->width));
-  S48_VECTOR_SET(v, 4, s48_enter_integer(cp->descent));
+  S48_VECTOR_SET(v, 3, s48_enter_fixnum(cp->ascent));
-  S48_VECTOR_SET(v, 5, s48_enter_integer(cp->attributes));
+  S48_VECTOR_SET(v, 4, s48_enter_fixnum(cp->descent));
+  S48_VECTOR_SET(v, 5, s48_enter_fixnum(cp->attributes));
 
   S48_GC_UNPROTECT();
   return v;

c/xlib/gcontext.c

@@ -1,84 +1,56 @@
 #include "xlib.h"
 
 unsigned long Values_To_GCValues(s48_value values, XGCValues* GCV) {
-  unsigned long mask = 0;
+  unsigned long mask = s48_extract_integer(S48_CAR(values));
-  int i;
+  s48_value v = S48_CDR(values);
-  for (i=0; i<23; i++) {
+
-    s48_value value = S48_VECTOR_REF(values, i);
+  if (mask & GCFunction)
-    if (S48_FALSE != value) {
+    GCV->function = s48_extract_integer(S48_VECTOR_REF(v, 0));
-      switch (i) {
+  if (mask & GCPlaneMask)
-      case 0: GCV->function = Symbol_To_Bit(value, Func_Syms);
+    GCV->plane_mask = SCX_EXTRACT_PIXEL(S48_VECTOR_REF(v, 1));
-	mask |= GCFunction;
+  if (mask & GCForeground)
-	break;
+    GCV->foreground = SCX_EXTRACT_PIXEL(S48_VECTOR_REF(v, 2));
-      case 1: GCV->plane_mask = SCX_EXTRACT_PIXEL(value);
+  if (mask & GCBackground)
-	mask |= GCPlaneMask;
+    GCV->background = SCX_EXTRACT_PIXEL(S48_VECTOR_REF(v, 3));
-	break;
+  if (mask & GCLineWidth)
-      case 2: GCV->foreground = SCX_EXTRACT_PIXEL(value);
+    GCV->line_width = s48_extract_integer(S48_VECTOR_REF(v, 4));
-	mask |= GCForeground;
+  if (mask & GCLineStyle)
-	break;
+    GCV->line_style = s48_extract_integer(S48_VECTOR_REF(v, 5));
-      case 3: GCV->background = SCX_EXTRACT_PIXEL(value);
+  if (mask & GCCapStyle)
-	mask |= GCBackground;
+    GCV->cap_style = s48_extract_integer(S48_VECTOR_REF(v, 6));
-	break;
+  if (mask & GCJoinStyle)
-      case 4: GCV->line_style = Symbol_To_Bit(value,Line_Style_Syms);
+    GCV->join_style = s48_extract_integer(S48_VECTOR_REF(v, 7));
-	mask |= GCLineStyle;
+  if (mask & GCFillStyle)
-	break;
+    GCV->fill_style = s48_extract_integer(S48_VECTOR_REF(v, 8));
-      case 5: GCV->cap_style = Symbol_To_Bit(value, Cap_Style_Syms);
+  if (mask & GCFillRule)
-	mask |= GCCapStyle;
+    GCV->fill_rule = s48_extract_integer(S48_VECTOR_REF(v, 9));
-	break;
+  if (mask & GCTile)
-      case 6: GCV->cap_style = Symbol_To_Bit(value, Cap_Style_Syms);
+    GCV->tile = SCX_EXTRACT_PIXMAP(S48_VECTOR_REF(v, 10));
-	mask |= GCCapStyle;
+  if (mask & GCStipple)
-	break;
+    GCV->stipple = SCX_EXTRACT_PIXMAP(S48_VECTOR_REF(v, 11));
-      case 7: GCV->join_style = Symbol_To_Bit(value, Join_Style_Syms);
+  if (mask & GCTileStipXOrigin)
-	mask |= GCJoinStyle;
+    GCV->ts_x_origin = s48_extract_integer(S48_VECTOR_REF(v, 12));
-	break;
+  if (mask & GCTileStipYOrigin)
-      case 8: GCV->fill_style = Symbol_To_Bit(value, Fill_Style_Syms);
+    GCV->ts_y_origin = s48_extract_integer(S48_VECTOR_REF(v, 13));
-	mask |= GCFillStyle;
+  if (mask & GCFont)
-	break;
+    GCV->font = SCX_EXTRACT_FONT(S48_VECTOR_REF(v, 14));
-      case 9: GCV->fill_rule = Symbol_To_Bit(value, Fill_Rule_Syms);
+  if (mask & GCSubwindowMode)
-	mask |= GCFillRule;
+    GCV->subwindow_mode = s48_extract_integer(S48_VECTOR_REF(v, 15));
-	break;
+  if (mask & GCGraphicsExposures)
-      case 10: GCV->tile = SCX_EXTRACT_PIXMAP(value);
+    GCV->graphics_exposures = S48_ENTER_BOOLEAN(S48_VECTOR_REF(v, 16));
-	mask |= GCTile;
+  if (mask & GCClipXOrigin)
-	break;
+    GCV->clip_x_origin = s48_extract_integer(S48_VECTOR_REF(v, 17));
-      case 11: GCV->stipple = SCX_EXTRACT_PIXMAP(value);
+  if (mask & GCClipYOrigin)
-	mask |= GCStipple;
+    GCV->clip_y_origin = s48_extract_integer(S48_VECTOR_REF(v, 18));
-	break;
+  if (mask & GCClipMask)
-      case 12: GCV->ts_x_origin = s48_extract_integer(value);
+    GCV->clip_mask = SCX_EXTRACT_PIXMAP(S48_VECTOR_REF(v, 19));
-	mask |= GCTileStipXOrigin;
+  if (mask & GCDashOffset)
-	break;
+    GCV->dash_offset = s48_extract_integer(S48_VECTOR_REF(v, 20));
-      case 13: GCV->ts_y_origin = s48_extract_integer(value);
+  if (mask & GCDashList)
-	mask |= GCTileStipYOrigin;
+    GCV->dashes = (char)s48_extract_integer(S48_VECTOR_REF(v, 21));
-	break;
+  if (mask & GCArcMode)
-      case 14: GCV->font = SCX_EXTRACT_FONT(value);
+    GCV->arc_mode = s48_extract_integer(S48_VECTOR_REF(v, 22));
-	mask |= GCFont;
+
-	break;
-      case 15: GCV->subwindow_mode = Symbol_To_Bit(value, Subwin_Mode_Syms);
-	mask |= GCSubwindowMode;
-	break;
-      case 16: GCV->graphics_exposures = !S48_FALSE_P(value);
-	mask |= GCGraphicsExposures;
-	break;
-      case 17: GCV->clip_x_origin = s48_extract_integer(value);
-	mask |= GCClipXOrigin;
-	break;
-      case 18: GCV->clip_y_origin = s48_extract_integer(value);
-	mask |= GCClipYOrigin;
-	break;
-      case 19: GCV->clip_mask = SCX_EXTRACT_PIXMAP(value);
-	mask |= GCClipMask;
-	break;
-      case 20: GCV->dash_offset = s48_extract_integer(value);
-	mask |= GCDashOffset;
-	break;
-      case 21: GCV->dashes = (char)s48_extract_integer(value);
-	mask |= GCDashList;
-	break;
-      case 22: GCV->arc_mode = Symbol_To_Bit(value, Arc_Mode_Syms);
-	mask |= GCArcMode;
-	break;
-      }
-    }
-  }
   return mask;
 }
 
@@ -102,9 +74,7 @@ s48_value scx_Copy_Gc(s48_value Xdisplay, s48_value Xsource, s48_value Xdest) {
 
 s48_value scx_Copy_Gc_To_Gc(s48_value Xdisplay, s48_value Xfrom, s48_value Xto,
 			    s48_value attrs) {
-  unsigned long mask = 0;
+  unsigned long mask = s48_extract_integer(attrs); // -1 for all! ??
-  mask = S48_SYMBOL_P(attrs) ? Symbol_To_Bit(attrs, Gcontext_Values_Syms) :
-    Symbols_To_Bits(attrs, Gcontext_Values_Syms);
   XCopyGC(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_GCONTEXT(Xfrom), 
 	  mask, SCX_EXTRACT_GCONTEXT(Xto));
   return S48_UNSPECIFIC;
@@ -137,32 +107,34 @@ s48_value scx_Get_Gc_Values (s48_value Xgcontext, s48_value Xdisplay) {
     res = s48_make_vector(23, S48_FALSE);
     S48_GC_PROTECT_1(res);
 
-    S48_VECTOR_SET(res, 0, Bit_To_Symbol(GCV.function, Func_Syms));
+    S48_VECTOR_SET(res, 0, s48_enter_integer(GCV.function));
     S48_VECTOR_SET(res, 1, SCX_ENTER_PIXEL(GCV.plane_mask));
     S48_VECTOR_SET(res, 2, SCX_ENTER_PIXEL(GCV.foreground));
     S48_VECTOR_SET(res, 3, SCX_ENTER_PIXEL(GCV.background));
-    S48_VECTOR_SET(res, 4, s48_enter_integer(GCV.line_width));
+    S48_VECTOR_SET(res, 4, s48_enter_fixnum(GCV.line_width));
-    S48_VECTOR_SET(res, 5, Bit_To_Symbol(GCV.line_style, Line_Style_Syms));
+    S48_VECTOR_SET(res, 5, s48_enter_integer(GCV.line_style));
-    S48_VECTOR_SET(res, 6, Bit_To_Symbol(GCV.cap_style, Cap_Style_Syms));
+    S48_VECTOR_SET(res, 6, s48_enter_integer(GCV.cap_style));
-    S48_VECTOR_SET(res, 7, Bit_To_Symbol(GCV.join_style, Join_Style_Syms));
+    S48_VECTOR_SET(res, 7, s48_enter_integer(GCV.join_style));
-    S48_VECTOR_SET(res, 8, Bit_To_Symbol(GCV.fill_style, Fill_Style_Syms));
+    S48_VECTOR_SET(res, 8, s48_enter_integer(GCV.fill_style));
-    S48_VECTOR_SET(res, 9, Bit_To_Symbol(GCV.fill_rule, Fill_Rule_Syms));
+    S48_VECTOR_SET(res, 9, s48_enter_integer(GCV.fill_rule));
-    S48_VECTOR_SET(res, 10, Bit_To_Symbol(GCV.arc_mode, Arc_Mode_Syms));
+    S48_VECTOR_SET(res, 10, s48_enter_integer(GCV.arc_mode));
     S48_VECTOR_SET(res, 11, SCX_ENTER_PIXMAP(GCV.tile));
     S48_VECTOR_SET(res, 12, SCX_ENTER_PIXMAP(GCV.stipple));
-    S48_VECTOR_SET(res, 13, s48_enter_integer(GCV.ts_x_origin));
+    S48_VECTOR_SET(res, 13, s48_enter_fixnum(GCV.ts_x_origin));
-    S48_VECTOR_SET(res, 14, s48_enter_integer(GCV.ts_y_origin));
+    S48_VECTOR_SET(res, 14, s48_enter_fixnum(GCV.ts_y_origin));
     S48_VECTOR_SET(res, 15, SCX_ENTER_FONT(GCV.font));
-    S48_VECTOR_SET(res, 16, Bit_To_Symbol(GCV.subwindow_mode, 
+    S48_VECTOR_SET(res, 16, s48_enter_integer(GCV.subwindow_mode));
-					  Subwin_Mode_Syms));
+    S48_VECTOR_SET(res, 17, S48_ENTER_BOOLEAN(GCV.graphics_exposures));
-    S48_VECTOR_SET(res, 17, GCV.graphics_exposures ? S48_TRUE : S48_FALSE);
+    S48_VECTOR_SET(res, 18, s48_enter_fixnum(GCV.clip_x_origin));
-    S48_VECTOR_SET(res, 18, s48_enter_integer(GCV.clip_x_origin));
+    S48_VECTOR_SET(res, 19, s48_enter_fixnum(GCV.clip_y_origin));
-    S48_VECTOR_SET(res, 19, s48_enter_integer(GCV.clip_y_origin));
     S48_VECTOR_SET(res, 20, SCX_ENTER_PIXMAP(GCV.clip_mask));
     S48_VECTOR_SET(res, 21, s48_enter_integer(GCV.dash_offset));
     S48_VECTOR_SET(res, 22, s48_enter_integer(GCV.dashes));
-  }
+
+    res = s48_cons(s48_enter_integer(mask), res);
+    
     S48_GC_UNPROTECT();
+  }
   return res;
 }
 
@@ -218,26 +190,25 @@ s48_value scx_Set_Gcontext_Clip_Rectangles (s48_value Xgcontext,
 		      SCX_EXTRACT_GCONTEXT(Xgcontext), 
 		      (int)s48_extract_integer (x),
 		      (int)s48_extract_integer (y), p, n, 
-		      Symbol_To_Bit(ord, Ordering_Syms));
+		      s48_extract_integer(ord));
 
   return S48_UNSPECIFIC;
 }
 
 s48_value scx_Query_Best_Size (s48_value Xdisplay, s48_value width, 
 			       s48_value height, s48_value shape) {
-
   unsigned int rw, rh;
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
 
   if (!XQueryBestSize (dpy, 
-		       Symbol_To_Bit (shape, Shape_Syms), 
+		       s48_extract_integer(shape),
 		       DefaultRootWindow (dpy), //??
 		       (int)s48_extract_integer (width), 
 		       (int)s48_extract_integer (height), 
 		       &rw, &rh))
     return S48_FALSE;
   else
-    return s48_cons (s48_enter_integer (rw), s48_enter_integer (rh));
+    return s48_cons (s48_enter_fixnum (rw), s48_enter_fixnum (rh));
 }
 
 

c/xlib/grab.c

@@ -1,7 +1,4 @@
 #include "xlib.h"
-#include "scheme48.h"
-
-
 
 int Get_Mode (s48_value m){
   return S48_EXTRACT_BOOLEAN(m) ? GrabModeSync :GrabModeAsync;
@@ -16,13 +13,13 @@ s48_value scx_Grab_Pointer (s48_value dpy, s48_value win,
   int res = XGrabPointer(SCX_EXTRACT_DISPLAY(dpy),
 			 SCX_EXTRACT_WINDOW(win),
 			 S48_EXTRACT_BOOLEAN(ownerp),
-			 Symbols_To_Bits(events, Event_Syms),
+			 s48_extract_integer(events),
 			 Get_Mode(psyncp), 
 			 Get_Mode(ksyncp),
 			 SCX_EXTRACT_WINDOW(confine_to),
 			 SCX_EXTRACT_CURSOR(cursor),
 			 SCX_EXTRACT_TIME(time));
-  return Bit_To_Symbol(res, Grabstatus_Syms);
+  return s48_enter_integer(res);
 }
 
 
@@ -37,11 +34,11 @@ s48_value scx_Grab_Button (s48_value dpy, s48_value win, s48_value button,
 			   s48_value psyncp, s48_value  ksyncp, 
 			   s48_value confine_to, s48_value cursor){
   XGrabButton(SCX_EXTRACT_DISPLAY(dpy),
-	      Symbol_To_Bit(button, Button_Syms),
+	      s48_extract_integer(button),
-	      Symbols_To_Bits (mods, State_Syms),
+	      s48_extract_integer(mods),
 	      SCX_EXTRACT_WINDOW(win),
 	      S48_EXTRACT_BOOLEAN(ownerp),
-	      Symbols_To_Bits(events, Event_Syms),
+	      s48_extract_integer(events),
 	      Get_Mode(psyncp), Get_Mode(ksyncp),
 	      SCX_EXTRACT_WINDOW(confine_to),
 	      SCX_EXTRACT_CURSOR(cursor));
@@ -52,8 +49,8 @@ s48_value scx_Grab_Button (s48_value dpy, s48_value win, s48_value button,
 s48_value scx_Ungrab_Button (s48_value Xdpy, s48_value Xwin,
 			     s48_value button, s48_value mods){
   XUngrabButton(SCX_EXTRACT_DISPLAY(Xdpy), 
-		Symbol_To_Bit(button, Button_Syms),
+		s48_extract_integer(button),
-		Symbols_To_Bits (mods, State_Syms),
+		s48_extract_integer(mods),
 		SCX_EXTRACT_WINDOW(Xwin));
   return S48_UNSPECIFIC;
 }
@@ -62,7 +59,7 @@ s48_value scx_Ungrab_Button (s48_value Xdpy, s48_value Xwin,
 s48_value scx_Change_Active_Pointer_Grab (s48_value Xdpy, s48_value events,
 					  s48_value cursor, s48_value time){
     XChangeActivePointerGrab (SCX_EXTRACT_DISPLAY(Xdpy),
-			      Symbols_To_Bits(events, Event_Syms),
+			      s48_extract_integer(events),
 			      SCX_EXTRACT_CURSOR(cursor),
 			      SCX_EXTRACT_TIME(time));
     return S48_UNSPECIFIC;
@@ -72,14 +69,13 @@ s48_value scx_Change_Active_Pointer_Grab (s48_value Xdpy, s48_value events,
 s48_value scx_Grab_Keyboard (s48_value Xdpy, s48_value Xwin, s48_value ownerp, 
 			     s48_value psyncp, s48_value ksyncp,
 			     s48_value time){
-  return Bit_To_Symbol((unsigned long)XGrabKeyboard (
+  int res = XGrabKeyboard( SCX_EXTRACT_DISPLAY(Xdpy),
-			   SCX_EXTRACT_DISPLAY(Xdpy),
 			   SCX_EXTRACT_WINDOW(Xwin),
 			   S48_EXTRACT_BOOLEAN(ownerp),
 			   Get_Mode(psyncp),
 			   Get_Mode (ksyncp),
-			   SCX_EXTRACT_TIME(time)),
+			   SCX_EXTRACT_TIME(time));
-		       Grabstatus_Syms);
+  return s48_enter_integer(res);
 }
 
 
@@ -98,7 +94,7 @@ s48_value scx_Grab_Key (s48_value Xdpy, s48_value Xwin, s48_value key,
     keycode = (int)s48_extract_integer(key);
   XGrabKey (SCX_EXTRACT_DISPLAY(Xdpy),
 	    keycode, 
-	    Symbols_To_Bits (mods, State_Syms),
+	    s48_extract_integer(mods),
 	    SCX_EXTRACT_WINDOW(Xwin),
 	    S48_EXTRACT_BOOLEAN(ownerp),
 	    Get_Mode(psyncp),
@@ -114,7 +110,7 @@ s48_value scx_Ungrab_Key (s48_value Xdpy, s48_value Xwin, s48_value key,
     keycode = (int)s48_extract_integer(key);
   XUngrabKey (SCX_EXTRACT_DISPLAY(Xdpy),
 	      keycode,
-	      Symbols_To_Bits (mods, State_Syms),
+	      s48_extract_integer(mods),
 	      SCX_EXTRACT_WINDOW(Xwin));
   return S48_UNSPECIFIC;
 }
@@ -122,14 +118,12 @@ s48_value scx_Ungrab_Key (s48_value Xdpy, s48_value Xwin, s48_value key,
 
 s48_value scx_Allow_Events (s48_value Xdpy, s48_value mode, s48_value time){
   XAllowEvents (SCX_EXTRACT_DISPLAY(Xdpy),
-		Symbol_To_Bit (mode, Allow_Events_Syms),
+		s48_extract_integer(mode),
 		SCX_EXTRACT_TIME(time));
     return S48_UNSPECIFIC;
 }
 
 
-
-
 s48_value scx_Grab_Server (s48_value Xdpy){
   XGrabServer(SCX_EXTRACT_DISPLAY(Xdpy));
   return S48_UNSPECIFIC;

c/xlib/graphics.c

@@ -287,7 +287,7 @@ s48_value scx_Fill_Polygon (s48_value Xdisplay, s48_value Xdrawable,
 			s48_value relative, s48_value shape){
   int n = S48_VECTOR_LENGTH(vec);
   int mode;
-  int sh = (int)Symbol_To_Bit(shape, Polyshape_Syms);
+  int sh = s48_extract_integer(shape);
   XPoint p[n];
   Vector_To_XPoints(vec, p, n);
   mode = !S48_FALSE_P(relative) ? CoordModePrevious : CoordModeOrigin;

c/xlib/init.c

@@ -1,5 +1,4 @@
 #include "xlib.h"
-#include "scheme48.h"
 
 s48_value scx_Xlib_Release_4_Or_Later () {
     return S48_TRUE;
@@ -21,8 +20,16 @@ s48_value scx_Xlib_Release_6_Or_Later () {
 #endif
 }
 
+s48_value symbol_now_binding = S48_FALSE;
+
+s48_value symbol_now() {
+  return S48_SHARED_BINDING_REF(symbol_now_binding);
+}
 
 void scx_init_init(void) {
+  S48_GC_PROTECT_GLOBAL(symbol_now_binding);
+  // *symbol-now* is defined in helper.scm
+  symbol_now_binding = s48_get_imported_binding("*symbol-now*");
   S48_EXPORT_FUNCTION(scx_Xlib_Release_4_Or_Later);
   S48_EXPORT_FUNCTION(scx_Xlib_Release_5_Or_Later);
   S48_EXPORT_FUNCTION(scx_Xlib_Release_6_Or_Later);

c/xlib/key.c

@@ -1,5 +1,4 @@
 #include "xlib.h"
-#include "scheme48.h"
 
 //#ifdef XLIB_RELEASE_5_OR_LATER
 // I don't know if XDisplayKeycodes() was already there in X11R4.
@@ -8,13 +7,13 @@
 s48_value scx_Display_Min_Keycode (s48_value d) {
   int mink, maxk;
   XDisplayKeycodes(SCX_EXTRACT_DISPLAY(d), &mink, &maxk);
-  return s48_enter_integer(mink);
+  return s48_enter_fixnum(mink);
 }
 
 s48_value scx_Display_Max_Keycode (s48_value d) {
   int mink, maxk;
   XDisplayKeycodes(SCX_EXTRACT_DISPLAY(d), &mink, &maxk);
-  return s48_enter_integer(maxk);
+  return s48_enter_fixnum(maxk);
 }
 
 //#ifdef XLIB_RELEASE_5_OR_LATER
@@ -28,7 +27,7 @@ s48_value scx_Display_Keysyms_Per_Keycode (s48_value d) {
   ksyms = XGetKeyboardMapping(SCX_EXTRACT_DISPLAY(d), (KeyCode)mink,
 			      maxk - mink + 1, &ksyms_per_kode);
   XFree(ksyms);
-  return s48_enter_integer(ksyms_per_kode);
+  return s48_enter_fixnum(ksyms_per_kode);
 }
 
 //#else
@@ -38,7 +37,7 @@ s48_value scx_Display_Keysyms_Per_Keycode (s48_value d) {
 //    Disable_Interrupts;
 //    (void)XKeycodeToKeysym (DISPLAY(d)->dpy, DISPLAY(d)->dpy->min_keycode, 0);
 //    Enable_Interrupts;
-//    return s48_enter_integer (DISPLAY(d)->dpy->keysyms_per_keycode);
+//    return s48_enter_fixnum (DISPLAY(d)->dpy->keysyms_per_keycode);
 //}
 //#endif
 
@@ -69,7 +68,7 @@ s48_value scx_Keysym_To_Keycode (s48_value d, s48_value k) {
   kc = XKeysymToKeycode (SCX_EXTRACT_DISPLAY(d),
 			 (KeySym)s48_extract_integer(k));
   //Enable_Interrupts;
-  return s48_enter_integer(kc);
+  return s48_enter_fixnum(kc);
 }
 
 s48_value scx_Lookup_String (s48_value d, s48_value k, s48_value mask) {
@@ -81,7 +80,7 @@ s48_value scx_Lookup_String (s48_value d, s48_value k, s48_value mask) {
 
   e.display = SCX_EXTRACT_DISPLAY(d);
   e.keycode = (int)s48_extract_integer(k);
-  e.state = Symbols_To_Bits(mask, State_Syms);
+  e.state = s48_extract_integer(mask);
   //Disable_Interrupts;
   len = XLookupString (&e, buf, 1024, &keysym_return, &status_return);
   //Enable_Interrupts;
@@ -109,7 +108,7 @@ s48_value scx_Refresh_Keyboard_Mapping (s48_value d, s48_value w,
   fake.type = MappingNotify;
   fake.display = SCX_EXTRACT_DISPLAY(d);
   fake.window = SCX_EXTRACT_WINDOW(w);
-  fake.request = Symbol_To_Bit (event, Mapping_Syms);
+  fake.request = s48_extract_integer(event);
   XRefreshKeyboardMapping (&fake);
   return S48_UNSPECIFIC;
 }

c/xlib/pixel.c

@@ -11,7 +11,8 @@ s48_value scx_White_Pixel(s48_value Xdisplay) {
   return SCX_ENTER_PIXEL( WhitePixel(dpy, DefaultScreen(dpy)) );
 }
 
-s48_value scx_Free_Pixel(s48_value Xpixel, s48_value Xdisplay, s48_value Xcolormap) {
+s48_value scx_Free_Pixel(s48_value Xpixel, s48_value Xdisplay,
+			 s48_value Xcolormap) {
   unsigned long pixels[1];
   pixels[0] = SCX_EXTRACT_PIXEL(Xpixel);
   

c/xlib/pixmap.c

@@ -57,13 +57,13 @@ s48_value scx_Read_Bitmap_File (s48_value Xdisplay, s48_value Xdrawable,
 			 &xhot, &yhot);
   // Not used: Enable_Interrupts;
   if (res != BitmapSuccess){
-    return Bit_To_Symbol ((unsigned long)ret, Bitmapstatus_Syms);
+    return s48_enter_integer(ret);
   }
   S48_GC_PROTECT_1 (ret);
-  ret = s48_cons (s48_enter_integer(yhot), S48_NULL);
+  ret = s48_cons (s48_enter_fixnum(yhot), S48_NULL);
-  ret = s48_cons (s48_enter_integer(xhot), ret);
+  ret = s48_cons (s48_enter_fixnum(xhot), ret);
-  ret = s48_cons (s48_enter_integer(height), ret);
+  ret = s48_cons (s48_enter_fixnum(height), ret);
-  ret = s48_cons (s48_enter_integer(width), ret);
+  ret = s48_cons (s48_enter_fixnum(width), ret);
   ret = s48_cons (SCX_ENTER_PIXMAP(bitmap), ret);
   S48_GC_UNPROTECT();
   return ret;
@@ -84,7 +84,7 @@ s48_value scx_Write_Bitmap_File (s48_value Xdisplay, s48_value file,
 			  (int)s48_extract_integer(x), 
 			  (int)s48_extract_integer(y));
   //  Enable_Interrupts;
-  return Bit_To_Symbol ((unsigned long)ret, Bitmapstatus_Syms);
+  return s48_enter_integer(ret);
 }
 
 

c/xlib/property.c

@@ -102,7 +102,7 @@ s48_value scx_Change_Property(s48_value Xdisplay, s48_value Xwindow,
 			  s48_value data){
   int i, x, f, m, nitems;
   char* buf;
-  m = Symbol_To_Bit (mode, Propmode_Syms);
+  m = s48_extract_integer(mode);
   f = (int)s48_extract_integer(format);
   switch (f) {
   case 8:

c/xlib/region.c

@@ -17,10 +17,10 @@ s48_value scx_Clip_Box(s48_value Xregion) {
   XClipBox(SCX_EXTRACT_REGION(Xregion), &r);
   
   S48_GC_PROTECT_1(v);
-  S48_VECTOR_SET(v, 0, s48_enter_integer(r.x));
+  S48_VECTOR_SET(v, 0, s48_enter_fixnum(r.x));
-  S48_VECTOR_SET(v, 1, s48_enter_integer(r.y));  
+  S48_VECTOR_SET(v, 1, s48_enter_fixnum(r.y));  
-  S48_VECTOR_SET(v, 2, s48_enter_integer(r.width));  
+  S48_VECTOR_SET(v, 2, s48_enter_fixnum(r.width));  
-  S48_VECTOR_SET(v, 3, s48_enter_integer(r.height));
+  S48_VECTOR_SET(v, 3, s48_enter_fixnum(r.height));
 
   S48_GC_UNPROTECT();
   return v;
@@ -51,7 +51,7 @@ s48_value scx_Rect_In_Region(s48_value Xregion, s48_value x, s48_value y,
   if (res == RectangleIn) res = 1;
   else if (res == RectangleOut) res = 0;
   else if (res == RectanglePart) res = 2;
-  return s48_enter_integer(res);
+  return s48_enter_fixnum(res);
 }
 
 s48_value scx_Intersect_Region(s48_value Xr1, s48_value Xr2) {
@@ -126,7 +126,7 @@ s48_value scx_Copy_Region(s48_value Xfrom, s48_value Xto) {
 s48_value scx_Polygon_Region(s48_value points, s48_value fillrule) {
   int n = S48_VECTOR_LENGTH(points);
   XPoint ps[n];
-  int fill_rule = Symbols_To_Bits(fillrule, Fill_Rule_Syms);
+  int fill_rule = s48_extract_integer(fillrule);
   int i;
   Region res;
   for (i=0; i < n; i++) {

c/xlib/text.c

@@ -31,7 +31,7 @@ s48_value scx_Text_Width(s48_value Xfontstruct, s48_value text,
     }
     i = XTextWidth(font, s, len);
   }
-  return s48_enter_integer((long)i);
+  return s48_enter_fixnum((long)i);
 }
   
 
@@ -57,15 +57,15 @@ s48_value scx_Extents_Text (s48_value Xfontstruct, s48_value text,
   }
   switch(s48_extract_integer(which)){
   case 0:
-    return s48_enter_integer((long) CI.lbearing);
+    return s48_enter_fixnum((long) CI.lbearing);
   case 1:
-    return s48_enter_integer((long) CI.rbearing);
+    return s48_enter_fixnum((long) CI.rbearing);
   case 2:
-    return s48_enter_integer((long) CI.width);
+    return s48_enter_fixnum((long) CI.width);
   case 3:
-    return s48_enter_integer((long) CI.ascent);
+    return s48_enter_fixnum((long) CI.ascent);
   case 4:
-    return s48_enter_integer((long) CI.descent);
+    return s48_enter_fixnum((long) CI.descent);
   }
   return S48_FALSE;
 }

c/xlib/util.c

@@ -28,38 +28,18 @@ s48_value scx_Parse_Geometry (s48_value strg) {
   S48_DECLARE_GC_PROTECT(1);
 
   res = XParseGeometry (s48_extract_string(strg), &x, &y, &w, &h);
+
+  ret = s48_make_vector(6, S48_FALSE);
+
   S48_GC_PROTECT_1(ret);
-  if (res & XNegative) {
+  if (res & XNegative) S48_VECTOR_SET(ret, 0, S48_TRUE);
-    ret = s48_cons(S48_TRUE, S48_NULL);
+  if (res & YNegative) S48_VECTOR_SET(ret, 1, S48_TRUE);
-  }else{
+  if (res & XValue) S48_VECTOR_SET(ret, 2, s48_enter_fixnum(x));
-    ret = s48_cons(S48_FALSE, S48_NULL);
+  if (res & YValue) S48_VECTOR_SET(ret, 3, s48_enter_fixnum(y));
-  }
+  if (res & WidthValue) S48_VECTOR_SET(ret, 4, s48_enter_fixnum(w));
-  if (res & YNegative) {
+  if (res & HeightValue) S48_VECTOR_SET(ret, 5, s48_enter_fixnum (h));
-    ret = s48_cons(S48_TRUE, ret);
-  }else{
-    ret = s48_cons(S48_FALSE, ret);
-  }
-  if (res & XValue) {
-    ret = s48_cons(s48_enter_integer(x), ret);
-  }else{
-    ret = s48_cons(S48_FALSE, ret);
-  }
-  if (res & YValue) {
-    ret = s48_cons(s48_enter_integer(y), ret);
-  }else{
-    ret = s48_cons(S48_FALSE, ret);
-  }
-  if (res & WidthValue) {
-    ret = s48_cons(s48_enter_integer(w), ret);
-  }else{
-    ret = s48_cons(S48_FALSE, ret);
-  }
-  if (res & HeightValue) {
-    ret = s48_cons(s48_enter_integer (h), ret);
-  }else{
-    ret = s48_cons(S48_FALSE, ret);
-  }
   S48_GC_UNPROTECT();
+
   return ret;
 }
 

c/xlib/visual.c

@@ -1,26 +1,55 @@
 #include "xlib.h"
 
-s48_value Enter_Visual_Info(XVisualInfo* vi) {
+s48_value Enter_Visual_And_Visual_Info(XVisualInfo* vi) {
   s48_value t = s48_make_vector(10, S48_FALSE);
   S48_DECLARE_GC_PROTECT(1);
   
   S48_GC_PROTECT_1(t);
 
-  S48_VECTOR_SET(t, 0, SCX_ENTER_VISUAL(vi->visual));
+  S48_VECTOR_SET(t, 0, s48_enter_integer(vi->visualid));
-  S48_VECTOR_SET(t, 1, s48_enter_integer(vi->visualid));
+  S48_VECTOR_SET(t, 1, s48_enter_fixnum(vi->screen));
-  S48_VECTOR_SET(t, 2, s48_enter_integer(vi->screen));
+  S48_VECTOR_SET(t, 2, s48_enter_fixnum(vi->depth));
-  S48_VECTOR_SET(t, 3, s48_enter_integer(vi->depth));
+  S48_VECTOR_SET(t, 3, s48_enter_integer(vi->class));
-  S48_VECTOR_SET(t, 4, Bit_To_Symbol(vi->class, Visual_Class_Syms));
+  S48_VECTOR_SET(t, 4, s48_enter_integer(vi->red_mask));
-  S48_VECTOR_SET(t, 5, s48_enter_integer(vi->red_mask));
+  S48_VECTOR_SET(t, 5, s48_enter_integer(vi->green_mask));
-  S48_VECTOR_SET(t, 6, s48_enter_integer(vi->green_mask));
+  S48_VECTOR_SET(t, 6, s48_enter_integer(vi->blue_mask));
-  S48_VECTOR_SET(t, 7, s48_enter_integer(vi->blue_mask));
+  S48_VECTOR_SET(t, 7, s48_enter_integer(vi->colormap_size));
-  S48_VECTOR_SET(t, 8, s48_enter_integer(vi->colormap_size));
+  S48_VECTOR_SET(t, 8, s48_enter_fixnum(vi->bits_per_rgb));
-  S48_VECTOR_SET(t, 9, s48_enter_integer(vi->bits_per_rgb));
+
+  t = s48_cons(s48_enter_integer(VisualAllMask), t);
+
+  t = s48_cons(SCX_ENTER_VISUAL(vi->visual), t);
 
   S48_GC_UNPROTECT();
   return t;
 }
 
+unsigned long Extract_Visual_Info(s48_value vi, XVisualInfo* VI) {
+  unsigned long mask = s48_extract_integer(S48_CAR(vi));
+  s48_value v = S48_CDR(vi);
+  
+  if (mask & VisualIDMask)
+    VI->visualid = s48_extract_integer(S48_VECTOR_REF(v, 0));
+  if (mask & VisualScreenMask)
+    VI->screen = s48_extract_integer(S48_VECTOR_REF(v, 1));
+  if (mask & VisualDepthMask)
+    VI->depth = s48_extract_integer(S48_VECTOR_REF(v, 2));
+  if (mask & VisualClassMask)
+    VI->class = s48_extract_integer(S48_VECTOR_REF(v, 3));
+  if (mask & VisualRedMaskMask)
+    VI->red_mask = s48_extract_integer(S48_VECTOR_REF(v, 4));
+  if (mask & VisualGreenMaskMask)
+    VI->green_mask = s48_extract_integer(S48_VECTOR_REF(v, 5));
+  if (mask & VisualBlueMaskMask)
+    VI->blue_mask = s48_extract_integer(S48_VECTOR_REF(v, 6));
+  if (mask & VisualColormapSizeMask)
+    VI->colormap_size = s48_extract_integer(S48_VECTOR_REF(v, 7));
+  if (mask & VisualBitsPerRGBMask)
+    VI->bits_per_rgb = s48_extract_integer(S48_VECTOR_REF(v, 8));
+
+  return mask;
+}
+
 s48_value scx_Get_Visual_Info(s48_value Xdisplay, s48_value v) {
   XVisualInfo template;
   XVisualInfo* visualList;
@@ -29,50 +58,7 @@ s48_value scx_Get_Visual_Info(s48_value Xdisplay, s48_value v) {
   s48_value res = S48_FALSE;
   S48_DECLARE_GC_PROTECT(1);
 
-  for (i=1; i<10; i++) {
+  mask = Extract_Visual_Info(v, &template);
-    s48_value val = S48_VECTOR_REF(v, i);
-    if (!S48_FALSE_P(val)) {
-      switch (i) {
-	// 0 = visual is not allowed here.
-      case 1: {
-	template.visualid = s48_extract_integer(val);
-	mask |= VisualIDMask;
-      } break;
-      case 2: {
-	template.screen = s48_extract_integer(val);
-	mask |= VisualScreenMask;
-      } break;
-      case 3: {
-	template.depth = s48_extract_integer(val);
-	mask |= VisualDepthMask;
-      } break;
-      case 4: {
-	template.class = Symbol_To_Bit(val, Visual_Class_Syms);
-	mask |= VisualClassMask;
-      } break;
-      case 5: {
-	template.red_mask = s48_extract_integer(val);
-	mask |= VisualRedMaskMask;
-      } break;
-      case 6: {
-	template.green_mask = s48_extract_integer(val);
-	mask |= VisualGreenMaskMask;
-      } break;
-      case 7: {
-	template.blue_mask = s48_extract_integer(val);
-	mask |= VisualBlueMaskMask;
-      } break;
-      case 8: {
-	template.colormap_size = s48_extract_integer(val);
-	mask |= VisualColormapSizeMask;
-      } break;
-      case 9: {
-	template.bits_per_rgb = s48_extract_integer(val);
-	mask |= VisualBitsPerRGBMask;
-      } break;
-      }
-    }
-  }
   
   visualList = XGetVisualInfo( SCX_EXTRACT_DISPLAY(Xdisplay),
 			       mask, &template, &visualsMatch);
@@ -81,7 +67,7 @@ s48_value scx_Get_Visual_Info(s48_value Xdisplay, s48_value v) {
   S48_GC_PROTECT_1(res);
   
   for (i=0; i<visualsMatch; i++)
-    S48_VECTOR_SET(res, i, Enter_Visual_Info(&visualList[i]));
+    S48_VECTOR_SET(res, i, Enter_Visual_And_Visual_Info(&visualList[i]));
   
   S48_GC_UNPROTECT();
   return res;
@@ -97,9 +83,9 @@ s48_value scx_Match_Visual_Info(s48_value Xdisplay, s48_value scrnum,
   if (XMatchVisualInfo(SCX_EXTRACT_DISPLAY(Xdisplay),
 		       s48_extract_integer(scrnum),
 		       s48_extract_integer(depth),
-		       Symbol_To_Bit(class, Visual_Class_Syms),
+		       s48_extract_integer(class),
 		       &r))
-    return Enter_Visual_Info(&r);
+    return Enter_Visual_And_Visual_Info(&r);
   else
     return S48_FALSE;
 }    

c/xlib/window.c

@@ -2,62 +2,39 @@
 
 unsigned long Attribs_To_XSetWindowAttributes(s48_value attribs, 
 					      XSetWindowAttributes* Xattrs) {
-  int i; unsigned long mask = 0;
+  unsigned long mask = s48_extract_integer(S48_CAR(attribs));
-  for (i=0; i<15; i++) {
+  s48_value v = S48_CDR(attribs);
-    s48_value value = S48_VECTOR_REF(attribs, i);
+  if (mask & CWBackPixmap)
-    if (S48_FALSE != value) {
+    Xattrs->background_pixmap = SCX_EXTRACT_PIXMAP(S48_VECTOR_REF(v, 0));
-      switch (i) {
+  if (mask & CWBackPixel)
-       case 0: Xattrs->background_pixmap = 
+    Xattrs->background_pixel = s48_extract_integer(S48_VECTOR_REF(v, 1));
-          S48_SYMBOL_P(value) ? ParentRelative : SCX_EXTRACT_PIXMAP(value);
+  if (mask & CWBorderPixmap)
-	mask |= CWBackPixmap;
+    Xattrs->border_pixmap = SCX_EXTRACT_PIXMAP(S48_VECTOR_REF(v, 2));
-	break;
+  if (mask & CWBorderPixel)
-      case 1: Xattrs->background_pixel = s48_extract_integer(value); 
+    Xattrs->border_pixel = s48_extract_integer(S48_VECTOR_REF(v, 3));
-	mask |= CWBackPixel;
+  if (mask & CWBitGravity)
-	break;
+    Xattrs->bit_gravity = s48_extract_integer(S48_VECTOR_REF(v, 4));
-      case 2: Xattrs->border_pixmap = 
+  if (mask & CWWinGravity)
-          S48_SYMBOL_P(value) ? CopyFromParent : s48_extract_integer(value);
+    Xattrs->win_gravity = s48_extract_integer(S48_VECTOR_REF(v, 5));
-	mask |= CWBorderPixmap;
+  if (mask & CWBackingStore)
-	break;
+    Xattrs->backing_store = s48_extract_integer(S48_VECTOR_REF(v, 6));
-      case 3: Xattrs->border_pixel = s48_extract_integer(value); 
+  if (mask & CWBackingPlanes)
-	mask |= CWBitGravity;
+    Xattrs->backing_planes = s48_extract_integer(S48_VECTOR_REF(v, 7));
-	break;
+  if (mask & CWBackingPixel)
-      case 4: Xattrs->bit_gravity = Symbol_To_Bit(value, Bit_Grav_Syms); 
+    Xattrs->backing_pixel = s48_extract_integer(S48_VECTOR_REF(v, 8));
-	mask |= CWBitGravity;
+  if (mask & CWOverrideRedirect)
-	break;
+    Xattrs->override_redirect = s48_extract_integer(S48_VECTOR_REF(v, 9));
-      case 5: Xattrs->win_gravity = Symbol_To_Bit(value, Grav_Syms); 
+  if (mask & CWSaveUnder)
-	mask |= CWWinGravity;
+    Xattrs->save_under = s48_extract_integer(S48_VECTOR_REF(v, 10));
-	break;
+  if (mask & CWEventMask)
-      case 6: Xattrs->backing_store = Symbol_To_Bit(value, Backing_Store_Syms);
+    Xattrs->event_mask = s48_extract_integer(S48_VECTOR_REF(v, 11));
-	mask |= CWBackingStore;
+  if (mask & CWDontPropagate)
-	break;
+    Xattrs->do_not_propagate_mask = s48_extract_integer(S48_VECTOR_REF(v, 12));
-      case 7: Xattrs->backing_planes = s48_extract_integer(value); 
+  if (mask & CWColormap)
-	mask |= CWBackingPlanes;
+    Xattrs->colormap = SCX_EXTRACT_COLORMAP(S48_VECTOR_REF(v, 13)); 
-	break;
+  if (mask & CWCursor)
-      case 8: Xattrs->backing_pixel = s48_extract_integer(value); 
+    Xattrs->cursor = SCX_EXTRACT_CURSOR(S48_VECTOR_REF(v, 14));
-	mask |= CWBackingPixel;
+
-	break;
-      case 9: Xattrs->override_redirect = s48_extract_integer(value); 
-	mask |= CWOverrideRedirect;
-	break;
-      case 10: Xattrs->save_under = s48_extract_integer(value); 
-	mask |= CWSaveUnder;
-	break;
-      case 11: Xattrs->event_mask = Symbols_To_Bits(value, Event_Mask_Syms); 
-	mask |= CWEventMask;
-	break;
-      case 12: Xattrs->do_not_propagate_mask = 
-		 Symbols_To_Bits(value, Event_Mask_Syms); 
-	mask |= CWDontPropagate;
-	break;
-      case 13: Xattrs->colormap = s48_extract_integer(value); 
-	mask |= CWColormap;
-	break;
-      case 14: Xattrs->cursor = s48_extract_integer(value); 
-	mask |= CWCursor;
-	break;
-      }
-    }
-  }
   return mask;
 }
 
@@ -119,7 +96,8 @@ s48_value scx_Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
 
   s48_value res = S48_NULL;
 
-  if (!XGetWindowAttributes(SCX_EXTRACT_DISPLAY(Xdisplay),SCX_EXTRACT_WINDOW(Xwindow),
+  if (!XGetWindowAttributes(SCX_EXTRACT_DISPLAY(Xdisplay),
+			    SCX_EXTRACT_WINDOW(Xwindow),
 			    &WA))
     res = S48_FALSE;
   else {
@@ -127,36 +105,32 @@ s48_value scx_Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
   
     res = s48_make_vector(23, S48_FALSE);
 
-    S48_VECTOR_SET(res, 0, s48_enter_integer(WA.x));
+    S48_VECTOR_SET(res, 0, s48_enter_fixnum(WA.x));
-    S48_VECTOR_SET(res, 1, s48_enter_integer(WA.y));
+    S48_VECTOR_SET(res, 1, s48_enter_fixnum(WA.y));
-    S48_VECTOR_SET(res, 2, s48_enter_integer(WA.width));
+    S48_VECTOR_SET(res, 2, s48_enter_fixnum(WA.width));
-    S48_VECTOR_SET(res, 3, s48_enter_integer(WA.height));
+    S48_VECTOR_SET(res, 3, s48_enter_fixnum(WA.height));
-    S48_VECTOR_SET(res, 4, s48_enter_integer(WA.border_width));
+    S48_VECTOR_SET(res, 4, s48_enter_fixnum(WA.border_width));
-    S48_VECTOR_SET(res, 5, s48_enter_integer(WA.depth));
+    S48_VECTOR_SET(res, 5, s48_enter_fixnum(WA.depth));
     S48_VECTOR_SET(res, 6, SCX_ENTER_VISUAL(WA.visual));
     S48_VECTOR_SET(res, 7, SCX_ENTER_WINDOW(WA.root));
-    S48_VECTOR_SET(res, 8, Bit_To_Symbol(WA.class, Class_Syms));
+    S48_VECTOR_SET(res, 8, s48_enter_integer(WA.class));
-    S48_VECTOR_SET(res, 9, Bit_To_Symbol(WA.bit_gravity, Bit_Grav_Syms));
+    S48_VECTOR_SET(res, 9, s48_enter_integer(WA.bit_gravity));
-    S48_VECTOR_SET(res, 10, Bit_To_Symbol(WA.win_gravity, Grav_Syms));
+    S48_VECTOR_SET(res, 10, s48_enter_integer(WA.win_gravity));
-    S48_VECTOR_SET(res, 11, Bit_To_Symbol(WA.backing_store, 
+    S48_VECTOR_SET(res, 11, s48_enter_integer(WA.backing_store));
-					  Backing_Store_Syms));
     S48_VECTOR_SET(res, 12, s48_enter_integer(WA.backing_planes));
     S48_VECTOR_SET(res, 13, SCX_ENTER_PIXEL(WA.backing_pixel));
-    S48_VECTOR_SET(res, 14, WA.save_under ? S48_TRUE : S48_FALSE );
+    S48_VECTOR_SET(res, 14, s48_enter_fixnum(WA.save_under));
     S48_VECTOR_SET(res, 15, SCX_ENTER_COLORMAP(WA.colormap));
-    S48_VECTOR_SET(res, 16, WA.map_installed ? S48_TRUE : S48_FALSE);
+    S48_VECTOR_SET(res, 16, s48_enter_fixnum(WA.map_installed));
-    S48_VECTOR_SET(res, 17, Bit_To_Symbol( WA.map_state, Map_State_Syms));
+    S48_VECTOR_SET(res, 17, s48_enter_integer(WA.map_state));
-    S48_VECTOR_SET(res, 18, Bits_To_Symbols( WA.all_event_masks, 
+    S48_VECTOR_SET(res, 18, s48_enter_integer(WA.all_event_masks));
-					     Event_Mask_Syms ));
+    S48_VECTOR_SET(res, 19, s48_enter_integer(WA.your_event_mask));
-    S48_VECTOR_SET(res, 19, Bits_To_Symbols( WA.your_event_mask, 
+    S48_VECTOR_SET(res, 20, s48_enter_integer(WA.do_not_propagate_mask));
-					     Event_Mask_Syms ));
+    S48_VECTOR_SET(res, 21, s48_enter_fixnum(WA.override_redirect));
-    S48_VECTOR_SET(res, 20, Bits_To_Symbols( WA.do_not_propagate_mask, 
-					     Event_Mask_Syms ));
-    S48_VECTOR_SET(res, 21, WA.override_redirect ? S48_TRUE : S48_FALSE);
-    
     S48_VECTOR_SET(res, 22, S48_FALSE);
-    //S48_VECTOR_SET(res, 22, s48_enter_integer((long)WA.screen));
+    //S48_VECTOR_SET(res, 22, s48_enter_fixnum((long)WA.screen));
     // WA.screen not yet supported
+    res = s48_cons(s48_enter_integer((1L<<23) - 1), res);
   }
 
   S48_GC_UNPROTECT();
@@ -164,32 +138,16 @@ s48_value scx_Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
 }
 
 s48_value Changes_To_XWindowChanges(s48_value changes, XWindowChanges* WC) {
-  int i; unsigned long mask = 0;
+  unsigned long mask = s48_extract_integer(S48_CAR(changes));
-  for (i=0; i<7; i++) {
+  s48_value v = S48_CDR(changes);
-    s48_value value = S48_VECTOR_REF(changes, i);
+
-    if (S48_FALSE != value) {
+  WC->x = s48_extract_integer(S48_VECTOR_REF(v, 0));
-      switch (i) {
+  WC->y = s48_extract_integer(S48_VECTOR_REF(v, 1));
-      case 0: WC->x = s48_extract_integer(value);
+  WC->width = s48_extract_integer(S48_VECTOR_REF(v, 2));
-	mask |= CWX;
+  WC->height = s48_extract_integer(S48_VECTOR_REF(v, 3));
-	break;
+  WC->sibling = SCX_EXTRACT_WINDOW(S48_VECTOR_REF(v, 4));
-      case 2: WC->y = s48_extract_integer(value);
+  WC->stack_mode = s48_extract_integer(S48_VECTOR_REF(v, 5));
-	mask |= CWY;
+
-	break;
-      case 3: WC->width = s48_extract_integer(value);
-	mask |= CWWidth;
-	break;
-      case 4: WC->height = s48_extract_integer(value);
-	mask |= CWHeight;
-	break;
-      case 5: WC->sibling = SCX_EXTRACT_WINDOW(value);
-	mask |= CWSibling;
-	break;
-      case 6: WC->stack_mode = Symbol_To_Bit(value, Stack_Mode_Syms);
-	mask |= CWStackMode;
-	break;
-      }
-    }
-  }
   return mask;
 }
 
@@ -214,7 +172,8 @@ s48_value scx_Unmap_Window(s48_value Xwindow, s48_value Xdisplay) {
 }
 
 s48_value scx_Destroy_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
-  XDestroySubwindows(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_WINDOW(Xwindow));
+  XDestroySubwindows(SCX_EXTRACT_DISPLAY(Xdisplay),
+		     SCX_EXTRACT_WINDOW(Xwindow));
   return S48_UNSPECIFIC;
 }
 
@@ -230,7 +189,8 @@ s48_value scx_Unmap_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
 
 s48_value scx_Circulate_Subwindows(s48_value Xwindow, s48_value Xdisplay,
 				   s48_value dir) {
-  XCirculateSubwindows(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_WINDOW(Xwindow), 
+  XCirculateSubwindows(SCX_EXTRACT_DISPLAY(Xdisplay),
+		       SCX_EXTRACT_WINDOW(Xwindow), 
 		       S48_FALSE_P(dir) ? RaiseLowest : LowerHighest);
   return S48_UNSPECIFIC;
 }
@@ -285,8 +245,8 @@ s48_value scx_Translate_Coordinates (s48_value Xdisplay, s48_value srcXwindow,
   S48_GC_PROTECT_1 (v);
 
   v = s48_make_vector(3, S48_FALSE);
-  S48_VECTOR_SET(v, 0, s48_enter_integer(rx));
+  S48_VECTOR_SET(v, 0, s48_enter_fixnum(rx));
-  S48_VECTOR_SET(v, 1, s48_enter_integer(ry));
+  S48_VECTOR_SET(v, 1, s48_enter_fixnum(ry));
   S48_VECTOR_SET(v, 2, SCX_ENTER_WINDOW(child));
 
   S48_GC_UNPROTECT();
@@ -308,14 +268,14 @@ s48_value scx_Query_Pointer (s48_value Xdisplay, s48_value Xwindow) {
   v = s48_make_vector(8, S48_FALSE);
   S48_GC_PROTECT_1(v);
 
-  S48_VECTOR_SET(v, 0, s48_enter_integer(x));
+  S48_VECTOR_SET(v, 0, s48_enter_fixnum(x));
-  S48_VECTOR_SET(v, 1, s48_enter_integer(y));
+  S48_VECTOR_SET(v, 1, s48_enter_fixnum(y));
   S48_VECTOR_SET(v, 2, ret ? S48_TRUE : S48_FALSE);
   S48_VECTOR_SET(v, 3, SCX_ENTER_WINDOW(root));
-  S48_VECTOR_SET(v, 4, s48_enter_integer(r_x));
+  S48_VECTOR_SET(v, 4, s48_enter_fixnum(r_x));
-  S48_VECTOR_SET(v, 5, s48_enter_integer(r_y));
+  S48_VECTOR_SET(v, 5, s48_enter_fixnum(r_y));
   S48_VECTOR_SET(v, 6, SCX_ENTER_WINDOW(child));
-  S48_VECTOR_SET(v, 7, Bits_To_Symbols ((unsigned long)mask, State_Syms));
+  S48_VECTOR_SET(v, 7, s48_enter_integer((unsigned long)mask));
 
   S48_GC_UNPROTECT();
   return v;
@@ -324,7 +284,8 @@ s48_value scx_Query_Pointer (s48_value Xdisplay, s48_value Xwindow) {
 s48_value scx_Get_Geometry(s48_value Xdisplay, s48_value Xdrawable) {
   s48_value v = S48_FALSE;
   Window root;
-  unsigned int x,y,width,height,border_width,depth;
+  int x, y;
+  unsigned int width, height, border_width, depth;
   S48_DECLARE_GC_PROTECT(1);
 
   XGetGeometry(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_DRAWABLE(Xdrawable),
@@ -333,12 +294,12 @@ s48_value scx_Get_Geometry(s48_value Xdisplay, s48_value Xdrawable) {
   v = s48_make_vector(7, S48_FALSE);
   S48_GC_PROTECT_1(v);
   S48_VECTOR_SET(v, 0, SCX_ENTER_WINDOW(root));
-  S48_VECTOR_SET(v, 1, s48_enter_integer(x));
+  S48_VECTOR_SET(v, 1, s48_enter_fixnum(x));
-  S48_VECTOR_SET(v, 2, s48_enter_integer(y));
+  S48_VECTOR_SET(v, 2, s48_enter_fixnum(y));
-  S48_VECTOR_SET(v, 3, s48_enter_integer(width));
+  S48_VECTOR_SET(v, 3, s48_enter_fixnum(width));
-  S48_VECTOR_SET(v, 4, s48_enter_integer(height));
+  S48_VECTOR_SET(v, 4, s48_enter_fixnum(height));
-  S48_VECTOR_SET(v, 5, s48_enter_integer(border_width));
+  S48_VECTOR_SET(v, 5, s48_enter_fixnum(border_width));
-  S48_VECTOR_SET(v, 6, s48_enter_integer(depth));
+  S48_VECTOR_SET(v, 6, s48_enter_fixnum(depth));
   S48_GC_UNPROTECT();
   return v;
 }

c/xlib/wm.c

@@ -44,13 +44,10 @@ s48_value scx_List_Installed_Colormaps(s48_value Xdisplay, s48_value Xwindow) {
 
 s48_value scx_Set_Input_Focus(s48_value Xdisplay, s48_value Xwindow, 
 			      s48_value revert_to, s48_value time) {
-  Window focus = PointerRoot;
+  Window focus = SCX_EXTRACT_WINDOW(Xwindow);
-  
-  if (!S48_SYMBOL_P(Xwindow))
-    focus = SCX_EXTRACT_WINDOW(Xwindow);
   
   XSetInputFocus (SCX_EXTRACT_DISPLAY(Xdisplay), focus, 
-		  Symbol_To_Bit (revert_to, Revert_Syms), 
+		  s48_extract_integer(revert_to),
 		  SCX_EXTRACT_TIME(time));
   return S48_UNSPECIFIC;
 }
@@ -65,7 +62,7 @@ s48_value scx_Input_Focus (s48_value Xdisplay) {
   ret = s48_cons (S48_NULL, S48_NULL);
   S48_GC_PROTECT_1 (ret);
   S48_SET_CAR(ret, SCX_ENTER_WINDOW(win));
-  S48_SET_CDR(ret, Bit_To_Symbol((unsigned long)revert_to, Revert_Syms));
+  S48_SET_CDR(ret, s48_enter_integer(revert_to));
 
   S48_GC_UNPROTECT();
   return ret;
@@ -99,13 +96,13 @@ s48_value scx_Set_Access_Control(s48_value Xdisplay, s48_value on) {
 s48_value scx_Change_Save_Set(s48_value Xdisplay, s48_value win, 
 			      s48_value mode) {
   XChangeSaveSet(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_WINDOW(win),
-		 Symbol_To_Bit(mode, Saveset_Syms));
+		 s48_extract_integer(mode));
   return S48_UNSPECIFIC;
 }
 
 s48_value scx_Set_Close_Down_Mode(s48_value Xdisplay, s48_value mode) {
   XSetCloseDownMode(SCX_EXTRACT_DISPLAY(Xdisplay),
-		    Symbol_To_Bit (mode, Closemode_Syms));
+		    s48_extract_integer(mode));
   return S48_UNSPECIFIC;
 }
 

c/xlib/xlib.h

@@ -21,7 +21,7 @@
 #define S48_FALSE_P(x) S48_EQ(x, S48_FALSE)
 #define S48_TRUE_P(x) S48_EQ(x, S48_TRUE)
 
-extern char* s48_extract_symbol(s48_value);
+extern s48_value symbol_now(); // defined in init.c
 
 /* Extraction-Macros for the new types, from their s48_value wrapping.
  */
@@ -42,7 +42,7 @@ extern char* s48_extract_symbol(s48_value);
 #define SCX_EXTRACT_DRAWABLE(x) (Drawable)s48_extract_integer(x)
 #define SCX_ENTER_ATOM(x) s48_enter_integer((long)x)
 #define SCX_EXTRACT_ATOM(x) (Atom)s48_extract_integer(x)
-#define SCX_ENTER_TIME(x) x == CurrentTime ? s48_enter_symbol("now") : s48_enter_integer(x)
+#define SCX_ENTER_TIME(x) x == CurrentTime ? symbol_now() : s48_enter_integer(x)
 #define SCX_EXTRACT_TIME(x) S48_SYMBOL_P(x) ? CurrentTime : (int)s48_extract_integer(x)
 #define SCX_EXTRACT_CURSOR(x) (Cursor)s48_extract_integer(x)
 #define SCX_ENTER_CURSOR(x) s48_enter_integer((long)x)
@@ -58,27 +58,3 @@ extern char* s48_extract_symbol(s48_value);
 extern unsigned long AList_To_XWindowChanges(s48_value alist, 
 					     XWindowChanges* WC);
 
-typedef struct {
-    Window root;
-    int x, y, width, height, border_width, depth;
-} GEOMETRY;
-
-
-typedef struct {
-  char *name;
-  unsigned long val;
-} SYMDESCR;
-
-
-
-extern SYMDESCR Func_Syms[], Bit_Grav_Syms[], Event_Syms[], Error_Syms[],
-  Grav_Syms[], Backing_Store_Syms[], Class_Syms[], Stack_Mode_Syms[],
-  Line_Style_Syms[], State_Syms[], Cap_Style_Syms[], Join_Style_Syms[],
-  Map_State_Syms[], Fill_Style_Syms[], Fill_Rule_Syms[], Arc_Mode_Syms[],
-  Subwin_Mode_Syms[], Button_Syms[], Cross_Mode_Syms[], Cross_Detail_Syms[],
-  Focus_Detail_Syms[], Place_Syms[], Visibility_Syms[], Prop_Syms[],
-  Mapping_Syms[], Direction_Syms[], Shape_Syms[], Propmode_Syms[],
-  Grabstatus_Syms[], Allow_Events_Syms[], Revert_Syms[], Polyshape_Syms[],
-  Initial_State_Syms[], Bitmapstatus_Syms[], Circulate_Syms[],
-  Ordering_Syms[], Byte_Order_Syms[], Saveset_Syms[], Closemode_Syms[],
-  Event_Mask_Syms[], Visual_Class_Syms[], Color_Flags_Syms[], Gcontext_Values_Syms[];

scheme/libs/libs-packages.scm

@@ -1,8 +1,8 @@
 (define-structure xpm xpm-interface
   (open scheme
 	xlib
-	xlib-types
+	xlib-internal-types
-	signals
+	signals primitives
 	external-calls
 	finite-types)
   (files xpm))

scheme/libs/xpm.scm

@@ -5,43 +5,60 @@
   xpm-attributes
   xpm-attribute-name
   xpm-attribute-index
-  (visual colormap depth color-symbols return-pixels exact-colors 
+  (visual colormap depth size hotspot char-per-pixel color-symbols rgb-filename
-   ;closeness rgb-closeness 
+   infos return-pixels extensions exact-colors closeness rgb-closeness
-   return-alloc-pixels alloc-close-colors
+   color-key color-table return-alloc-pixels alloc-close-colors bitmap-format
-   bitmap-format
+   alloc-color free-colors color-closure))
-   ))
+
+(define-enumerated-type bitmap-format :bitmap-format
+  bitmap-format? bitmap-formats bitmap-format-name bitmap-format-index
+  (xy-bitmap 
+   bitmap-format-1 ;; means xy-pixmap, but is not allowed as a bitmap-format
+   z-pixmap))
+
+(define (integer->bitmap-format int)
+  (vector-ref bitmap-formats int))
+
+(define (bitmap-format->integer v)
+  (bitmap-format-index v))
+
+(define xpm-attribute-alist->integer+vector
+  (make-enum-alist->integer+vector
+   xpm-attributes xpm-attribute-index
+   (lambda (v)
+     (cond
+      ((eq? v (xpm-attribute visual))
+       visual-Xvisual)
+      ((eq? v (xpm-attribute colormap))
+       colormap-Xcolormap)
+      ((eq? v (xpm-attribute depth))
+       (lambda (x) x))
+;      ((eq? v (xpm-attribute color-symbols))
+;       (lambda (color-symbols)
+;	 (list->vector
+;	  (map (lambda (mapping)
+;		 (list->vector
+;		  (list (name->string (car mapping))
+;			(name->string (cadr mapping))
+;			(pixel-Xpixel (caddr mapping)))))
+;	       color-symbols))))
+      ((or (eq? v (xpm-attribute return-pixels))
+	   (eq? v (xpm-attribute return-alloc-pixels)))
+       (lambda (x) x))
+      ((or (eq? v (xpm-attribute exact-colors))
+	   (eq? v (xpm-attribute alloc-close-colors)))
+       (lambda (x) (if x 1 0)))
+      ((eq? v (xpm-attribute bitmap-format))
+       bitmap-format->integer) ;; xypixmap not allowed
+      (else (lambda (x)
+	      (warn "attribute not supported" v)
+	      (unspecific)))))))
 
 (define (name->string obj)
   (if (symbol? obj)
       (symbol->string obj)
       obj))
 
-(define xpm-attribute-alist->vector
-  (make-enum-alist->vector
-   xpm-attributes xpm-attribute-index
-   (lambda (i)
-     (case i
-       ((0) visual-Xvisual)
-       ((1) colormap-Xcolormap)
-       ((2) (lambda (x) x))
-       ((3) (lambda (color-symbols)
-	      (list->vector
-	       (map (lambda (mapping)
-		      (list->vector
-		       (list (name->string (car mapping))
-			     (name->string (cadr mapping))
-			     (pixel-Xpixel (caddr mapping)))))
-		    color-symbols))))
-       ((4 6) (lambda (x) x))
-       ((5 7) (lambda (x)
-		    (if x 1 0)))
-       ((8) (lambda (bitmap-format)
-	      (case bitmap-format
-		((z-pixmap) 0)
-		((xy-bitmap) 1)
-		(else (error "illegal bitmap format" bitmap-format)))))
-       ))))
-
 (define (make-result display vec)
   (vector-set! vec 0 (make-pixmap (vector-ref vec 0) 
 				  display #t))
@@ -54,7 +71,7 @@
 	    (display-Xdisplay (drawable-display drawable))
 	    (drawable-Xobject drawable)
 	    data
-	    (xpm-attribute-alist->vector xpm-attribute-alist))))
+	    (xpm-attribute-alist->integer+vector xpm-attribute-alist))))
     (case r
       ((0) (error "Not enough memory!"))
       ((1) (error "Invalid XPM-File data." data))
@@ -74,7 +91,7 @@
 	    (display-Xdisplay (drawable-display drawable))
 	    (drawable-Xobject drawable)
 	    filename
-	    (xpm-attribute-alist->vector xpm-attribute-alist))))
+	    (xpm-attribute-alist->integer+vector xpm-attribute-alist))))
     (case r
       ((0) (error "Not enough memory!"))
       ((1) (error "Invalid XPM-File data." filename))

scheme/xlib/client.scm

@@ -38,7 +38,7 @@
   (if (not (%reconfigure-wm-window (display-Xdisplay (window-display window))
 				   (window-Xwindow window)
 				   screen-number
-				   (window-change-alist->vector
+				   (window-change-alist->integer+vector
 				    window-change-alist)))
       (error "cannot reconfigure window"
 	     window)))
@@ -91,10 +91,15 @@
 ;; set-text-property! sets the property specified by atom of the
 ;; specified window to value - a list of strings or symbols.
 
+(define (s->s s)
+  (if (symbol? s)
+      (symbol->string s)
+      s))
+
 (define (set-text-property! window value atom)
   (let ((res (%set-text-property! (display-Xdisplay (window-display window))
 				  (window-Xwindow window)
-				  (list->vector value)
+				  (list->vector (map s->s value))
 				  (atom-Xatom atom))))
     (if res
 	res
@@ -165,6 +170,16 @@
 ;; enumerated type for the XWMHints type. used by set-wm-hints! and
 ;; get-wm-hints.
 
+(define-enumerated-type initial-state :initial-state
+  initial-state? initial-states initial-state-name initial-state-index
+  (withdrawn normal initial-state-2 iconic initial-state-4))
+
+(define (initial-state->integer v)
+  (initial-state-index v))
+
+(define (integer->initial-state i)
+  (vector-ref initial-states i))
+
 (define-enumerated-type wm-hint :wm-hint
   wm-hint?
   wm-hints
@@ -182,30 +197,45 @@
    ((make-wm-hint-alist)
     '())))
 
-(define wm-hint-alist->vector
+(define wm-hint-alist->integer+vector
-  (make-enum-alist->vector
+  (make-enum-alist->integer+vector
    wm-hints wm-hint-index
-   (lambda (i)
+   (lambda (v)
-     (case i
+     (cond
-       ((0 7) (lambda (x) (if x 1 0)))
+      ((or (eq? v (wm-hint input?))
-       ((2 5) pixmap-Xpixmap)
+	   (eq? v (wm-hint urgency)))
-       ((3 6) window-Xwindow)
+       (lambda (x) x))
-       (else (lambda (x) x))))))
+      ((eq? v (wm-hint initial-state))
+       initial-state->integer)
+      ((or (eq? v (wm-hint icon-pixmap))
+	   (eq? v (wm-hint icon-mask)))
+       pixmap-Xpixmap)
+      ((or (eq? v (wm-hint icon-window))
+	   (eq? v (wm-hint window-group)))
+       window-Xwindow)
+      ((eq? v (wm-hint icon-position))
+       (lambda (x) x))))))
 
-(define vector->wm-hint-alist
+(define (integer+vector->wm-hint-alist display)
-  (make-vector->enum-alist
+  (make-integer+vector->enum-alist
-   wm-hints
+   wm-hints wm-hint-index
-   (lambda (i display)
+   (lambda (v)
-     (case i
+     (cond
-       ((2 5) (lambda (Xpixmap)
+      ((or (eq? v (wm-hint input?))
-		(if (null? Xpixmap)
+	   (eq? v (wm-hint urgency)))
-		    '()
+       (lambda (x) x))
-		    (make-pixmap Xpixmap display #f))))
+      ((eq? v (wm-hint initial-state))
-       ((3 6) (lambda (Xwindow)
+       integer->initial-state)
-		(if (null? Xwindow)
+      ((or (eq? v (wm-hint icon-pixmap))
-		    '()
+	   (eq? v (wm-hint icon-mask)))
-		    (make-window Xwindow display #f))))
+       (lambda (Xpixmap)
-       (else (lambda (x) x))))))
+	 (make-pixmap Xpixmap display #f)))
+      ((or (eq? v (wm-hint icon-window))
+	   (eq? v (wm-hint window-group)))
+       (lambda (Xwindow)
+	 (make-window Xwindow display #f)))
+      ((eq? v (wm-hint icon-position))
+       (lambda (x) x))))))
 
 ;; get-wm-hints reads the window manager hints and returns them as an
 ;; alist mapping wm-hint types to specific values. If a hints is not
@@ -216,7 +246,7 @@
   (let ((res (%wm-hints (display-Xdisplay (window-display window))
 			(window-Xwindow window))))
     (filter (lambda (x) (not (null? (cdr x))))
-	    (vector->wm-hint-alist res (window-display window)))))
+	    ((integer+vector->wm-hint-alist (window-display window)) res))))
 
 (import-lambda-definition %wm-hints (Xdisplay Xwindow)
   "scx_Wm_Hints")
@@ -228,7 +258,7 @@
 (define (set-wm-hints! window wm-hint-alist)
   (%set-wm-hints! (display-Xdisplay (window-display window))
 		  (window-Xwindow window)
-		  (wm-hint-alist->vector wm-hint-alist)))
+		  (wm-hint-alist->integer+vector wm-hint-alist)))
 
 (import-lambda-definition %set-wm-hints! (Xdisplay Xwindow args)
   "scx_Set_Wm_Hints")
@@ -308,17 +338,23 @@
    ((make-size-hint-alist)
     '())))
 
-(define size-hint-alist->vector
+(define size-hint-alist->integer+vector
-  (make-enum-alist->vector
+  (make-enum-alist->integer+vector
    size-hints size-hint-index
-   (lambda (i)
+   (lambda (v)
-     (lambda (x) x))))
+     (cond
+      ((eq? v (size-hint win-gravity))
+       gravity->integer)
+      (else (lambda (x) x))))))
 
-(define vector->size-hint-alist
+(define integer+vector->size-hint-alist
   (make-vector->enum-alist
    size-hints
-   (lambda (i extra)
+   (lambda (v)
-     (lambda (x) x))))
+     (cond
+      ((eq? v (size-hint win-gravity))
+       integer->gravity)
+      (else (lambda (x) x))))))
 
 ;; get-wm-normal-hints/set-wm-normal-hints! get or set the size hints
 ;; stored in the WM_NORMAL_HINTS property on the specified window. The
@@ -331,7 +367,7 @@
   (let* ((v (%wm-normal-hints (display-Xdisplay (window-display window))
 			      (window-Xwindow window))))
         (filter (lambda (x) (not (null? (cdr x))))
-		(vector->size-hint-alist v #f))))
+		(integer+vector->size-hint-alist v))))
 
 (import-lambda-definition %wm-normal-hints (Xdisplay Xwindow)
   "scx_Wm_Normal_Hints")
@@ -339,7 +375,7 @@
 (define (set-wm-normal-hints! window size-hint-alist)
   (%set-wm-normal-hints! (display-Xdisplay (window-Xwindow window))
 			 (window-Xwindow window)
-			 (size-hint-alist->vector size-hint-alist)))
+			 (size-hint-alist->integer+vector size-hint-alist)))
 
 (import-lambda-definition %set-wm-normal-hints! (Xdisplay Xwindow alist)
   "scx_Set_Wm_Normal_Hints")

scheme/xlib/colormap.scm

@@ -114,9 +114,19 @@
   (%store-color (display-Xdisplay (colormap-display colormap))
 		(colormap-Xcolormap colormap)
 		(pixel-Xpixel pixel) (color-Xcolor color)
+		(color-flags->integer
 		 (if (null? flags)
 		     '(do-red do-green do-blue)
-		    (car flags))))
+		     (car flags)))))
+
+(define (color-flags->integer flags)
+  (fold-right (lambda (s res)
+		(case s
+		  ((do-red) (bitwise-ior res 1))
+		  ((do-green) (bitwise-ior res 2))
+		  ((do-blue) (bitwise-ior res 4))
+		  (else (error "illegal color-flag" s))))
+	      0 flags))
 
 (import-lambda-definition %store-color (Xdisplay Xcolormap Xpixel Xcolor 
 						 flags)
@@ -133,9 +143,10 @@
 		       (list->vector
 			(list (pixel-Xpixel (car p-c-f))
 			      (color-Xcolor (cadr p-c-f))
+			      (color-flags->integer
 			       (if (null? (cddr p-c-f))
 				   '(do-red do-green do-blue)
-				  (caddr p-c-f)))))
+				   (caddr p-c-f))))))
 		     cells))))
     (%store-colors (display-Xdisplay (colormap-display colormap))
 		   (colormap-Xcolormap colormap)

scheme/xlib/display.scm

@@ -165,7 +165,7 @@
 ;; 'msb-first.
 
 (define (display-image-byte-order display)
-  (%display-image-byte-order (display-Xdisplay display)))
+  (integer->byte-order (%display-image-byte-order (display-Xdisplay display))))
 
 (import-lambda-definition %display-image-byte-order (Xdisplay)
   "scx_Display_Image_Byte_Order")
@@ -183,7 +183,7 @@
 ;; See BitmapBitOrder.
 
 (define (display-bitmap-bit-order display)
-  (%display-bitmap-bit-order (display-Xdisplay display)))
+  (integer->bit-order (%display-bitmap-bit-order (display-Xdisplay display))))
 
 (import-lambda-definition %display-bitmap-bit-order (Xdisplay)
   "scx_Display_Bitmap_Bit_Order")
@@ -305,7 +305,7 @@
 (define (display-select-input window event-mask)
   (%display-select-input (display-Xdisplay (window-display window))
 			 (window-Xwindow window)
-			 event-mask))
+			 (event-mask->integer event-mask)))
 
 (import-lambda-definition %display-select-input (Xdisplay Xwindow Xevent-mask)
   "scx_Display_Select_Input")

scheme/xlib/drawable-type.scm

@@ -1,15 +1,37 @@
-;; abstractions for a "drawable" which is a window or a pixmap.
+;; A "drawable" is a window or a pixmap. But sometimes we can't know
+;; what it is. So in that case we just remember the display and the
+;; Xlib ID.
+
+(define-record-type drawable :drawable
+  (really-make-drawable Xobject display)
+  really-drawable?
+  (Xobject really-drawable-Xobject)
+  (display really-drawable-display))
 
 (define (drawable? object)
   (or (window? object)
-      (pixmap? object)))
+      (pixmap? object)
+      (really-drawable? object)))
 
-(define (drawable-abstraction pixmap-fun window-fun)
+(define (make-drawable Xobject display)
+  ;; let's see if we can find out what this object is? window/pixmap
+  (let ((is-window? (window-list-find Xobject))
+	(is-pixmap? (pixmap-list-find Xobject)))
+    (cond
+     (is-window? (make-window Xobject display #f))
+     (is-pixmap? (make-pixmap Xobject display #f))
+     (else (really-make-drawable Xobject display)))))
+
+(define (drawable-abstraction drawable-fun pixmap-fun window-fun)
   (lambda (drawable)
     (cond
+     ((really-drawable? drawable) (drawable-fun drawable))
      ((pixmap? drawable) (pixmap-fun drawable))
      ((window? drawable) (window-fun drawable))
      (else (error "expected a drawable object" drawable)))))
 
-(define drawable-display (drawable-abstraction pixmap-display window-display))
+(define drawable-display
-(define drawable-Xobject (drawable-abstraction pixmap-Xpixmap window-Xwindow))
+  (drawable-abstraction really-drawable-display pixmap-display window-display))
+
+(define drawable-Xobject
+  (drawable-abstraction really-drawable-Xobject pixmap-Xpixmap window-Xwindow))

scheme/xlib/error.scm

@@ -33,12 +33,23 @@
   (set! *most-recent-x-error*
 	(next-x-error *most-recent-x-error*)))
 
+(define-enumerated-type error-code :error-code
+  error-code? error-codes error-code-name error-code-index
+  (success bad-request bad-value bad-window bad-pixmap bad-atom
+   bad-cursor bad-font bad-match bad-drawable bad-access bad-alloc
+   bad-color bad-gc bad-id-choice bad-name bad-length bad-implementation))
+
+(define (integer->error-code i)
+  (if (< i (vector-length error-codes))
+      (vector-ref error-codes i)
+      ;; there can be larger numbers - extension errors
+      i))
 
 (define internal-x-error-handler
   (lambda (infos)
     (let ((display (make-display (vector-ref infos 0) #f))
 	  (ser-num (vector-ref infos 1))
-	  (error-code (vector-ref infos 2))
+	  (error-code (integer->error-code (vector-ref infos 2)))
 	  (major-opcode (vector-ref infos 3))
 	  (minor-opcode (vector-ref infos 4))
 	  (res-id (vector-ref infos 5))

scheme/xlib/event-types.scm

@@ -0,0 +1,859 @@
+;; An enumerated type for event types. They correspond to the
+;; constants defined in X.h. So don't change the order!
+
+(define-enumerated-type event-type :event-type
+  event-type?
+  event-types
+  event-type-name
+  event-type-index
+  (event-type-0 event-type-1 ;; those are not defined
+   key-press key-release button-press button-release motion-notify
+   enter-notify leave-notify focus-in focus-out keymap-notify expose
+   graphics-expose no-expose visibility-notify create-notify destroy-notify
+   unmap-notify map-notify map-request reparent-notify configure-notify
+   configure-request gravity-notify resize-request circulate-notify
+   circulate-request property-notify selection-clear selection-request
+   selection-notify colormap-notify client-message mapping-notify))
+
+(define (integer->event-type i)
+  (vector-ref event-types i))
+
+;; *******************************************************************
+
+(define (any-event-type event)
+  (let ((f
+	 (cond
+	  ((key-event? event) key-event-type)
+	  ((button-event? event) button-event-type)
+	  ((motion-event? event) motion-event-type)
+	  ((crossing-event? event) crossing-event-type)
+	  ((focus-change-event? event) focus-change-event-type)
+	  ((expose-event? event) expose-event-type)
+	  ((graphics-expose-event? event) graphics-expose-event-type)
+	  ((no-expose-event? event) no-expose-event-type)
+	  ((visibility-event? event) visibility-event-type)
+	  ((create-window-event? event) create-window-event-type)
+	  ((destroy-window-event? event) destroy-window-event-type)
+	  ((unmap-event? event) unmap-event-type)
+	  ((map-event? event) map-event-type)
+	  ((map-request-event? event) map-request-event-type)
+	  ((reparent-event? event) reparent-event-type)
+	  ((configure-event? event) configure-event-type)
+	  ((gravity-event? event) gravity-event-type)
+	  ((resize-request-event? event) resize-request-event-type)
+	  ((configure-request-event? event) configure-request-event-type)
+	  ((circulate-event? event) circulate-event-type)
+	  ((circulate-request-event? event) circulate-request-event-type)
+	  ((property-event? event) property-event-type)
+	  ((selection-clear-event? event) selection-clear-event-type)
+	  ((colormap-event? event) colormap-event-type)
+	  ((client-message-event? event) client-message-event-type)
+	  ((mapping-event? event) mapping-event-type)
+	  ((error-event? event) error-event-type)
+	  ((keymap-event? event) keymap-event-type))))
+    (f event)))
+
+;; *******************************************************************
+
+(define-record-type key-event :key-event
+  (really-make-key-event type serial send-event? display window root subwindow 
+			 time x y x-root y-root state keycode same-screen?)
+  key-event?
+  (type key-event-type)
+  (serial key-event-serial)
+  (send-event? key-event-send-event?)
+  (display key-event-display)
+  (window key-event-window)
+  (root key-event-root)
+  (subwindow key-event-subwindow)
+  (time key-event-time)
+  (x key-event-x)
+  (y key-event-y)
+  (x-root key-event-x-root)
+  (y-root key-event-y-root)
+  (state key-event-state)
+  (keycode key-event-keycode)
+  (same-screen? key-event-same-screen?))
+
+;(define (key-pressed-event? event)
+;  (and (key-event? event)
+;       (eq? (key-event-type event) (event-type key-pressed))))
+
+;(define (key-released-event? event)
+;  (and (key-event? event)
+;       (eq? (key-event-type event) (event-type key-released))))
+
+(define (make-key-event type serial send-event? display window root subwindow 
+			time x y x-root y-root state keycode same-screen?)
+  (let ((display (make-display display #f)))
+    (really-make-key-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-window root display #f)
+     (make-window subwindow display #f)
+     time x y x-root y-root
+     (integer->state-set state)
+     keycode same-screen?)))
+
+;; *******************************************************************
+
+(define-record-type button-event :button-event
+  (really-make-button-event type serial send-event? display window root
+			    subwindow time x y x-root y-root state button
+			    same-screen?)
+  button-event?
+  (type button-event-type)
+  (serial button-event-serial)
+  (send-event? button-event-send-event?)
+  (display button-event-display)
+  (window button-event-window)
+  (root button-event-root)
+  (subwindow button-event-subwindow)
+  (time button-event-time)
+  (x button-event-x)
+  (y button-event-y)
+  (x-root button-event-x-root)
+  (y-root button-event-y-root)
+  (state button-event-state)
+  (button button-event-button)
+  (same-screen? button-event-same-screen?))
+
+;(define (button-pressed-event? event)
+;  (and (button-event? event)
+;       (eq? (button-event-type event) (event-type button-pressed))))
+
+;(define (button-released-event? event)
+;  (and (button-event? event)
+;       (eq? (button-event-type event) (event-type button-released))))
+
+(define (make-button-event type serial send-event? display window root
+			   subwindow time x y x-root y-root state button
+			   same-screen?)
+  (let ((display (make-display display #f)))
+    (really-make-button-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-window root display #f)
+     (make-window subwindow display #f)
+     time x y x-root y-root
+     (integer->state-set state)
+     (integer->button button)
+     same-screen?)))
+
+;; *******************************************************************
+
+(define-record-type motion-event :motion-event
+  (really-make-motion-event type serial send-event? display window root
+			    subwindow time x y x-root y-root state is-hint?
+			    same-screen?)
+  motion-event?
+  (type motion-event-type)
+  (serial motion-event-serial)
+  (send-event? motion-event-send-event?)
+  (display motion-event-display)
+  (window motion-event-window)
+  (root motion-event-root)
+  (subwindow motion-event-subwindow)
+  (time motion-event-time)
+  (x motion-event-x)
+  (y motion-event-y)
+  (x-root motion-event-x-root)
+  (y-root motion-event-y-root)
+  (state motion-event-state)
+  (is-hint? motion-event-is-hint?)
+  (same-screen? motion-event-same-screen?))
+
+(define (make-motion-event type serial send-event? display window root
+			   subwindow time x y x-root y-root state is-hint?
+			   same-screen?)
+  (let ((display (make-display display #f)))
+    (really-make-button-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-window root display #f)
+     (make-window subwindow display #f)
+     time x y x-root y-root
+     (integer->state-set state)
+     (integer->is-hint? is-hint?) ;; subset of Notify Mode
+     same-screen?)))
+
+;; *******************************************************************
+
+(define-record-type crossing-event :crossing-event
+  (really-make-crossing-event type serial send-event? display window root 
+			      subwindow time x y x-root y-root mode detail 
+			      same-screen? focus? state)
+  crossing-event?
+  (type crossing-event-type)
+  (serial crossing-event-serial)
+  (send-event? crossing-event-send-event?)
+  (display crossing-event-display)
+  (window crossing-event-window)
+  (root crossing-event-root)
+  (subwindow crossing-event-subwindow)
+  (time crossing-event-time)
+  (x crossing-event-x)
+  (y crossing-event-y)
+  (x-root crossing-event-x-root)
+  (y-root crossing-event-y-root)
+  (mode crossing-event-mode)
+  (detail crossing-event-detail)
+  (same-screen? crossing-event-same-screen?)
+  (focus? crossing-event-focus?)
+  (state crossing-event-state))
+
+;(define (enter-window-event? event)
+;  (and (crossing-event? event)
+;       (eq? (crossing-event-type event) (event-type enter-window))))
+
+;(define (leave-window-event? event)
+;  (and (crossing-event? event)
+;       (eq? (crossing-event-type event) (event-type leave-window))))
+
+(define (make-crossing-event type serial send-event? display window root
+			     subwindow time x y x-root y-root mode detail
+			     same-screen? focus? state)
+  (let ((display (make-display display #f)))
+    (really-make-crossing-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-window root display #f)
+     (make-window subwindow display #f)
+     time x y x-root y-root
+     (integer->notify-mode mode)
+     (integer->notify-detail detail)
+     same-screen? focus?
+     (integer->state-set state)))) ;; Elk treats state a button ?!
+
+;; *******************************************************************
+
+(define-record-type focus-change-event :focus-change-event
+  (really-make-focus-change-event type serial send-event? display window mode 
+				  detail)
+  focus-change-event?
+  (type focus-change-event-type)
+  (serial focus-change-event-serial)
+  (send-event? focus-change-event-send-event?)
+  (display focus-change-event-display)
+  (window focus-change-event-window)
+  (mode focus-change-event-mode)
+  (detail focus-change-event-detail))
+
+;(define (focus-in-event? event)
+;  (and (focus-change-event? event)
+;       (eq? (focus-change-event-type event) (event-type focus-in))))
+
+;(define (focus-out-event? event)
+;  (and (focus-change-event? event)
+;       (eq? (focus-change-event-type event) (event-type focus-out))))
+
+(define (make-focus-change-event type serial send-event? display window mode
+				 detail)
+  (let ((display (make-display display #f)))
+    (really-make-focus-change-event
+     type serial send-event? display
+     (make-window window display #f)
+     (integer->notify-mode mode)
+     (integer->notify-detail detail))))
+
+;; *******************************************************************
+
+(define-record-type expose-event :expose-event
+  (really-make-expose-event type serial send-event? display window x y width 
+			    height count)
+  expose-event?
+  (type expose-event-type)
+  (serial expose-event-serial)
+  (send-event? expose-event-send-event?)
+  (display expose-event-display)
+  (window expose-event-window)
+  (x expose-event-x)
+  (y expose-event-y)
+  (width expose-event-width)
+  (height expose-event-height)
+  (count expose-event-count))
+
+(define (make-expose-event type serial send-event? display window x y
+			   width height count)
+  (let ((display (make-display display #f)))
+    (really-make-expose-event
+     type serial send-event? display
+     (make-window window display #f)
+     x y width height count)))
+
+;; *******************************************************************
+
+(define-record-type graphics-expose-event :graphics-expose-event
+  (really-make-graphics-expose-event type serial send-event? display drawable
+				     x y width height major-code minor-code)
+  graphics-expose-event?
+  (type graphics-expose-event-type)
+  (serial graphics-expose-event-serial)
+  (send-event? graphics-expose-event-send-event?)
+  (display graphics-expose-event-display)
+  (drawable graphics-expose-event-drawable)
+  (x graphics-expose-event-x)
+  (y graphics-expose-event-y)
+  (width graphics-expose-event-width)
+  (height graphics-expose-event-height)
+  (major-code graphics-expose-event-major-code)
+  (minor-code graphics-expose-event-minor-code))
+
+(define (make-graphics-expose-event type serial send-event? display drawable 
+				    x y width height count
+				    major-code minor-code)
+  (let ((display (make-display display #f)))
+    (really-make-graphics-expose-event
+     type serial send-event? display
+     (make-drawable drawable display)
+     x y width height count major-code minor-code)))
+
+;; *******************************************************************
+
+(define-record-type no-expose-event :no-expose-event
+  (really-make-no-expose-event type serial send-event? display drawable
+			       major-code minor-code)
+  no-expose-event?
+  (type no-expose-event-type)
+  (serial no-expose-event-serial)
+  (send-event? no-expose-event-send-event?)
+  (display no-expose-event-display)
+  (drawable no-expose-event-drawable)
+  (major-code no-expose-event-major-code)
+  (minor-code no-expose-event-minor-code))
+
+(define (make-no-expose-event type serial send-event? display drawable 
+			      major-code minor-code)
+  (let ((display (make-display display #f)))
+    (really-make-no-expose-event
+     type serial send-event? display
+     (make-drawable drawable display)
+     major-code minor-code)))
+
+;; *******************************************************************
+
+(define-record-type visibility-event :visibility-event
+  (really-make-visibility-event type serial send-event? display window state)
+  visibility-event?
+  (type visibility-event-type)
+  (serial visibility-event-serial)
+  (send-event? visibility-event-send-event?)
+  (display visibility-event-display)
+  (window visibility-event-window)
+  (state visibility-event-state))
+
+(define (make-visibility-event type serial send-event? display window state)
+  (let ((display (make-display display #f)))
+    (really-make-visibility-event
+     type serial send-event? display
+     (make-window window display #f)
+     (integer->visibility-state state))))
+
+;; *******************************************************************
+
+(define-record-type create-window-event :create-window-event
+  (really-make-create-window-event type serial send-event? display parent
+				   window x y width height border-width 
+				   override-redirect?)
+  create-window-event?
+  (type create-window-event-type)
+  (serial create-window-event-serial)
+  (send-event? create-window-event-send-event?)
+  (display create-window-event-display)
+  (parent create-window-event-parent)
+  (window create-window-event-window)
+  (x create-window-event-x)
+  (y create-window-event-y)
+  (width create-window-event-width)
+  (height create-window-event-height)
+  (border-width create-window-event-border-width)
+  (override-redirect? create-window-event-override-redirect?))
+
+(define (make-create-window-event type serial send-event? display parent
+				  window x y width height border-width 
+				  override-redirect?)
+  (let ((display (make-display display #f)))
+    (really-make-create-window-event
+     type serial send-event? display
+     (make-window parent display #f)
+     (make-window window display #f)
+     x y width height border-width override-redirect?)))
+
+;; *******************************************************************
+
+(define-record-type destroy-window-event :destroy-window-event
+  (really-make-destroy-window-event type serial send-event? display event
+				    window)
+  destroy-window-event?
+  (type destroy-window-event-type)
+  (serial destroy-window-event-serial)
+  (send-event? destroy-window-event-send-event?)
+  (display destroy-window-event-display)
+  (event destroy-window-event-event)
+  (window destroy-window-event-window))
+
+(define (make-destroy-window-event type serial send-event? display event
+				   window)
+  (let ((display (make-display display #f)))
+    (really-make-destroy-window-event
+     type serial send-event? display
+     (make-window event display #f)
+     (make-window window display #f))))
+
+;; *******************************************************************
+
+(define-record-type unmap-event :unmap-event
+  (really-make-unmap-event type serial send-event? display event window 
+			   from-configure?)
+  unmap-event?
+  (type unmap-event-type)
+  (serial unmap-event-serial)
+  (send-event? unmap-event-send-event?)
+  (display unmap-event-display)
+  (event unmap-event-event)
+  (window unmap-event-window)
+  (from-configure? unmap-event-from-configure?))
+
+(define (make-unmap-event type serial send-event? display event window
+			  from-configure?)
+  (let ((display (make-display display #f)))
+    (really-make-unmap-event
+     type serial send-event? display
+     (make-window event display #f)
+     (make-window window display #f)
+     from-configure?)))
+
+;; *******************************************************************
+
+(define-record-type map-event :map-event
+  (really-make-map-event type serial send-event? display event window 
+			 override-redirect?)
+  map-event?
+  (type map-event-type)
+  (serial map-event-serial)
+  (send-event? map-event-send-event?)
+  (display map-event-display)
+  (event map-event-event)
+  (window map-event-window)
+  (override-redirect? map-event-override-redirect?))
+
+(define (make-map-event type serial send-event? display event window
+			from-configure?)
+  (let ((display (make-display display #f)))
+    (really-make-map-event
+     type serial send-event? display
+     (make-window event display #f)
+     (make-window window display #f)
+     from-configure?)))
+
+;; *******************************************************************
+
+(define-record-type map-request-event :map-request-event
+  (really-make-map-request-event type serial send-event? display parent window)
+  map-request-event?
+  (type map-request-event-type)
+  (serial map-request-event-serial)
+  (send-event? map-request-event-send-event?)
+  (display map-request-event-display)
+  (parent map-request-event-parent)
+  (window map-request-event-window))
+
+(define (make-map-request-event type serial send-event? display parent window)
+  (let ((display (make-display display #f)))
+    (really-make-map-request-event
+     type serial send-event? display
+     (make-window parent display #f)
+     (make-window window display #f))))
+
+;; *******************************************************************
+
+(define-record-type reparent-event :reparent-event
+  (really-make-reparent-event type serial send-event? display event window
+			      parent x y override-redirect?)
+  reparent-event?
+  (type reparent-event-type)
+  (serial reparent-event-serial)
+  (send-event? reparent-event-send-event?)
+  (display reparent-event-display)
+  (event reparent-event-event)
+  (window reparent-event-window)
+  (parent reparent-event-parent)
+  (x reparent-event-x)
+  (y reparent-event-y)
+  (override-redirect? reparent-event-override-redirect?))
+
+(define (make-reparent-event type serial send-event? display event window
+			     parent x y override-redirect?)
+  (let ((display (make-display display #f)))
+    (really-make-reparent-event
+     type serial send-event? display
+     (make-window event display #f)
+     (make-window window display #f)
+     (make-window parent display #f)
+     x y override-redirect?)))
+
+;; *******************************************************************
+
+(define-record-type configure-event :configure-event
+  (really-make-configure-event type serial send-event? display event window 
+			       x y width height border-width above 
+			       override-redirect?)
+  configure-event?
+  (type configure-event-type)
+  (serial configure-event-serial)
+  (send-event? configure-event-send-event?)
+  (display configure-event-display)
+  (event configure-event-event)
+  (window configure-event-window)
+  (x configure-event-x)
+  (y configure-event-y)
+  (width configure-event-width)
+  (height configure-event-height)
+  (border-width configure-event-border-width)
+  (above configure-event-above)
+  (override-redirect? configure-event-override-redirect?))
+
+(define (make-configure-event type serial send-event? display event window
+			      x y width height border-width above 
+			      override-redirect?)
+  (let ((display (make-display display #f)))
+    (really-make-configure-event
+     type serial send-event? display
+     (make-window event display #f)
+     (make-window window display #f)
+     x y width height border-width
+     (make-window above display #f)
+     override-redirect?)))
+
+;; *******************************************************************
+
+(define-record-type gravity-event :gravity-event
+  (really-make-gravity-event type serial send-event? display event window x y)
+  gravity-event?
+  (type gravity-event-type)
+  (serial gravity-event-serial)
+  (send-event? gravity-event-send-event?)
+  (display gravity-event-display)
+  (event gravity-event-event)
+  (window gravity-event-window)
+  (x gravity-event-x)
+  (y gravity-event-y))
+
+(define (make-gravity-event type serial send-event? display event window x y)
+  (let ((display (make-display display #f)))
+    (really-make-gravity-event
+     type serial send-event? display
+     (make-window event display #f)
+     (make-window window display #f)
+     x y)))
+
+;; *******************************************************************
+
+(define-record-type resize-request-event :resize-request-event
+  (really-make-resize-request-event type serial send-event? display window 
+				    width height)
+  resize-request-event?
+  (type resize-request-event-type)
+  (serial resize-request-event-serial)
+  (send-event? resize-request-event-send-event?)
+  (display resize-request-event-display)
+  (window resize-request-event-window)
+  (width resize-request-event-width)
+  (height resize-request-event-height))
+
+(define (make-resize-request-event type serial send-event? display window
+				   width height)
+  (let ((display (make-display display #f)))
+    (really-make-resize-request-event
+     type serial send-event? display
+     (make-window window display #f)
+     width height)))
+
+;; *******************************************************************
+
+(define-record-type configure-request-event :configure-request-event
+  (really-make-configure-request-event type serial send-event? display parent 
+				       window window-changes-alist)
+  configure-request-event?
+  (type configure-request-event-type)
+  (serial configure-request-event-serial)
+  (send-event? configure-request-event-send-event?)
+  (display configure-request-event-display)
+  (parent configure-request-event-parent)
+  (window configure-request-event-window)
+  (window-changes-alist configure-request-event-window-changes-alist))
+
+(define (make-configure-request-event type serial send-event? display window
+				      x y width height border-width above
+				      detail value-mask)
+  (let ((display (make-display display #f)))
+    (really-make-configure-request-event
+     type serial send-event? display
+     (make-window window display #f)
+     ((integer+vector->window-change-alist display)
+      (cons value-mask
+	    (list->vector 
+	     (list x y width height border-width above detail)))))))
+
+;; *******************************************************************
+
+(define-record-type circulate-event :circulate-event
+  (really-make-circulate-event type serial send-event? display event window 
+			       place)
+  circulate-event?
+  (type circulate-event-type)
+  (serial circulate-event-serial)
+  (send-event? circulate-event-send-event?)
+  (display circulate-event-display)
+  (event circulate-event-event)
+  (window circulate-event-window)
+  (place circulate-event-place))
+
+(define (make-circulate-event type serial send-event? display event window 
+			      place)
+  (let ((display (make-display display #f)))
+    (really-make-circulate-event
+     type serial send-event? display
+     (make-window event display #f)
+     (make-window window display #f)
+     (integer->place place))))
+
+;; *******************************************************************
+
+(define-record-type circulate-request-event :circulate-request-event
+  (really-make-circulate-request-event type serial send-event? display parent 
+				       window place)
+  circulate-request-event?
+  (type circulate-request-event-type)
+  (serial circulate-request-event-serial)
+  (send-event? circulate-request-event-send-event?)
+  (display circulate-request-event-display)
+  (parent circulate-request-event-parent)
+  (window circulate-request-event-window)
+  (place circulate-request-event-place))
+
+(define (make-circulate-request-event type serial send-event? display parent
+				      window place)
+  (let ((display (make-display display #f)))
+    (really-make-circulate-request-event
+     type serial send-event? display
+     (make-window parent display #f)
+     (make-window window display #f)
+     (integer->place place))))
+
+;; *******************************************************************
+
+(define-record-type property-event :property-event
+  (really-make-property-event type serial send-event? display window atom time
+			      state)
+  property-event?
+  (type property-event-type)
+  (serial property-event-serial)
+  (send-event? property-event-send-event?)
+  (display property-event-display)
+  (window property-event-window)
+  (atom property-event-atom)
+  (time property-event-time)
+  (state property-event-state))
+
+(define (make-property-event type serial send-event? display window atom
+			     time state)
+  (let ((display (make-display display #f)))
+    (really-make-property-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-atom atom)
+     time
+     (integer->property-state state))))
+
+;; *******************************************************************
+
+(define-record-type selection-clear-event :selection-clear-event
+  (really-make-selection-clear-event type serial send-event? display window 
+				     selection time)
+  selection-clear-event?
+  (type selection-clear-event-type)
+  (serial selection-clear-event-serial)
+  (send-event? selection-clear-event-send-event?)
+  (display selection-clear-event-display)
+  (window selection-clear-event-window)
+  (selection selection-clear-event-selection)
+  (time selection-clear-event-time))
+
+(define (make-selection-clear-event type serial send-event? display window
+				    selection time)
+  (let ((display (make-display display #f)))
+    (really-make-selection-clear-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-atom selection)
+     time)))
+
+;; *******************************************************************
+
+(define-record-type selection-request-event :selection-request-event
+  (really-make-selection-request-event type serial send-event? display owner 
+				       requestor atom target property time)
+  selection-request-event?
+  (type selection-request-event-type)
+  (serial selection-request-event-serial)
+  (send-event? selection-request-event-send-event?)
+  (display selection-request-event-display)
+  (owner selection-request-event-owner)
+  (requestor selection-request-event-requestor)
+  (atom selection-request-event-atom)
+  (target selection-request-event-target)
+  (property selection-request-event-property)
+  (time selection-request-event-time))
+
+(define (make-selection-request-event type serial send-event? display window
+				      selection time)
+  (let ((display (make-display display #f)))
+    (really-make-selection-request-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-atom selection)
+     time)))
+
+;; *******************************************************************
+
+(define-record-type selection-event :selection-event
+  (really-make-selection-event type serial send-event? display requestor
+			       selection target property time)
+  selection-event?
+  (type selection-event-type)
+  (serial selection-event-serial)
+  (send-event? selection-event-send-event?)
+  (display selection-event-display)
+  (requestor selection-event-requestor)
+  (selection selection-event-selection)
+  (target selection-event-target)
+  (property selection-event-property)
+  (time selection-event-time))
+
+(define (make-selection-event type serial send-event? display requestor
+			      selection target property time)
+  (let ((display (make-display display #f)))
+    (really-make-selection-event
+     type serial send-event? display
+     (make-window requestor display #f)
+     (make-atom selection)
+     (make-atom target)
+     (make-atom property)
+     time)))
+
+;; *******************************************************************
+
+(define-record-type colormap-event :colormap-event
+  (really-make-colormap-event type serial send-event? display window colormap
+			      new? state)
+  colormap-event?
+  (type colormap-event-type)
+  (serial colormap-event-serial)
+  (send-event? colormap-event-send-event?)
+  (display colormap-event-display)
+  (window colormap-event-window)
+  (colormap colormap-event-colormap)
+  (new? colormap-event-new?)
+  (state colormap-event-state))
+
+(define (make-colormap-event type serial send-event? display window colormap
+			     new? state)
+  (let ((display (make-display display #f)))
+    (really-make-colormap-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-colormap colormap display #f)
+     new?
+     (integer->colormap-state state))))
+
+;; *******************************************************************
+
+(define-record-type client-message-event :client-message-event
+  (really-make-client-message-event type serial send-event? display window 
+				    message-type format data)
+  client-message-event?
+  (type client-message-event-type)
+  (serial client-message-event-serial)
+  (send-event? client-message-event-send-event?)
+  (display client-message-event-display)
+  (window client-message-event-window)
+  (message-type client-message-event-message-type)
+  (format client-message-event-format)
+  (data client-message-event-data))
+
+(define (make-client-message-event type serial send-event? display window
+				   message-type data)
+  (let ((display (make-display display #f)))
+    (really-make-client-message-event
+     type serial send-event? display
+     (make-window window display #f)
+     (make-atom message-type)
+     format
+     data)))
+
+;; *******************************************************************
+
+(define-record-type mapping-event :mapping-event
+  (really-make-mapping-event type serial send-event? display window request 
+			     first-keycode count)
+  mapping-event?
+  (type mapping-event-type)
+  (serial mapping-event-serial)
+  (send-event? mapping-event-send-event?)
+  (display mapping-event-display)
+  (window mapping-event-window)
+  (request mapping-event-request)
+  (first-keycode mapping-event-first-keycode)
+  (count mapping-event-count))
+
+(define (make-mapping-event type serial send-event? display window request
+			    first-keycode count)
+  (let ((display (make-display display #f)))
+    (really-make-mapping-event
+     type serial send-event? display
+     (make-window window display #f)
+     (integer->mapping-request request)
+     first-keycode count)))
+
+;; *******************************************************************
+
+(define-record-type error-event :error-event
+  (really-make-error-event type serial send-event? display serial error-code
+			   request-code minor-code resourceid)
+  error-event?
+  (type error-event-type)
+  (serial error-event-serial)
+  (send-event? error-event-send-event?)
+  (display error-event-display)
+  (serial error-event-serial)
+  (error-code error-event-error-code)
+  (request-code error-event-request-code)
+  (minor-code error-event-minor-code)
+  (resourceid error-event-resourceid))
+
+(define (make-error-event type display serial error-code request-code
+			  minor-code resourceid)
+  (let ((display (make-display display #f)))
+    (really-make-error-event
+     type display serial
+     error-code request-code
+     minor-code resourceid)))
+
+;; *******************************************************************
+
+(define-record-type keymap-event :keymap-event
+  (really-make-keymap-event type serial send-event? display bit-vector)
+  keymap-event?
+  (type keymap-event-type)
+  (serial keymap-event-serial)
+  (send-event? keymap-event-send-event?)
+  (display keymap-event-display)
+  (bit-vector keymap-event-bit-vector))
+
+(define (make-keymap-event type serial send-event? display window bit-vector)
+  ;; window is not used...
+  (let ((display (make-display display #f)))
+    (really-make-keymap-event
+     type serial send-event? display
+     bit-vector)))

scheme/xlib/event.scm

@@ -1,128 +1,77 @@
+;; wait-event blocks the current thread until an event is available,
+;; and then it returns this new event.
+
+(define (wait-event dpy) ; needs ports, locks
+  (let ((port (display-message-inport dpy)))
+    (disable-interrupts!)
+    (if (not (char-ready? port))
+	(begin 
+	  (obtain-lock (port-lock port))
+	  (add-pending-channel (port->channel port))
+	  (wait-for-channel (port->channel port)) ;; enables interrupts
+	  (release-lock (port-lock port)))
+	(enable-interrupts!))
+    (next-event dpy)))
+
 (define (event-ready? display)
   (char-ready? (display-message-inport display)))
 
-(define (complete-event event)
+;; creates an event type
-  (let* ((type (event-type event))
-	 (args (event-args event))
-	 (comp (lambda (idx func)
-		 (vector-set! args idx
-			      (func (vector-ref args idx))))))
-    ;; for all types
-    (comp 2 (lambda (Xdisplay) ;; Display the event was read from
-	      (make-display Xdisplay #f)))
-    (comp 3 (lambda (Xwin) ;; event-window it is reported relative to
-	      (make-window Xwin (vector-ref args 2) #f)))
-    (let* ((display (vector-ref args 2))
-	   (window (vector-ref args 3))
-	   (sidx 4) ;; start index of event-dependand fields
-	   (make-window* (lambda (Xwindow)
-			   (make-window Xwindow display #f))))
-      ;; special entries
-      (case type
-	((key-press key-release button-press button-release motion-notify) 
-	 ;; root window that the event occured on
-	 (comp (+ sidx 0) make-window*)
-	 ;; child window
-	 (comp (+ sidx 1) make-window*))
-	 ;; time in milliseconds ?? ...
-	((enter-notify leave-notify)
-	 (comp (+ sidx 0) make-window*) ;; root window
-	 (comp (+ sidx 1) make-window*));; subwindow
-	 ;; time??
-	((create-notify destroy-notify unmap-notify map-notify map-request 
-	  gravity-notify circulate-request)
-	 (comp (+ sidx 0) make-window*))
-	((reparent-notify configure-request)
-	 (comp (+ sidx 0) make-window*)
-	 (comp (+ sidx 1) make-window*))
-	((property-notify selection-clear)
-	 (comp (+ sidx 0) make-atom)) ;;??
-	 ;; time??
-	((selection-request)
-	 (comp (+ sidx 0) make-window*)
-	 (comp (+ sidx 1) make-atom) ;;??
-	 (comp (+ sidx 2) make-atom)
-	 (comp (+ sidx 3) make-atom))
-	((selection-notify)
-	 (comp (+ sidx 0) make-atom)
-	 (comp (+ sidx 1) make-atom)
-	 (comp (+ sidx 2) make-atom))
-	((colormap-notify) ;;??
-	 (comp (+ sidx 0) (lambda (Xcolormap)
-			    (make-colormap Xcolormap #f))))
-	((client-message)
-	 (comp (+ sidx 0) make-atom)) ;;??
-	) ;; case end
 
-      (event-set-args! event (event-args->alist event))
+(define (complete-event type args)
-      event)))
+  (let ((constructor (event-constructor type)))
+    (apply constructor (cons type (vector->list args)))))
   
-(define (event-args->alist event)
+(define (event-constructor type)
-  (let ((type (event-type event)))
+  (cond
-    (map cons
+   ((or (eq? type (event-type key-press))
-	 (append
+	(eq? type (event-type key-release))) make-key-event)
-	  ;; these fields belong to all events
+   ((or (eq? type (event-type button-press))
-	  '(serial send-event? display) ; the window is named differently
+	(eq? type (event-type button-release))) make-button-event)
-	  (case type
+   ((eq? type (event-type motion-notify)) make-motion-event)
-	    ((key-press key-release button-press button-release motion-notify)
+   ((or (eq? type (event-type enter-notify))
-	     (append '(window root-window sub-window time x y x-root y-root 
+	(eq? type (event-type leave-notify))) make-crossing-event)
-			      state)
+   ((or (eq? type (event-type focus-in))
-		     (case type
+	(eq? type (event-type focus-out))) make-focus-change-event)
-		       ((key-press key-release) '(key-code))
+   ((eq? type (event-type keymap-notify)) make-keymap-event)
-		       ((button-press button-release) '(button))
+   ((eq? type (event-type expose)) make-expose-event)
-		       ((motion-notify) '(is-hint?)))
+   ((eq? type (event-type graphics-expose)) make-graphics-expose-event)
-		     '(same-screen?)))
+   ((eq? type (event-type no-expose)) make-no-expose-event)
-	    ((enter-notify leave-notify)
+   ((eq? type (event-type visibility-notify)) make-visibility-event)
-	     '(window root-window sub-window time x y x-root y-root cross-mode 
+   ((eq? type (event-type create-notify)) make-create-window-event)
-		      cross-detail same-screen? focus? button-mask))
+   ((eq? type (event-type destroy-notify)) make-destroy-window-event)
-	    ((focus-in focus-out) '(window cross-mode focus-detail))
+   ((eq? type (event-type unmap-notify)) make-unmap-event)
-	    ((keymap-notify) '(window keymap))
+   ((eq? type (event-type map-notify)) make-map-event)
-	    ((expose) '(window x y width height count))
+   ((eq? type (event-type map-request)) make-map-request-event)
-	    ((graphics-expose) '(window x y width height count major-code 
+   ((eq? type (event-type reparent-notify)) make-reparent-event)
-					minor-code))
+   ((eq? type (event-type configure-notify)) make-configure-event)
-	    ((no-expose) '(window major-code minor-code))
+   ((eq? type (event-type configure-request)) make-configure-request-event)
-	    ((visibility-notify) '(window visibility-state))
+   ((eq? type (event-type gravity-notify)) make-gravity-event)
-	    ((create-notify) '(root-window window x y width height border-width 
+   ((eq? type (event-type resize-request)) make-resize-request-event)
-					   override-redirect?))
+   ((eq? type (event-type circulate-notify)) make-circulate-event)
-	    ((destroy-notify) '(event-window window))
+   ((eq? type (event-type circulate-request)) make-circulate-request-event)
-	    ((unmap-notify) '(event-window window from-configure))
+   ((eq? type (event-type property-notify)) make-property-event)
-	    ((map-notify) '(event-window window override-redirect?))
+   ((eq? type (event-type selection-clear)) make-selection-clear-event)
-	    ((map-request) '(parent-window window))
+   ((eq? type (event-type selection-request)) make-selection-request-event)
-	    ((reparent-notify) '(event-window parent-window window x y 
+   ((eq? type (event-type selection-notify)) make-selection-event)
-					      override-redirect?))
+   ((eq? type (event-type colormap-notify)) make-colormap-event)
-	    ((configure-notify) '(event-window window x y width height 
+   ((eq? type (event-type client-message)) make-client-message-event)
-					       border-width above-window 
+   ((eq? type (event-type mapping-notify)) make-mapping-event)
-					       override-redirect?))
+   (else (error "message type not supported" type))))
-	    ((configure-request) '(parent-window window x y width height 
+
-						 border-width above-window 
+;;event-type-0 event-type-1 ;; those are not defined
-						 override-redirect?))
-	    ((gravity-notify) '(event-window window x y))
-	    ((resize-request) '(window width height))
-	    ((circulate-notify) '(event-window window place))
-	    ((circulate-request) '(parent-window window place))
-	    ((property-notify) '(window atom time property-state))
-	    ((selection-clear) '(window selection-atom time))
-	    ((selection-request) '(owner-window requestor-window selection-atom 
-						target-atom property-atom time))
-	    ((selection-notify) '(requestor-window selection-atom target-atom 
-						   property-atom time))
-	    ((colormap-notify) '(window colormap new? colormap-installed?))
-	    ((client-message) '(window message-type message-data))
-	    ((mapping-notify) '(window request keycode count))))
-	 (vector->list (event-args event)))))
 
 (define (next-event display)
   (let ((r (%next-event (display-Xdisplay display))))
-    (complete-event (make-event (car r)
+    (complete-event (integer->event-type (car r)) (cdr r))))
-				(cdr r)))))
 
 (import-lambda-definition %next-event (Xdisplay)
   "scx_Next_Event")
 
 (define (peek-event display)
   (let ((r (%peek-event (display-Xdisplay display))))
-    (complete-event (make-event (car r)
+    (complete-event (integer->event-type (car r))
-				(cdr r)))))
+		    (cdr r))))
 
 (import-lambda-definition %peek-event (Xdisplay)
   "scx_Peek_Event")
@@ -144,21 +93,6 @@
 (import-lambda-definition %get-motion-events (Xdisplay Xwindow from to)
   "scx_Get_Motion_Events")
 
-;; wait-event blocks the current thread until an event is available,
-;; and then it returns this new event.
-
-(define (wait-event dpy) ; needs ports, locks
-  (let ((port (display-message-inport dpy)))
-    (disable-interrupts!)
-    (if (not (char-ready? port))
-	(begin 
-	  (obtain-lock (port-lock port))
-	  (add-pending-channel (port->channel port))
-	  (wait-for-channel (port->channel port)) ;; enables interrupts
-	  (release-lock (port-lock port)))
-	(enable-interrupts!))
-    (next-event dpy)))
-
 ;;; Only here until scsh provides us with select
 (import-lambda-definition add-pending-channel (channel)
   "scx_add_pending_channel")

scheme/xlib/font.scm

@@ -79,11 +79,19 @@
 ;; the font. See XFontStruct.
 
 (define (font-info font)
-  (%font-info (font-Xfontstruct font)))
+  (let ((v (%font-info (font-Xfontstruct font))))
+    (vector-set! v 0 (integer->font-direction (vector-ref v 0)))
+    v))
 
 (import-lambda-definition %font-info (Xfontstruct)
   "scx_Font_Info")
 
+(define (integer->font-direction i)
+  (case i
+    ((0) 'left-to-right)
+    ((1) 'right-to-left)
+    (else i)))
+
 (define (font-info-getter num)
   (lambda (font)
     (vector-ref (font-info font)

scheme/xlib/gcontext.scm

@@ -1,3 +1,106 @@
+;; create-gcontext returns a newly create graphic context for the
+;; specified drawable (a window or a pixmap). The gc-value-alist has
+;; to be an alist mapping a gc-value (defined above) to a
+;; corresponding value. See XCreateGC.
+
+(define (create-gcontext drawable gc-value-alist)
+  (let ((display (drawable-display drawable))
+	(Xobject (drawable-Xobject drawable))
+	(values (gc-value-alist->integer+vector gc-value-alist)))
+    (let ((Xgcontext (%create-gcontext (display-Xdisplay display)
+				       Xobject
+				       values)))
+      (make-gcontext Xgcontext display #t))))
+
+(import-lambda-definition %create-gcontext (Xdisplay Xdrawable values)
+  "scx_Create_Gc")
+
+;; *******************************************************************
+
+(define-enumerated-type gc-function :gc-function
+  gc-function? gc-functions gc-function-name gc-function-index
+  (clear and and-reverse copy and-inverted no-op xor or nor equiv
+   invert or-reverse copy-inverted or-inverted nand set))
+
+(define (integer->gc-function int)
+  (vector-ref gc-functions int))
+
+(define (gc-function->integer v)
+  (gc-function-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type line-style :line-style
+  line-style? line-styles line-style-name line-style-index
+  (solid on-off-dash double-dash))
+
+(define (integer->line-style int)
+  (vector-ref line-styles int))
+
+(define (line-style->integer v)
+  (line-style-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type cap-style :cap-style
+  cap-style? cap-styles cap-style-name cap-style-index
+  (not-last butt round projecting))
+
+(define (integer->cap-style int)
+  (vector-ref cap-styles int))
+
+(define (cap-style->integer v)
+  (cap-style-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type join-style :join-style
+  join-style? join-styles join-style-name join-style-index
+  (miter round bevel))
+
+(define (integer->join-style int)
+  (vector-ref join-styles int))
+
+(define (join-style->integer v)
+  (join-style-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type fill-style :fill-style
+  fill-style? fill-styles fill-style-name fill-style-index
+  (solid tiled strippled opaque-strippled))
+
+(define (integer->fill-style int)
+  (vector-ref fill-styles int))
+
+(define (fill-style->integer v)
+  (fill-style-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type subwindow-mode :subwindow-mode
+  subwindow-mode? subwindow-modes subwindow-mode-name subwindow-mode-index
+  (clip-by-children include-inferiors))
+
+(define (integer->subwindow-mode int)
+  (vector-ref subwindow-modes int))
+
+(define (subwindow-mode->integer v)
+  (subwindow-mode-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type arc-mode :arc-mode
+  arc-mode? arc-modes arc-mode-name arc-mode-index
+  (chord pie-slice))
+
+(define (integer->arc-mode int)
+  (vector-ref arc-modes int))
+
+(define (arc-mode->integer v)
+  (arc-mode-index v))
+
+;; *******************************************************************
 ;; an enumerated type corresponding to XGCValues.
 
 (define-enumerated-type gc-value :gc-value
@@ -19,33 +122,109 @@
    ((make-gc-value-alist)
     '())))
 
-(define gc-value-alist->vector
+(define-enum-set-type gc-value-set :gc-value-set
-  (make-enum-alist->vector 
+  gc-value-set? make-gc-value-set
+  gc-value gc-value? gc-values gc-value-index)
+
+(define integer->gc-value-set
+  (make-integer->enum-set gc-values gc-value-index make-gc-value-set))
+
+(define gc-value-set->integer
+  (make-enum-set->integer gc-value-index))
+
+(define gc-value-alist->integer+vector
+  (make-enum-alist->integer+vector
+   gc-values
+   gc-value-index
+   (lambda (attr)
+     (cond
+      ((eq? attr (gc-value function))
+       gc-function->integer)
+      ((or (eq? attr (gc-value plane-mask))
+	   (eq? attr (gc-value foreground))
+	   (eq? attr (gc-value background)))
+       pixel-Xpixel)
+      ((eq? attr (gc-value line-width))
+       (lambda (x) x))
+      ((eq? attr (gc-value line-style))
+       line-style->integer)
+      ((eq? attr (gc-value cap-style))
+       cap-style->integer)
+      ((eq? attr (gc-value join-style))
+       join-style->integer)
+      ((eq? attr (gc-value fill-style))
+       fill-style->integer)
+      ((eq? attr (gc-value fill-rule))
+       fill-rule->integer)
+      ((or (eq? attr (gc-value tile))
+	   (eq? attr (gc-value stipple))
+	   (eq? attr (gc-value clip-mask)))
+       pixmap-Xpixmap)
+      ((or (eq? attr (gc-value ts-x-origin))
+	   (eq? attr (gc-value ts-y-origin)))
+       (lambda (x) x))
+      ((eq? attr (gc-value font))
+       font-Xfont)
+      ((eq? attr (gc-value subwindow-mode))
+       subwindow-mode->integer)
+      ((eq? attr (gc-value graphics-exposures))
+       (lambda (x) x))
+      ((or (eq? attr (gc-value clip-x-origin))
+	   (eq? attr (gc-value clip-y-origin)))
+       (lambda (x) x))
+      ((or (eq? attr (gc-value dash-offset))
+	   (eq? attr (gc-value dash-list)))
+       (lambda (x) x))
+      ((eq? attr (gc-value arc-mode))
+       arc-mode->integer)))))
+
+(define (integer+vector->gc-value-alist display)
+  (make-integer+vector->enum-alist
    gc-values gc-value-index
-   (lambda (i)
+   (lambda (v)
-     (case i
+     (cond
-       ((1 2 3) pixel-Xpixel)
+      ((eq? v (gc-value function))
-       ((10 11 19) pixmap-Xpixmap)
+       integer->gc-function)
-       ((14) font-Xfont)
+      ((or (eq? v (gc-value plane-mask))
-       ((16) (lambda (x) (if x 1 0)))
+	   (eq? v (gc-value foreground))
-       (else (lambda (x) x))))))
+	   (eq? v (gc-value background)))
-
+       (lambda (Xpixel)
-;; create-gcontext returns a newly create graphic context for the
+	 (make-pixel Xpixel #f #f)))
-;; specified drawable (a window or a pixmap). The gc-value-alist has
+      ((eq? v (gc-value line-width))
-;; to be an alist mapping a gc-value (defined above) to a
+       (lambda (x) x))
-;; corresponding value. See XCreateGC.
+      ((eq? v (gc-value line-style))
-
+       integer->line-style)
-(define (create-gcontext drawable gc-value-alist)
+      ((eq? v (gc-value cap-style))
-  (let ((display (drawable-display drawable))
+       integer->cap-style)
-	(Xobject (drawable-Xobject drawable))
+      ((eq? v (gc-value join-style))
-	(values (gc-value-alist->vector gc-value-alist)))
+       integer->join-style)
-    (let ((Xgcontext (%create-gcontext (display-Xdisplay display)
+      ((eq? v (gc-value fill-style))
-				       Xobject
+       integer->fill-style)
-				       values)))
+      ((eq? v (gc-value fill-rule))
-      (make-gcontext Xgcontext display #t))))
+       integer->fill-rule)
-
+      ((or (eq? v (gc-value tile))
-(import-lambda-definition %create-gcontext (Xdisplay Xdrawable values)
+	   (eq? v (gc-value stipple))
-  "scx_Create_Gc")
+	   (eq? v (gc-value clip-mask)))
+       (lambda (Xpixmap)
+	 (make-pixmap Xpixmap display #f)))
+      ((or (eq? v (gc-value ts-x-origin))
+	   (eq? v (gc-value ts-y-origin))
+	   (eq? v (gc-value clip-x-origin))
+	   (eq? v (gc-value clip-y-origin)))
+       (lambda (x) x))
+      ((eq? v (gc-value font))
+       (lambda (Xfont)
+	 ;; -> see Xlib Programming Manual 5.12
+	 (make-font #f Xfont #f display #t)))
+      ((eq? v (gc-value subwindow-mode))
+       integer->subwindow-mode)
+      ((eq? v (gc-value graphics-exposures))
+       (lambda (x) x))
+      ((or (eq? v (gc-value dash-offset))
+	   (eq? v (gc-value dash-list)))
+       (lambda (x) x))
+      ((eq? v (gc-value arc-mode))
+       integer->arc-mode)))))
 
 ;; copy-gcontext returns a newly create duplicate of the given
 ;; gcontext, and assigns it to the specified drawable. See XCopyGC.
@@ -62,14 +241,15 @@
   "scx_Copy_Gc")
 
 ;; copy-gcontext! copies the specified attributes from gc-from to
-;; gc-to. The attributes have to be a list of gc-values as defined
+;; gc-to. The attributes have to be a enum-set of gc-value. It can be
-;; above. if no gc-values list is specified, then all attributes are
+;; created with the function make-gc-value-set or the macro
-;; copied. See XCopyGC.
+;; gc-value-set. if no gc-value-set is specified, then all attributes
+;; are ;; copied. See XCopyGC.
 
 (define (copy-gcontext! gc-from gc-to . maybe-gc-values)
   (let ((gc-values (if (null? maybe-gc-values)
-		       'all
+		       -1
-		       (map gc-value-name (car maybe-gc-values)))))
+		       (gc-value-set->integer (car maybe-gc-values)))))
     (%copy-gcontext! (display-Xdisplay (gcontext-display gc-from))
 		     (gcontext-Xgcontext gc-from)
 		     (gcontext-Xgcontext gc-to)
@@ -89,25 +269,11 @@
     (let ((vals (%get-gcontext-values Xgcontext Xdisplay)))
       (if (not vals)
 	  (error "cannot get gcontext values." gcontext)
-	  (vector->gc-value-alist vals display)))))
+	  ((integer+vector->gc-value-alist display) vals)))))
 
 (import-lambda-definition %get-gcontext-values (Xgcontext Xdisplay)
   "scx_Get_Gc_Values")
 
-(define vector->gc-value-alist
-  (make-vector->enum-alist
-   gc-values
-   (lambda (i display)
-     (case i
-       ((1 2 3) (lambda (Xpixel)
-		  (make-pixel Xpixel #f #f)))
-       ((11 12 20) (lambda (Xpixmap)
-		     (make-pixmap Xpixmap display #f)))
-       ((14) (lambda (Xfont)
-	       ;; -> see Xlib Programming Manual 5.12
-	       (make-font #f Xfont #f display #t)))
-       (else (lambda (x) x))))))
-
 (define (make-gcontext-getter name)
   (lambda (gcontext)
     (cdr (assq name (get-gcontext-values gcontext)))))
@@ -157,7 +323,7 @@
 (define (change-gcontext gcontext gc-value-alist)
   (%change-gcontext (gcontext-Xgcontext gcontext)
 		    (display-Xdisplay (gcontext-display gcontext))
-		    (gc-value-alist->vector gc-value-alist)))
+		    (gc-value-alist->integer+vector gc-value-alist)))
 
 (import-lambda-definition %change-gcontext (Xgcontext Xdisplay args)
   "scx_Change_Gc")
@@ -225,15 +391,27 @@
 ;; graphic context to the list of rectangles and sets the clip
 ;; origin. Each rectangle has to be a list (x y height width). The
 ;; coordinates of the rectangles are interpreted relative to the clip
-;; origin specified by x and y. ordering can be one of 'unsorted,
+;; origin specified by x and y. possible values for ordering are
-;; 'y-sorted, 'xy-sorted or 'xy-banded. See XSetClipRectangles.
+;; defined below. If none is specified (rectangle-ordering unsorted)
+;; is used. See XSetClipRectangles.
 
-(define (set-gcontext-clip-rectangles! gcontext x y rectangles ordering)
+(define-enumerated-type rectangle-ordering :rectangle-ordering
-  (%set-gcontext-clip-rectangles! (gcontext-Xgcontext gcontext)
+  rectangle-ordering? rectangle-orderings
+  rectangle-ordering-name rectangle-ordering-index
+  (unsorted y-sorted xy-sorted xy-banded))
+
+(define (rectangle-ordering->integer v)
+  (rectangle-ordering-index v))
+
+(define (set-gcontext-clip-rectangles! gcontext x y rectangles . ordering)
+  (%set-gcontext-clip-rectangles!
+   (gcontext-Xgcontext gcontext)
    (display-Xdisplay (gcontext-display gcontext))
    x y 
    (list->vector rectangles)
-				  ordering))
+   (rectangle-ordering->integer (if (null? ordering)
+				    (rectangle-ordering unsorted)
+				    (car ordering)))))
 
 (import-lambda-definition %set-gcontext-clip-rectangles! (Xgcontext Xdisplay x 
 							  y v ord)
@@ -246,7 +424,7 @@
 ;; fastest. For 'stipple, this is the size that can be stippled
 ;; fastest. See XQueryBestSize.
 
-(define (query-best-size display width height shape)
+(define (query-best-size display width height shape) ;; not exported
   (%query-best-size (display-Xdisplay display)
 		    width height shape))
 
@@ -254,10 +432,10 @@
   "scx_Query_Best_Size")
 
 (define (query-best-cursor display width height)
-  (query-best-size display width height 'cursor))
+  (query-best-size display width height 0))
 
 (define (query-best-tile display width height)
-  (query-best-size display width height 'tile))
+  (query-best-size display width height 1))
 
 (define (query-best-stipple display width height)
-  (query-best-size display width height 'stipple))
+  (query-best-size display width height 2))

scheme/xlib/grab.scm

@@ -5,15 +5,24 @@
 ;;     (success not-viewable already-grabbed frozen invalide-time)
 ;; See XGrabPointer.
 
+(define-enumerated-type grab-status :grab-status
+  grab-status? grab-states grab-status-name grab-status-index
+  (success already-grabbed invalid-time not-viewable frozen))
+
+(define (integer->grab-status i)
+  (vector-ref grab-states i))
+
 (define (grab-pointer window owner? events ptr-sync? kbd-sync?
 		      confine-to cursor time)
+  (integer->grab-status
    (%grab-pointer (display-Xdisplay (window-display window))
 		  (window-Xwindow window)
-		 owner? events
+		  owner? 
+		  (event-mask->integer events)
 		  ptr-sync? kbd-sync?
 		  (window-Xwindow confine-to)
 		  (cursor-Xcursor cursor)
-		 time))
+		  time)))
 
 (import-lambda-definition %grab-pointer (Xdisplay Xwindow owner? events
 					 ptr-sync? kbd-sync?
@@ -37,7 +46,11 @@
 		     confine-to cursor)
   (%grab-button (display-Xdisplay (window-display window))
 		(window-Xwindow window)
-		button mod owner? events ptr-sync? kbd-sync?
+		(button->integer button) ;; any-button
+		(state-set->integer mod)
+		owner?
+		(event-mask->integer events)
+		ptr-sync? kbd-sync?
 		(window-Xwindow confine-to)
 		(cursor-Xcursor cursor)))
 
@@ -53,7 +66,8 @@
 (define (ungrab-button window button modifiers)
   (%ungrab-button (display-Xdisplay (window-display window))
 		  (window-Xwindow window)
-		  button modifiers))
+		  (button->integer button)
+		  (state-set->integer modifiers)))
 
 (import-lambda-definition %ungrab-button (Xdisplay Xwindow 
 					  button modifiers)
@@ -65,7 +79,9 @@
 
 (define (change-active-pointer-grab display events cursor time)
   (%change-active-p-g (display-Xdisplay display)
-		      events cursor time))
+		      (event-mask->integer events)
+		      (cursor-Xcursor cursor)
+		      time))
 
 (import-lambda-definition %change-active-p-g (Xdislay events
 					      cursor time)
@@ -79,9 +95,10 @@
 ;; grab-Key. See XGrabKeyboard and XUngrabKeyboard.
 		  
 (define (grab-keyboard window owner? ptr-sync? kbd-sync? time)
+  (integer->grab-status
    (%grab-keyboard (display-Xdisplay (window-display window))
 		   (window-Xwindow window)
-		  owner? ptr-sync? kbd-sync? time))
+		   owner? ptr-sync? kbd-sync? time)))
 
 (import-lambda-definition %grab-keyboard (Xdisplay Xwindow
 						   owner? ptr-sync? kbd-sync?
@@ -104,7 +121,9 @@
 (define (grab-key window key mod owner? ptr-sync? kbd-sync?)
   (%grab-key (display-Xdisplay (window-display window))
 	     (window-Xwindow window)
-	     key mod owner? ptr-sync? kbd-sync? (symbol? key)))
+	     key
+	     (state-set->integer mod)
+	     owner? ptr-sync? kbd-sync? (symbol? key)))
 
 (import-lambda-definition %grab-key (Xdisplay xwindow key mod
 				     owner ptr-sync? kbd-sync? flag)
@@ -113,7 +132,9 @@
 (define (ungrab-key window key mod)
   (%ungrab-key (display-Xdisplay (window-display window))
 	       (window-Xwindow window)
-	       key mod (symbol? key)))
+	       key
+	       (state-set->integer mod)
+	       (symbol? key)))
 
 (import-lambda-definition %ungrab-key (Xdisplay Xwindow key mod
 				       flag)
@@ -122,9 +143,18 @@
 ;; allow-events function releases some queued events if the client has
 ;; caused a device to freeze. See XAllowEvents.
 
+(define-enumerated-type allow-event :allow-event
+  allow-event? allow-events allow-event-name allow-event-index
+  (async-pointer sync-pointer replay-pointer async-keyboard
+   sync-keyboard replay-keyboard async-both sync-both))
+
+(define (allow-event->integer v)
+  (allow-event-index v))
+
 (define (allow-events display mode time)
   (%allow-events (display-Xdisplay display)
-		 mode time))
+		 (allow-event->integer mode)
+		 time))
 
 (import-lambda-definition %allow-events (Xdisplay mode time)
   "scx_Allow_Events")

scheme/xlib/graphics.scm

@@ -228,7 +228,15 @@
   (%fill-polygon (display-Xdisplay (drawable-display drawable))
 		 (drawable-Xobject drawable)
 		 (gcontext-Xgcontext gcontext)
-		 (list->vector points) relative? shape))
+		 (list->vector points) relative?
+		 (polygon-shape->integer shape)))
+
+(define-enumerated-type polygon-shape :polygon-shape
+  polygon-shape? polygon-shapes polygon-shape-name polygon-shape-index
+  (complex non-convex convex))
+
+(define (polygon-shape->integer v)
+  (polygon-shape-index v))
 
 (import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext
 						  vec relative shape)

scheme/xlib/helper.scm

@@ -39,7 +39,7 @@
 
 ;;
 
-(define-exported-binding "string->symbol" string->symbol)
+(define-exported-binding "*symbol-now*" 'now)
 
 
 ;; alist-split returns multiple values. the first values are all associations 

scheme/xlib/key.scm

@@ -68,7 +68,8 @@
 
 (define (lookup-string display keycode mask)
   (%lookup-string (display-Xdisplay display)
-		  keycode mask))
+		  keycode
+		  (state-set->integer mask)))
 
 (import-lambda-definition %lookup-string (Xdisplay kc m)
   "scx_Lookup_String")
@@ -95,7 +96,7 @@
 (define (refresh-keyboard-mapping window type)
   (%refresh-keyboard-mapping (display-Xdisplay (window-display window))
 			     (window-Xwindow window)
-			     type))
+			     (mapping-request->integer type)))
 
 (import-lambda-definition %refresh-keyboard-mapping (Xdisplay Xwindow type)
   "scx_Refresh_Keyboard_Mapping")

scheme/xlib/pixmap.scm

@@ -57,7 +57,14 @@
 				filename)))
     (if (pair? res)
 	(set-car! res (make-pixmap (car res) (drawable-display drawable) #t))
-	res)))
+	(bitmap-error res filename))))
+
+(define (bitmap-error i data)
+  (case i
+    ((0) #t) ;; no error
+    ((1) (error "could not open file" data))
+    ((2) (error "invalid bitmap data in file" data))
+    ((3) (error "not enough memory to create bitmap" data))))
 
 (import-lambda-definition %read-bitmap-file (Xdisplay Xdrawable file)
   "scx_Read_Bitmap_File")
@@ -72,8 +79,10 @@
 	(xy-hot (cond
 		 ((null? hotspot) (cons -1 -1))
 		 (else (car hotspot)))))
+    (bitmap-error 
      (%write-bitmap-file dpy filename (pixmap-Xpixmap pixmap) width height 
-			(car xy-hot) (cdr xy-hot))))
+			 (car xy-hot) (cdr xy-hot))
+     filename)))
 
 (import-lambda-definition %write-bitmap-file (Xdisplay file Xpixmap w h x y)
   "scx_Write_Bitmap_File")

scheme/xlib/property.scm

@@ -68,7 +68,16 @@
 		    (window-Xwindow window)
 		    (atom-Xatom property)
 		    (atom-Xatom type)
-		    format mode data))
+		    format
+		    (property-mode->integer mode)
+		    data))
+
+(define (property-mode->integer mode)
+  (case mode
+    ((replace) 0)
+    ((prepend) 1)
+    ((append) 2)
+    (else (error "illegal change-property mode" mode))))
 
 (import-lambda-definition %change-property (Xdisplay Xwindow Xatom_prop
 					    Xatom_type format mode data)

scheme/xlib/region.scm

@@ -146,7 +146,7 @@
 
 (define (polygon-region points fill-rule)
   (make-region (%polygon-region (list->vector points)
-				fill-rule)
+				(fill-rule->integer fill-rule))
 	       #t))
 
 (import-lambda-definition %polygon-region (points fillrule)

scheme/xlib/types.scm

@@ -0,0 +1,503 @@
+;; Extensions to enum-sets (some are defined in enum-sets-internal,
+;; but that is not exported)
+
+(define (integer->enum-list all-elements element-index int)
+  (let loop ((res '())
+	     (test (vector->list all-elements)))
+    (if (null? test)
+	(reverse res)
+	(if (> (bitwise-and 
+		(arithmetic-shift int (- (element-index (car test))))
+		1)
+	       0)
+	    (loop (cons (car test) res)
+		  (cdr test))
+	    (loop res 
+		  (cdr test))))))
+
+(define (make-integer->enum-set all-elements element-index constructor)
+  (lambda (int)
+    (constructor (integer->enum-list all-elements element-index
+				     int))))
+
+(define (enum-list->integer element-index elements)
+  (fold-right (lambda (e res)
+		(bitwise-ior (arithmetic-shift 1 (element-index e))
+			     res))
+	      0
+	      elements))
+
+(define (make-enum-set->integer element-index)
+  (lambda (set)
+    (enum-list->integer element-index (enum-set->list set))))
+
+;; alists mapping enum-types to some values
+
+(define (make-enum-alist->integer+vector all-elements element-index-ref
+					 converter)
+  (lambda (enum-alist)
+    (cons (enum-list->integer element-index-ref
+			      (map car enum-alist))
+	  (let ((v (make-vector (vector-length all-elements) 
+				(unspecific))))
+	    (for-each (lambda (a)
+			(vector-set! v 
+				     (element-index-ref (car a))
+				     ((converter (car a)) (cdr a))))
+		      enum-alist)
+	    v))))
+
+(define (make-integer+vector->enum-alist all-elements element-index-ref
+					 converter)
+  (lambda (int-vec)
+    (let ((int (car int-vec))
+	  (vec (cdr int-vec)))
+      (let* ((enums (integer->enum-list all-elements element-index-ref
+					int))
+	     (values (map (lambda (e)
+			    ((converter e)
+			     (vector-ref vec
+					 (element-index-ref e))))
+			  enums)))
+	(map cons enums values)))))
+
+;; *******************************************************************
+
+(define-enumerated-type state :state
+  state? states state-name state-index
+  (shift lock control mod1 mod2 mod3 mod4 mod5
+   button1 button2 button3 button4 button5
+   state-13 state-14
+   any-modifier))
+
+(define-enum-set-type state-set :state-set
+  state-set? make-state-set
+  state state? states state-index)
+
+(define integer->state-set
+  (make-integer->enum-set states state-index make-state-set))
+
+(define state-set->integer
+  (make-enum-set->integer state-index))
+
+;; *******************************************************************
+
+(define-enumerated-type button :button
+  button? buttons button-name button-index
+  (button1 button2 button3 button4 button5))
+
+(define (integer->button int)
+  (vector-ref buttons int))
+
+(define (button->integer b)
+  (button-index b))
+
+;; *******************************************************************
+
+;; this is a special NotifyMode for MotionNotify events.
+;; NotifyNormal = 0, NotifyHint = 1
+;; therefore we just represent it as the boolean is-hint?
+
+(define (integer->is-hint? int)
+  (= int 1))
+
+(define (is-hint?->integer is-hint?)
+  (if is-hint? 1 0))
+
+;; *******************************************************************
+
+(define-enumerated-type notify-mode :notify-mode
+  notify-mode? notify-modes notify-mode-name notify-mode-index
+  (normal grab ungrab while-grabbed))
+
+(define (integer->notify-mode int)
+  (vector-ref notify-modes int))
+
+(define (notify-mode->integer v)
+  (notify-mode-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type notify-detail :notify-detail
+  notify-detail? notify-details notify-detail-name notify-detail-index
+  (ancestor virtual inferior nonlinear nonlinear-virtual pointer
+   pointer-root detail-none))
+
+(define (integer->notify-detail int)
+  (vector-ref notify-details int))
+
+(define (notify-detail->integer v)
+  (notify-detail-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type visibility-state :visibility-state
+  visibility-state? visibility-states visibility-state-name 
+  visibility-state-index
+  (unobscured partially-obscured fully-obscured))
+
+(define (integer->visibility-state int)
+  (vector-ref visibility-states int))
+
+(define (visibility-state->integer v)
+  (visibility-state-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type place :place
+  place? places place-name place-index
+  (on-top on-bottom))
+
+(define (integer->place int)
+  (vector-ref places int))
+
+(define (place->integer v)
+  (place-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type property-state :property-state
+  property-state? property-states property-state-name property-state-index
+  (new-value delete))
+
+(define (integer->property-state int)
+  (vector-ref property-states int))
+
+(define (property-state->integer v)
+  (property-state-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type colormap-state :colormap-state
+  colormap-state? colormap-states colormap-state-name colormap-state-index
+  (uninstalled installed))
+
+(define (integer->colormap-state int)
+  (vector-ref colormap-states int))
+
+(define (colormap-state->integer v)
+  (colormap-state-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type mapping-request :mapping-request
+  mapping-request? mapping-requests mapping-request-name mapping-request-index
+  (modifier keyboard pointer))
+
+(define (integer->mapping-request int)
+  (vector-ref mapping-requests int))
+
+(define (mapping-request->integer v)
+  (mapping-request-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type bit-gravity :bit-gravity
+  bit-gravity? bit-gravities bit-gravity-name bit-gravity-index
+  (forget north-west north north-east west center east south-west
+   south south-east static))
+
+(define (integer->bit-gravity int)
+  (vector-ref bit-gravities int))
+
+(define (bit-gravity->integer v)
+  (bit-gravity-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type gravity :gravity
+  gravity? gravities gravity-name gravity-index
+  (unmap north-west north north-east west center east south-west
+   south south-east static))
+
+(define (integer->gravity int)
+  (vector-ref gravities int))
+
+(define (gravity->integer v)
+  (gravity-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type backing-store :backing-store
+  backing-store? backing-stores backing-store-name backing-store-index
+  (not-useful when-mapped always))
+
+(define (integer->backing-store int)
+  (vector-ref backing-stores int))
+
+(define (backing-store->integer v)
+  (backing-store-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type event-mask-item :event-mask-item
+  event-mask-item? event-mask-items event-mask-item-name event-mask-item-index
+  (key-press key-release button-press button-release enter-window leave-window
+   pointer-motion pointer-motion-hint button-1-motion button-2-motion 
+   button-3-motion button-4-motion button-5-motion button-motion keymap-state
+   exposure visibility-change structure-notify resize-redirect
+   substructure-notify substructure-redirect focus-change property-change
+   colormap-change owner-grab-button))
+
+(define (integer->event-mask-item int)
+  (vector-ref event-mask-items int))
+
+(define (event-mask-item->integer v)
+  (event-mask-item-index v))
+
+(define-enum-set-type event-mask :event-mask
+  event-mask? make-event-mask
+  event-mask-item event-mask-item? event-mask-items event-mask-item-index)
+
+(define integer->event-mask
+  (make-integer->enum-set event-mask-items event-mask-item-index
+			  make-event-mask))
+
+(define event-mask->integer
+  (make-enum-set->integer event-mask-item-index))
+
+(define event-mask-all-events
+  (make-event-mask (vector->list event-mask-items)))
+
+;; *******************************************************************
+
+;; enumerated type for window attributes that can be changed in
+;; create-window and with change-window-attributes.
+
+(define-enumerated-type set-window-attribute :set-window-attribute
+  set-window-attribute?
+  set-window-attributes
+  set-window-attribute-name
+  set-window-attribute-index
+  ;; don't change the order of the attributes!
+  ;; special values: background-pixmap can be a pixmap,
+  ;; 'parent-relative or 'none. border-pixmap can be a pixmap or
+  ;; 'copy-from-parent.
+  (background-pixmap background-pixel border-pixmap border-pixel
+   bit-gravity gravity backing-store backing-planes backing-pixel
+   override-redirect save-under event-mask do-not-propagate-mask colormap
+   cursor))
+
+(define-syntax make-set-window-attribute-alist
+  (syntax-rules 
+   ()
+   ((make-set-window-attribute-alist (attr arg) rest ...)
+    (cons (cons (set-window-attribute attr) arg)
+	  (make-set-window-attribute-alist rest ...)))
+   ((make-set-window-attribute-alist)
+    '())))
+
+(define set-window-attribute-alist->integer+vector
+  (make-enum-alist->integer+vector
+   set-window-attributes
+   set-window-attribute-index
+   (lambda (attr)
+     (cond
+      ((eq? attr (set-window-attribute background-pixmap))
+       (lambda (background)
+	 (cond
+	  ((pixmap? background) (pixmap-Xpixmap background))
+	  ((eq? background 'parent-relative) 1)
+	  ((eq? background 'none) 0)
+	  (else (error "invalid background-pixmap" background)))))
+      ((eq? attr (set-window-attribute border-pixmap))
+       (lambda (border)
+	 (cond
+	  ((pixmap? border) (pixmap-Xpixmap border))
+	  ((eq? border 'copy-from-parent) 0)
+	  (else (error "invalid border-pixmap" border)))))
+      ((or (eq? attr (set-window-attribute background-pixel))
+	   (eq? attr (set-window-attribute border-pixel))
+	   (eq? attr (set-window-attribute backing-pixel))
+	   (eq? attr (set-window-attribute backing-planes)))
+       pixel-Xpixel)
+      ((eq? attr (set-window-attribute bit-gravity))
+       bit-gravity->integer)
+      ((eq? attr (set-window-attribute gravity))
+       gravity->integer)
+      ((eq? attr (set-window-attribute backing-store))
+       backing-store->integer)
+      ((or (eq? attr (set-window-attribute override-redirect))
+	   (eq? attr (set-window-attribute save-under)))
+       (lambda (v)
+	 (if v 1 0)))
+      ((or (eq? attr (set-window-attribute event-mask))
+	   (eq? attr (set-window-attribute do-not-propagate-mask)))
+       event-mask->integer)
+      ((eq? attr (set-window-attribute colormap))
+       colormap-Xcolormap)
+      ((eq? attr (set-window-attribute cursor))
+       cursor-Xcursor)
+      (else (error "invalid set-window-attribute" attr))))))
+
+;; *******************************************************************
+
+(define-enumerated-type map-state :map-state
+  map-state? map-states map-state-name map-state-index
+  (is-unmapped is-unviewable is-viewable))
+
+(define (integer->map-state int)
+  (vector-ref map-states int))
+
+(define (map-state->integer v)
+  (map-state-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type window-class :window-class
+  window-class? window-classs window-class-name window-class-index
+  (input-output input-only))
+
+(define (integer->window-class int)
+  (vector-ref window-classs int))
+
+(define (window-class->integer v)
+  (window-class-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type window-attribute :window-attribute
+  window-attribute?
+  window-attributes
+  window-attribute-name
+  window-attribute-index
+  ;; screen is not supported yet - so it will be always #f
+  (x y width height border-width depth visual root class bit-gravity
+   gravity backing-store backing-planes backing-pixel save-under
+   colormap map-installed map-state all-event-masks your-event-mask
+   do-not-propagate-mask override-redirect screen))
+
+(define-syntax make-window-attribute-alist
+  (syntax-rules 
+   ()
+   ((make-window-attribute-alist (attr arg) rest ...)
+    (cons (cons (window-attribute attr) arg)
+	  (make-window-attribute-alist rest ...)))
+   ((make-window-attribute-alist)
+    '())))
+
+(define (integer+vector->window-attribute-alist display)
+  (make-integer+vector->enum-alist
+   window-attributes window-attribute-index
+   (lambda (v)
+     (cond
+      ((eq? v (window-attribute visual))
+       make-visual)
+      ((eq? v (window-attribute root))
+       (lambda (Xwindow)
+	 (make-window Xwindow display #f)))
+      ((eq? v (window-attribute class))
+       integer->window-class)
+      ((eq? v (window-attribute bit-gravity))
+       integer->bit-gravity)
+      ((eq? v (window-attribute gravity))
+       integer->gravity)
+      ((eq? v (window-attribute backing-store))
+       integer->backing-store)
+      ((or (eq? v (window-attribute backing-planes))
+	   (eq? v (window-attribute backing-pixel)))
+       (lambda (Xpixel)
+	 (make-pixel Xpixel #f #f)))
+      ((or (eq? v (window-attribute save-under))
+	   (eq? v (window-attribute map-installed))
+	   (eq? v (window-attribute override-redirect)))
+       (lambda (x) (not (= x 0))))
+      ((eq? v (window-attribute colormap))
+       (lambda (Xcolormap)
+	 (make-colormap Xcolormap display #f)))
+      ((eq? v (window-attribute map-state))
+       integer->map-state)
+      ((or (eq? v (window-attribute all-event-masks))
+	   (eq? v (window-attribute your-event-mask))
+	   (eq? v (window-attribute do-not-propagate-mask)))
+       integer->event-mask)
+      ((eq? v (window-attribute screen))
+       (lambda (x) x))
+      (else (lambda (x) x))))))
+
+;; *******************************************************************
+
+(define-enumerated-type stack-mode :stack-mode
+  stack-mode? stack-modes stack-mode-name stack-mode-index
+  (above below top-if buttom-if opposite))
+
+(define (integer->stack-mode int)
+  (vector-ref stack-modes int))
+
+(define (stack-mode->integer v)
+  (stack-mode-index v))
+
+;; an enumerated type for XWindowChange. Used in configure-window
+
+(define-enumerated-type window-change :window-change
+  window-change? window-changes window-change-name window-change-index
+  (x y width height border-width sibling stack-mode))
+
+(define-syntax make-window-change-alist
+  (syntax-rules 
+   ()
+   ((make-window-change-alist (attr arg) rest ...)
+    (cons (cons (window-change attr) arg)
+	  (make-window-change-alist rest ...)))
+   ((make-window-change-alist)
+    '())))
+
+(define window-change-alist->integer+vector
+  (make-enum-alist->integer+vector
+   window-changes window-change-index
+   (lambda (v)
+     (cond
+      ((eq? v (window-change sibling))
+       window-Xwindow)
+      ((eq? v (window-change stack-mode))
+       stack-mode->integer)
+      (else (lambda (x) x))))))
+
+(define (integer+vector->window-change-alist display)
+  (make-integer+vector->enum-alist
+   window-changes window-change-index
+   (lambda (v)
+     (cond
+      ((eq? v (window-change sibling))
+       (lambda (Xwindow)
+	 (make-window Xwindow display #f)))
+      ((eq? v (window-change stack-mode))
+       integer->stack-mode)
+      (else (lambda (x) x))))))
+
+;; *******************************************************************
+
+(define-enumerated-type byte-order :byte-order
+  byte-order? byte-orders byte-order-name byte-order-index
+  (lsb-first msb-first))
+
+(define (integer->byte-order int)
+  (vector-ref byte-orders int))
+
+(define (byte-order->integer v)
+  (byte-order-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type bit-order :bit-order
+  bit-order? bit-orders bit-order-name bit-order-index
+  (lsb-first msb-first))
+
+(define (integer->bit-order int)
+  (vector-ref bit-orders int))
+
+(define (bit-order->integer v)
+  (bit-order-index v))
+
+;; *******************************************************************
+
+(define-enumerated-type fill-rule :fill-rule
+  fill-rule? fill-rules fill-rule-name fill-rule-index
+  (even-odd winding))
+
+(define (integer->fill-rule int)
+  (vector-ref fill-rules int))
+
+(define (fill-rule->integer v)
+  (fill-rule-index v))
+

scheme/xlib/utility.scm

@@ -49,7 +49,7 @@
 ;; string. See XParseGeometry.
 
 (define (parse-geometry string)
-  (reverse (%parse-geometry string)))
+  (vector->list (%parse-geometry string)))
 
 (import-lambda-definition %parse-geometry (string)
   "scx_Parse_Geometry")

scheme/xlib/visual.scm

@@ -2,8 +2,7 @@
 ;; visual-info. The corresponding values have the following meaning:
 ;; screen-number  the screen this visual belongs to
 ;; depth          the depth of the screen
-;; class          one of 'direct-color 'gray-scale 'pseudo-color 
+;; class          the visual-class (see below)
-;;                'static-color 'static-gray 'true-color
 ;; red-mask       these masks are used for direct-color and true-color
 ;; green-mask     to specify which bits of the pixel value specify
 ;; blue-mask      red, green or blue values.
@@ -32,26 +31,13 @@
    ((make-visual-info-alist)
     '())))
 
-(define visual-info-alist->vector
-  (make-enum-alist->vector
-   visual-infos visual-info-index
-   (lambda (i)
-     (lambda (x) x))))
-
-(define (vector->visual-info-alist vector)
-  (vector-set! vector 0 (make-visual (vector-ref vector 0)))
-  (map cons
-       (vector->list visual-infos)
-       (vector->list vector)))
-
-;; returns a list of visual informations of visuals that match the
-;; template given by visual-info-alist. the 'visual element is not
-;; allowed here. See XGetVisualInfo.
-
 (define (get-visual-info display visual-info-alist)
   (let ((res (%get-visual-info (display-Xdisplay display)
-			       (visual-info-alist->vector visual-info-alist))))
+			       (visual-info-alist->integer+vector 
-    (map vector->visual-info-alist
+				visual-info-alist))))
+    (map (lambda (p)
+	   (cons (make-visual (car p))
+		 (integer+vector->visual-info-alist (cdr p))))
 	 (vector->list res))))
 
 (import-lambda-definition %get-visual-info (Xdisplay v)
@@ -65,17 +51,72 @@
 (import-lambda-definition %visual-id (Xvisual)
   "scx_Visual_ID")
 
-;; match-visual-info returns info on a matching visual or #f if none
+;; match-visual-info returns a pair of a visual that matches the given
-;; exists.
+;; criteria and a visual-info-alist of it.#f is returned if no such
+;; visual exists.
 
 (define (match-visual-info display screen-number depth class)
   (let ((res (%match-visual-info (display-Xdisplay display)
 				 screen-number
 				 depth
-				 class)))
+				 (visual-class->integer class))))
     (if res
-	(visual-info-alist->vector res)
+	(cons (make-visual (car res))
+	      (visual-info-alist->integer+vector (cdr res)))
 	res)))
 
 (import-lambda-definition %match-visual-info (Xdisplay scrnum depth class)
   "scx_Match_Visual_Info")
+
+;; *******************************************************************
+
+(define-enumerated-type visual-class :visual-class
+  visual-class? visual-classs visual-class-name visual-class-index
+  (static-gray gray-scale static-color pseudo-color true-color direct-color))
+
+(define (integer->visual-class int)
+  (vector-ref visual-classs int))
+
+(define (visual-class->integer v)
+  (visual-class-index v))
+
+;; A visual information is an alist with keys of the type
+;; visual-info. The corresponding values have the following meaning:
+;; screen-number  the screen this visual belongs to
+;; depth          the depth of the screen
+;; class          one of 'direct-color 'gray-scale 'pseudo-color 
+;;                'static-color 'static-gray 'true-color
+;; red-mask       these masks are used for direct-color and true-color
+;; green-mask     to specify which bits of the pixel value specify
+;; blue-mask      red, green or blue values.
+;; colormap-size  tells how many different pixel value are valid
+;; bits-per-rgb   specifies how many bits in each of the red, green 
+;;                and blue values in a colorcell are used to drive 
+;;                the rgb gun in the screen.
+;; visual         this value can be passed to other functions, e.g. 
+;;                create-window.
+;; visual-id      this value is not normally needed by applications.
+
+(define-enumerated-type visual-info :visual-info
+  visual-info? visual-infos visual-info-name visual-info-index
+  (visual-id screen depth class red-mask green-mask blue-mask 
+   colormap-size bits-per-rgp))
+
+(define visual-info-alist->integer+vector
+  (make-enum-alist->integer+vector
+   visual-infos visual-info-index
+   (lambda (v)
+     (cond
+      ((eq? v (visual-info class))
+       visual-class->integer)
+      (else (lambda (x) x))))))
+
+(define integer+vector->visual-info-alist
+  (make-integer+vector->enum-alist
+   visual-infos visual-info-index
+   (lambda (v)
+     (cond
+      ((eq? v (visual-info class))
+       integer->visual-class)
+      (else (lambda (x) x))))))
+

scheme/xlib/window.scm

@@ -9,7 +9,7 @@
 
 (define (create-window parent x y width height border-width depth class 
 		       visual set-window-attribute-alist)
-  (let ((attribs (set-window-attribute-alist->vector
+  (let ((attribs (set-window-attribute-alist->integer+vector
 		  set-window-attribute-alist))
 	(depth (cond
 		((eq? depth 'copy-from-parent) #f)
@@ -51,93 +51,13 @@
 
 ;; *** change-window-attributes **************************************
 
-;; enumerated type for window attributes that can be changed in
-;; create-window and with change-window-attributes.
-
-(define-enumerated-type set-window-attribute :set-window-attribute
-  set-window-attribute?
-  set-window-attributes
-  set-window-attribute-name
-  set-window-attribute-index
-  ;; don't change the order of the attributes!
-  ;; special values: background-pixmap can be a pixmap,
-  ;; 'parent-relative or 'none. border-pixmap can be a pixmap or
-  ;; 'copy-from-parent.
-  (background-pixmap background-pixel border-pixmap border-pixel
-   bit-gravity gravity backing-store backing-planes backing-pixel
-   override-redirect save-under event-mask do-not-propagate-mask colormap
-   cursor))
-
-(define-syntax make-set-window-attribute-alist
-  (syntax-rules 
-   ()
-   ((make-set-window-attribute-alist (attr arg) rest ...)
-    (cons (cons (set-window-attribute attr) arg)
-	  (make-set-window-attribute-alist rest ...)))
-   ((make-set-window-attribute-alist)
-    '())))
-
-(define set-window-attribute-alist->vector
-  (make-enum-alist->vector 
-   set-window-attributes set-window-attribute-index
-   (lambda (i)
-     (case i
-       ((0) (lambda (background)
-	      (cond
-	       ((pixmap? background) (pixmap-Xpixmap background))
-	       ((eq? background 'parent-relative) background)
-	       ((none-resource? background) 0)
-	       (else (error "invalid background pixmap" 
-			    background)))))
-       ((1) pixel-Xpixel)
-       ((2) (lambda (border)
-	      (cond
-	       ((pixmap? border) (pixmap-Xpixmap border))
-	       ((eq? border 'copy-from-parent) border)
-	       (else (error "invalid border pixmap" 
-			    border)))))
-       ((3) pixel-Xpixel)
-       ((8) pixel-Xpixel)
-       ((9) (lambda (override-redirect)
-	      (if override-redirect 1 0)))
-       ((10) (lambda (save-under)
-	       (if save-under 1 0)))
-       ((13) colormap-Xcolormap)
-       ((14) cursor-Xcursor)
-       (else (lambda (x) x))))))
-
-;; a macro for an easier creation of such an alist.
-
-(define set-window-attribute-by-name
-  (let* ((attributes (vector->list set-window-attributes))
-	 (alist (map cons (map set-window-attribute-name
-			       attributes)
-		     attributes)))
-    (lambda (name)
-      (let ((r (assq name alist)))
-	(if r 
-	    (cdr r)
-	    (error "attribute name not defined" name))))))
-
-;(define-syntax make-set-window-attribute-alist
-;  (syntax-rules ()
-;    ((make-set-window-attribute-alist) '())
-;    ((make-set-window-attribute-alist 'item)
-;     `(cons (cons ,(set-window-attribute-by-name (car item))
-;		  ,(cadr item))
-;	    '()))
-;    ((make-set-window-attribute-alist item1 item2 ...)
-;     (cons (cons (set-window-attribute-by-name (car item1))
-;		 (cadr item1))
-;	   (make-set-window-attribute-alist item2 ...)))))
-
 ;; change-window-attributes takes an alist of set-window-attributes
 ;; mapping to specific values. See XChangeWindowAttributes.
 
 (define (change-window-attributes window set-window-attribute-alist)
   (%change-window-attributes (window-Xwindow window)
 			     (display-Xdisplay (window-display window))
-			     (set-window-attribute-alist->vector
+			     (set-window-attribute-alist->integer+vector
 			      set-window-attribute-alist)))
 
 (import-lambda-definition %change-window-attributes (Xwindow Xdisplay attribs)
@@ -182,41 +102,12 @@
   (make-win-attr-setter (set-window-attribute cursor)))
 
 ;; *** configure-window **********************************************
-;; an enumerated type for configure-window (see XConfigureWindow)
+;; This set the window-attributes.
-
-(define-enumerated-type window-change :window-change
-  window-change?
-  window-changes
-  window-change-name
-  window-change-index
-  ; do not change this order
-  ; sibling is a window, stack-mode can be one of 'above, 'below,
-  ; 'top-if, 'buttom-if and 'opposite.
-  (x y width height border-width sibling stack-mode))
-
-(define-syntax make-window-change-alist
-  (syntax-rules 
-   ()
-   ((make-window-change-alist (attr arg) rest ...)
-    (cons (cons (window-change attr) arg)
-	  (make-window-change-alist rest ...)))
-   ((make-window-change-alist)
-    '())))
-
-(define window-change-alist->vector
-  (make-enum-alist->vector 
-   window-changes window-change-index
-   (lambda (i)
-     (case i
-       ((5) window-Xwindow)
-       (else (lambda (x) x))))))
-
-;; This sets the window-attributes listed above
 
 (define (configure-window window window-change-alist)
   (%configure-window (window-Xwindow window)
 		     (display-Xdisplay (window-display window))
-		     (window-change-alist->vector
+		     (window-change-alist->integer+vector
 		      window-change-alist)))
 
 (import-lambda-definition %configure-window (Xwindow Xdisplay changes)
@@ -241,48 +132,14 @@
 ;; *** get-window-attributes *****************************************
 ;; get-window-attributes returns attributes of the specified window.
 
-(define-enumerated-type window-attribute :window-attribute
-  window-attribute?
-  window-attributes
-  window-attribute-name
-  window-attribute-index
-  ;; don't change the order of the attributes!
-  ;; screen is not supported yet - so it will be always #f
-  (x y width height border-width depth visual root class bit-gravity
-   gravity backing-store backing-planes backing-pixel save-under
-   colormap map-installed map-state all-event-masks your-event-mask
-   do-not-propagate-mask override-redirect screen))
-
-(define-syntax make-window-attribute-alist
-  (syntax-rules 
-   ()
-   ((make-window-attribute-alist (attr arg) rest ...)
-    (cons (cons (window-attribute attr) arg)
-	  (make-window-attribute-alist rest ...)))
-   ((make-window-attribute-alist)
-    '())))
-
-(define vector->window-attribute-alist 
-  (make-vector->enum-alist
-   window-attributes
-   (lambda (i display)
-     (case i
-       ((13) (lambda (Xpixel) ; backing-pixel
-	       (make-pixel Xpixel #f #f)))
-       ((7) (lambda (Xwindow) ; root
-	      (make-window Xwindow display #f)))
-       ((15) (lambda (Xcolormap)
-	       (make-colormap Xcolormap display #f)))
-       ((6) make-visual)
-       (else (lambda (x) x))))))
-
 (define (get-window-attributes window)
   (let ((Xwindow (window-Xwindow window))
 	(Xdisplay (display-Xdisplay (window-display window))))
     (let ((values (%get-window-attributes Xdisplay Xwindow)))
       (if (not values)
 	  (error "cannot get window attributes." window)
-	  (vector->window-attribute-alist values (window-display window))))))
+	  ((integer+vector->window-attribute-alist (window-display window))
+	   values)))))
 
 (import-lambda-definition %get-window-attributes (Xdisplay Xwindow)
   "scx_Get_Window_Attributes")
@@ -300,7 +157,7 @@
 (define window-depth (make-win-attr-getter (window-attribute depth)))
 (define window-visual (make-win-attr-getter (window-attribute visual)))
 (define window-root (make-win-attr-getter (window-attribute root)))
-(define window-class (make-win-attr-getter (window-attribute class)))
+(define window-window-class (make-win-attr-getter (window-attribute class)))
 (define window-bit-gravity 
   (make-win-attr-getter (window-attribute bit-gravity)))
 (define window-gravity
@@ -325,8 +182,8 @@
 (define window-override-redirect 
   (make-win-attr-getter (window-attribute override-redirect)))
 
-;; The map-window function maps the window and all of its subwindows that have 
+;; The map-window function maps the window and all of its subwindows
-;; had map requests. See XMapWindow.
+;; that have had map requests. See XMapWindow.
 
 (define (map-window window)
   (%map-window (window-Xwindow window) 
@@ -335,8 +192,8 @@
 (import-lambda-definition %map-window (Xwindow Xdisplay)
   "scx_Map_Window")
 
-;; The unmap-window function unmaps the specified window and causes the 
+;; The unmap-window function unmaps the specified window and causes
-;; X server to generate an unmap-notify event. See XUnmapWindow.
+;; the X server to generate an unmap-notify event. See XUnmapWindow.
 
 (define (unmap-window window)
   (%unmap-window (window-Xwindow window)
@@ -345,8 +202,9 @@
 (import-lambda-definition %unmap-window (Xwindow Xdisplay)
   "scx_Unmap_Window")
 
-;; The destroy-subwindows function destroys all inferior windows of the 
+;; The destroy-subwindows function destroys all inferior windows of
-;; specified window, in bottom-to-top stacking order. See XDestroySubWindows.
+;; the specified window, in bottom-to-top stacking order. See
+;; XDestroySubWindows.
 
 (define (destroy-subwindows window)
   (%destroy-subwindows (window-Xwindow window)
@@ -355,8 +213,8 @@
 (import-lambda-definition %destroy-subwindows (Xwindow Xdisplay)
   "scx_Destroy_Subwindows")
 
-;; The map-subwindows function maps all subwindows for a  specified window in 
+;; The map-subwindows function maps all subwindows for a specified
-;; top-to-bottom stacking order. See XMapSubwindows
+;; window in top-to-bottom stacking order. See XMapSubwindows
 
 (define (map-subwindows window)
   (%map-subwindows (window-Xwindow window)
@@ -365,8 +223,9 @@
 (import-lambda-definition %map-subwindows (Xwindow Xdisplay)
   "scx_Map_Subwindows")
 
-;; The unmap-subwindows function unmaps all subwindows for each subwindow 
+;; The unmap-subwindows function unmaps all subwindows for each
-;; and expose events on formerly obscured windows. See XUnmapSubwindow.
+;; subwindow and expose events on formerly obscured windows. See
+;; XUnmapSubwindow.
 
 (define (unmap-subwindows window)
   (%unmap-subwindows (window-Xwindow window)
@@ -386,15 +245,16 @@
 (import-lambda-definition %circulate-subwindows (Xwindow Xdisplay dir)
   "scx_Circulate_Subwindows")
 
-;; The clear-window function clears the entire area in the specified window.
+;; The clear-window function clears the entire area in the specified
-;; See XClearWindow.
+;; window.  See XClearWindow.
 
 (define (clear-window window)
   (clear-area window 0 0 0 0 #f))
 
-;; The raise-window (lower-window) function raises (lowers) the specified window
+;; The raise-window (lower-window) function raises (lowers) the
-;; to the top (button) of the stack so that no sibling window obscures it (it 
+;; specified window to the top (button) of the stack so that no
-;; does not obscure any sibling windows). See XRaiseWindow.
+;; sibling window obscures it (it does not obscure any sibling
+;; windows). See XRaiseWindow.
 
 (define (raise-window window)
   (set-window-stack-mode! window 'above))
@@ -402,10 +262,11 @@
 (define (lower-window window)
   (set-window-stack-mode! window 'below))
 
-;; The restack-windows function restacks the windows in the order specified, 
+;; The restack-windows function restacks the windows in the order
-;; from top to bottom. The stacking order of the first window in the windows 
+;; specified, from top to bottom. The stacking order of the first
-;; list is unaffected, but the other windows in the array are stacked underneath
+;; window in the windows list is unaffected, but the other windows in
-;; the first window, in the order of the list. See XRestackWindows.
+;; the array are stacked underneath the first window, in the order of
+;; the list. See XRestackWindows.
 
 (define (restack-windows window-list)
   (let loop ((w (car window-list))
@@ -416,8 +277,8 @@
 	  (set-window-stack-mode! n 'below)
 	  (loop n (cdr t))))))
 
-;; query-tree returns a list of three elements: root window, parent window and 
+;; query-tree returns a list of three elements: root window, parent
-;; child windows of the given window. See XQueryTree.
+;; window and child windows of the given window. See XQueryTree.
 
 (define (query-tree window)
   (let* ((display (window-display window))
@@ -433,11 +294,11 @@
 (import-lambda-definition %query-tree (Xwindow Xdisplay)
   "scx_Query_Tree")
 
-;; translate-coordinates takes the x and y coordinates relative to the source 
+;; translate-coordinates takes the x and y coordinates relative to the
-;; window's origin and returns a list of three elements: the x and y coordinates
+;; source window's origin and returns a list of three elements: the x
-;; relative to the destination window's origin. If the source window and the 
+;; and y coordinates relative to the destination window's origin. If
-;; destination window are on different screens the result is #f. See 
+;; the source window and the destination window are on different
-;; XTranslateCoordinates.
+;; screens the result is #f. See XTranslateCoordinates.
 
 (define (translate-coordinates src-window x y dst-window)
   (let* ((display (window-display src-window))
@@ -457,10 +318,11 @@
   "scx_Translate_Coordinates")
 
 
-;; query-pointer returns a list of eight elements: x and y coordinates, a 
+;; query-pointer returns a list of eight elements: x and y
-;; boolean indicating whether the pointer is on the same screen as the specified
+;; coordinates, a boolean indicating whether the pointer is on the
-;; window, the root window, the root window's x and y coordinates, the child 
+;; same screen as the specified window, the root window, the root
-;; window and a list of modifier names (see grab-button). See XQueryPointer.
+;; window's x and y coordinates, the child window and a list of
+;; modifier names (see grab-button). See XQueryPointer.
 
 (define (query-pointer window)
   (let* ((display (window-display window))
@@ -468,6 +330,7 @@
 			      (window-Xwindow window))))
     (vector-set! res 3 (make-window (vector-ref res 3) display #f))
     (vector-set! res 6 (make-window (vector-ref res 6) display #f))
+    (vector-set! res 7 (integer->state-set (vector-ref res 7)))
     (vector->list res)))
 
 (import-lambda-definition %query-pointer (Xdisplay Xwindow)

scheme/xlib/wm.scm

@@ -53,24 +53,33 @@
 
 (define (set-input-focus display window revert-to time)
   (%set-input-focus (display-Xdisplay display)
-		    (begin
+		    (case window
-		      (if (not (or (window? window)
+		      ((none) 0)
-				   (eq? window 'pointer-root)))
+		      ((pointer-root) 1)
-			  (error "expected argument of type window; given"
+		      (else (window-Xwindow window)))
-				 window))
+		    (revert-to->integer revert-to)
-		      window)
 		    time))
 
-(import-lambda-definition %set-input-focus (Xdisplay Xwindow)
+(import-lambda-definition %set-input-focus (Xdisplay Xwindow revert-to time)
   "scx_Set_Input_Focus")
 
+(define-enumerated-type revert-to :revert-to
+  revert-to? revert-tos revert-to-name revert-to-index
+  (none pointer-root parent))
+
+(define (integer->revert-to i)
+  (vector-ref revert-tos i))
+
+(define (revert-to->integer v)
+  (revert-to-index v))
+
 ;; input-focus returns the current focus window and the current focus
 ;; state as a pair. See XGetInputFocus.
 
 (define (input-focus display)
   (let ((ret (%input-focus (display-Xdisplay display))))
     (cons (make-window (car ret) display #f)
-	  (cdr ret))))
+	  (integer->revert-to (cdr ret)))))
 
 (import-lambda-definition %input-focus (Xdisplay)
   "scx_Input_Focus")
@@ -140,7 +149,14 @@
 (define (change-save-set window mode)
   (%change-save-set (display-Xdisplay (window-display window))
 		    (window-Xwindow window)
-		    mode))
+		    (save-set-mode->integer mode)))
+
+(define-enumerated-type save-set :save-set
+  save-set? save-sets save-set-name save-set-index
+  (insert delete))
+
+(define (save-set-mode->integer v)
+  (save-set-index v))
 
 (import-lambda-definition %change-save-set (Xdisplay Xwindow mode)
   "scx_Change_Save_Set")
@@ -151,7 +167,14 @@
 
 (define (set-close-down-mode display mode)
   (%set-close-down-mode (display-Xdisplay display)
-			mode))
+			(close-down-mode->integer mode)))
+
+(define-enumerated-type close-down-mode :close-down-mode
+  close-down-mode? close-down-modes close-down-mode-name close-down-mode-index
+  (destroy-all retain-permanent retain-temporary))
+
+(define (close-down-mode->integer v)
+  (close-down-mode-index v))
 
 (import-lambda-definition %set-close-down-mode (Xdisplay mode)
   "scx_Set_Close_Down_Mode")

scheme/xlib/xlib-interfaces.scm

@@ -1,12 +1,5 @@
 (define-interface xlib-display-interface
-  (export display?
+  (export open-display
-	  open-display
-	  close-display
-	  display-after-function 
-	  after-function ;; compatibility with Elk, same as above
-	  display-set-after-function! 
-	  set-after-function! ;; compatibility with Elk, same as above
-
 	  display-default-root-window
 	  display-root-window ;; same as above
 	  display-default-colormap
@@ -33,11 +26,8 @@
 	  display-flush-output
 	  display-wait-output
 	  display-no-op
-	  no-op ;; compatibility with Elk, same as above
 	  display-list-depths
-	  list-depths ;; compatibility with Elk, same as above
 	  display-list-pixmap-formats
-	  list-pixmap-formats ;; compatibility with Elk, same as above
 	  synchronize
 	  display-select-input
 
@@ -45,25 +35,13 @@
 	  ))
 
 (define-interface xlib-window-interface
-  (export window?
+  (export create-window
-	  drawable?
-	  window-display
-	  create-window	  
 	  create-simple-window
-	  destroy-window
 	  change-window-attributes
 	  get-window-attributes
 	  map-window
 	  unmap-window
 
-	  ((set-window-attribute 
-	    window-attribute 
-	    window-change
-	    make-set-window-attribute-alist
-	    make-window-attribute-alist 
-	    make-window-change-alist) :syntax)
-	  window-change-alist->vector ; has to be exported for client.scm
-
 	  set-window-background-pixmap!
 	  set-window-background-pixel!
 	  set-window-border-pixmap!
@@ -96,7 +74,7 @@
 	  window-depth
 	  window-visual
 	  window-root
-	  window-class
+	  window-window-class
 	  window-bit-gravity
 	  window-backing-store
 	  window-backing-planes
@@ -122,8 +100,7 @@
 
 	  query-tree
 	  translate-coordinates
-	  query-pointer
+	  query-pointer))
-	  ))
 
 (define-interface xlib-drawable-interface
   (export drawable?
@@ -137,17 +114,13 @@
 
 (define-interface xlib-color-interface
   (export make-color
-	  color?
 	  color-rgb-values
 	  query-color
 	  query-colors
 	  lookup-color))
 
 (define-interface xlib-colormap-interface
-  (export make-colormap
+  (export create-colormap
-	  colormap?
-	  free-colormap
-	  colormap-display
 	  alloc-color!
 	  query/alloc-named-color
 	  alloc-named-color
@@ -155,33 +128,28 @@
 	  alloc-color-cells
 	  store-color
 	  store-colors
-	  create-colormap
+	  copy-colormap-and-free))
-	  copy-colormap-and-free
-	  ))
 
 (define-interface xlib-pixel-interface
-  (export pixel?
+  (export pixel-value
-	  pixel-value
 	  black-pixel
-	  white-pixel
+	  white-pixel))
-	  ))
 
 (define-interface xlib-gcontext-interface
-  (export gcontext?
+  (export create-gcontext
-	  gcontext-display
-	  create-gcontext
 	  copy-gcontext
 	  copy-gcontext!
-	  free-gcontext
 
-	  ((gc-value make-gc-value-alist) :syntax)
+	  ((gc-value gc-value-set make-gc-value-alist) :syntax)
+	  make-gc-value-set
 
-	  query-best-size
 	  query-best-cursor
 	  query-best-tile
 	  query-best-stipple
 
 	  get-gcontext-values
+	  ((gc-function line-style cap-style join-style fill-style
+	    subwindow-mode arc-mode rectangle-ordering) :syntax)
 	  gcontext-function
 	  gcontext-plane-mask
 	  gcontext-foreground
@@ -231,8 +199,7 @@
 	  set-gcontext-dash-offset!
 
 	  set-gcontext-clip-rectangles!
-	  set-gcontext-dashlist!
+	  set-gcontext-dashlist!))
-	  ))
 
 (define-interface xlib-graphics-interface
   (export clear-area
@@ -251,18 +218,14 @@
 	  fill-arc
 	  draw-arcs
 	  fill-arcs
+	  ((polygon-shape) :syntax)
 	  fill-polygon
 	  rectangle
 	  bounds
 	  points->segments))
 
 (define-interface xlib-font-interface
-  (export font?
+  (export list-font-names
-	  font-display
-	  open-font
-	  close-font
-	  font-name
-	  list-font-names
 	  list-fonts
 
 	  font-info
@@ -303,24 +266,325 @@
 	  set-font-path!))
 	  
 (define-interface xlib-pixmap-interface 
-  (export pixmap?
+  (export create-pixmap
-	  free-pixmap
-	  pixmap-display
-	  create-pixmap
 	  create-bitmap-from-data
 	  create-pixmap-from-bitmap-data
 	  read-bitmap-file
 	  write-bitmap-file))
 
 (define-interface xlib-event-interface
-  (export event-type
+  (export event-ready?
-	  event-args
-	  event?
-	  event-ready?
 	  events-pending
 	  next-event
 	  peek-event
-	  wait-event))
+	  wait-event
+	  
+  ((event-type) :syntax)
+  any-event-type
+
+  key-event?
+  key-event-type
+  key-event-serial
+  key-event-send-event?
+  key-event-display
+  key-event-window
+  key-event-root
+  key-event-subwindow
+  key-event-time
+  key-event-x
+  key-event-y
+  key-event-x-root
+  key-event-y-root
+  key-event-state
+  key-event-keycode
+  key-event-same-screen?
+  button-event?
+  button-event-type
+  button-event-serial
+  button-event-send-event?
+  button-event-display
+  button-event-window
+  button-event-root
+  button-event-subwindow
+  button-event-time
+  button-event-x
+  button-event-y
+  button-event-x-root
+  button-event-y-root
+  button-event-state
+  button-event-button
+  button-event-same-screen?
+  motion-event?
+  motion-event-type
+  motion-event-serial
+  motion-event-send-event?
+  motion-event-display
+  motion-event-window
+  motion-event-root
+  motion-event-subwindow
+  motion-event-time
+  motion-event-x
+  motion-event-y
+  motion-event-x-root
+  motion-event-y-root
+  motion-event-state
+  motion-event-is-hint?
+  motion-event-same-screen?
+  crossing-event?
+  crossing-event-type
+  crossing-event-serial
+  crossing-event-send-event?
+  crossing-event-display
+  crossing-event-window
+  crossing-event-root
+  crossing-event-subwindow
+  crossing-event-time
+  crossing-event-x
+  crossing-event-y
+  crossing-event-x-root
+  crossing-event-y-root
+  crossing-event-mode
+  crossing-event-detail
+  crossing-event-same-screen?
+  crossing-event-focus?
+  crossing-event-state
+  focus-change-event?
+  focus-change-event-type
+  focus-change-event-serial
+  focus-change-event-send-event?
+  focus-change-event-display
+  focus-change-event-window
+  focus-change-event-mode
+  focus-change-event-detail
+  expose-event?
+  expose-event-type
+  expose-event-serial
+  expose-event-send-event?
+  expose-event-display
+  expose-event-window
+  expose-event-x
+  expose-event-y
+  expose-event-width
+  expose-event-height
+  expose-event-count
+  graphics-expose-event?
+  graphics-expose-event-type
+  graphics-expose-event-serial
+  graphics-expose-event-send-event?
+  graphics-expose-event-display
+  graphics-expose-event-drawable
+  graphics-expose-event-x
+  graphics-expose-event-y
+  graphics-expose-event-width
+  graphics-expose-event-height
+  graphics-expose-event-major-code
+  graphics-expose-event-minor-code
+  no-expose-event?
+  no-expose-event-type
+  no-expose-event-serial
+  no-expose-event-send-event?
+  no-expose-event-display
+  no-expose-event-drawable
+  no-expose-event-major-code
+  no-expose-event-minor-code
+  visibility-event?
+  visibility-event-type
+  visibility-event-serial
+  visibility-event-send-event?
+  visibility-event-display
+  visibility-event-window
+  visibility-event-state
+  create-window-event?
+  create-window-event-type
+  create-window-event-serial
+  create-window-event-send-event?
+  create-window-event-display
+  create-window-event-parent
+  create-window-event-window
+  create-window-event-x
+  create-window-event-y
+  create-window-event-width
+  create-window-event-height
+  create-window-event-border-width
+  create-window-event-override-redirect?
+  destroy-window-event?
+  destroy-window-event-type
+  destroy-window-event-serial
+  destroy-window-event-send-event?
+  destroy-window-event-display
+  destroy-window-event-event
+  destroy-window-event-window
+  unmap-event?
+  unmap-event-type
+  unmap-event-serial
+  unmap-event-send-event?
+  unmap-event-display
+  unmap-event-event
+  unmap-event-window
+  unmap-event-from-configure?
+  map-event?
+  map-event-type
+  map-event-serial
+  map-event-send-event?
+  map-event-display
+  map-event-event
+  map-event-window
+  map-event-override-redirect?
+  map-request-event?
+  map-request-event-type
+  map-request-event-serial
+  map-request-event-send-event?
+  map-request-event-display
+  map-request-event-parent
+  map-request-event-window
+  reparent-event?
+  reparent-event-type
+  reparent-event-serial
+  reparent-event-send-event?
+  reparent-event-display
+  reparent-event-event
+  reparent-event-window
+  reparent-event-parent
+  reparent-event-x
+  reparent-event-y
+  reparent-event-override-redirect?
+  configure-event?
+  configure-event-type
+  configure-event-serial
+  configure-event-send-event?
+  configure-event-display
+  configure-event-event
+  configure-event-window
+  configure-event-x
+  configure-event-y
+  configure-event-width
+  configure-event-height
+  configure-event-border-width
+  configure-event-above
+  configure-event-override-redirect?
+  gravity-event?
+  gravity-event-type
+  gravity-event-serial
+  gravity-event-send-event?
+  gravity-event-display
+  gravity-event-event
+  gravity-event-window
+  gravity-event-x
+  gravity-event-y
+  resize-request-event?
+  resize-request-event-type
+  resize-request-event-serial
+  resize-request-event-send-event?
+  resize-request-event-display
+  resize-request-event-window
+  resize-request-event-width
+  resize-request-event-height
+  configure-request-event?
+  configure-request-event-type
+  configure-request-event-serial
+  configure-request-event-send-event?
+  configure-request-event-display
+  configure-request-event-parent
+  configure-request-event-window
+  configure-request-event-window-changes-alist
+  circulate-event?
+  circulate-event-type
+  circulate-event-serial
+  circulate-event-send-event?
+  circulate-event-display
+  circulate-event-event
+  circulate-event-window
+  circulate-event-place
+  circulate-request-event?
+  circulate-request-event-type
+  circulate-request-event-serial
+  circulate-request-event-send-event?
+  circulate-request-event-display
+  circulate-request-event-parent
+  circulate-request-event-window
+  circulate-request-event-place
+  property-event?
+  property-event-type
+  property-event-serial
+  property-event-send-event?
+  property-event-display
+  property-event-window
+  property-event-atom
+  property-event-time
+  property-event-state
+  selection-clear-event?
+  selection-clear-event-type
+  selection-clear-event-serial
+  selection-clear-event-send-event?
+  selection-clear-event-display
+  selection-clear-event-window
+  selection-clear-event-selection
+  selection-clear-event-time
+  selection-request-event?
+  selection-request-event-type
+  selection-request-event-serial
+  selection-request-event-send-event?
+  selection-request-event-display
+  selection-request-event-owner
+  selection-request-event-requestor
+  selection-request-event-atom
+  selection-request-event-target
+  selection-request-event-property
+  selection-request-event-time
+  selection-event?
+  selection-event-type
+  selection-event-serial
+  selection-event-send-event?
+  selection-event-display
+  selection-event-requestor
+  selection-event-selection
+  selection-event-target
+  selection-event-property
+  selection-event-time
+  colormap-event?
+  colormap-event-type
+  colormap-event-serial
+  colormap-event-send-event?
+  colormap-event-display
+  colormap-event-window
+  colormap-event-colormap
+  colormap-event-new?
+  colormap-event-state
+  client-message-event?
+  client-message-event-type
+  client-message-event-serial
+  client-message-event-send-event?
+  client-message-event-display
+  client-message-event-window
+  client-message-event-message-type
+  client-message-event-format
+  client-message-event-data
+  mapping-event?
+  mapping-event-type
+  mapping-event-serial
+  mapping-event-send-event?
+  mapping-event-display
+  mapping-event-window
+  mapping-event-request
+  mapping-event-first-keycode
+  mapping-event-count
+  error-event?
+  error-event-type
+  error-event-serial
+  error-event-send-event?
+  error-event-display
+  error-event-serial
+  error-event-error-code
+  error-event-request-code
+  error-event-minor-code
+  error-event-resourceid
+  keymap-event?
+  keymap-event-type
+  keymap-event-serial
+  keymap-event-send-event?
+  keymap-event-display
+  keymap-event-bit-vector
+))
 
 (define-interface xlib-text-interface
   (export text-width
@@ -335,10 +599,7 @@
 	  ))
 
 (define-interface xlib-property-interface
-  (export atom?
+  (export find-atom
-	  make-atom
-	  intern-atom
-	  find-atom
 	  atom-name
 	  list-properties
 	  get-property
@@ -350,21 +611,18 @@
 	  convert-selection))
 
 (define-interface xlib-cursor-interface
-  (export cursor?
+  (export create-pixmap-cursor
-	  cursor-display
-	  free-cursor
-	  create-pixmap-cursor
 	  create-cursor ;; same as above
 	  create-glyph-cursor
 	  create-font-cursor
 	  recolor-cursor))
 
-
 (define-interface xlib-wm-interface
   (export reparent-window
 	  install-colormap
 	  uninstall-colormap
 	  list-installed-colormaps
+	  ((revert-to save-set close-down-mode) :syntax)
 	  set-input-focus
 	  input-focus
 	  general-warp-pointer
@@ -397,12 +655,13 @@
 	  set-wm-command!
 	  get-transient-for
 	  set-transient-for!
-	  get-wm-normal-hints
+
-	  set-wm-normal-hints!
+	  ((wm-hint size-hint initial-state
-	  ((wm-hint 
-	    size-hint
 	    make-wm-hint-alist
 	    make-size-hint-alist) :syntax)
+
+	  get-wm-normal-hints
+	  set-wm-normal-hints!
 	  get-wm-hints
 	  set-wm-hints!
 	  get-icon-sizes
@@ -431,7 +690,8 @@
 	  x-error-text
 	  most-recent-x-error
 	  next-x-error
-	  x-fatal-error-handler))
+	  x-fatal-error-handler
+	  ((error-code) :syntax)))
 
 (define-interface xlib-extension-interface
   (export list-extensions
@@ -462,21 +722,21 @@
 	  allow-events
 	  grab-server
 	  ungrab-server
+	  ((grab-status allow-event) :syntax)
 	  ;; syntax: with-server-grabbed
 	  ))
 
 (define-interface xlib-visual-interface
-  (export visual?
+  (export get-visual-info
-	  get-visual-info
 	  visual-id
 	  match-visual-info
-	  (make-visual-info-alist :syntax)
+
+	  ((visual-info visual-class window-class
+	    make-visual-info-alist bit-order byte-order) :syntax)
 	  ))
 
 (define-interface xlib-region-interface
-  (export region?
+  (export create-region
-	  destroy-region
-	  create-region
 	  clip-box
 	  region-empty?
 	  region-equal?
@@ -498,8 +758,57 @@
 
 ;; all together
 
+(define-interface xlib-types-interface
+  ;; a subset of xlib-internal-types-interface
+  (export
+   
+   display? display-after-function 
+   display-set-after-function! close-display
+
+   window? destroy-window window-display
+
+   drawable? drawable-display
+
+   color?
+
+   colormap? free-colormap colormap-display
+
+   pixel?
+
+   gcontext? free-gcontext gcontext? gcontext-display
+
+   pixmap? free-pixmap pixmap-display
+
+   font? font-display font-name open-font close-font
+
+   atom? make-atom intern-atom
+
+   cursor? cursor-display free-cursor
+
+   visual?
+
+   region? destroy-region
+
+   ((event-mask) :syntax)
+   event-mask-all-events
+
+   ((state state-set button notify-mode notify-detail
+     visibility-state place property-state colormap-state
+     mapping-request bit-gravity gravity) :syntax)
+
+   ((set-window-attribute window-change stack-mode
+     window-attribute
+     make-set-window-attribute-alist
+     make-window-attribute-alist 
+     make-window-change-alist) :syntax)
+
+   ((fill-rule) :syntax)
+   ))
+   
+
 (define-interface xlib-interface
-  (compound-interface xlib-display-interface
+  (compound-interface xlib-types-interface
+		      xlib-display-interface
 		      xlib-pixmap-interface
 		      xlib-window-interface
 		      xlib-drawable-interface

scheme/xlib/xlib-internal-interfaces.scm

@@ -11,121 +11,78 @@
 ;; these are internal interfaces that describe the construction and access
 ;; functions to all the new datatypes. They are not needed by the user
 
-(define-interface xlib-display-type-interface
+(define-interface xlib-internal-types-interface
-  (export make-display
+  (export
-	  display?
-	  display-Xdisplay
-	  display-after-function
-	  display-set-after-function!
-	  close-display
-	  display-message-inport))
    
-(define-interface xlib-window-type-interface
+   display? make-display display-Xdisplay display-after-function 
-  (export make-window
+   display-set-after-function! close-display display-message-inport
-	  destroy-window
-	  window?
-	  window-Xwindow
-	  window-display))
 
-(define-interface xlib-drawable-type-interface
+   window? make-window destroy-window window-Xwindow window-display
-  (export drawable?
-	  drawable-abstraction
-	  drawable-display
-	  drawable-Xobject))
 
-(define-interface xlib-color-type-interface
+   drawable? make-drawable drawable-abstraction drawable-display
-  (export internal-make-color
+   drawable-Xobject
-	  extract-rgb-values
-	  create-color
-	  color?
-	  color-Xcolor))
 
-(define-interface xlib-colormap-type-interface
+   color? internal-make-color extract-rgb-values create-color color-Xcolor
-  (export make-colormap
-	  colormap?
-	  free-colormap
-	  colormap-display
-	  colormap-Xcolormap))
 
-(define-interface xlib-pixel-type-interface
+   colormap? make-colormap free-colormap colormap-display colormap-Xcolormap
-  (export make-pixel
-	  pixel?
-	  pixel-Xpixel))
 
-(define-interface xlib-gcontext-type-interface
+   pixel? make-pixel pixel-Xpixel
-  (export make-gcontext
-	  free-gcontext
-	  gcontext?
-	  gcontext-display
-	  gcontext-Xgcontext))
 
-(define-interface xlib-pixmap-type-interface
+   gcontext? make-gcontext free-gcontext gcontext? gcontext-display
-  (export make-pixmap
+   gcontext-Xgcontext
-	  free-pixmap
-	  pixmap?
-	  pixmap-Xpixmap
-	  pixmap-display))
 
-(define-interface xlib-event-type-interface
+   pixmap? make-pixmap free-pixmap pixmap-Xpixmap pixmap-display
-  (export make-event
-	  event?
-	  event-type
-	  event-args
-	  event-set-args!))
 
-(define-interface xlib-font-type-interface
+   font? make-font font-Xfont font-Xfontstruct font-display font-name
-  (export make-font
+   load-font open-font unload-font close-font
-	  font?
-	  font-Xfont
-	  font-Xfontstruct
-	  font-display
-	  font-name
-	  load-font
-	  open-font
-	  unload-font
-	  close-font))
 
-(define-interface xlib-atom-type-interface
+   atom? make-atom atom-Xatom intern-atom
-  (export atom?
-	  make-atom
-	  atom-Xatom
-	  intern-atom))
 
-(define-interface xlib-cursor-type-interface
+   cursor? make-cursor cursor-display cursor-Xcursor free-cursor
-  (export cursor?
-	  make-cursor
-	  cursor-display
-	  cursor-Xcursor
-	  free-cursor))
 
-(define-interface xlib-visual-type-interface
+   visual? make-visual visual-Xvisual
-  (export visual?
-	  make-visual
-	  visual-Xvisual))
 
-(define-interface xlib-region-type-interface
+   region? make-region destroy-region region-Xregion
-  (export region?
-	  make-region
-	  destroy-region
-	  region-Xregion))
 
-;; all in one
+   ((event-mask) :syntax) event-mask-all-events
+   integer->event-mask event-mask->integer
+
+   integer->state-set state-set->integer
+   integer->button button->integer
+   integer->is-hint? is-hint?->integer
+   integer->notify-mode notify-mode->integer
+   integer->notify-detail notify-detail->integer
+   integer->visibility-state visibility-state->integer
+   integer->place place->integer
+   integer->property-state property-state->integer
+   integer->colormap-state colormap-state->integer
+   integer->mapping-request mapping-request->integer
+
+   ((state state-set button notify-mode notify-detail
+     visibility-state place property-state colormap-state
+     mapping-request bit-gravity gravity backing-store) :syntax)
+
+   gravity->integer integer->gravity
+
+   make-enum-alist->integer+vector
+   make-integer+vector->enum-alist
+   make-integer->enum-set make-enum-set->integer
+   
+   set-window-attribute-alist->integer+vector
+   ((set-window-attribute make-set-window-attribute-alist) :syntax)
+
+   ((window-change make-window-change-alist stack-mode) :syntax)
+   window-change-alist->integer+vector integer+vector->window-change-alist
+
+   ((window-attribute make-window-attribute-alist) :syntax)
+   integer+vector->window-attribute-alist
+   
+   ((window-class) :syntax)
+
+   ((byte-order bit-order) :syntax)
+   integer->byte-order integer->bit-order
+
+   ((fill-rule) :syntax)
+   fill-rule->integer integer->fill-rule
 
-(define-interface xlib-types-interface
-  (compound-interface
-   xlib-helper-interface
-   xlib-display-type-interface
-   xlib-window-type-interface
-   xlib-drawable-type-interface
-   xlib-color-type-interface
-   xlib-colormap-type-interface
-   xlib-pixel-type-interface
-   xlib-gcontext-type-interface
-   xlib-pixmap-type-interface
-   xlib-event-type-interface
-   xlib-font-type-interface
-   xlib-atom-type-interface
-   xlib-cursor-type-interface
-   xlib-visual-type-interface
-   xlib-region-type-interface
    ))

scheme/xlib/xlib-internal-packages.scm

@@ -6,7 +6,13 @@
 ;; the other xlib packages need this to gain direct access to the new datatypes.
 ;; Normal users shouldn't use this package.
 
-(define-structure xlib-types xlib-types-interface
+(define-structure xlib-helper xlib-helper-interface
+  (open scheme
+	external-calls
+	list-lib)
+  (files helper))
+
+(define-structure xlib-internal-types xlib-internal-types-interface
   (open scheme
 	signals ;; for error
 	fdes    ;; see above
@@ -17,9 +23,9 @@
 	define-record-types
 	external-calls
 	byte-vectors ;; for color-type.scm
-	)
+	finite-types enum-sets bitwise
-  (files helper
+	xlib-helper)
-	 display-type 
+  (files display-type 
 	 color-type
 	 colormap-type
 	 pixel-type
@@ -27,9 +33,9 @@
 	 window-type
 	 drawable-type
 	 gcontext-type
-	 event-type
 	 font-type
 	 atom-type
 	 cursor-type
 	 visual-type
-	 region-type))
+	 region-type
+	 types))

scheme/xlib/xlib-packages.scm

@@ -2,7 +2,7 @@
   (open	scheme
 	signals  ;; for error
 	external-calls
-	xlib-types)
+	xlib-internal-types)
   (files display))
 
 (define-structure xlib-window xlib-window-interface
@@ -10,7 +10,8 @@
 	signals ;; for error	
 	external-calls
 	receiving
-	xlib-types
+	xlib-internal-types
+	xlib-helper
 	xlib-graphics ;; for clear-window
 	finite-types ;; for define-enumerated-type
 	)
@@ -20,7 +21,7 @@
 (define-structure xlib-drawable xlib-drawable-interface
   (open	scheme
 	external-calls
-	xlib-types
+	xlib-internal-types
 	xlib-window
 	xlib-pixmap)
   (files drawable))
@@ -30,21 +31,25 @@
   (open	scheme
 	signals  ;; for error
 	external-calls
-	xlib-types)
+	xlib-internal-types
+	xlib-helper)
   (files color))
 
 
 (define-structure xlib-colormap xlib-colormap-interface
   (open	scheme
 	external-calls
-	xlib-types)
+	bitwise
+	signals
+	list-lib
+	xlib-internal-types)
   (files colormap))
 
 
 (define-structure xlib-pixel xlib-pixel-interface
   (open	scheme
 	external-calls
-	xlib-types)
+	xlib-internal-types)
   (files pixel))
 
 
@@ -53,8 +58,8 @@
 	signals  ;; for error
 	external-calls
 	receiving
-	finite-types ;; for define-enumerated-type
+	finite-types enum-sets
-	xlib-types)
+	xlib-internal-types)
   (files gcontext))
 
 
@@ -62,15 +67,15 @@
   (open scheme
 	signals  ;; for error
 	external-calls
-	xlib-types)
+	xlib-internal-types)
   (files pixmap)) ;;...
 
 (define-structure xlib-graphics xlib-graphics-interface
   (open scheme
 	external-calls
-	xlib-types
+	xlib-internal-types
 	list-lib ;; for fold-right
-	)
+	finite-types)
   (files graphics))
 
 (define-structure xlib-event xlib-event-interface
@@ -81,14 +86,16 @@
 	ports locks  ;; for locking the port
 	channel-i/o ;; for wait-for-channel
 	interrupts
-	xlib-types)
+	finite-types define-record-types
-  (files event))
+	xlib-internal-types)
+  (files event event-types))
 
 (define-structure xlib-font xlib-font-interface
   (open scheme
 	signals  ;; for error
 	external-calls
-	xlib-types
+	xlib-internal-types
+	xlib-helper
 	bitwise  ;; for bitwise-and, arithmetix-shift
 	)
   (files font))
@@ -98,45 +105,50 @@
 	signals  ;; for error
 	external-calls
 	ascii    ;; for char->ascii etc.
-	xlib-types)
+	xlib-internal-types
+	xlib-helper)
   (files text))
 
 (define-structure xlib-property xlib-property-interface
   (open scheme
 	external-calls
-	xlib-types)
+	signals
+	xlib-internal-types
+	xlib-helper)
   (files property))
 
 (define-structure xlib-cursor xlib-cursor-interface
   (open scheme
 	external-calls
-	xlib-types)
+	xlib-internal-types
+	xlib-helper)
   (files cursor))
 
 (define-structure xlib-wm xlib-wm-interface
   (open scheme
 	external-calls
-	xlib-types
+	xlib-internal-types
 	signals ;; for error
-	)
+	finite-types
+	xlib-helper)
   (files wm))
 
 (define-structure xlib-client xlib-client-interface
   (open scheme
 	external-calls
-	xlib-types
+	xlib-internal-types
 	xlib-display ;; for check-screen-number
 	xlib-window ; for window-change-alist->vector
 	signals ;; for error
 	finite-types ;; for define-enumerated-type
 	list-lib ;; for filter
-	)
+	xlib-helper)
   (files client))
 
 (define-structure xlib-key xlib-key-interface
   (open scheme
 	external-calls
-	xlib-types)
+	xlib-internal-types)
   (files key))
 
 (define-structure xlib-error xlib-error-interface
@@ -144,20 +156,21 @@
 	external-calls
 	placeholders
 	define-record-types
-	xlib-types)
+	finite-types
+	xlib-internal-types)
   (files error))
 
 (define-structure xlib-extension xlib-extension-interface
   (open scheme
 	external-calls
-	xlib-types)
+	xlib-internal-types)
   (files extension))
 
 (define-structure xlib-utility xlib-utility-interface
   (open scheme
 	external-calls
 	receiving
-	xlib-types
+	xlib-internal-types
 	xlib-display
 	xlib-property)
   (files utility))
@@ -165,26 +178,34 @@
 (define-structure xlib-grab xlib-grab-interface
   (open scheme
 	external-calls
-	xlib-types)
+	finite-types
+	xlib-internal-types)
   (files grab))
 
 (define-structure xlib-visual xlib-visual-interface
   (open scheme
 	external-calls
 	finite-types ;; for enumerated types
-	xlib-types)
+	xlib-internal-types)
   (files visual))
 
 (define-structure xlib-region xlib-region-interface
   (open scheme
 	external-calls
-	xlib-types)
+	xlib-internal-types)
   (files region))
 
+(define-structure xlib-types xlib-types-interface
+  (open scheme
+	finite-types
+	define-record-types
+	xlib-internal-types))
+
 ;; all together
 
 (define-structure xlib xlib-interface
-  (open xlib-display
+  (open xlib-types
+	xlib-display
 	xlib-pixmap
 	xlib-window
 	xlib-drawable