home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / swat / c / scxl.c < prev    next >
C/C++ Source or Header  |  1995-08-02  |  38KB  |  1,012 lines
  1. /* X11 support similar to that in Joel Bartlett's Scheme-To-C xlib (scxl) */
  2.  
  3. #include "scheme.h"
  4. #include "prims.h"
  5. #include "ux.h"
  6. #include "uxselect.h"
  7.  
  8. /* Changed 7/95 by Nick in an attempt to fix problem Hal was having with SWAT over PPP (i.e. slow connections) */
  9. /* commented out 'cause x11.h includes em all
  10. #include <X11/Xlib.h>
  11. #include <X11/cursorfont.h>
  12. #include <X11/keysym.h>
  13. #include <X11/Xutil.h>
  14. #include <X11/Xatom.h>
  15. #include "ansidecl.h" */
  16.  
  17. #include "x11.h"
  18.  
  19. extern void EXFUN (block_signals, (void));
  20. extern void EXFUN (unblock_signals, (void));
  21.  
  22. /* end nick's changes - but see below for more */
  23.  
  24.  
  25. /* Operations */
  26.  
  27. DEFINE_PRIMITIVE ("%XAllocNamedColor", Prim_scxl_allocated_named_color,
  28.           5, 5, 0)
  29. { /* (%XAllocNamedColor display colormap color-string
  30.                         return-alloc return-exact)
  31.   */
  32.   PRIMITIVE_HEADER(5);
  33.   CHECK_ARG(4, STRING_P);
  34.   CHECK_ARG(5, STRING_P);
  35.   if (STRING_LENGTH(ARG_REF(4)) < sizeof (XColor))
  36.     error_bad_range_arg(4);
  37.   if (STRING_LENGTH(ARG_REF(5)) < sizeof (XColor))
  38.     error_bad_range_arg(5);
  39.   PRIMITIVE_RETURN
  40.     (long_to_integer
  41.      ((long) XAllocNamedColor((Display *) arg_integer(1),
  42.                   (Colormap) arg_integer(2),
  43.                   STRING_ARG(3),
  44.                   (XColor *) STRING_ARG(4),
  45.                   (XColor *) STRING_ARG(5))));
  46. }
  47.  
  48. DEFINE_PRIMITIVE ("%XChangeWindowAttributes", Prim_scxl_change_wind_attr,
  49.           4, 4, 0)
  50. { /* (%XChangeWindowAttributes display window mask attributes) */
  51.   /* ATTRIBUTES is a string */
  52.   PRIMITIVE_HEADER(4);
  53.   CHECK_ARG(4, STRING_P);
  54.   if (STRING_LENGTH(ARG_REF(4)) < sizeof (XSetWindowAttributes))
  55.     error_bad_range_arg(4);
  56.   XChangeWindowAttributes((Display *) arg_integer(1),
  57.               (Window) arg_integer(2),
  58.               (unsigned long) arg_integer(3),
  59.               (XSetWindowAttributes *) STRING_ARG(4));
  60.   PRIMITIVE_RETURN(UNSPECIFIC);
  61. }
  62.  
  63. DEFINE_PRIMITIVE ("%XCheckMaskEvent", Prim_scxl_check_mask_event, 3, 3, 0)
  64. { /* (%XCheckMaskEvent display event-mask return-event) */
  65.   PRIMITIVE_HEADER (3);
  66.   CHECK_ARG(3, STRING_P);
  67.   if (STRING_LENGTH(ARG_REF(3)) < sizeof(XEvent))
  68.     error_bad_range_arg(3);
  69.   PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT
  70.             (XCheckMaskEvent ((Display *) arg_integer(1),
  71.                       (long) arg_integer(2),
  72.                       (XEvent *) STRING_ARG(3))));
  73. }
  74.  
  75. DEFINE_PRIMITIVE ("%XClearArea", Prim_scxl_clear_area, 7, 7, 0)
  76. { /* (%XClearArea display window x y width height) */
  77.   PRIMITIVE_HEADER (7);
  78.   XClearArea ((Display *) arg_integer(1),
  79.           (Drawable) arg_integer(2),
  80.           (int) arg_integer(3),
  81.           (int) arg_integer(4),
  82.           (unsigned int) arg_integer(5),
  83.           (unsigned int) arg_integer(6),
  84.           (Bool) BOOLEAN_ARG(7));
  85.   PRIMITIVE_RETURN (UNSPECIFIC);
  86. }
  87.  
  88. DEFINE_PRIMITIVE ("%XClearWindow", Prim_scxl_clear_window, 2, 2, 0)
  89. { /* (%XClearWindow display window) */
  90.   PRIMITIVE_HEADER (2);
  91.   XClearWindow ((Display *) arg_integer(1),
  92.         (Drawable) arg_integer(2));
  93.   PRIMITIVE_RETURN (UNSPECIFIC);
  94. }
  95.  
  96. DEFINE_PRIMITIVE ("%XCloseDisplay", Prim_scxl_close, 1, 1, 0)
  97. { /* (%XCloseDisplay display) */
  98.   PRIMITIVE_HEADER (1);
  99.   XCloseDisplay((Display *) arg_integer(1));
  100.   PRIMITIVE_RETURN (UNSPECIFIC);
  101. }
  102.  
  103. DEFINE_PRIMITIVE ("%XConnectionNumber", Prim_scxl_connection_number, 1, 1, 0)
  104. { /* (%XConnectionNumber display) */
  105.   PRIMITIVE_HEADER (1);
  106.   PRIMITIVE_RETURN (long_to_integer
  107.             (XConnectionNumber((Display *) arg_integer(1))));
  108. }
  109.  
  110. DEFINE_PRIMITIVE ("%XCreateGC", Prim_scxl_create_gc, 4, 4, 0)
  111. { /* (%XCreateGC display window mask values) */
  112.   PRIMITIVE_HEADER(4);
  113.   CHECK_ARG(4, STRING_P);
  114.   if (STRING_LENGTH(ARG_REF(4)) < sizeof(XGCValues))
  115.     error_bad_range_arg(4);
  116.   PRIMITIVE_RETURN
  117.     (long_to_integer
  118.      ((long) XCreateGC((Display *) arg_integer(1),
  119.                (Drawable) arg_integer(2),
  120.                (unsigned long) arg_integer(3),
  121.                (XGCValues *) STRING_ARG(4))));
  122. }
  123.  
  124. DEFINE_PRIMITIVE ("%XCreateRegion", Prim_scxl_create_region, 0, 0, 0)
  125. { /* (%XCreateRegion) */
  126.   Region Result;
  127.   PRIMITIVE_HEADER(0);
  128.   Result = XCreateRegion();
  129.   PRIMITIVE_RETURN (long_to_integer ((long) Result));
  130. }
  131.  
  132. DEFINE_PRIMITIVE ("%XCreateSimpleWindow", Prim_scxl_create_simple_window,
  133.           9, 9, 0)
  134. { /* (%XCreateSimpleWindow display parent-window x y width height
  135.                            border-width border-color background-color)
  136.   */
  137.   PRIMITIVE_HEADER(9);
  138.   PRIMITIVE_RETURN
  139.     (long_to_integer
  140.      ((long) XCreateSimpleWindow
  141.       ((Display *) arg_integer(1),
  142.        (Window) arg_integer(2),
  143.        (int) arg_integer(3),
  144.        (int) arg_integer(4),
  145.        (unsigned int) arg_integer(5),
  146.        (unsigned int) arg_integer(6),
  147.        (unsigned int) arg_integer(7),
  148.        (unsigned long) arg_integer(8),
  149.        (unsigned long) arg_integer(9))));
  150. }
  151.  
  152. DEFINE_PRIMITIVE ("%XDecodeButtonEvent", prim_scxl_decode_button, 2, 2, 0)
  153. { /* (%XDecodeButtonEvent event vector) */
  154.   SCHEME_OBJECT Result = ARG_REF(2);
  155.   SCHEME_OBJECT *Next;
  156.   XButtonEvent *Input;
  157.  
  158.   PRIMITIVE_HEADER (2);
  159.   CHECK_ARG(1, STRING_P);
  160.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XButtonEvent))
  161.     error_bad_range_arg(1);
  162.   CHECK_ARG(2, VECTOR_P);
  163.   if (VECTOR_LENGTH(Result) < 15)
  164.    error_bad_range_arg(2);
  165.   Input = (XButtonEvent *) STRING_ARG(1);
  166.   Next = VECTOR_LOC(Result, 0);
  167.   *Next++ = long_to_integer ((long) (Input->type));   /* 0 */
  168.   *Next++ = long_to_integer ((long) (Input->serial)); /* 1 */
  169.   *Next++ = BOOLEAN_TO_OBJECT(Input->send_event);     /* 2 */
  170.   *Next++ = long_to_integer ((long) (Input->display)); /* 3 */
  171.   *Next++ = long_to_integer ((long) (Input->window)); /* 4 */
  172.   *Next++ = long_to_integer ((long) (Input->root));   /* 5 */
  173.   *Next++ = long_to_integer ((long) (Input->subwindow)); /* 6 */
  174.   *Next++ = long_to_integer ((long) (Input->time));   /* 7 */
  175.   *Next++ = long_to_integer ((long) (Input->x));      /* 8 */
  176.   *Next++ = long_to_integer ((long) (Input->y));      /* 9 */
  177.   *Next++ = long_to_integer ((long) (Input->x_root)); /* 10 */
  178.   *Next++ = long_to_integer ((long) (Input->y_root)); /* 11 */
  179.   *Next++ = long_to_integer ((long) (Input->state));  /* 12 */
  180.   *Next++ = long_to_integer ((long) (Input->button));  /* 13 */
  181.   *Next = BOOLEAN_TO_OBJECT(Input->same_screen);      /* 14 */
  182.   PRIMITIVE_RETURN (UNSPECIFIC);
  183. }
  184.   
  185. DEFINE_PRIMITIVE ("%XDecodeConfigureEvent",
  186.           prim_scxl_decode_config, 2, 2, 0)
  187. { /* (%XDecodeConfigureEvent event vector) */
  188.   SCHEME_OBJECT Result = ARG_REF(2);
  189.   SCHEME_OBJECT *Next;
  190.   XConfigureEvent *Input;
  191.  
  192.   PRIMITIVE_HEADER (2);
  193.   CHECK_ARG(1, STRING_P);
  194.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XConfigureEvent))
  195.     error_bad_range_arg(1);
  196.   CHECK_ARG(2, VECTOR_P);
  197.   if (VECTOR_LENGTH(Result) < 13)
  198.    error_bad_range_arg(2);
  199.   Input = (XConfigureEvent *) STRING_ARG(1);
  200.   Next = VECTOR_LOC(Result, 0);
  201.   *Next++ = long_to_integer ((long) (Input->type));   /* 0 */
  202.   *Next++ = long_to_integer ((long) (Input->serial)); /* 1 */
  203.   *Next++ = BOOLEAN_TO_OBJECT(Input->send_event);     /* 2 */
  204.   *Next++ = long_to_integer ((long) (Input->display)); /* 3 */
  205.   *Next++ = long_to_integer ((long) (Input->event));  /* 4 */
  206.   *Next++ = long_to_integer ((long) (Input->window)); /* 5 */
  207.   *Next++ = long_to_integer ((long) (Input->x));      /* 6 */
  208.   *Next++ = long_to_integer ((long) (Input->y));      /* 7 */
  209.   *Next++ = long_to_integer ((long) (Input->width));  /* 8 */
  210.   *Next++ = long_to_integer ((long) (Input->height)); /* 9 */
  211.   *Next++ = long_to_integer ((long) (Input->border_width)); /* 10 */
  212.   *Next++ = long_to_integer ((long) (Input->above));  /* 11 */
  213.   *Next = BOOLEAN_TO_OBJECT(Input->override_redirect); /* 12 */
  214.   PRIMITIVE_RETURN (UNSPECIFIC);
  215. }
  216.   
  217. DEFINE_PRIMITIVE ("%XDecodeCrossingEvent", prim_scxl_decode_crossing, 2, 2, 0)
  218. { /* (%XDecodeCrossingEvent event vector) */
  219.   SCHEME_OBJECT Result = ARG_REF(2);
  220.   SCHEME_OBJECT *Next;
  221.   XCrossingEvent *Input;
  222.  
  223.   PRIMITIVE_HEADER (2);
  224.   CHECK_ARG(1, STRING_P);
  225.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XCrossingEvent))
  226.     error_bad_range_arg(1);
  227.   CHECK_ARG(2, VECTOR_P);
  228.   if (VECTOR_LENGTH(Result) < 17)
  229.    error_bad_range_arg(2);
  230.   Input = (XCrossingEvent *) STRING_ARG(1);
  231.   Next = VECTOR_LOC(Result, 0);
  232.   *Next++ = long_to_integer ((long) (Input->type));   /* 0 */
  233.   *Next++ = long_to_integer ((long) (Input->serial)); /* 1 */
  234.   *Next++ = BOOLEAN_TO_OBJECT(Input->send_event);     /* 2 */
  235.   *Next++ = long_to_integer ((long) (Input->display)); /* 3 */
  236.   *Next++ = long_to_integer ((long) (Input->window)); /* 4 */
  237.   *Next++ = long_to_integer ((long) (Input->root));   /* 5 */
  238.   *Next++ = long_to_integer ((long) (Input->subwindow)); /* 6 */
  239.   *Next++ = long_to_integer ((long) (Input->time));   /* 7 */
  240.   *Next++ = long_to_integer ((long) (Input->x));      /* 8 */
  241.   *Next++ = long_to_integer ((long) (Input->y));      /* 9 */
  242.   *Next++ = long_to_integer ((long) (Input->x_root)); /* 10 */
  243.   *Next++ = long_to_integer ((long) (Input->y_root)); /* 11 */
  244.   *Next++ = long_to_integer ((long) (Input->mode));   /* 12 */
  245.   *Next++ = long_to_integer ((long) (Input->detail)); /* 13 */
  246.   *Next++ = BOOLEAN_TO_OBJECT(Input->same_screen);    /* 14 */
  247.   *Next++ = BOOLEAN_TO_OBJECT(Input->focus);          /* 15 */
  248.   *Next = long_to_integer ((long) (Input->state));    /* 16 */
  249.   PRIMITIVE_RETURN (UNSPECIFIC);
  250. }
  251.   
  252. DEFINE_PRIMITIVE ("%XDecodeExposeEvent", prim_scxl_decode_expose, 2, 2, 0)
  253. { /* (%XDecodeExposeEvent event vector) */
  254.   SCHEME_OBJECT Result = ARG_REF(2);
  255.   SCHEME_OBJECT *Next;
  256.   XExposeEvent *Input;
  257.  
  258.   PRIMITIVE_HEADER (2);
  259.   CHECK_ARG(1, STRING_P);
  260.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XExposeEvent))
  261.     error_bad_range_arg(1);
  262.   CHECK_ARG(2, VECTOR_P);
  263.   if (VECTOR_LENGTH(Result) < 10)
  264.    error_bad_range_arg(2);
  265.   Input = (XExposeEvent *) STRING_ARG(1);
  266.   Next = VECTOR_LOC(Result, 0);
  267.   *Next++ = long_to_integer ((long) (Input->type));   /* 0 */
  268.   *Next++ = long_to_integer ((long) (Input->serial)); /* 1 */
  269.   *Next++ = BOOLEAN_TO_OBJECT(Input->send_event);     /* 2 */
  270.   *Next++ = long_to_integer ((long) (Input->display)); /* 3 */
  271.   *Next++ = long_to_integer ((long) (Input->window)); /* 4 */
  272.   *Next++ = long_to_integer ((long) (Input->x));      /* 5 */
  273.   *Next++ = long_to_integer ((long) (Input->y));      /* 6 */
  274.   *Next++ = long_to_integer ((long) (Input->width));  /* 7 */
  275.   *Next++ = long_to_integer ((long) (Input->height)); /* 8 */
  276.   *Next = long_to_integer ((long) (Input->count));    /* 9 */
  277.   PRIMITIVE_RETURN (UNSPECIFIC);
  278. }
  279.  
  280. DEFINE_PRIMITIVE ("%XDecodeKeyEvent", prim_scxl_decode_key, 2, 2, 0)
  281. { /* (%XDecodeKeyEvent event vector) */
  282.   SCHEME_OBJECT Result = ARG_REF(2);
  283.   SCHEME_OBJECT *Next;
  284.   XKeyEvent *Input;
  285.  
  286.   PRIMITIVE_HEADER (2);
  287.   CHECK_ARG(1, STRING_P);
  288.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XKeyEvent))
  289.     error_bad_range_arg(1);
  290.   CHECK_ARG(2, VECTOR_P);
  291.   if (VECTOR_LENGTH(Result) < 15)
  292.    error_bad_range_arg(2);
  293.   Input = (XKeyEvent *) STRING_ARG(1);
  294.   Next = VECTOR_LOC(Result, 0);
  295.   *Next++ = long_to_integer ((long) (Input->type));   /* 0 */
  296.   *Next++ = long_to_integer ((long) (Input->serial)); /* 1 */
  297.   *Next++ = BOOLEAN_TO_OBJECT(Input->send_event);     /* 2 */
  298.   *Next++ = long_to_integer ((long) (Input->display)); /* 3 */
  299.   *Next++ = long_to_integer ((long) (Input->window)); /* 4 */
  300.   *Next++ = long_to_integer ((long) (Input->root));   /* 5 */
  301.   *Next++ = long_to_integer ((long) (Input->subwindow)); /* 6 */
  302.   *Next++ = long_to_integer ((long) (Input->time));   /* 7 */
  303.   *Next++ = long_to_integer ((long) (Input->x));      /* 8 */
  304.   *Next++ = long_to_integer ((long) (Input->y));      /* 9 */
  305.   *Next++ = long_to_integer ((long) (Input->x_root)); /* 10 */
  306.   *Next++ = long_to_integer ((long) (Input->y_root)); /* 11 */
  307.   *Next++ = long_to_integer ((long) (Input->state));  /* 12 */
  308.   *Next++ = long_to_integer ((long) (Input->keycode)); /* 13 */
  309.   *Next = BOOLEAN_TO_OBJECT(Input->same_screen);      /* 14 */
  310.   PRIMITIVE_RETURN (UNSPECIFIC);
  311. }
  312.  
  313. DEFINE_PRIMITIVE ("%XDecodeMotionEvent", prim_scxl_decode_motion, 2, 2, 0)
  314. { /* (%XDecodeMotionEvent event vector) */
  315.   SCHEME_OBJECT Result = ARG_REF(2);
  316.   SCHEME_OBJECT *Next;
  317.   XMotionEvent *Input;
  318.  
  319.   PRIMITIVE_HEADER (2);
  320.   CHECK_ARG(1, STRING_P);
  321.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XMotionEvent))
  322.     error_bad_range_arg(1);
  323.   CHECK_ARG(2, VECTOR_P);
  324.   if (VECTOR_LENGTH(Result) < 15)
  325.    error_bad_range_arg(2);
  326.   Input = (XMotionEvent *) STRING_ARG(1);
  327.   Next = VECTOR_LOC(Result, 0);
  328.   *Next++ = long_to_integer ((long) (Input->type));   /* 0 */
  329.   *Next++ = long_to_integer ((long) (Input->serial)); /* 1 */
  330.   *Next++ = BOOLEAN_TO_OBJECT(Input->send_event);     /* 2 */
  331.   *Next++ = long_to_integer ((long) (Input->display)); /* 3 */
  332.   *Next++ = long_to_integer ((long) (Input->window)); /* 4 */
  333.   *Next++ = long_to_integer ((long) (Input->root));   /* 5 */
  334.   *Next++ = long_to_integer ((long) (Input->subwindow)); /* 6 */
  335.   *Next++ = long_to_integer ((long) (Input->time));   /* 7 */
  336.   *Next++ = long_to_integer ((long) (Input->x));      /* 8 */
  337.   *Next++ = long_to_integer ((long) (Input->y));      /* 9 */
  338.   *Next++ = long_to_integer ((long) (Input->x_root)); /* 10 */
  339.   *Next++ = long_to_integer ((long) (Input->y_root)); /* 11 */
  340.   *Next++ = long_to_integer ((long) (Input->state));  /* 12 */
  341.   *Next++ = long_to_integer ((long) (Input->is_hint)); /* 13 */
  342.   *Next = BOOLEAN_TO_OBJECT(Input->same_screen);      /* 14 */
  343.   PRIMITIVE_RETURN (UNSPECIFIC);
  344. }
  345.   
  346. DEFINE_PRIMITIVE ("%XDecodeUnknownEvent", Prim_scxl_decode_unknown, 2, 2, 0)
  347. { /* (%XDecodeUnknownEvent event vector) */
  348.   SCHEME_OBJECT Result = ARG_REF(2);
  349.   SCHEME_OBJECT *Next;
  350.   XAnyEvent *Input;
  351.  
  352.   PRIMITIVE_HEADER (2);
  353.   CHECK_ARG(1, STRING_P);
  354.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XAnyEvent))
  355.     error_bad_range_arg(1);
  356.   CHECK_ARG(2, VECTOR_P);
  357.   if (VECTOR_LENGTH(Result) < 5)
  358.    error_bad_range_arg(2);
  359.   Input = (XAnyEvent *) STRING_ARG(1);
  360.   Next = VECTOR_LOC(Result, 0);
  361.   *Next++ = long_to_integer ((long) (Input->type));   /* 0 */
  362.   *Next++ = long_to_integer ((long) (Input->serial)); /* 1 */
  363.   *Next++ = BOOLEAN_TO_OBJECT(Input->send_event);     /* 2 */
  364.   *Next++ = long_to_integer ((long) (Input->display)); /* 3 */
  365.   *Next = long_to_integer ((long) (Input->window));   /* 4 */
  366.   PRIMITIVE_RETURN (UNSPECIFIC);
  367. }
  368.  
  369. DEFINE_PRIMITIVE ("%XDecodeWindowAttributes", Prim_scxl_decode_wind_attr, 2, 2, 0)
  370. { /* (%XDecodeWindowAttributes attributes vector) */
  371.   SCHEME_OBJECT Result = ARG_REF(2);
  372.   SCHEME_OBJECT *Next;
  373.   XWindowAttributes *Input;
  374.  
  375.   PRIMITIVE_HEADER (2);
  376.   CHECK_ARG(1, STRING_P);
  377.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(XWindowAttributes))
  378.     error_bad_range_arg(1);
  379.   CHECK_ARG(2, VECTOR_P);
  380.   if (VECTOR_LENGTH(Result) < 23)
  381.    error_bad_range_arg(2);
  382.   Input = (XWindowAttributes *) STRING_ARG(1);
  383.   Next = VECTOR_LOC(Result, 0);
  384.   *Next++ = long_to_integer ((long) (Input->x));      /* 0 */
  385.   *Next++ = long_to_integer ((long) (Input->y));      /* 1 */
  386.   *Next++ = long_to_integer ((long) (Input->width));  /* 2 */
  387.   *Next++ = long_to_integer ((long) (Input->height)); /* 3 */
  388.   *Next++ = long_to_integer ((long) (Input->border_width)); /* 4 */
  389.   *Next++ = long_to_integer ((long) (Input->depth));  /* 5 */
  390.   *Next++ = long_to_integer ((long) (Input->visual)); /* 6 */
  391.   *Next++ = long_to_integer ((long) (Input->root));   /* 7 */
  392.   *Next++ = long_to_integer ((long) (Input->class));  /* 8 */
  393.   *Next++ = long_to_integer ((long) (Input->bit_gravity)); /* 9 */
  394.   *Next++ = long_to_integer ((long) (Input->win_gravity)); /* 10 */
  395.   *Next++ = long_to_integer ((long) (Input->backing_store)); /* 11 */
  396.   *Next++ = long_to_integer ((long) (Input->backing_planes)); /* 12 */
  397.   *Next++ = long_to_integer ((long) (Input->backing_pixel)); /* 13 */
  398.   *Next++ = BOOLEAN_TO_OBJECT(Input->save_under);     /* 14 */
  399.   *Next++ = long_to_integer ((long) (Input->colormap));    /* 15 */
  400.   *Next++ = BOOLEAN_TO_OBJECT(Input->map_installed);  /* 16 */
  401.   *Next++ = long_to_integer ((long) (Input->map_state)); /* 17 */
  402.   *Next++ = long_to_integer ((long) (Input->all_event_masks)); /* 18 */
  403.   *Next++ = long_to_integer ((long) (Input->your_event_mask)); /* 19 */
  404.   *Next++ = long_to_integer ((long) (Input->do_not_propagate_mask)); /* 20 */
  405.   *Next++ = BOOLEAN_TO_OBJECT(Input->override_redirect); /* 21 */
  406.   *Next = long_to_integer ((long) (Input->screen));   /* 22 */
  407.   PRIMITIVE_RETURN (UNSPECIFIC);
  408. }
  409.  
  410. DEFINE_PRIMITIVE ("%XDecodeXColor", Prim_scxl_decode_xcolor, 2, 2, 0)
  411. { /* (%XDecodeXColor xcolor vector) */
  412.   SCHEME_OBJECT Result = ARG_REF(2);
  413.   SCHEME_OBJECT *Next;
  414.   XColor *Input;
  415.  
  416.   PRIMITIVE_HEADER (2);
  417.   CHECK_ARG(1, STRING_P);
  418.   if (STRING_LENGTH(ARG_REF(1)) != sizeof(XColor))
  419.     error_bad_range_arg(1);
  420.   CHECK_ARG(2, VECTOR_P);
  421.   if (VECTOR_LENGTH(Result) < 5)
  422.    error_bad_range_arg(2);
  423.   Input = (XColor *) STRING_ARG(1);
  424.   Next = VECTOR_LOC(Result, 0);
  425.   *Next++ = long_to_integer ((long) (Input->pixel));  /* 0 */
  426.   *Next++ = long_to_integer ((long) (Input->red));    /* 1 */
  427.   *Next++ = long_to_integer ((long) (Input->green));  /* 2 */
  428.   *Next++ = long_to_integer ((long) (Input->blue));   /* 3 */
  429.   *Next = long_to_integer ((long) (Input->flags));    /* 4 */
  430.   PRIMITIVE_RETURN (UNSPECIFIC);
  431. }
  432.  
  433. DEFINE_PRIMITIVE ("%XDefaultColormap", Prim_scxl_default_colormap, 2, 2, 0)
  434. { /* (%XDefaultColormap display screen) */
  435.   PRIMITIVE_HEADER(2);
  436.   PRIMITIVE_RETURN
  437.     (long_to_integer
  438.      ((long) XDefaultColormap((Display *) arg_integer(1),
  439.                   arg_integer(2))));
  440. }
  441.  
  442. DEFINE_PRIMITIVE ("%XDefaultRootWindow", Prim_scxl_default_root_window,
  443.           1, 1, 0)
  444. { /* (%XDefaultRootWindow display) */
  445.   PRIMITIVE_HEADER(1);
  446.   PRIMITIVE_RETURN
  447.     (long_to_integer
  448.      ((long) XDefaultRootWindow ((Display *) arg_integer(1))));
  449. }
  450.  
  451. DEFINE_PRIMITIVE ("%XDefaultScreen", Prim_scxl_default_screen, 1, 1, 0)
  452. { /* (%XDefaultScreen display) */
  453.   PRIMITIVE_HEADER(1);
  454.   PRIMITIVE_RETURN
  455.     (long_to_integer
  456.      ((long) XDefaultScreen((Display *) arg_integer(1))));
  457. }
  458.  
  459. DEFINE_PRIMITIVE ("%XDestroyRegion", Prim_scxl_destroy_region, 1, 1, 0)
  460. { /* (%XDestroyRegion region) */
  461.   PRIMITIVE_HEADER (1);
  462.   XDestroyRegion ((Region) arg_integer(1));
  463.   PRIMITIVE_RETURN(UNSPECIFIC);
  464. }
  465.  
  466. DEFINE_PRIMITIVE ("%XDestroyWindow", Prim_scxl_destroy_window, 2, 2, 0)
  467. { /* (%XDestroyWindow display window) */
  468.   PRIMITIVE_HEADER (2);
  469.   XDestroyWindow((Display *) arg_integer(1),
  470.          (Window) arg_integer(2));
  471.   PRIMITIVE_RETURN(UNSPECIFIC);
  472. }
  473.  
  474. DEFINE_PRIMITIVE ("%XDrawArc", Prim_scxl_draw_arc, 9, 9, 0)
  475. { /* (%XDrawArc display window context
  476.                       x y width height angle1 angle2) */
  477.   PRIMITIVE_HEADER (9);
  478.   XDrawArc((Display *) arg_integer(1),
  479.        (Drawable) arg_integer(2),
  480.        (GC) arg_integer(3),
  481.        (int) arg_integer(4),
  482.        (int) arg_integer(5),
  483.        (unsigned int) arg_integer(6),
  484.        (unsigned int) arg_integer(7),
  485.        (unsigned int) arg_integer(8),
  486.        (unsigned int) arg_integer(9));
  487.   PRIMITIVE_RETURN (UNSPECIFIC);
  488. }
  489.  
  490. DEFINE_PRIMITIVE ("%XDrawLine", Prim_scxl_draw_line, 7, 7, 0)
  491. { /* (%XDrawLine display window context x1 y1 x2 y2) */
  492.   PRIMITIVE_HEADER (7);
  493.   XDrawLine((Display *) arg_integer(1),
  494.         (Drawable) arg_integer(2),
  495.         (GC) arg_integer(3),
  496.         (int) arg_integer(4),
  497.         (int) arg_integer(5),
  498.         (int) arg_integer(6),
  499.         (int) arg_integer(7));
  500.   PRIMITIVE_RETURN (UNSPECIFIC);
  501. }
  502.  
  503. DEFINE_PRIMITIVE ("%XDrawRectangle", Prim_scxl_draw_rectangle, 7, 7, 0)
  504. { /* (%XDrawRectangle display window context x y width height) */
  505.   PRIMITIVE_HEADER (7);
  506.   XDrawRectangle((Display *) arg_integer(1),
  507.          (Drawable) arg_integer(2),
  508.          (GC) arg_integer(3),
  509.          (int) arg_integer(4),
  510.          (int) arg_integer(5),
  511.          (unsigned int) arg_integer(6),
  512.          (unsigned int) arg_integer(7));
  513.   PRIMITIVE_RETURN (UNSPECIFIC);
  514. }
  515.  
  516. DEFINE_PRIMITIVE ("%XFillArc", Prim_scxl_fill_arc, 9, 9, 0)
  517. { /* (%XFillArc display window context
  518.                       x y width height angle1 angle2) */
  519.   PRIMITIVE_HEADER (9);
  520.   XFillArc((Display *) arg_integer(1),
  521.        (Drawable) arg_integer(2),
  522.        (GC) arg_integer(3),
  523.        (int) arg_integer(4),
  524.        (int) arg_integer(5),
  525.        (unsigned int) arg_integer(6),
  526.        (unsigned int) arg_integer(7),
  527.        (unsigned int) arg_integer(8),
  528.        (unsigned int) arg_integer(9));
  529.   PRIMITIVE_RETURN (UNSPECIFIC);
  530. }
  531.  
  532. DEFINE_PRIMITIVE ("%XFillRectangle", Prim_scxl_fill_rectangle, 7, 7, 0)
  533. { /* (%XFillRectangle display window context x y width height) */
  534.   PRIMITIVE_HEADER (7);
  535.   XFillRectangle((Display *) arg_integer(1),
  536.          (Drawable) arg_integer(2),
  537.          (GC) arg_integer(3),
  538.          (int) arg_integer(4),
  539.          (int) arg_integer(5),
  540.          (unsigned int) arg_integer(6),
  541.          (unsigned int) arg_integer(7));
  542.   PRIMITIVE_RETURN (UNSPECIFIC);
  543. }
  544.  
  545. DEFINE_PRIMITIVE ("%XFlush", Prim_scxl_flush, 1, 1, 0)
  546. { /* (%XFlush display) */
  547.   PRIMITIVE_HEADER (1);
  548.   XFlush((Display *) arg_integer(1));
  549.   PRIMITIVE_RETURN (UNSPECIFIC);
  550. }
  551.  
  552. DEFINE_PRIMITIVE ("%XFreeColormap", Prim_scxl_free_colormap, 2, 2, 0)
  553. { /* (%XFreeColormap display colormap) */
  554.   PRIMITIVE_HEADER(2);
  555.   XFreeColormap((Display *) arg_integer(1), (Colormap) arg_integer(2));
  556.   PRIMITIVE_RETURN(UNSPECIFIC);
  557. }
  558.  
  559. DEFINE_PRIMITIVE ("%XFreeGC", Prim_scxl_free_gc, 2, 2, 0)
  560. { /* (%XFreeGC display graphic-context) */
  561.   PRIMITIVE_HEADER(2);
  562.   XFreeGC((Display *) arg_integer(1), (GC) arg_integer(2));
  563.   PRIMITIVE_RETURN(UNSPECIFIC);
  564. }
  565.  
  566. DEFINE_PRIMITIVE ("%XGetDefault", Prim_scxl_get_default, 3, 3, 0)
  567. { /* (%XGetDefault display program option) */
  568.   PRIMITIVE_HEADER(3);
  569.   PRIMITIVE_RETURN
  570.     (char_pointer_to_string
  571.      ((unsigned char *) XGetDefault((Display *) arg_integer(1),
  572.                     STRING_ARG(2),
  573.                     STRING_ARG(3))));
  574. }
  575.  
  576. DEFINE_PRIMITIVE ("%XGetWindowAttributes", Prim_scxl_get_wind_attr, 3, 3, 0)
  577. { /* (%XGetWindowAttributes display window attributes-to-fill) */
  578.   PRIMITIVE_HEADER(3);
  579.   CHECK_ARG(3, STRING_P);
  580.   if (STRING_LENGTH(ARG_REF(3)) < sizeof(XWindowAttributes))
  581.     error_bad_range_arg(3);
  582.   PRIMITIVE_RETURN
  583.     (long_to_integer
  584.      ((long)
  585.       XGetWindowAttributes((Display *) arg_integer(1),
  586.                (Window) arg_integer(2),
  587.                (XWindowAttributes *) STRING_ARG(3))));
  588. }
  589.  
  590. DEFINE_PRIMITIVE ("%XIntersectRegion", Prim_scxl_intersect_reg, 3, 3, 0)
  591. { /* (%XIntersectRegion source1 source2 dest) */
  592.   PRIMITIVE_HEADER (3);
  593.   XIntersectRegion((Region) arg_integer(1),
  594.            (Region) arg_integer(2),
  595.            (Region) arg_integer(3));
  596.   PRIMITIVE_RETURN(UNSPECIFIC);
  597. }
  598.  
  599. DEFINE_PRIMITIVE ("%XLoadFont", Prim_scxl_load_font, 2, 2, 0)
  600. { /* (%XLoadFont display name-string) */
  601.   PRIMITIVE_HEADER (2);
  602.   PRIMITIVE_RETURN
  603.     (long_to_integer ((long) XLoadFont((Display *) arg_integer(1),
  604.                        STRING_ARG(2))));
  605. }
  606.  
  607. DEFINE_PRIMITIVE ("%XMapWindow", Prim_scxl_map_window, 2, 2, 0)
  608. { /* (%XMapWindow display window) */
  609.   PRIMITIVE_HEADER(2);
  610.   XMapWindow((Display *) arg_integer(1),
  611.          (Window) arg_integer(2));
  612.   PRIMITIVE_RETURN (UNSPECIFIC);
  613. }
  614.  
  615. DEFINE_PRIMITIVE ("%XNextEvent", Prim_scxl_next_event, 2, 2, 0)
  616. { /* (%XNextEvent display returned-event) */
  617.   PRIMITIVE_HEADER (2);
  618.   CHECK_ARG(2, STRING_P);
  619.   if (STRING_LENGTH(ARG_REF(2)) < sizeof(XEvent))
  620.     error_bad_range_arg(2);
  621.   XNextEvent((Display *) arg_integer(1),
  622.          (XEvent *) STRING_ARG(2));
  623.   PRIMITIVE_RETURN (UNSPECIFIC);
  624. }
  625.      
  626. DEFINE_PRIMITIVE ("%XOpenDisplay", Prim_scxl_open_display, 1, 1, 0)
  627. { /* (%XOpenDisplay string) */
  628.   PRIMITIVE_HEADER (1);
  629.   {
  630.     /* Changed 7/95 by Nick in an attempt to fix problem Hal was having with SWAT over PPP (i.e. slow connections) */
  631.     Display * display;
  632.     block_signals ();
  633.     display = XOpenDisplay(STRING_ARG(1));
  634.     unblock_signals ();
  635.     PRIMITIVE_RETURN (long_to_integer((long) display));
  636.   }
  637. }
  638.  
  639. DEFINE_PRIMITIVE ("%XPending", Prim_scxl_pending, 1, 1, 0)
  640. { /* (%XPending display) */
  641.   PRIMITIVE_HEADER (1);
  642.   PRIMITIVE_RETURN
  643.     (long_to_integer(XPending ((Display *) arg_integer(1))));
  644. }
  645.  
  646. DEFINE_PRIMITIVE ("%XPutBackEvent", Prim_scxl_put_back_event, 2, 2, 0)
  647. { /* (%XPutBackEvent display event) */
  648.   PRIMITIVE_HEADER (2);
  649.   CHECK_ARG(2, STRING_P);
  650.   if (STRING_LENGTH(ARG_REF(2)) < sizeof(XEvent))
  651.     error_bad_range_arg(2);
  652.   XPutBackEvent ((Display *) arg_integer(1),
  653.          (XEvent *) STRING_ARG(2));
  654.   PRIMITIVE_RETURN (UNSPECIFIC);
  655. }
  656.  
  657. DEFINE_PRIMITIVE ("%XQueryPointer", Prim_scxl_query_pointer, 3, 3, 0)
  658. { /* (%XQueryPointer display window result-vector) */
  659.   SCHEME_OBJECT Result = ARG_REF(3);
  660.   SCHEME_OBJECT *Next;
  661.   Window Root=0, Child=0;
  662.   int Root_X=0, Root_Y=0, Win_X=0, Win_Y=0;
  663.   unsigned int Keys_Buttons=0;
  664.   Bool result_status;
  665.  
  666.   PRIMITIVE_HEADER (3);
  667.   CHECK_ARG(3, VECTOR_P);
  668.   if (VECTOR_LENGTH(Result) < 8) error_bad_range_arg(3);
  669.   result_status = XQueryPointer((Display *) arg_integer(1),
  670.                 (Window) arg_integer(2),
  671.                 &Root, &Child, &Root_X, &Root_Y,
  672.                 &Win_X, &Win_Y, &Keys_Buttons);
  673.   Next = VECTOR_LOC(Result, 0);
  674.   *Next++ = BOOLEAN_TO_OBJECT(result_status);          /* 0 */
  675.   *Next++ = long_to_integer ((long) Root);          /* 1 */
  676.   *Next++ = long_to_integer ((long) Child);          /* 2 */
  677.   *Next++ = long_to_integer ((long) Root_X);          /* 3 */
  678.   *Next++ = long_to_integer ((long) Root_Y);          /* 4 */
  679.   *Next++ = long_to_integer ((long) Win_X);          /* 5 */
  680.   *Next++ = long_to_integer ((long) Win_Y);          /* 6 */
  681.   *Next++ = long_to_integer ((long) Keys_Buttons);    /* 7 */
  682.   PRIMITIVE_RETURN (UNSPECIFIC);
  683. }
  684.  
  685. DEFINE_PRIMITIVE ("%XQueryTree", Prim_query_tree, 2, 2, 0)
  686. { /* (%XQueryTree display window)
  687.      returns a vector of #(root parent . kids)
  688.   */
  689.   SCHEME_OBJECT Kid_Return;
  690.   Window Root, Parent, *Kids;
  691.   unsigned int NKids, i;
  692.  
  693.   PRIMITIVE_HEADER (2);
  694.   if (XQueryTree((Display *) arg_integer(1), (Window) arg_integer(2),
  695.          &Root, &Parent, &Kids, &NKids)==0)
  696.   { error_external_return();
  697.   }
  698.   Kid_Return = allocate_marked_vector(TC_VECTOR, NKids+2, true);
  699.   VECTOR_SET(Kid_Return, 0, long_to_integer((long) Root));
  700.   VECTOR_SET(Kid_Return, 1, long_to_integer((long) Parent));
  701.   for (i=0; i < NKids; i++)
  702.     VECTOR_SET(Kid_Return, i+2, long_to_integer((long) Kids[i]));
  703.   XFree(Kids);
  704.   PRIMITIVE_RETURN (Kid_Return);
  705. }
  706.  
  707. DEFINE_PRIMITIVE ("%XScreenCount", Prim_scxl_screencount, 1, 1, 0)
  708. { /* (%XScreenCount display) */
  709.   PRIMITIVE_HEADER(1);
  710.   PRIMITIVE_RETURN (long_to_integer
  711.             (XScreenCount((Display *) arg_integer(1))));
  712. }
  713.  
  714. DEFINE_PRIMITIVE ("%XSetForeground", Prim_scxl_set_foreground, 3, 3, 0)
  715. { /* (%XSetForeground display context pixel) */
  716.   PRIMITIVE_HEADER(3);
  717.   XSetForeground((Display *) arg_integer(1),
  718.          (GC) arg_integer(2),
  719.          arg_integer(3));
  720.   PRIMITIVE_RETURN (UNSPECIFIC);
  721. }
  722.  
  723.  
  724. DEFINE_PRIMITIVE ("%XSetFunction", Prim_scxl_set_function, 3, 3, 0)
  725. { /* (%XSetFunction display context function_number) */
  726.   PRIMITIVE_HEADER(3);
  727.   XSetFunction((Display *) arg_integer(1),
  728.          (GC) arg_integer(2),
  729.          arg_integer(3));
  730.   PRIMITIVE_RETURN (UNSPECIFIC);
  731. }
  732.  
  733.  
  734. DEFINE_PRIMITIVE ("%XSetRegion", Prim_scxl_set_region, 3, 3, 0)
  735. { /* (%XSetForeground display gc region) */
  736.   PRIMITIVE_HEADER(3);
  737.   XSetRegion((Display *) arg_integer(1),
  738.          (GC) arg_integer(2),
  739.          (Region) arg_integer(3));
  740.   PRIMITIVE_RETURN (UNSPECIFIC);
  741. }
  742.  
  743. DEFINE_PRIMITIVE ("%XStoreName", Prim_scxl_store_name, 3, 3, 0)
  744. { /* (%XStoreName display window title-string */
  745.   PRIMITIVE_HEADER (3);
  746.   XStoreName((Display *) arg_integer(1),
  747.          (Window) arg_integer(2),
  748.          STRING_ARG(3));
  749.   PRIMITIVE_RETURN (UNSPECIFIC);
  750. }
  751.  
  752. DEFINE_PRIMITIVE ("%XSubtractRegion", Prim_scxl_subtract_reg, 3, 3, 0)
  753. { /* (%XSubtractRegion source1 source2 dest) */
  754.   PRIMITIVE_HEADER (3);
  755.   XSubtractRegion((Region) arg_integer(1),
  756.           (Region) arg_integer(2),
  757.           (Region) arg_integer(3));
  758.   PRIMITIVE_RETURN(UNSPECIFIC);
  759. }
  760.  
  761. DEFINE_PRIMITIVE ("%XTranslateCoordinates", Prim_scxl_translate_coords,
  762.           6, 6, 0)
  763. { /* (%XTranslateCoordinates display old-window new-window x y vector)
  764.   */
  765.   int X, Y;
  766.   Window W;
  767.   SCHEME_OBJECT Vect;
  768.   Boolean status;
  769.   PRIMITIVE_HEADER (6);
  770.   Vect = VECTOR_ARG(6);
  771.   if (VECTOR_LENGTH(Vect) < 4) error_bad_range_arg(6);
  772.   status = XTranslateCoordinates((Display *) arg_integer(1),
  773.                  (Window) arg_integer(2),
  774.                  (Window) arg_integer(3),
  775.                  (int) arg_integer(4),
  776.                  (int) arg_integer(5),
  777.                  &X, &Y, &W);
  778.   VECTOR_SET(Vect, 0, BOOLEAN_TO_OBJECT(status));
  779.   VECTOR_SET(Vect, 1, long_to_integer((long) X));
  780.   VECTOR_SET(Vect, 2, long_to_integer((long) Y));
  781.   VECTOR_SET(Vect, 3, long_to_integer((long) W));
  782.   PRIMITIVE_RETURN (UNSPECIFIC);
  783. }
  784.  
  785. DEFINE_PRIMITIVE ("%XUnionRegion", Prim_scxl_union_reg, 3, 3, 0)
  786. { /* (%XUnionRegion source1 source2 dest) */
  787.   PRIMITIVE_HEADER (3);
  788.   XUnionRegion((Region) arg_integer(1),
  789.            (Region) arg_integer(2),
  790.            (Region) arg_integer(3));
  791.   PRIMITIVE_RETURN(UNSPECIFIC);
  792. }
  793.  
  794. DEFINE_PRIMITIVE ("%XUnionRectSpecsWithRegion!", Prim_scxl_union_rectspecs, 6, 6, 0)
  795. { /* (%XUnionRectSpecsWithRegion! x y width height inregion outregion) */
  796.   XRectangle Rect;
  797.   PRIMITIVE_HEADER (6);
  798.   Rect.x = arg_integer(1);
  799.   Rect.y = arg_integer(2);
  800.   Rect.width = arg_integer(3);
  801.   Rect.height = arg_integer(4);
  802.   XUnionRectWithRegion(&Rect,
  803.                (Region) (arg_integer (5)),
  804.                (Region) (arg_integer (6)));
  805.   PRIMITIVE_RETURN (UNSPECIFIC);
  806. }
  807.  
  808. DEFINE_PRIMITIVE ("%XUnloadFont", Prim_scxl_unload_font, 2, 2, 0)
  809. { /* (%XUnloadFont display font) */
  810.   PRIMITIVE_HEADER(2);
  811.   XUnloadFont((Display *) arg_integer(1), (Font) arg_integer(2));
  812.   PRIMITIVE_RETURN(UNSPECIFIC);
  813. }
  814.  
  815. /* Data structure constructors.  These are represented as strings to */
  816. /* circumvent  garbage collection */
  817.  
  818. DEFINE_PRIMITIVE ("%XMake-Color", Prim_scxl_make_color, 0, 0, 0)
  819. { /* (%XMake-Color) */
  820.   PRIMITIVE_HEADER (0);
  821.   PRIMITIVE_RETURN(allocate_string(sizeof(XColor)));
  822. }
  823.  
  824. DEFINE_PRIMITIVE ("%XMake-Event", Prim_scxl_make_event, 0, 0, 0)
  825. { /* (%XMake-Event) */
  826.   PRIMITIVE_HEADER (0);
  827.   PRIMITIVE_RETURN(allocate_string(sizeof(XEvent)));
  828. }
  829.  
  830. DEFINE_PRIMITIVE ("%XMake-GCValues", Prim_scxl_make_gc_values, 0, 0, 0)
  831. { /* (%XMake-GCValues) */
  832.   PRIMITIVE_HEADER (0);
  833.   PRIMITIVE_RETURN(allocate_string(sizeof(XGCValues)));
  834. }
  835.  
  836. DEFINE_PRIMITIVE ("%XMake-GetWindowAttributes", Prim_scxl_make_get_wind_attr,
  837.           0, 0, 0)
  838. { /* (%XMake-GetWindowAttributes) */
  839.   PRIMITIVE_HEADER (0);
  840.   PRIMITIVE_RETURN(allocate_string(sizeof(XWindowAttributes)));
  841. }
  842.  
  843. DEFINE_PRIMITIVE ("%XMake-SetWindowAttributes", Prim_scxl_make_set_wind_attr,
  844.           0, 0, 0)
  845. { /* (%XMake-SetWindowAttributes) */
  846.   PRIMITIVE_HEADER (0);
  847.   PRIMITIVE_RETURN(allocate_string(sizeof(XSetWindowAttributes)));
  848. }
  849.  
  850. /* Mutators */
  851.  
  852. #define Mutator(StructType, Field, FieldType, Converter)    \
  853. {                                \
  854.   PRIMITIVE_HEADER(2);                        \
  855.   CHECK_ARG(1, STRING_P);                    \
  856.   if (STRING_LENGTH(ARG_REF(1)) < sizeof(StructType))        \
  857.     error_bad_range_arg(1);                    \
  858.   ((StructType *) (STRING_ARG(1)))->Field =            \
  859.     ((FieldType) Converter(2));                    \
  860.   PRIMITIVE_RETURN (UNSPECIFIC);                \
  861. }
  862.  
  863. DEFINE_PRIMITIVE ("%XSetWindowAttributes-Event_Mask!",
  864.           Prim_scxl_XSetWindowAttributes_Event_Mask_bang,
  865.           2, 2, 0)
  866.   Mutator(XSetWindowAttributes, event_mask, long, arg_integer)
  867.  
  868. static int
  869. DEFUN (x_io_error_handler, (display),
  870.        Display * display)
  871. {
  872.   fprintf (stderr, "\nX IO Error on display 0x%x\n", display);
  873.   error_external_return ();
  874. }
  875.  
  876. void DEFUN (Scheme_x_error_handler, (display, error_event),
  877.         Display * display AND
  878.         XErrorEvent * error_event)
  879. {
  880.   char buffer [2048];
  881.   XGetErrorText (display, (error_event -> error_code),
  882.          buffer, (sizeof (buffer)));
  883.   fprintf (stderr, "\nX Error: %s\n", buffer);
  884.   fprintf (stderr, "         Request code: %d\n",
  885.        (error_event -> request_code));
  886.   fprintf (stderr, "         Error serial: 0x%x\n",
  887.        (error_event -> serial));
  888.   fprintf (stderr, "         Display: %d (0x%x)\n",
  889.        error_event->display, error_event->display);
  890.   fprintf (stderr, "         Resource ID: %d (0x%x)\n",
  891.        error_event->resourceid, error_event->resourceid);
  892.   fprintf (stderr, "         Minor code: %d (0x%x)\n",
  893.        error_event->minor_code, error_event->minor_code);
  894.   fflush (stderr);
  895. }
  896.  
  897. static int
  898. DEFUN (Scheme_low_x_error_handler, (display, error_event),
  899.        Display * display AND
  900.        XErrorEvent * error_event)
  901. { Scheme_x_error_handler(display, error_event);
  902.   error_external_return ();
  903. }
  904.  
  905. DEFINE_PRIMITIVE("%XInitSCXL!", Prim_scxl_init, 0, 0, 0)
  906. { extern int _XDefaultError();
  907.   PRIMITIVE_HEADER (0);
  908.   XSetErrorHandler (Scheme_low_x_error_handler);
  909.   XSetIOErrorHandler (x_io_error_handler);
  910.   PRIMITIVE_RETURN (UNSPECIFIC);
  911. }
  912.  
  913. DEFINE_PRIMITIVE("%XSync", Prim_scxl_sync, 2, 2, 0)
  914. { PRIMITIVE_HEADER (2);
  915.   XSync((Display *) arg_integer(1), BOOLEAN_ARG(2));
  916.   PRIMITIVE_RETURN (UNSPECIFIC);
  917. }
  918.  
  919. DEFINE_PRIMITIVE("%XSynchronize", Prim_scxl_synchronize, 2, 2, 0)
  920. { PRIMITIVE_HEADER (2);
  921.   XSynchronize((Display *) arg_integer(1), BOOLEAN_ARG(2));
  922.   PRIMITIVE_RETURN (UNSPECIFIC);
  923. }
  924.  
  925. SCHEME_OBJECT Debug_State_Flag;
  926.  
  927. DEFINE_PRIMITIVE("%SetDebugState!", Prim_scxl_state, 1, 1, 0)
  928. { PRIMITIVE_HEADER(1);
  929.   Debug_State_Flag = ARG_REF(1);
  930.   PRIMITIVE_RETURN(UNSPECIFIC);
  931. }
  932.  
  933. extern char *EXFUN (dload_initialize_file, (void));
  934.  
  935. char *
  936.   DEFUN_VOID (dload_initialize_file)
  937. { declare_primitive("%XAllocNamedColor", Prim_scxl_allocated_named_color,
  938.           5, 5, 0);
  939.   declare_primitive("%XChangeWindowAttributes", Prim_scxl_change_wind_attr,
  940.           4, 4, 0);
  941.   declare_primitive("%XCheckMaskEvent", Prim_scxl_check_mask_event, 3, 3, 0);
  942.   declare_primitive("%XClearArea", Prim_scxl_clear_area, 7, 7, 0);
  943.   declare_primitive("%XClearWindow", Prim_scxl_clear_window, 2, 2, 0);
  944.   declare_primitive("%XCloseDisplay", Prim_scxl_close, 1, 1, 0);
  945.   declare_primitive("%XConnectionNumber", Prim_scxl_connection_number, 1, 1, 0);
  946.   declare_primitive("%XCreateGC", Prim_scxl_create_gc, 4, 4, 0);
  947.   declare_primitive("%XCreateRegion", Prim_scxl_create_region, 0, 0, 0);
  948.   declare_primitive("%XCreateSimpleWindow", Prim_scxl_create_simple_window,
  949.           9, 9, 0);
  950.   declare_primitive("%XDecodeButtonEvent", prim_scxl_decode_button, 2, 2, 0);
  951.   declare_primitive("%XDecodeConfigureEvent",
  952.           prim_scxl_decode_config, 2, 2, 0);
  953.   declare_primitive("%XDecodeCrossingEvent", prim_scxl_decode_crossing, 2, 2, 0);
  954.   declare_primitive("%XDecodeExposeEvent", prim_scxl_decode_expose, 2, 2, 0);
  955.   declare_primitive("%XDecodeKeyEvent", prim_scxl_decode_key, 2, 2, 0);
  956.   declare_primitive("%XDecodeMotionEvent", prim_scxl_decode_motion, 2, 2, 0);
  957.   declare_primitive("%XDecodeUnknownEvent", Prim_scxl_decode_unknown, 2, 2, 0);
  958.   declare_primitive("%XDecodeWindowAttributes", Prim_scxl_decode_wind_attr, 2, 2, 0);
  959.   declare_primitive("%XDecodeXColor", Prim_scxl_decode_xcolor, 2, 2, 0);
  960.   declare_primitive("%XDefaultColormap", Prim_scxl_default_colormap, 2, 2, 0);
  961.   declare_primitive("%XDefaultRootWindow", Prim_scxl_default_root_window,
  962.           1, 1, 0);
  963.   declare_primitive("%XDefaultScreen", Prim_scxl_default_screen, 1, 1, 0);
  964.   declare_primitive("%XDestroyRegion", Prim_scxl_destroy_region, 1, 1, 0);
  965.   declare_primitive("%XDestroyWindow", Prim_scxl_destroy_window, 2, 2, 0);
  966.   declare_primitive("%XDrawArc", Prim_scxl_draw_arc, 9, 9, 0);
  967.   declare_primitive("%XDrawLine", Prim_scxl_draw_line, 7, 7, 0);
  968.   declare_primitive("%XDrawRectangle", Prim_scxl_draw_rectangle, 7, 7, 0);
  969.   declare_primitive("%XFillArc", Prim_scxl_fill_arc, 9, 9, 0);
  970.   declare_primitive("%XFillRectangle", Prim_scxl_fill_rectangle, 7, 7, 0);
  971.   declare_primitive("%XFlush", Prim_scxl_flush, 1, 1, 0);
  972.   declare_primitive("%XFreeColormap", Prim_scxl_free_colormap, 2, 2, 0);
  973.   declare_primitive("%XFreeGC", Prim_scxl_free_gc, 2, 2, 0);
  974.   declare_primitive("%XGetDefault", Prim_scxl_get_default, 3, 3, 0);
  975.   declare_primitive("%XGetWindowAttributes", Prim_scxl_get_wind_attr, 3, 3, 0);
  976.   declare_primitive("%XIntersectRegion", Prim_scxl_intersect_reg, 3, 3, 0);
  977.   declare_primitive("%XLoadFont", Prim_scxl_load_font, 2, 2, 0);
  978.   declare_primitive("%XMapWindow", Prim_scxl_map_window, 2, 2, 0);
  979.   declare_primitive("%XNextEvent", Prim_scxl_next_event, 2, 2, 0);
  980.   declare_primitive("%XOpenDisplay", Prim_scxl_open_display, 1, 1, 0);
  981.   declare_primitive("%XPending", Prim_scxl_pending, 1, 1, 0);
  982.   declare_primitive("%XPutBackEvent", Prim_scxl_put_back_event, 2, 2, 0);
  983.   declare_primitive("%XQueryPointer", Prim_scxl_query_pointer, 3, 3, 0);
  984.   declare_primitive("%XQueryTree", Prim_query_tree, 2, 2, 0);
  985.   declare_primitive("%XScreenCount", Prim_scxl_screencount, 1, 1, 0);
  986.   declare_primitive("%XSetForeground", Prim_scxl_set_foreground, 3, 3, 0);
  987.   declare_primitive("%XSetFunction", Prim_scxl_set_function, 3, 3, 0);
  988.   declare_primitive("%XSetRegion", Prim_scxl_set_region, 3, 3, 0);
  989.   declare_primitive("%XStoreName", Prim_scxl_store_name, 3, 3, 0);
  990.   declare_primitive("%XSubtractRegion", Prim_scxl_subtract_reg, 3, 3, 0);
  991.   declare_primitive("%XTranslateCoordinates", Prim_scxl_translate_coords,
  992.           6, 6, 0);
  993.   declare_primitive("%XUnionRegion", Prim_scxl_union_reg, 3, 3, 0);
  994.   declare_primitive("%XUnionRectSpecsWithRegion!", Prim_scxl_union_rectspecs, 6, 6, 0);
  995.   declare_primitive("%XUnloadFont", Prim_scxl_unload_font, 2, 2, 0);
  996.   declare_primitive("%XMake-Color", Prim_scxl_make_color, 0, 0, 0);
  997.   declare_primitive("%XMake-Event", Prim_scxl_make_event, 0, 0, 0);
  998.   declare_primitive("%XMake-GCValues", Prim_scxl_make_gc_values, 0, 0, 0);
  999.   declare_primitive("%XMake-GetWindowAttributes", Prim_scxl_make_get_wind_attr,
  1000.           0, 0, 0);
  1001.   declare_primitive("%XMake-SetWindowAttributes", Prim_scxl_make_set_wind_attr,
  1002.           0, 0, 0);
  1003.   declare_primitive("%XSetWindowAttributes-Event_Mask!",
  1004.           Prim_scxl_XSetWindowAttributes_Event_Mask_bang,
  1005.           2, 2, 0);
  1006.   declare_primitive("%XInitSCXL!", Prim_scxl_init, 0, 0, 0);
  1007.   declare_primitive("%XSync", Prim_scxl_sync, 2, 2, 0);
  1008.   declare_primitive("%XSynchronize", Prim_scxl_synchronize, 2, 2, 0);
  1009.   declare_primitive("%SetDebugState!", Prim_scxl_state, 1, 1, 0);
  1010.   return "#SCXL";
  1011. }
  1012.