+ fixed some bugs.

+ added optional screen argument to some display-functions.
+ added more any-event-* functions.
+ implemented send-event.
+ updated interfaces.

c/xlib/client.c

@@ -382,6 +382,12 @@ s48_value scx_Wm_Normal_Hints(s48_value dpy, s48_value win) {
   v = s48_make_vector(10, S48_NULL);
   S48_GC_PROTECT_1(v);
 
+  if ((SH.flags & USPosition) != 0)
+    S48_VECTOR_SET(v, 0, S48_VECTOR_REF(v, 2));
+  
+  if ((SH.flags & USSize) != 0)
+    S48_VECTOR_SET(v, 1, S48_VECTOR_REF(v, 3));
+  
   if (((SH.flags & PPosition) != 0) || ((SH.flags & USPosition) != 0))
     S48_VECTOR_SET(v, 2, s48_cons(s48_enter_fixnum(SH.x),
 				  s48_enter_fixnum(SH.y)));
@@ -390,12 +396,6 @@ s48_value scx_Wm_Normal_Hints(s48_value dpy, s48_value win) {
     S48_VECTOR_SET(v, 3, s48_cons(s48_enter_fixnum(SH.width), 
 				  s48_enter_fixnum(SH.height)));
   
-  if ((SH.flags & USPosition) != 0)
-    S48_VECTOR_SET(v, 0, S48_VECTOR_REF(v, 2));
-  
-  if ((SH.flags & USSize) != 0)
-    S48_VECTOR_SET(v, 1, S48_VECTOR_REF(v, 3));
-  
   if ((SH.flags & PMinSize) != 0)
     S48_VECTOR_SET(v, 4, s48_cons(s48_enter_fixnum(SH.min_width), 
 				  s48_enter_fixnum(SH.min_height)));
@@ -420,7 +420,7 @@ s48_value scx_Wm_Normal_Hints(s48_value dpy, s48_value win) {
 				  s48_enter_fixnum(SH.base_height)));
   
   if ((SH.flags & PWinGravity) != 0)
-    S48_VECTOR_SET(v, 18, s48_enter_integer(SH.win_gravity));
+    S48_VECTOR_SET(v, 9, s48_enter_integer(SH.win_gravity));
 
   v = s48_cons(s48_enter_integer(SH.flags), v);
 
@@ -431,7 +431,7 @@ 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 = S48_CAR(hints);
+  long mask = s48_extract_integer(S48_CAR(hints));
   s48_value v = S48_CDR(hints);
 
   if (mask & USPosition) {

c/xlib/display.c

@@ -62,21 +62,27 @@ s48_value scx_Display_Default_Root_Window(s48_value Xdisplay) {
   return SCX_ENTER_WINDOW(wnd);
 }
 
-s48_value scx_Display_Default_Colormap(s48_value Xdisplay) {
+s48_value scx_Display_Root_Window(s48_value Xdisplay, s48_value scr_num) {
+  Window wnd = RootWindow(SCX_EXTRACT_DISPLAY(Xdisplay),
+			  s48_extract_integer(scr_num));
+  return SCX_ENTER_WINDOW(wnd);
+}
+
+s48_value scx_Display_Default_Colormap(s48_value Xdisplay, s48_value scr) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  Colormap cmp = DefaultColormap(dpy, DefaultScreen(dpy));
+  Colormap cmp = DefaultColormap(dpy, s48_extract_integer(scr));
   return SCX_ENTER_COLORMAP(cmp);
 }
 
-s48_value scx_Display_Default_Gcontext(s48_value Xdisplay) {
+s48_value scx_Display_Default_Gcontext(s48_value Xdisplay, s48_value scr) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  GC gc = DefaultGC(dpy, DefaultScreen(dpy));
+  GC gc = DefaultGC(dpy, s48_extract_integer(scr));
   return SCX_ENTER_GCONTEXT(gc);
 }
 
-s48_value scx_Display_Default_Depth(s48_value Xdisplay) {
+s48_value scx_Display_Default_Depth(s48_value Xdisplay, s48_value scr) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  int depth = DefaultDepth(dpy, DefaultScreen(dpy));
+  int depth = DefaultDepth(dpy, s48_extract_integer(scr));
   return s48_enter_fixnum(depth);
 }
 
@@ -159,24 +165,24 @@ s48_value scx_Display_Bitmap_Pad(s48_value Xdisplay) {
   return s48_enter_integer(bp);
 }
 
-s48_value scx_Display_Width(s48_value Xdisplay) {
+s48_value scx_Display_Width(s48_value Xdisplay, s48_value scr) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_fixnum(DisplayWidth(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayWidth(dpy, s48_extract_integer(scr)));
 }
 
-s48_value scx_Display_Height(s48_value Xdisplay) {
+s48_value scx_Display_Height(s48_value Xdisplay, s48_value scr) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_fixnum(DisplayHeight(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayHeight(dpy, s48_extract_integer(scr)));
 }
 
-s48_value scx_Display_Width_Mm (s48_value Xdisplay) {
+s48_value scx_Display_Width_Mm (s48_value Xdisplay, s48_value scr) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_fixnum(DisplayWidthMM(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayWidthMM(dpy, s48_extract_integer(scr)));
 }
 
-s48_value scx_Display_Height_Mm (s48_value Xdisplay) {
+s48_value scx_Display_Height_Mm (s48_value Xdisplay, s48_value scr) {
   Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
-  return s48_enter_fixnum(DisplayHeightMM(dpy, DefaultScreen(dpy)));
+  return s48_enter_fixnum(DisplayHeightMM(dpy, s48_extract_integer(scr)));
 }
 
 s48_value scx_Display_Motion_Buffer_Size(s48_value Xdisplay) {
@@ -249,6 +255,7 @@ s48_value scx_Display_Select_Input(s48_value Xdisplay, s48_value Xwindow,
   XSelectInput(SCX_EXTRACT_DISPLAY(Xdisplay),
 	       SCX_EXTRACT_WINDOW(Xwindow),
 	       s48_extract_integer(event_mask));
+  return S48_UNSPECIFIC;
 }
 
 void scx_init_display(void) {
@@ -261,6 +268,7 @@ void scx_init_display(void) {
   S48_EXPORT_FUNCTION(scx_Close_Display);
   S48_EXPORT_FUNCTION(scx_Display_Message_fd);
   S48_EXPORT_FUNCTION(scx_Display_Default_Root_Window);
+  S48_EXPORT_FUNCTION(scx_Display_Root_Window);
   S48_EXPORT_FUNCTION(scx_Display_Default_Colormap);
   S48_EXPORT_FUNCTION(scx_Display_Default_Gcontext);
   S48_EXPORT_FUNCTION(scx_Display_Default_Depth);

c/xlib/event.c

@@ -2,13 +2,13 @@
 #include "scheme48.h"
 
 #define ECAST(name, type) type* name = (type*)e
-#define sidx 4
+#define sidx 5
 #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;
+  s48_value temp = S48_FALSE;
   int i;
   S48_DECLARE_GC_PROTECT(2);
   S48_GC_PROTECT_2(r, temp);
@@ -76,9 +76,13 @@ s48_value scx_enter_event(XEvent* e) {
   case KeymapNotify : {
     ECAST(q, XKeymapEvent);
     SETSIZE(1);
-    temp = s48_make_string(32, (char)0);
+    temp = s48_make_vector(32*8, s48_enter_integer(0));
-    for (i=0; i < 32; i++) 
+    for (i=0; i < 32; i++) {
-      S48_STRING_SET(temp, i, q->key_vector[i]);
+      int j;
+      char b = q->key_vector[i];
+      for (j = 0; j < 8; j++)
+	S48_VECTOR_SET(temp, i*8 + j, (b & (1 << j)) ? 1 : 0);
+    }
     SET(sidx+0, temp);
   } break;
 
@@ -281,7 +285,7 @@ s48_value scx_enter_event(XEvent* e) {
     default : temp = s48_enter_integer(q->format); //??
     }
 
-    SET(sidx+1, temp);
+    SET(sidx+2, temp);
   } break;
 
   case MappingNotify : {
@@ -301,21 +305,292 @@ s48_value scx_enter_event(XEvent* e) {
   // XAnyEvent entries
   {
     ECAST(q, XAnyEvent);
-    SET(0, s48_enter_integer(q->serial));
+    SET(0, s48_enter_integer(q->type));
-    SET(1, S48_ENTER_BOOLEAN(q->send_event));
+    SET(1, s48_enter_integer(q->serial));
-    SET(2, SCX_ENTER_DISPLAY(q->display));
+    SET(2, S48_ENTER_BOOLEAN(q->send_event));
-    SET(3, SCX_ENTER_WINDOW(q->window));
+    SET(3, SCX_ENTER_DISPLAY(q->display));
+    SET(4, SCX_ENTER_WINDOW(q->window));
   }
   // more??
   
-  // And the Event-Name
-  temp = s48_enter_integer(e->type);
-  r = s48_cons(temp, r);
-
   S48_GC_UNPROTECT();
   return r;
 }
 
+#define REF(i) S48_VECTOR_REF(v, i)
+
+XEvent scx_extract_event(s48_value type, s48_value v) {
+  XEvent e;
+
+  e.xany.type = s48_extract_integer(REF(0));
+  e.xany.serial = s48_extract_integer(REF(1));
+  e.xany.send_event = S48_EXTRACT_BOOLEAN(REF(2));
+  e.xany.display = SCX_EXTRACT_DISPLAY(REF(3));
+
+  switch (s48_extract_integer(type)) {
+  case KeyPress: case KeyRelease: {
+    e.xkey.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xkey.root = SCX_EXTRACT_WINDOW(REF(5));
+    e.xkey.subwindow = SCX_EXTRACT_WINDOW(REF(6));
+    e.xkey.time = SCX_EXTRACT_TIME(REF(7));
+    e.xkey.x = s48_extract_integer(REF(8));
+    e.xkey.y = s48_extract_integer(REF(9));
+    e.xkey.x_root = s48_extract_integer(REF(10));
+    e.xkey.y_root = s48_extract_integer(REF(11));
+    e.xkey.state = s48_extract_integer(REF(12));
+    e.xkey.keycode = s48_extract_integer(REF(13));
+    e.xkey.same_screen = S48_EXTRACT_BOOLEAN(REF(14));
+  } break;
+  case ButtonPress: case ButtonRelease: {
+    e.xbutton.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xbutton.root = SCX_EXTRACT_WINDOW(REF(5));
+    e.xbutton.subwindow = SCX_EXTRACT_WINDOW(REF(6));
+    e.xbutton.time = SCX_EXTRACT_TIME(REF(7));
+    e.xbutton.x = s48_extract_integer(REF(8));
+    e.xbutton.y = s48_extract_integer(REF(9));
+    e.xbutton.x_root = s48_extract_integer(REF(10));
+    e.xbutton.y_root = s48_extract_integer(REF(11));
+    e.xbutton.state = s48_extract_integer(REF(12));
+    e.xbutton.button = s48_extract_integer(REF(13));
+    e.xbutton.same_screen = S48_EXTRACT_BOOLEAN(REF(14));
+  } break;
+  case MotionNotify: {
+    e.xmotion.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xmotion.root = SCX_EXTRACT_WINDOW(REF(5));
+    e.xmotion.subwindow = SCX_EXTRACT_WINDOW(REF(6));
+    e.xmotion.time = SCX_EXTRACT_TIME(REF(7));
+    e.xmotion.x = s48_extract_integer(REF(8));
+    e.xmotion.y = s48_extract_integer(REF(9));
+    e.xmotion.x_root = s48_extract_integer(REF(10));
+    e.xmotion.y_root = s48_extract_integer(REF(11));
+    e.xmotion.state = s48_extract_integer(REF(12));
+    e.xmotion.is_hint = s48_extract_integer(REF(13));
+    e.xmotion.same_screen = S48_EXTRACT_BOOLEAN(REF(14));
+  } break;
+  case EnterNotify: case LeaveNotify: {
+    e.xcrossing.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xcrossing.root = SCX_EXTRACT_WINDOW(REF(5));
+    e.xcrossing.subwindow = SCX_EXTRACT_WINDOW(REF(6));
+    e.xcrossing.time = SCX_EXTRACT_TIME(REF(7));
+    e.xcrossing.x = s48_extract_integer(REF(8));
+    e.xcrossing.y = s48_extract_integer(REF(9));
+    e.xcrossing.x_root = s48_extract_integer(REF(10));
+    e.xcrossing.y_root = s48_extract_integer(REF(11));
+    e.xcrossing.mode = s48_extract_integer(REF(12));
+    e.xcrossing.detail = s48_extract_integer(REF(13));
+    e.xcrossing.same_screen = S48_EXTRACT_BOOLEAN(REF(14));
+    e.xcrossing.focus = S48_EXTRACT_BOOLEAN(REF(15));
+    e.xcrossing.state = s48_extract_integer(REF(16));
+  } break;
+  case Expose: {
+    e.xexpose.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xexpose.x = s48_extract_integer(REF(5));
+    e.xexpose.y = s48_extract_integer(REF(6));
+    e.xexpose.width = s48_extract_integer(REF(7));
+    e.xexpose.height = s48_extract_integer(REF(8));
+    e.xexpose.count = s48_extract_integer(REF(9));
+  } break;
+  case GraphicsExpose: {
+    e.xgraphicsexpose.drawable = SCX_EXTRACT_WINDOW(REF(4));
+    e.xgraphicsexpose.x = s48_extract_integer(REF(5));
+    e.xgraphicsexpose.y = s48_extract_integer(REF(6));
+    e.xgraphicsexpose.width = s48_extract_integer(REF(7));
+    e.xgraphicsexpose.height = s48_extract_integer(REF(8));
+    e.xgraphicsexpose.count = s48_extract_integer(REF(9));
+    e.xgraphicsexpose.major_code = s48_extract_integer(REF(10));
+    e.xgraphicsexpose.minor_code = s48_extract_integer(REF(11));
+  } break;
+  case NoExpose: {
+    e.xnoexpose.drawable = SCX_EXTRACT_WINDOW(REF(4));
+    e.xnoexpose.major_code = s48_extract_integer(REF(5));
+    e.xnoexpose.minor_code = s48_extract_integer(REF(6));
+  } break;
+  case VisibilityNotify: {
+    e.xvisibility.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xvisibility.state = s48_extract_integer(REF(5));
+  } break;
+  case CreateNotify: {
+    e.xcreatewindow.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xcreatewindow.x = s48_extract_integer(REF(5));
+    e.xcreatewindow.y = s48_extract_integer(REF(6));
+    e.xcreatewindow.width = s48_extract_integer(REF(7));
+    e.xcreatewindow.height = s48_extract_integer(REF(8));
+    e.xcreatewindow.border_width = s48_extract_integer(REF(9));
+    e.xcreatewindow.override_redirect = S48_EXTRACT_BOOLEAN(REF(10));
+  } break;
+  case DestroyNotify: {
+    e.xdestroywindow.event = SCX_EXTRACT_WINDOW(REF(4));
+    e.xdestroywindow.window = SCX_EXTRACT_WINDOW(REF(5));
+  } break;
+  case UnmapNotify: {
+    e.xunmap.event = SCX_EXTRACT_WINDOW(REF(4));
+    e.xunmap.window = SCX_EXTRACT_WINDOW(REF(5));
+    e.xunmap.from_configure = S48_EXTRACT_BOOLEAN(REF(6));
+  } break;
+  case MapNotify: {
+    e.xmap.event = SCX_EXTRACT_WINDOW(REF(4));
+    e.xmap.window = SCX_EXTRACT_WINDOW(REF(5));
+    e.xmap.override_redirect = S48_EXTRACT_BOOLEAN(REF(6));
+  } break;
+  case MapRequest: {
+    e.xmaprequest.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xmaprequest.parent = SCX_EXTRACT_WINDOW(REF(5));
+  } break;
+  case ReparentNotify: {
+    e.xreparent.event = SCX_EXTRACT_WINDOW(REF(4));
+    e.xreparent.window = SCX_EXTRACT_WINDOW(REF(5));
+    e.xreparent.parent = SCX_EXTRACT_WINDOW(REF(6));
+    e.xreparent.x = s48_extract_integer(REF(7));
+    e.xreparent.y = s48_extract_integer(REF(8));
+    e.xreparent.override_redirect = S48_EXTRACT_BOOLEAN(REF(9));
+  } break;
+  case ConfigureNotify: {
+    e.xconfigure.event = SCX_EXTRACT_WINDOW(REF(4));
+    e.xconfigure.window = SCX_EXTRACT_WINDOW(REF(5));
+    e.xconfigure.x = s48_extract_integer(REF(6));
+    e.xconfigure.y = s48_extract_integer(REF(7));
+    e.xconfigure.width = s48_extract_integer(REF(8));
+    e.xconfigure.height = s48_extract_integer(REF(9));
+    e.xconfigure.border_width = s48_extract_integer(REF(10));
+    e.xconfigure.above = SCX_EXTRACT_WINDOW(REF(11));
+    e.xconfigure.override_redirect = S48_EXTRACT_BOOLEAN(REF(12));
+  } break;
+  case GravityNotify: {
+    e.xgravity.event = SCX_EXTRACT_WINDOW(REF(4));
+    e.xgravity.window = SCX_EXTRACT_WINDOW(REF(5));
+    e.xgravity.x = s48_extract_integer(REF(6));
+    e.xgravity.y = s48_extract_integer(REF(7));
+  } break;
+  case ResizeRequest: {
+    e.xresizerequest.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xresizerequest.width = s48_extract_integer(REF(5));
+    e.xresizerequest.height = s48_extract_integer(REF(6));
+  } break;
+  case ConfigureRequest: {
+    e.xconfigurerequest.parent = SCX_EXTRACT_WINDOW(REF(4));
+    e.xconfigurerequest.window = SCX_EXTRACT_WINDOW(REF(5));
+    {
+      XWindowChanges WC;
+      unsigned long mask = Changes_To_XWindowChanges(REF(6), &WC);
+      e.xconfigurerequest.x = WC.x;
+      e.xconfigurerequest.y = WC.y;
+      e.xconfigurerequest.width = WC.width;
+      e.xconfigurerequest.height = WC.height;
+      e.xconfigurerequest.border_width = WC.border_width;
+      e.xconfigurerequest.above = WC.sibling;
+      e.xconfigurerequest.detail = WC.stack_mode;
+      e.xconfigurerequest.value_mask = mask;
+    }
+  } break;
+  case CirculateNotify: {
+    e.xcirculate.event = SCX_EXTRACT_WINDOW(REF(4));
+    e.xcirculate.window = SCX_EXTRACT_WINDOW(REF(5));
+    e.xcirculate.place = s48_extract_integer(REF(6));
+  } break;
+  case CirculateRequest: {
+    e.xcirculaterequest.parent = SCX_EXTRACT_WINDOW(REF(4));
+    e.xcirculaterequest.window = SCX_EXTRACT_WINDOW(REF(5));
+    e.xcirculaterequest.place = s48_extract_integer(REF(6));
+  } break;
+  case PropertyNotify: {
+    e.xproperty.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xproperty.atom = SCX_EXTRACT_ATOM(REF(5));
+    e.xproperty.time = SCX_EXTRACT_TIME(REF(6));
+    e.xproperty.state = s48_extract_integer(REF(7));
+  } break;
+  case SelectionClear: {
+    e.xselectionclear.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xselectionclear.selection = SCX_EXTRACT_ATOM(REF(5));
+    e.xselectionclear.time = SCX_EXTRACT_TIME(REF(6));
+  } break;
+  case SelectionRequest: {
+    e.xselectionrequest.owner = SCX_EXTRACT_WINDOW(REF(4));
+    e.xselectionrequest.requestor = SCX_EXTRACT_WINDOW(REF(5));
+    e.xselectionrequest.selection = SCX_EXTRACT_ATOM(REF(6));
+    e.xselectionrequest.target = SCX_EXTRACT_ATOM(REF(7));
+    e.xselectionrequest.property = SCX_EXTRACT_ATOM(REF(8));
+    e.xselectionrequest.time = SCX_EXTRACT_TIME(REF(9));
+  } break;
+  case SelectionNotify: {
+    e.xselection.requestor = SCX_EXTRACT_WINDOW(REF(4));
+    e.xselection.selection = SCX_EXTRACT_ATOM(REF(5));
+    e.xselection.target = SCX_EXTRACT_ATOM(REF(6));
+    e.xselection.property = SCX_EXTRACT_ATOM(REF(7));
+    e.xselection.time = SCX_EXTRACT_TIME(REF(8));
+  } break;
+  case ColormapNotify: {
+    e.xcolormap.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xcolormap.colormap = SCX_EXTRACT_COLORMAP(REF(5));
+    e.xcolormap.new = S48_EXTRACT_BOOLEAN(REF(6));
+    e.xcolormap.state = s48_extract_integer(REF(7));
+  } break;
+  case ClientMessage: {
+    e.xclient.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xclient.message_type = SCX_EXTRACT_ATOM(REF(5));
+    e.xclient.format = s48_extract_integer(REF(6));
+    {
+      s48_value data = REF(7);
+      int i;
+      for (i = 0; i < S48_VECTOR_LENGTH(data); i++) {
+	switch (e.xclient.format) {
+	case 8:
+	  if (i < 20)
+	    e.xclient.data.b[i] =
+	      (char)s48_extract_integer(S48_VECTOR_REF(data, i));
+	case 16:
+	  if (i < 10)
+	    e.xclient.data.s[i] =
+	      (short)s48_extract_integer(S48_VECTOR_REF(data, i));
+	case 32:
+	  if (i < 5)
+	    e.xclient.data.l[i] =
+	      (long)s48_extract_integer(S48_VECTOR_REF(data, i));
+	}
+      }
+    }
+  } break;
+  case MappingNotify: {
+    e.xmapping.window = SCX_EXTRACT_WINDOW(REF(4));
+    e.xmapping.request = s48_extract_integer(REF(5));
+    e.xmapping.first_keycode = s48_extract_integer(REF(6));
+    e.xmapping.count = s48_extract_integer(REF(7));
+  } break;
+  // Error Event...
+  case KeymapNotify: {
+    e.xkeymap.window = (Window)0; // not used.
+    {
+      s48_value bits = REF(4);
+      int j, bn;
+      char b;
+      for (bn = 0; bn < 32; bn++) {
+	b = 0;
+	for (j = 0; j < 8; j++)
+	  b = b | ((char)S48_VECTOR_REF(bits, bn*8 + j) << j);
+	e.xkeymap.key_vector[bn] = b;
+      }
+    }
+  } break;
+  // default ??
+  } // switch.
+
+  return e;
+}
+
+s48_value scx_Send_Event(s48_value Xdisplay, s48_value Xwindow,
+			 s48_value propagate,
+			 s48_value event_mask, s48_value vector,
+			 s48_value type) {
+  XEvent e = scx_extract_event(type, vector);
+  
+  Status r = XSendEvent(SCX_EXTRACT_DISPLAY(Xdisplay),
+			SCX_EXTRACT_WINDOW(Xwindow),
+			S48_EXTRACT_BOOLEAN(propagate),
+			s48_extract_integer(event_mask),
+			&e);
+  return r ? S48_TRUE : S48_FALSE;
+}
+
+
 s48_value scx_Next_Event(s48_value Xdisplay) {
   XEvent e;
   XNextEvent(SCX_EXTRACT_DISPLAY(Xdisplay), &e);
@@ -369,6 +644,7 @@ s48_value scx_add_pending_channel (channel){
   return S48_UNSPECIFIC;
 }
 void scx_init_event(void) {
+  S48_EXPORT_FUNCTION(scx_Send_Event);
   S48_EXPORT_FUNCTION(scx_Next_Event);
   S48_EXPORT_FUNCTION(scx_Peek_Event);
   S48_EXPORT_FUNCTION(scx_Events_Pending);

c/xlib/property.c

@@ -17,9 +17,10 @@ s48_value scx_Find_Atom (s48_value Xdisplay, s48_value name){
 }
 
 s48_value scx_Atom_Name (s48_value Xdisplay, s48_value a) {
-    register char *s;
+    char* s;
     // not used: Disalbe_Interrupts
-    s = XGetAtomName (SCX_EXTRACT_DISPLAY(Xdisplay), a);
+    s = XGetAtomName (SCX_EXTRACT_DISPLAY(Xdisplay),
+		      s48_extract_integer(a));
     // not used: Enable_Interrupts
     return s48_enter_string (s);
 }

c/xlib/window.c

@@ -141,12 +141,20 @@ s48_value Changes_To_XWindowChanges(s48_value changes, XWindowChanges* WC) {
   unsigned long mask = s48_extract_integer(S48_CAR(changes));
   s48_value v = S48_CDR(changes);
 
-  WC->x = s48_extract_integer(S48_VECTOR_REF(v, 0));
+  if (mask & CWX)
-  WC->y = s48_extract_integer(S48_VECTOR_REF(v, 1));
+    WC->x = s48_extract_integer(S48_VECTOR_REF(v, 0));
-  WC->width = s48_extract_integer(S48_VECTOR_REF(v, 2));
+  if (mask & CWY)
-  WC->height = s48_extract_integer(S48_VECTOR_REF(v, 3));
+    WC->y = s48_extract_integer(S48_VECTOR_REF(v, 1));
-  WC->sibling = SCX_EXTRACT_WINDOW(S48_VECTOR_REF(v, 4));
+  if (mask & CWWidth)
-  WC->stack_mode = s48_extract_integer(S48_VECTOR_REF(v, 5));
+    WC->width = s48_extract_integer(S48_VECTOR_REF(v, 2));
+  if (mask & CWHeight)
+    WC->height = s48_extract_integer(S48_VECTOR_REF(v, 3));
+  if (mask & CWBorderWidth)
+    WC->height = s48_extract_integer(S48_VECTOR_REF(v, 4));
+  if (mask & CWSibling)
+    WC->sibling = SCX_EXTRACT_WINDOW(S48_VECTOR_REF(v, 5));
+  if (mask & CWStackMode)
+    WC->stack_mode = s48_extract_integer(S48_VECTOR_REF(v, 6));
 
   return mask;
 }

scheme/xlib/client.scm

@@ -348,8 +348,8 @@
       (else (lambda (x) x))))))
 
 (define integer+vector->size-hint-alist
-  (make-vector->enum-alist
+  (make-integer+vector->enum-alist
-   size-hints
+   size-hints size-hint-index
    (lambda (v)
      (cond
       ((eq? v (size-hint win-gravity))
@@ -366,14 +366,13 @@
 (define (get-wm-normal-hints window)
   (let* ((v (%wm-normal-hints (display-Xdisplay (window-display window))
 			      (window-Xwindow window))))
-        (filter (lambda (x) (not (null? (cdr x))))
+    (integer+vector->size-hint-alist v)))
-		(integer+vector->size-hint-alist v))))
 
 (import-lambda-definition %wm-normal-hints (Xdisplay Xwindow)
   "scx_Wm_Normal_Hints")
 
 (define (set-wm-normal-hints! window size-hint-alist)
-  (%set-wm-normal-hints! (display-Xdisplay (window-Xwindow window))
+  (%set-wm-normal-hints! (display-Xdisplay (window-display window))
 			 (window-Xwindow window)
 			 (size-hint-alist->integer+vector size-hint-alist)))
 

scheme/xlib/display.scm

@@ -30,47 +30,59 @@
 (define (display-default-root-window display)
   (let* ((Xdisplay (display-Xdisplay display))
 	 (Xwindow (%default-root-window Xdisplay)))
-    (make-window Xwindow (make-display Xdisplay #f) #f)))
+    (make-window Xwindow display #f)))
-
-;; for compatibility with Elk.
-(define display-root-window display-default-root-window)
 
 (import-lambda-definition %default-root-window (Xdisplay) 
    "scx_Display_Default_Root_Window")
 
+;; display-root-window returns the root window of the specified screen.
+;; See RootWindow.
+
+(define (display-root-window display screen-number)
+  (let* ((Xdisplay (display-Xdisplay display))
+	 (Xwindow (%root-window Xdisplay screen-number)))
+    (make-window Xwindow display #f)))
+
+(import-lambda-definition %root-window (Xdisplay scr_num) 
+   "scx_Display_Root_Window")
+
 ;; display-default-colormap return the default colormap for allocation on the
 ;; default screen of the specified display. See DefaultColormap.
 
-(define (display-default-colormap display)
+(define (display-default-colormap display . maybe-screen-number)
   (let* ((Xdisplay (display-Xdisplay display))
-	 (Xcolormap (%default-colormap Xdisplay)))
+	 (scr (get-maybe-screen-number display maybe-screen-number))
+	 (Xcolormap (%default-colormap Xdisplay
+				       scr)))
     (make-colormap Xcolormap display #f)))
 
 ;; for compatibility with Elk.
 (define display-colormap display-default-colormap)
 
-(import-lambda-definition %default-colormap (Xdisplay) 
+(import-lambda-definition %default-colormap (Xdisplay scr) 
    "scx_Display_Default_Colormap")
 
 ;; display-default-gcontext return the default graphics context for the root
 ;; window of the default screen of the specified display. See DefaultGC.
 
-(define (display-default-gcontext display)
+(define (display-default-gcontext display . maybe-screen-number)
   (let* ((Xdisplay (display-Xdisplay display))
-	 (Xgcontext (%default-gcontext Xdisplay)))
+	 (scr (get-maybe-screen-number display maybe-screen-number))
+	 (Xgcontext (%default-gcontext Xdisplay scr)))
     (make-gcontext Xgcontext display #f)))
 
-(import-lambda-definition %default-gcontext (Xdisplay) 
+(import-lambda-definition %default-gcontext (Xdisplay scr) 
   "scx_Display_Default_Gcontext")
 
 ;; display-default-depth returns the depth (number of planes) of the default 
 ;; root window of the default screen of the specified display. See DefaultDepth.
 
-(define (display-default-depth display)
+(define (display-default-depth display . maybe-screen-number)
-  (let ((Xdisplay (display-Xdisplay display)))
+  (let ((Xdisplay (display-Xdisplay display))
-    (%default-depth Xdisplay)))
+	(scr (get-maybe-screen-number display maybe-screen-number)))
+    (%default-depth Xdisplay scr)))
 
-(import-lambda-definition %default-depth (Xdisplay)
+(import-lambda-definition %default-depth (Xdisplay scr)
   "scx_Display_Default_Depth")
 
 ;; display-default-screen-number returns the default screen number of the given 
@@ -90,16 +102,19 @@
 (define (display-default-visual display . screen-number)
   (make-visual 
    (%default-visual (display-Xdisplay display)
-		    (if (null? screen-number)
+		    (get-maybe-screen-number display screen-number))))
-			(display-default-screen-number display)
-			(begin
-			  (check-screen-number display (car screen-number))
-			  (car screen-number))))))
 
 (import-lambda-definition %default-visual (Xdisplay scr-num)
   "scx_Display_Default_Visual")
 
 ;; internal function
+(define (get-maybe-screen-number dpy maybe-screen-number)
+  (if (null? maybe-screen-number)
+      (display-default-screen-number dpy)
+      (begin
+	(check-screen-number dpy (car maybe-screen-number))
+	(car maybe-screen-number))))
+
 (define (check-screen-number display screen-number)
   (if (or (< screen-number 0)
 	  (>= screen-number (display-screen-count display)))
@@ -108,9 +123,9 @@
 ;; display-cells returns the number of entries in the default colormap of the 
 ;; specified screen. See DisplayCells.
 
-(define (display-cells display screen-number)
+(define (display-cells display . maybe-screen-number)
-  (check-screen-number display screen-number)
+  (%display-cells (display-Xdisplay display)
-  (%display-cells (display-Xdisplay display) screen-number))
+		  (get-maybe-screen-number display maybe-screen-number)))
 
 (import-lambda-definition %display-cells (Xdisplay screen-number)
   "scx_Display_Cells")
@@ -118,9 +133,9 @@
 ;; display-planes returns the depth of the root window of the specified screen.
 ;; See DisplayPlanes.
 
-(define (display-planes display screen-number)
+(define (display-planes display . maybe-screen-number)
-  (check-screen-number display screen-number)
+  (%display-planes (display-Xdisplay display)
-  (%display-planes (display-Xdisplay display) screen-number))
+		   (get-maybe-screen-number display maybe-screen-number)))
 
 (import-lambda-definition %display-planes (Xdisplay screen-number)
   "scx_Display_Planes")
@@ -200,31 +215,35 @@
 ;; display-width (-height) returns the width (height) of the screen in pixels. 
 ;; See DisplayWidth (DisplayHeight).
 
-(define (display-width display)
+(define (display-width display . maybe-screen-number)
-  (%display-width (display-Xdisplay display)))
+  (%display-width (display-Xdisplay display)
+		  (get-maybe-screen-number display maybe-screen-number)))
 
-(import-lambda-definition %display-width (Xdisplay)
+(import-lambda-definition %display-width (Xdisplay scr)
   "scx_Display_Width")
 
-(define (display-height display)
+(define (display-height display . maybe-screen-number)
-  (%display-height (display-Xdisplay display)))
+  (%display-height (display-Xdisplay display)
+		   (get-maybe-screen-number display maybe-screen-number)))
 
-(import-lambda-definition %display-height (Xdisplay)
+(import-lambda-definition %display-height (Xdisplay scr)
   "scx_Display_Height")
 
 ;; display-width-mm (-height-mm) returns the width (height) of the screen in 
 ;; millimeters. See DisplayWidthMM (DisplayHeightMM).
 
-(define (display-width-mm display)
+(define (display-width-mm display . maybe-screen-number)
-  (%display-width-mm (display-Xdisplay display)))
+  (%display-width-mm (display-Xdisplay display)
+		     (get-maybe-screen-number display maybe-screen-number)))
 
-(import-lambda-definition %display-width-mm (Xdisplay)
+(import-lambda-definition %display-width-mm (Xdisplay scr)
   "scx_Display_Width_Mm")
 
-(define (display-height-mm display)
+(define (display-height-mm display . maybe-screen-number)
-  (%display-height-mm (display-Xdisplay display)))
+  (%display-height-mm (display-Xdisplay display)
+		      (get-maybe-screen-number display maybe-screen-number)))
 
-(import-lambda-definition %display-height-mm (Xdisplay)
+(import-lambda-definition %display-height-mm (Xdisplay scr)
   "scx_Display_Height_Mm")
 
 ;; See XDisplayMotionBufferSize.

scheme/xlib/event.scm

@@ -16,12 +16,24 @@
 (define (event-ready? display)
   (char-ready? (display-message-inport display)))
 
+(define (send-event window propagate? event-mask event)
+  (let ((Xdisplay (display-Xdisplay (window-display window)))
+	(Xwindow (window-Xwindow window))
+	(mask (event-mask->integer event-mask))
+	(v (any-event->vector event))
+	(type (event-type->integer (any-event-type event))))
+    (%send-event Xdisplay Xwindow propagate? mask v type)))
+
+(import-lambda-definition %send-event (Xdisplay Xwindow propagate mask v type)
+  "scx_Send_Event")
+
 ;; creates an event type
 
-(define (complete-event type args)
+(define (complete-event v)
-  (let ((constructor (event-constructor type)))
+  (vector-set! v 0 (integer->event-type (vector-ref v 0)))
-    (apply constructor (cons type (vector->list args)))))
+  (let ((constructor (event-constructor (vector-ref v 0))))
-  
+    (apply constructor (vector->list v))))
+
 (define (event-constructor type)
   (cond
    ((or (eq? type (event-type key-press))
@@ -63,15 +75,14 @@
 
 (define (next-event display)
   (let ((r (%next-event (display-Xdisplay display))))
-    (complete-event (integer->event-type (car r)) (cdr r))))
+    (complete-event r)))
 
 (import-lambda-definition %next-event (Xdisplay)
   "scx_Next_Event")
 
 (define (peek-event display)
   (let ((r (%peek-event (display-Xdisplay display))))
-    (complete-event (integer->event-type (car r))
+    (complete-event r)))
-		    (cdr r))))
 
 (import-lambda-definition %peek-event (Xdisplay)
   "scx_Peek_Event")

scheme/xlib/types.scm

@@ -84,7 +84,7 @@
 
 (define-enumerated-type button :button
   button? buttons button-name button-index
-  (button1 button2 button3 button4 button5))
+  (any-button button1 button2 button3 button4 button5))
 
 (define (integer->button int)
   (vector-ref buttons int))
@@ -346,7 +346,7 @@
 
 (define-enumerated-type window-class :window-class
   window-class? window-classs window-class-name window-class-index
-  (input-output input-only))
+  (copy-from-parent input-output input-only))
 
 (define (integer->window-class int)
   (vector-ref window-classs int))

scheme/xlib/xlib-interfaces.scm

@@ -1,7 +1,7 @@
 (define-interface xlib-display-interface
   (export open-display
 	  display-default-root-window
-	  display-root-window ;; same as above
+	  display-root-window
 	  display-default-colormap
 	  display-colormap ;; same as above
 	  display-default-gcontext
@@ -42,6 +42,7 @@
 	  map-window
 	  unmap-window
 
+	  change-window-attributes
 	  set-window-background-pixmap!
 	  set-window-background-pixel!
 	  set-window-border-pixmap!
@@ -58,6 +59,7 @@
 	  set-window-colormap!
 	  set-window-cursor!
 
+	  configure-window
 	  set-window-x!
 	  set-window-y!
 	  set-window-width!
@@ -66,6 +68,7 @@
 	  set-window-sibling!
 	  set-window-stack-mode!
 
+	  get-window-attributes
 	  window-x
 	  window-y
 	  window-width
@@ -278,10 +281,16 @@
 	  next-event
 	  peek-event
 	  wait-event
+	  send-event
 	  
   ((event-type) :syntax)
   any-event-type
+  any-event-serial
+  any-event-send-event?
+  any-event-display
+  any-event-window
 
+  create-key-event
   key-event?
   key-event-type
   key-event-serial
@@ -298,6 +307,8 @@
   key-event-state
   key-event-keycode
   key-event-same-screen?
+  
+  create-button-event
   button-event?
   button-event-type
   button-event-serial
@@ -314,6 +325,8 @@
   button-event-state
   button-event-button
   button-event-same-screen?
+
+  create-motion-event
   motion-event?
   motion-event-type
   motion-event-serial
@@ -330,6 +343,8 @@
   motion-event-state
   motion-event-is-hint?
   motion-event-same-screen?
+  
+  create-crossing-event
   crossing-event?
   crossing-event-type
   crossing-event-serial
@@ -348,6 +363,8 @@
   crossing-event-same-screen?
   crossing-event-focus?
   crossing-event-state
+  
+  create-focus-change-event
   focus-change-event?
   focus-change-event-type
   focus-change-event-serial
@@ -356,6 +373,8 @@
   focus-change-event-window
   focus-change-event-mode
   focus-change-event-detail
+  
+  create-expose-event
   expose-event?
   expose-event-type
   expose-event-serial
@@ -367,6 +386,8 @@
   expose-event-width
   expose-event-height
   expose-event-count
+
+  create-graphics-expose-event
   graphics-expose-event?
   graphics-expose-event-type
   graphics-expose-event-serial
@@ -379,6 +400,8 @@
   graphics-expose-event-height
   graphics-expose-event-major-code
   graphics-expose-event-minor-code
+
+  create-no-expose-event
   no-expose-event?
   no-expose-event-type
   no-expose-event-serial
@@ -387,6 +410,8 @@
   no-expose-event-drawable
   no-expose-event-major-code
   no-expose-event-minor-code
+
+  create-visibility-event
   visibility-event?
   visibility-event-type
   visibility-event-serial
@@ -394,6 +419,8 @@
   visibility-event-display
   visibility-event-window
   visibility-event-state
+
+  create-create-window-event
   create-window-event?
   create-window-event-type
   create-window-event-serial
@@ -407,6 +434,8 @@
   create-window-event-height
   create-window-event-border-width
   create-window-event-override-redirect?
+
+  create-destroy-window-event
   destroy-window-event?
   destroy-window-event-type
   destroy-window-event-serial
@@ -414,6 +443,8 @@
   destroy-window-event-display
   destroy-window-event-event
   destroy-window-event-window
+
+  create-unmap-event
   unmap-event?
   unmap-event-type
   unmap-event-serial
@@ -422,6 +453,8 @@
   unmap-event-event
   unmap-event-window
   unmap-event-from-configure?
+  
+  create-map-event
   map-event?
   map-event-type
   map-event-serial
@@ -430,6 +463,8 @@
   map-event-event
   map-event-window
   map-event-override-redirect?
+  
+  create-map-request-event
   map-request-event?
   map-request-event-type
   map-request-event-serial
@@ -437,6 +472,8 @@
   map-request-event-display
   map-request-event-parent
   map-request-event-window
+
+  create-reparent-event
   reparent-event?
   reparent-event-type
   reparent-event-serial
@@ -448,6 +485,8 @@
   reparent-event-x
   reparent-event-y
   reparent-event-override-redirect?
+  
+  create-configure-event
   configure-event?
   configure-event-type
   configure-event-serial
@@ -462,6 +501,8 @@
   configure-event-border-width
   configure-event-above
   configure-event-override-redirect?
+
+  create-gravity-event
   gravity-event?
   gravity-event-type
   gravity-event-serial
@@ -471,6 +512,8 @@
   gravity-event-window
   gravity-event-x
   gravity-event-y
+  
+  create-resize-request-event
   resize-request-event?
   resize-request-event-type
   resize-request-event-serial
@@ -479,6 +522,8 @@
   resize-request-event-window
   resize-request-event-width
   resize-request-event-height
+  
+  create-configure-request-event
   configure-request-event?
   configure-request-event-type
   configure-request-event-serial
@@ -486,7 +531,9 @@
   configure-request-event-display
   configure-request-event-parent
   configure-request-event-window
-  configure-request-event-window-changes-alist
+  configure-request-event-window-change-alist
+
+  create-circulate-event
   circulate-event?
   circulate-event-type
   circulate-event-serial
@@ -495,6 +542,8 @@
   circulate-event-event
   circulate-event-window
   circulate-event-place
+
+  create-circulate-request-event
   circulate-request-event?
   circulate-request-event-type
   circulate-request-event-serial
@@ -503,6 +552,8 @@
   circulate-request-event-parent
   circulate-request-event-window
   circulate-request-event-place
+  
+  create-property-event
   property-event?
   property-event-type
   property-event-serial
@@ -512,6 +563,8 @@
   property-event-atom
   property-event-time
   property-event-state
+
+  create-selection-clear-event
   selection-clear-event?
   selection-clear-event-type
   selection-clear-event-serial
@@ -520,6 +573,8 @@
   selection-clear-event-window
   selection-clear-event-selection
   selection-clear-event-time
+
+  create-selection-request-event
   selection-request-event?
   selection-request-event-type
   selection-request-event-serial
@@ -527,10 +582,12 @@
   selection-request-event-display
   selection-request-event-owner
   selection-request-event-requestor
-  selection-request-event-atom
+  selection-request-event-selection
   selection-request-event-target
   selection-request-event-property
   selection-request-event-time
+
+  create-selection-event
   selection-event?
   selection-event-type
   selection-event-serial
@@ -541,6 +598,8 @@
   selection-event-target
   selection-event-property
   selection-event-time
+
+  create-colormap-event
   colormap-event?
   colormap-event-type
   colormap-event-serial
@@ -550,6 +609,8 @@
   colormap-event-colormap
   colormap-event-new?
   colormap-event-state
+
+  create-client-message-event
   client-message-event?
   client-message-event-type
   client-message-event-serial
@@ -559,6 +620,8 @@
   client-message-event-message-type
   client-message-event-format
   client-message-event-data
+  
+  create-mapping-event
   mapping-event?
   mapping-event-type
   mapping-event-serial
@@ -568,16 +631,8 @@
   mapping-event-request
   mapping-event-first-keycode
   mapping-event-count
-  error-event?
+
-  error-event-type
+  create-keymap-event
-  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
@@ -797,7 +852,7 @@
      mapping-request bit-gravity gravity) :syntax)
 
    ((set-window-attribute window-change stack-mode
-     window-attribute
+     window-attribute map-state
      make-set-window-attribute-alist
      make-window-attribute-alist 
      make-window-change-alist) :syntax)

scheme/xlib/xlib-internal-interfaces.scm

@@ -77,7 +77,7 @@
    ((window-attribute make-window-attribute-alist) :syntax)
    integer+vector->window-attribute-alist
    
-   ((window-class) :syntax)
+   ((window-class map-state) :syntax)
 
    ((byte-order bit-order) :syntax)
    integer->byte-order integer->bit-order