home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / XPRED.C < prev    next >
C/C++ Source or Header  |  1996-06-04  |  92KB  |  4,218 lines

  1. /* Copyright 1991 Digital Equipment Corporation.
  2.  ** Distributed only by permission.
  3.  **
  4.  ** Last modified on Wed Mar  2 11:32:59 MET 1994 by rmeyer
  5.  **      modified on Fri Jan 28 14:24:13 MET 1994 by dumant
  6.  **      modified on Thu Jun 24 06:55:40 1993 by Rmeyer
  7.  **      modified on Thu Nov 26 20:13:50 1992 by herve
  8.  *****************************************************************/
  9. /*     $Id: xpred.c,v 1.3 1995/07/27 19:28:45 duchier Exp $     */
  10.  
  11. #ifndef lint
  12. static char vcid[] = "$Id: xpred.c,v 1.3 1995/07/27 19:28:45 duchier Exp $";
  13. #endif /* lint */
  14.  
  15.  
  16. #ifdef X11
  17.  
  18.  
  19.  
  20. #include <stdio.h>
  21. #include <ctype.h>
  22. #include <malloc.h>
  23. #include <sys/types.h>
  24. #include <sys/time.h>
  25. #include <sys/ioctl.h>
  26.  
  27. #ifndef NEEDXLIBINT
  28. #include <X11/Xlib.h>
  29. #else
  30. #include <X11/Xlibint.h>
  31. #endif
  32. #include <X11/Xutil.h>
  33. #include <X11/keysym.h>
  34.  
  35. #include "extern.h"
  36. #include "token.h"
  37. #include "print.h"
  38. #include "built_ins.h"
  39. #include "types.h"
  40. #include "trees.h"
  41. #include "lefun.h"
  42. #include "login.h"
  43. #include "error.h"
  44. #include "memory.h"
  45. #include "templates.h"
  46. #include "modules.h"
  47. #include "xpred.h"
  48. #include "xdisplaylist.h"
  49.  
  50. #include "life_icon"
  51.  
  52.  
  53. /*****************************************/
  54.  
  55.  
  56. #define stdin_fileno fileno(stdin)
  57. #define CR 0x0d
  58. #define BS 0x08
  59.  
  60.  
  61. /* a closure for enum xevents_list */
  62. typedef struct wl_EventClosure
  63. {
  64.   Display *display;
  65.   Window window;
  66.   long mask;
  67.   ptr_psi_term beginSpan;
  68. } EventClosure;
  69.  
  70.  
  71. /*****************************************/
  72.  
  73.  
  74. ptr_psi_term xevent_existing = NULL;
  75. ptr_psi_term xevent_list = NULL;
  76.  
  77. ptr_definition xevent,xkeyboard_event,xbutton_event,/* RM: 7/12/92 */
  78.   xexpose_event,xdestroy_event,xmotion_event,
  79.   
  80.   xenter_event,xleave_event,xmisc_event,/* RM: 3rd May 93 */
  81.   
  82.   xdisplay,xdrawable,xwindow,xpixmap,xconfigure_event,
  83.   xgc,xdisplaylist;
  84.  
  85.  
  86. long x_window_creation = FALSE;
  87.  
  88. /*****************************************/
  89.  
  90. static long xevent_mask[] = {
  91. 0,                /* ???             0 */
  92. 0,                /* ???             1 */
  93. KeyPressMask,            /* KeyPress         2 */
  94. KeyReleaseMask,            /* KeyRelease         3 */
  95. ButtonPressMask,        /* ButtonPress          4 */ 
  96. ButtonReleaseMask,        /* ButtonRelease     5 */
  97.  
  98. PointerMotionMask |    PointerMotionHintMask |    ButtonMotionMask |
  99. Button1MotionMask |    Button2MotionMask |    Button3MotionMask |
  100. Button4MotionMask |        Button5MotionMask,
  101.                 /* MotionNotify         6 */
  102. EnterWindowMask,        /* EnterNotify         7 */
  103. LeaveWindowMask,        /* LeaveNotify         8 */
  104. FocusChangeMask,        /* FocusIn         9 */
  105. FocusChangeMask,        /* FocusOut        10 */
  106. KeymapStateMask,        /* KeymapNotify        11 */
  107. ExposureMask,            /* Expose        12 */
  108. 0,                /* GraphicsExpose    13 */
  109. 0,                /* NoExpose        14 */
  110. VisibilityChangeMask,        /* VisibilityNotify    15 */
  111. SubstructureNotifyMask,        /* CreateNotify        16 */
  112. SubstructureNotifyMask,        /* DestroyNotify    17 */
  113. StructureNotifyMask,        /* UnmapNotify        18 */
  114. StructureNotifyMask,        /* MapNotify        19 */
  115. SubstructureRedirectMask,    /* MapRequest        20 */
  116. SubstructureNotifyMask,        /* ReparentNotify    21 */
  117. StructureNotifyMask,        /* ConfigureNotify    22 */
  118. SubstructureRedirectMask,    /* ConfigureRequest    23 */
  119. StructureNotifyMask,        /* GravityNotify    24 */
  120. ResizeRedirectMask,        /* ResizeRequest    25 */
  121. StructureNotifyMask,        /* CirculateNotify    26 */
  122. SubstructureRedirectMask,    /* CirculateRequest    27 */
  123. PropertyChangeMask,        /* PropertyNotify    28 */
  124. 0,                /* SelectionClear    29 */
  125. 0,                /* SelectionRequest    30 */
  126. 0,                /* SelectionNotify    31 */
  127. ColormapChangeMask,        /* ColormapNotify    32 */
  128. 0,                /* ClientMessage    33 */
  129. 0                /* MappingNotify    34 */
  130. };
  131.  
  132.  
  133.  
  134. static char* xevent_name[] = {
  135.   "???",
  136.   "???",
  137.   "KeyPress",
  138.   "KeyRelease",
  139.   "ButtonPress",
  140.   "ButtonRelease",
  141.   "MotionNotify",
  142.   "EnterNotify",
  143.   "LeaveNotify",
  144.   "FocusIn",
  145.   "FocusOut",
  146.   "KeymapNotify",
  147.   "Expose",
  148.   "GraphicsExpose",
  149.   "NoExpose",
  150.   "VisibilityNotify",
  151.   "CreateNotify",
  152.   "DestroyNotify",
  153.   "UnmapNotify",
  154.   "MapNotify",
  155.   "MapRequest",
  156.   "ReparentNotify",
  157.   "ConfigureNotify",
  158.   "ConfigureRequest",
  159.   "GravityNotify",
  160.   "ResizeRequest",
  161.   "CirculateNotify",
  162.   "CirculateRequest",
  163.   "PropertyNotify",
  164.   "SelectionClear",
  165.   "SelectionRequest",
  166.   "SelectionNotify",
  167.   "ColormapNotify",
  168.   "ClientMessage",
  169.   "MappingNotify"
  170. };
  171.  
  172.  
  173.  
  174.  
  175. /*****************************************************************/
  176. /* Macros */
  177.  
  178. #define DrawableGC(w)(GC)GetIntAttr(GetPsiAttr(w,"graphic_context"),"id")
  179. #define WindowDisplayList(w) GetIntAttr(GetPsiAttr(w,"display_list"),"id")
  180.  
  181. /* Macros to keep GCC happy. RM: Feb  9 1994  */
  182. #define DISP(X)(Display *)val[X]
  183. #define DRAW(X)(Drawable)val[X]
  184. #define WIND(X)(Window)val[X]
  185. #define GCVAL(X)(GC)val[X]
  186. #define FONT(X)(Font)val[X]
  187. #define CMAP(X)(Colormap)val[X]  
  188. #define STRG(X)(char *)val[X]
  189.  
  190.   
  191.   
  192. /*****************************************************************/
  193. /* Static */
  194. /* handle the errors X */
  195.  
  196.  
  197. static int x_handle_error(display,x_error)
  198.      Display *display;
  199.      XErrorEvent *x_error;
  200. {
  201.   char msg[128];
  202.   XGetErrorText(display,x_error->error_code,msg,128);
  203.   Errorline("X error message: %s.\n",msg);
  204.   /* don't use abort_life(TRUE) because it tries to destroy windows ...
  205.      and loops because the window is yet in the stack !!
  206.      jch - Fri Aug  7 17:58:27 MET DST 1992
  207.      */
  208.   exit_life(TRUE);
  209. }
  210.  
  211.  
  212. static int x_handle_fatal_error(display)
  213.      Display *display;
  214. {
  215.   Errorline("fatal X Error.\n");
  216.   exit_life(TRUE);
  217. }
  218.  
  219.  
  220. /*  RM: Jun 24 1993  */
  221. /* JCH didn't understand ANYTHING about trailing! */
  222.  
  223. void bk_stack_add_int_attr(t,attrname,value)
  224.      ptr_psi_term t;
  225.      char *attrname;
  226.      long value;
  227. {
  228.   ptr_psi_term t1;
  229.   ptr_node n;
  230.   char *perm;
  231.   
  232.  
  233.   perm=heap_copy_string(attrname);
  234.   n=find(featcmp,perm,t->attr_list);
  235.   if(n) {
  236.     t1=(ptr_psi_term)n->data;
  237.     deref_ptr(t1);
  238.     if(!t1->value) {
  239.       push_ptr_value(int_ptr,&(t1->value));
  240.       t1->value=heap_alloc(sizeof(REAL));
  241.     }
  242.     *(REAL *)t1->value =(REAL) value;
  243.   }
  244.   else {
  245.     t1=stack_psi_term(4);
  246.     t1->type=integer;
  247.     t1->value=heap_alloc(sizeof(REAL));
  248.     *(REAL *)t1->value =(REAL) value;
  249.     bk_stack_insert(featcmp,perm,&(t->attr_list),t1);
  250.   }
  251. }
  252.  
  253.  
  254. void bk_change_psi_attr(t,attrname,value)
  255.      ptr_psi_term t;
  256.      char *attrname;
  257.      ptr_psi_term value;
  258. {
  259.   ptr_psi_term t1;
  260.   ptr_node n;
  261.   char *perm;
  262.   
  263.  
  264.   perm=heap_copy_string(attrname);
  265.   n=find(featcmp,perm,t->attr_list);
  266.   if(n) {
  267.     t1=(ptr_psi_term)n->data;
  268.     deref_ptr(t1);
  269.     *t1= *value;
  270.     /*push_ptr_value(psi_term_ptr,&(t1->coref));*/
  271.     if(value!=t1)
  272.       value->coref=t1;
  273.   }
  274.   else
  275.     bk_stack_insert(featcmp,perm,&(t->attr_list),value);
  276. }
  277.  
  278.  
  279.  
  280.  
  281.  
  282. /*****************************************************************/
  283. /* Utility */
  284. /* unify psi_term T to the integer value V */
  285. /* could be in builtins.c */
  286.  
  287. long unify_int_result(t,v)
  288.      ptr_psi_term t;
  289.      long v;
  290. {
  291.   long smaller;
  292.   long success=TRUE;
  293.   
  294.   
  295.   deref_ptr(t);
  296.   push_ptr_value(int_ptr,&(t->value));
  297.   t->value = heap_alloc(sizeof(REAL));
  298.   *(REAL *) t->value = v;
  299.   
  300.   matches(t->type,integer,&smaller);
  301.   
  302.   if(!smaller) 
  303.     {
  304.       push_ptr_value(def_ptr,&(t->type));
  305.       t->type = integer;
  306.       t->status = 0;
  307.     }
  308.   else
  309.     success = FALSE;
  310.   
  311.   if(success) 
  312.     {
  313.       i_check_out(t);
  314.       if(t->resid)
  315.     release_resid(t);
  316.     }
  317.   
  318.   return success;
  319. }
  320.  
  321.  
  322. /*****************************************************************/
  323. /* Static */
  324. /* build a psi-term of type t with a feature f of value v */
  325.  
  326. static ptr_psi_term NewPsi(t,f,v)
  327.      ptr_definition t;
  328.      char * f;
  329.      long v;
  330. {
  331.   ptr_psi_term p;
  332.   
  333.   p = stack_psi_term(4);
  334.   p->type = t;
  335.   bk_stack_add_int_attr(p,f,v);
  336.   return p;
  337. }
  338.  
  339.  
  340. /*****************************************************************/
  341. /* Utilities */
  342. /* return the value of the attribute attributeName on the psi-term psiTerm */
  343.  
  344. long GetIntAttr(psiTerm,attributeName)
  345.      
  346.      ptr_psi_term psiTerm;
  347.      char *attributeName;
  348. {
  349.   ptr_node nodeAttr;
  350.   ptr_psi_term psiValue;
  351.   
  352.   
  353.   deref_ptr(psiTerm);
  354.   nodeAttr=find(featcmp,attributeName,psiTerm->attr_list);
  355.   if(!nodeAttr) {
  356.     Errorline("in GetIntAttr: didn't find %s on %P\n",
  357.            attributeName,
  358.            psiTerm);
  359.     exit_life(TRUE);
  360.   }
  361.   
  362.   psiValue=(ptr_psi_term)nodeAttr->data;
  363.   deref_ptr(psiValue);
  364.   if(psiValue->value)
  365.     return *(REAL *) psiValue->value;
  366.   else {
  367.     /* Errorline("in GetIntAttr: no value!\n"); */
  368.     return -34466; /* Real nasty hack for now  RM: Apr 23 1993  */
  369.   }
  370. }
  371.  
  372.  
  373.  
  374. /*****************************************************************/
  375. /* Utilities */
  376. /* return the psi-term of the attribute attributeName on the psi-term psiTerm */
  377.  
  378. ptr_psi_term GetPsiAttr(psiTerm,attributeName)
  379.      
  380.      ptr_psi_term psiTerm;
  381.      char *attributeName;
  382. {
  383.   ptr_node nodeAttr;
  384.   ptr_psi_term psiValue;
  385.   
  386.   
  387.   if((nodeAttr = find(featcmp,attributeName,psiTerm->attr_list)) == NULL)
  388.     {
  389.       Errorline("in GetPsiAttr: no attribute name on psi-term ?\n");
  390.       exit_life(TRUE);
  391.     }
  392.   
  393.   if((psiValue =(ptr_psi_term) nodeAttr->data) == NULL)
  394.     {
  395.       Errorline("in GetPsiAttr: no value on psi-term ?\n");
  396.       exit_life(TRUE);
  397.     }
  398.   
  399.   return psiValue;
  400. }
  401.  
  402. /*****************************************************************/
  403. /* Static */
  404. /* resize the pixmap of the window */
  405.  
  406. static void ResizePixmap(psi_window,display,window,width,height)
  407.      
  408.      ptr_psi_term psi_window;
  409.      Display *display;
  410.      Window window;
  411.      unsigned long width,height;
  412. {
  413.   Pixmap pixmap;
  414.   GC pixmapGC;
  415.   ptr_psi_term psiPixmap,psiPixmapGC;
  416.   XGCValues gcvalues;
  417.   XWindowAttributes attr;
  418.   ptr_psi_term psi_gc;
  419.   
  420.     
  421.   /* free the old pixmap */
  422.   psiPixmap = GetPsiAttr(psi_window,"pixmap");
  423.   psiPixmapGC=NULL;
  424.   
  425.   if((pixmap = GetIntAttr(psiPixmap,"id")) != 0)
  426.     {
  427.       /* change the pixmap */
  428.       XFreePixmap(display,pixmap);
  429.       /* change the pixmap'gc too,because the gc is created on the pixmap ! */
  430.  
  431.       psiPixmapGC = GetPsiAttr(psiPixmap,"graphic_context");
  432.  
  433.       /*  RM: Jun 24 1993  */
  434.       pixmapGC=(GC)GetIntAttr(psiPixmapGC,"id");
  435.       if(pixmapGC)
  436.     XFreeGC(display,pixmapGC);
  437.       
  438.       bk_stack_add_int_attr(psiPixmap,"id",NULL);
  439.       bk_stack_add_int_attr(psiPixmapGC,"id",NULL);
  440.     }
  441.   
  442.   /* init a new pixmap on the window */
  443.   XGetWindowAttributes(display,window,&attr);
  444.   if((pixmap = XCreatePixmap(display,window,
  445.                    attr.width+1,attr.height+1,
  446.                    attr.depth)) != 0)
  447.     {
  448.       bk_stack_add_int_attr(psiPixmap,"id",pixmap);
  449.       gcvalues.cap_style = CapRound;
  450.       gcvalues.join_style = JoinRound;
  451.       pixmapGC = XCreateGC(display,pixmap,
  452.                 GCJoinStyle|GCCapStyle,&gcvalues);
  453.  
  454.       /*  RM: Jun 24 1993  */
  455.       if(psiPixmapGC)
  456.     bk_stack_add_int_attr(psiPixmapGC,"id",pixmapGC);
  457.       else
  458.     psiPixmapGC=NewPsi(xgc,"id",pixmapGC);
  459.       bk_change_psi_attr(psiPixmap,"graphic_context",psiPixmapGC);
  460.     }
  461. }
  462.  
  463.  
  464. /*****************************************************************/
  465. /* Static */
  466. /* free all attributes of a window,that is: its display list,its gc,
  467.    its pixmap ... */
  468.  
  469. static void FreeWindow(display,psi_window)
  470.      
  471.      Display *display;
  472.      ptr_psi_term psi_window;
  473.      
  474. {
  475.   ptr_psi_term psiPixmap;
  476.   
  477.   
  478.   XFreeGC(display,DrawableGC(psi_window));
  479.   x_free_display_list(WindowDisplayList(psi_window));
  480.   
  481.   psiPixmap = GetPsiAttr(psi_window,"pixmap");
  482.   XFreeGC(display,DrawableGC(psiPixmap));
  483.   XFreePixmap(display,GetIntAttr(psiPixmap,"id"));
  484. }
  485.  
  486.  
  487. /*****************************************************************/
  488. /******** xcOpenConnection
  489.   
  490.   xcOpenConnection(+Name,-Connection)
  491.   
  492.   open a connection to the X server.
  493.   
  494.   */
  495.  
  496. long xcOpenConnection()
  497.      
  498. {
  499.   include_var_builtin(2);
  500.   ptr_definition types[2];
  501.   char *display;
  502.   Display * connection;
  503.   ptr_psi_term psiConnection;
  504.   
  505.   
  506.   types[0] = quoted_string;
  507.   types[1] = xdisplay;
  508.   
  509.   
  510.   begin_builtin(xcOpenConnection,2,1,types);
  511.   
  512.   if(strcmp(STRG(0),""))
  513.     display =STRG(0);
  514.   else
  515.     display = NULL; 
  516.   
  517.   if(connection = XOpenDisplay(display))
  518.     {
  519.       psiConnection = NewPsi(xdisplay,"id",connection);
  520.       push_goal(unify,psiConnection,args[1],NULL);
  521.       
  522.       success = TRUE;
  523.     }
  524.   else
  525.     {
  526.       Errorline("could not open connection in %P.\n",g);
  527.       success = FALSE;
  528.     }
  529.   
  530.   end_builtin();
  531. }
  532.  
  533.  
  534. /*****************************************************************/
  535. /******** xcDefaultRootWindow
  536.   
  537.   xcDefaultRootWindow(+Display,-Root)
  538.   
  539.   return the root window of the given display
  540.   
  541.   */
  542.  
  543. long xcDefaultRootWindow()
  544.      
  545. {
  546.   include_var_builtin(2);
  547.   ptr_definition types[2];
  548.   Display *display;
  549.   ptr_psi_term psiRoot;
  550.   
  551.   
  552.   types[0] = real;
  553.   types[1] = xdrawable;
  554.   
  555.   begin_builtin(xcDefaultRootWindow,2,1,types);
  556.   
  557.   display = DISP(0);
  558.   
  559.   psiRoot = NewPsi(xwindow,"id",DefaultRootWindow(display));
  560.   
  561.   push_goal(unify,psiRoot,args[1],NULL);
  562.   success = TRUE;
  563.   
  564.   end_builtin();
  565. }
  566.  
  567.  
  568.  
  569. /*****************************************************************/
  570. /******** static GetConnectionAttribute */
  571.  
  572. static long GetConnectionAttribute(display,attributeId,attribute)
  573.      
  574.      Display *display;
  575.      long attributeId,*attribute;
  576.      
  577. {
  578.   switch(attributeId) 
  579.     {
  580.     case 0: 
  581.       *attribute =(unsigned long) ConnectionNumber(display);
  582.       break;
  583.     case 1: 
  584. #ifndef __alpha
  585.       *attribute =(unsigned long)(display->proto_major_version);
  586. #endif
  587.       break;
  588.     case 2: 
  589. #ifndef __alpha
  590.       *attribute =(unsigned long)(display->proto_minor_version);
  591. #endif
  592.       break;
  593.     case 3: 
  594.       *attribute =(unsigned long) ServerVendor(display);
  595.       break;
  596.     case 4: 
  597.       *attribute =(unsigned long) ImageByteOrder(display);
  598.       break;
  599.     case 5: 
  600.       *attribute =(unsigned long) BitmapUnit(display);
  601.       break;
  602.     case 6: 
  603.       *attribute =(unsigned long) BitmapPad(display);
  604.       break;
  605.     case 7: 
  606.       *attribute =(unsigned long) BitmapBitOrder(display);
  607.       break;
  608.     case 8: 
  609.       *attribute =(unsigned long) VendorRelease(display);
  610.       break;
  611.     case 9:
  612. #ifndef __alpha
  613.       *attribute =(unsigned long)(display->qlen);
  614. #endif
  615.       break;
  616.     case 10: 
  617.       *attribute =(unsigned long) LastKnownRequestProcessed(display);
  618.       break;
  619.     case 11: 
  620. #ifndef __alpha
  621.       *attribute =(unsigned long)(display->request);
  622. #endif
  623.       break;
  624.     case 12: 
  625.       *attribute =(unsigned long) DisplayString(display); 
  626.       break;
  627.     case 13: 
  628.       *attribute =(unsigned long) DefaultScreen(display); 
  629.       break;
  630.     case 14: 
  631. #ifndef __alpha
  632.       *attribute =(unsigned long)(display->min_keycode);
  633. #endif
  634.       break;
  635.     case 15: 
  636. #ifndef __alpha
  637.       *attribute =(unsigned long)(display->max_keycode);
  638. #endif
  639.       break;
  640.     default: 
  641.       return FALSE;
  642.       break;
  643.     }
  644.   
  645.   return TRUE;
  646. }
  647.  
  648.  
  649. long xcQueryTextExtents(); /*  RM: Apr 20 1993  */
  650.  
  651.  
  652. /*****************************************************************/
  653. /******** xcGetConnectionAttribute
  654.   
  655.   xcGetConnectionAttribute(+Display,+AttributeId,-Value)
  656.   
  657.   returns the value corresponding to the attribute id.
  658.   
  659.   */
  660.  
  661. long xcGetConnectionAttribute()
  662.      
  663. {
  664.   include_var_builtin(3);
  665.   ptr_definition types[3];
  666.   long attr;
  667.   
  668.   
  669.   types[0] = real;
  670.   types[1] = real;
  671.   types[2] = real;
  672.   
  673.   begin_builtin(xcGetConnectionAttribute,3,2,types);
  674.   
  675.   if(GetConnectionAttribute(DISP(0),DRAW(1),&attr))
  676.     {
  677.       unify_real_result(args[2],(REAL) attr);
  678.       success = TRUE;
  679.     }
  680.   else
  681.     {
  682.       Errorline("could not get connection attribute in %P.\n",g);
  683.       success = FALSE;
  684.     }
  685.   
  686.   end_builtin();
  687. }
  688.  
  689.  
  690. /*****************************************************************/
  691. /******** GetScreenAttribute */
  692.  
  693. static long GetScreenAttribute(display,screen,attributeId,attribute)
  694.      
  695.      Display *display;
  696.      long screen,attributeId,*attribute;
  697.      
  698. {
  699.   Screen *s;
  700.   
  701.   
  702.   s = ScreenOfDisplay(display,screen);
  703.   switch(attributeId) 
  704.     {
  705.     case 0: 
  706.       *attribute =(unsigned long) DisplayOfScreen(s);
  707.       break;
  708.     case 1: 
  709.       *attribute =(unsigned long) RootWindowOfScreen(s);
  710.       break;
  711.     case 2: 
  712.       *attribute =(unsigned long) WidthOfScreen(s);
  713.       break;
  714.     case 3: 
  715.       *attribute =(unsigned long) HeightOfScreen(s);
  716.       break;
  717.     case 4: 
  718.       *attribute =(unsigned long) WidthMMOfScreen(s);
  719.       break;
  720.     case 5: 
  721.       *attribute =(unsigned long) HeightMMOfScreen(s);
  722.       break;
  723.     case 6: 
  724.       *attribute =(unsigned long) DefaultDepthOfScreen(s);
  725.       break;
  726.     case 7: 
  727.       *attribute =(unsigned long) DefaultVisualOfScreen(s);
  728.       break;
  729.     case 8: 
  730.       *attribute =(unsigned long) DefaultGCOfScreen(s);
  731.       break;
  732.     case 9: 
  733.       *attribute =(unsigned long) DefaultColormapOfScreen(s);
  734.       break;
  735.     case 10: 
  736.       *attribute =(unsigned long) WhitePixelOfScreen(s);
  737.       break;
  738.     case 11: 
  739.       *attribute =(unsigned long) BlackPixelOfScreen(s);
  740.       break;
  741.     case 12: 
  742.       *attribute =(unsigned long) MaxCmapsOfScreen(s);
  743.       break;
  744.     case 13: 
  745.       *attribute =(unsigned long) MinCmapsOfScreen(s);
  746.       break;
  747.     case 14: 
  748.       *attribute =(unsigned long) DoesBackingStore(s);
  749.       break;
  750.     case 15: 
  751.       *attribute =(unsigned long) DoesSaveUnders(s);
  752.       break;
  753.     case 16: 
  754.       *attribute =(unsigned long) EventMaskOfScreen(s);
  755.       break;
  756.     default: 
  757.       return FALSE;
  758.       break;
  759.     }
  760.   
  761.   return TRUE;
  762. }
  763.  
  764.  
  765. /*****************************************************************/
  766. /******** xcGetScreenAttribute
  767.   
  768.   xcGetScreenAttribute(+Display,+Screen,+AttributeId,-Value)
  769.   
  770.   returns the value corresponding to the attribute id.
  771.   
  772.   */
  773.  
  774. long xcGetScreenAttribute()
  775.      
  776. {
  777.   include_var_builtin(4);
  778.   ptr_definition types[4];
  779.   long attr;
  780.   
  781.   
  782.   types[0] = real;
  783.   types[1] = real;
  784.   types[2] = real;
  785.   types[3] = real;
  786.   
  787.   begin_builtin(xcGetScreenAttribute,4,3,types);
  788.   
  789.   if(GetScreenAttribute(DISP(0),DRAW(1),val[2],&attr))
  790.     {
  791.       unify_real_result(args[3],(REAL) attr);
  792.       success = TRUE;
  793.     }
  794.   else
  795.     {
  796.       Errorline("could not get screen attribute in %P.\n",g);
  797.       success = FALSE;
  798.     }
  799.   
  800.   end_builtin();
  801. }
  802.  
  803.  
  804. /*****************************************************************/
  805. /******** xcCloseConnection
  806.   
  807.   xcCloseConnection(+Connection)
  808.   
  809.   Close the connection.
  810.   
  811.   */
  812.  
  813. long xcCloseConnection()
  814.      
  815. {
  816.   include_var_builtin(1);
  817.   ptr_definition types[1];
  818.   
  819.   
  820.   types[0] = real;
  821.   
  822.   begin_builtin(xcCloseConnection,1,1,types);
  823.   
  824.   XCloseDisplay(DISP(0));
  825.   success = TRUE;
  826.   
  827.   end_builtin();
  828. }
  829.  
  830.  
  831.  
  832. /*****************************************************************/
  833. /******** xcCreateSimpleWindow
  834.   
  835.   xcCreateSimpleWindow(+Display,+Parent,+X,+Y,+Width,+Height,
  836.   +BackGroundColor,+WindowTitle,+IconTitle,
  837.   +BorderWidth,+BorderColor,
  838.   +Permanent,+Show,-Window)
  839.   
  840.   create a simple window.
  841.   
  842.   */
  843.  
  844. long xcCreateSimpleWindow()
  845.      
  846. {
  847.   include_var_builtin(14);
  848.   ptr_definition types[14];
  849.   Window window;
  850.   Pixmap life_icon;
  851.   XSizeHints hints;
  852.   XWindowChanges changes;
  853.   unsigned long changesMask;
  854.   XSetWindowAttributes attributes;
  855.   unsigned long attributesMask;
  856.   long j;
  857.   long permanent,show;
  858.   Display *display;
  859.   GC gc;
  860.   XGCValues gcvalues;
  861.   ptr_psi_term psiWindow;
  862.   
  863.   
  864.   for(j = 0; j < 14; j++)
  865.     types[j] = real;
  866.   types[7]= quoted_string;
  867.   types[8]= quoted_string;
  868.   types[11]= boolean;
  869.   types[12]= boolean;
  870.   
  871.   begin_builtin(xcCreateSimpleWindow,14,13,types);
  872.   
  873.   permanent = val[11];
  874.   show = val[12];
  875.   
  876.   if(window = XCreateSimpleWindow(DISP(0),WIND(1),/* display,parent */
  877.                     val[2],val[3],/* X,Y */
  878.                     val[4],val[5],/* Width,Height */
  879.                     val[9],val[10],/* BorderWidth,BorderColor */
  880.                     val[6]))        /* BackGround */
  881.     {
  882.       psiWindow = stack_psi_term(4);
  883.       psiWindow->type = xwindow;
  884.       bk_stack_add_int_attr(psiWindow,"id",window);
  885.       
  886.       /* attach the icon of life */
  887.       life_icon = XCreateBitmapFromData(DISP(0),window,life_icon_bits,
  888.                      life_icon_width,life_icon_height);
  889.       /* set properties */
  890. #if 0
  891.       hints.x = val[2];
  892.       hints.y = val[3];
  893.       hints.width =val[4] ;
  894.       hints.height = val[5];
  895.       hints.flags = PPosition | PSize;
  896. #endif
  897.       hints.flags = 0;
  898.       XSetStandardProperties(DISP(0),window,
  899.                  STRG(7),STRG(8),
  900.                  life_icon,arg_v,arg_c,
  901.                  &hints);    
  902. #if 0
  903.       changes.x = val[2];
  904.       changes.y = val[3];
  905.       changes.width =val[4] ;
  906.       changes.height = val[5];
  907.       changesMask = CWX | CWY | CWWidth | CWHeight;
  908.       display = DISP(0);
  909.       XReconfigureWMWindow(DISP(0),window,DefaultScreen(display),
  910.                 changesMask,&changes);
  911. #endif
  912.       /* set the background color */
  913.       XSetWindowBackground(DISP(0),window,val[6]);
  914. #if 0
  915.       /* set the geometry before to show the window */
  916.       XMoveResizeWindow(DISP(0),window,
  917.              val[2],val[3],val[4],val[5]);
  918. #endif
  919.       /* set the back pixel in order to have the color when deiconify */
  920.       attributes.background_pixel = val[6];
  921.       attributes.backing_pixel = val[6];
  922.       attributesMask = CWBackingPixel|CWBackPixel;
  923.       XChangeWindowAttributes(DISP(0),window,
  924.                    attributesMask,&attributes);
  925.       
  926.       if(!permanent)
  927.     {
  928.       push_window(destroy_window,DISP(0),window);
  929.       x_window_creation = TRUE;
  930.     }
  931.       else
  932.     if(show)
  933.       push_window(show_window,DISP(0),window);
  934.       
  935. #if 0
  936.       /* map window is made in xCreateWindow(see xpred.lf) */
  937.       /* due to the flag overrideRedirect */
  938.       if(show)
  939.     x_show_window(DISP(0),window);
  940. #endif
  941.       
  942.       /* create a GC on the window for the next outputs */
  943.       gcvalues.cap_style = CapRound;
  944.       gcvalues.join_style = JoinRound;
  945.       gc = XCreateGC(DISP(0),window,GCJoinStyle|GCCapStyle,&gcvalues);
  946.       bk_change_psi_attr(psiWindow,"graphic_context",
  947.               NewPsi(xgc,"id",gc));
  948.       
  949.       /* init a display list on the window for the refresh window */
  950.       bk_change_psi_attr(psiWindow,"display_list",
  951.               NewPsi(xdisplaylist,"id",x_display_list()));
  952.       
  953.       /* init a pixmap on the window for the refresh mechanism */
  954.       bk_change_psi_attr(psiWindow,"pixmap",
  955.               NewPsi(xpixmap,"id",NULL));
  956.       ResizePixmap(psiWindow,DISP(0),window,val[4],val[5]);
  957.       
  958.       push_goal(unify,psiWindow,args[13],NULL);
  959.       success = TRUE;
  960.     }
  961.   else
  962.     {
  963.       Errorline("could not create a simple window in %P.\n",g);
  964.       success = FALSE;
  965.     }
  966.   
  967.   end_builtin();
  968. }
  969.  
  970.  
  971. /*****************************************************************/
  972. #if 0
  973.  
  974. xcCreateWindow is not used anymore since we use xcCreateSimpleWindow.
  975.   I just keep this code in case - jch - Thu Aug  6 16:11:23 MET DST 1992
  976.   
  977.   /******** xcCreateWindow
  978.     
  979.     xcCreateWindow(+Connection,+Parent,+X,+Y,+Width,+Height,
  980.     +BorderWidth,+Depth,+Class,+Visual,
  981.     +Permanent,+Show,-Window)
  982.     
  983.     create a window on the display Connection.
  984.     
  985.     */
  986.   
  987.   long xcCreateWindow()
  988.  
  989. {
  990.   include_var_builtin(13);
  991.   ptr_definition types[13];
  992.   Window window;
  993.   XWindowChanges changes;
  994.   unsigned long changesMask;
  995.   XSizeHints hints;
  996.   long j,permanent,show;
  997.   GC gc;
  998.   XGCValues gcvalues;
  999.   
  1000.   
  1001.   for(j = 0; j < 13; j++)
  1002.     types[j] = real;
  1003.   
  1004.   begin_builtin(xcCreateWindow,13,12,types);
  1005.   
  1006.   permanent = val[10];
  1007.   show = val[11];
  1008.   
  1009.   if(window = XCreateWindow(DISP(0),WIND(1),/* display,parent */
  1010.                   val[2],val[3],/* X,Y */
  1011.                   val[4],val[5],/* Width,Height */
  1012.                   val[6],val[7],/* BorderWidth,Depth */
  1013.                   val[8],val[9],/* Class,Visual */
  1014.                   0,(XSetWindowAttributes *) NULL))
  1015.     {
  1016.       unify_real_result(args[12],(REAL) window);
  1017.       
  1018.       changes.x = val[2];
  1019.       changes.y = val[3];
  1020.       changes.width =val[4] ;
  1021.       changes.height = val[5];
  1022.       changesMask = CWX | CWY | CWWidth | CWHeight;
  1023.       XConfigureWindow(DISP(0),window,changesMask,&changes);
  1024.       
  1025.       hints.x = val[2];
  1026.       hints.y = val[3];
  1027.       hints.width =val[4] ;
  1028.       hints.height = val[5];
  1029.       hints.flags = PPosition | PSize;
  1030.       XSetNormalHints(DISP(0),window,&hints);
  1031.       
  1032.       if(!permanent)
  1033.     {
  1034.       push_window(destroy_window,DISP(0),window);
  1035.       x_window_creation = TRUE;
  1036.     }
  1037.       else
  1038.     if(show)
  1039.       push_window(show_window,DISP(0),window);
  1040.       
  1041.       if(show)
  1042.     x_show_window(DISP(0),window);
  1043.       
  1044.       /* create a GC on the window for the next outputs */
  1045.       gcvalues.cap_style = CapRound;
  1046.       gcvalues.join_style = JoinRound;
  1047.       gc = XCreateGC(DISP(0),window,GCJoinStyle|GCCapStyle,&gcvalues);
  1048.       bk_stack_add_int_attr(args[12],"gc",gc);
  1049.       
  1050.       /* init a display list on the window for the refresh window */
  1051.       bk_stack_add_int_attr(args[12],"display_list",NULL);
  1052.       
  1053.       success = TRUE;
  1054.     }
  1055.   else
  1056.     {
  1057.       Errorline("could not create window in %P.\n",g);
  1058.       success = FALSE;
  1059.     }
  1060.   
  1061.   end_builtin();
  1062. }
  1063.  
  1064. #endif
  1065.  
  1066.  
  1067. /*****************************************************************/
  1068. /******** xcSetStandardProperties
  1069.   
  1070.   xcSetStandardProperties(+Display,+Window,+WindowTitle,+IconTitle,
  1071.   +X,+Y,+Width,+Height)
  1072.   
  1073.   */
  1074.  
  1075. long xcSetStandardProperties()
  1076. {
  1077.   include_var_builtin(8);
  1078.   ptr_definition types[8];
  1079.   long j;
  1080.   XSizeHints hints;
  1081.   
  1082.   
  1083.   for(j=0; j<8; j++)
  1084.     types[j] = real;
  1085.   types[1] = xwindow;
  1086.   types[2] = quoted_string;
  1087.   types[3] = quoted_string;
  1088.   
  1089.   begin_builtin(xcSetStandardProperties,8,8,types);
  1090.   
  1091.   hints.x = val[4];
  1092.   hints.y = val[5];
  1093.   hints.width = val[6] ;
  1094.   hints.height = val[7];
  1095.   hints.flags = PPosition | PSize; 
  1096.   
  1097.   XSetStandardProperties(DISP(0),WIND(1),
  1098.             (char*)val[2],(char*)val[3],/* window title,icon title */
  1099.              None,              /* icon pixmap */
  1100.             (char **) NULL,0, /* argv,argc */
  1101.              &hints); 
  1102.   
  1103.   ResizePixmap(args[1],val[0],val[1],val[6],val[7]);
  1104.   
  1105.   success = TRUE;
  1106.   
  1107.   end_builtin();
  1108.   
  1109. }
  1110.  
  1111.  
  1112.  
  1113. /*****************************************************************/
  1114. /******** xcGetWindowGeometry
  1115.   
  1116.   xcGetWindowGeometry(+Display,+Window,-X,-Y,-Width,-Height)
  1117.   
  1118.   returns the geometry of the window.
  1119.   
  1120.   */
  1121.  
  1122. long xcGetWindowGeometry()
  1123.      
  1124. {
  1125.   include_var_builtin(6);
  1126.   ptr_definition types[6];
  1127.   int j,x,y;
  1128.   unsigned int w,h,bw,d;
  1129.   Window r;
  1130.   
  1131.   
  1132.   for(j=0; j<6; j++)
  1133.     types[j] = real;
  1134.   types[1] = xdrawable;
  1135.   
  1136.   begin_builtin(xcGetWindowGeometry,6,2,types);
  1137.   
  1138.   if(XGetGeometry(DISP(0),DRAW(1),
  1139.             &r,&x,&y,&w,&h,&bw,&d))
  1140.     {
  1141.       unify_real_result(args[2],(REAL) x);
  1142.       unify_real_result(args[3],(REAL) y);
  1143.       unify_real_result(args[4],(REAL) w);
  1144.       unify_real_result(args[5],(REAL) h);
  1145.       success = TRUE;
  1146.     }
  1147.   else
  1148.     {
  1149.       Errorline("could not get the geometry in %P.\n",g);
  1150.       success = FALSE;
  1151.     }
  1152.   
  1153.   end_builtin();
  1154. }
  1155.  
  1156.  
  1157. /*****************************************************************/
  1158. /******** GetWindowAttribute */
  1159.  
  1160. static long GetWindowAttribute(display,window,attributeId,attribute)
  1161.      
  1162.      Display *display; long window,attributeId,*attribute;
  1163. {
  1164.   XWindowAttributes windowAttributes;
  1165.   
  1166.   
  1167.   XGetWindowAttributes(display,window,&windowAttributes);
  1168.   switch(attributeId) 
  1169.     {
  1170.     case 0: 
  1171.       *attribute = windowAttributes.x;    
  1172.       break;
  1173.     case 1: 
  1174.       *attribute = windowAttributes.y;
  1175.       break;
  1176.     case 2: 
  1177.       *attribute = windowAttributes.width;
  1178.       break;
  1179.     case 3: 
  1180.       *attribute = windowAttributes.height;
  1181.       break;
  1182.     case 4: 
  1183.       *attribute = windowAttributes.border_width;
  1184.       break;
  1185.     case 5: 
  1186.       *attribute = windowAttributes.depth;
  1187.       break;
  1188.     case 6: 
  1189.       *attribute = windowAttributes.root;
  1190.       break;
  1191.     case 7: 
  1192.       *attribute =(unsigned long)windowAttributes.screen;
  1193.       break;
  1194.     case 8: 
  1195.       *attribute =(unsigned long)windowAttributes.visual;
  1196.       break;
  1197.     case 9: 
  1198.       *attribute = windowAttributes.class;
  1199.       break;
  1200.     case 10: 
  1201.       *attribute = windowAttributes.all_event_masks;
  1202.       break;
  1203.     case 11: 
  1204.       *attribute = windowAttributes.bit_gravity;
  1205.       break;
  1206.     case 12: 
  1207.       *attribute = windowAttributes.win_gravity;
  1208.       break;
  1209.     case 13: 
  1210.       *attribute = windowAttributes.backing_store;
  1211.       break;
  1212.     case 14: 
  1213.       *attribute = windowAttributes.backing_planes;
  1214.       break;
  1215.     case 15: 
  1216.       *attribute = windowAttributes.backing_pixel;
  1217.       break;
  1218.     case 16: 
  1219.       *attribute = windowAttributes.override_redirect;
  1220.       break;
  1221.     case 17: 
  1222.       *attribute = windowAttributes.save_under;
  1223.       break;
  1224.     case 18: 
  1225.       *attribute = windowAttributes.your_event_mask;
  1226.       break;
  1227.     case 19: 
  1228.       *attribute = windowAttributes.do_not_propagate_mask;
  1229.       break;
  1230.     case 20: 
  1231.       *attribute = windowAttributes.colormap;
  1232.       break;
  1233.     case 21: 
  1234.       *attribute = windowAttributes.map_installed;
  1235.       break;
  1236.     case 22: 
  1237.       *attribute = windowAttributes.map_state;
  1238.       break;
  1239.     default: 
  1240.       return FALSE;
  1241.       break;
  1242.     }
  1243.   return TRUE;
  1244. }
  1245.  
  1246.  
  1247. /*****************************************************************/
  1248. /******** xcGetWindowAttribute
  1249.   
  1250.   xcGetWindowAttribute(+Display,+Window,+AttributeId,-Value)
  1251.   
  1252.   returns the value corresponding to the attribute id of the window.
  1253.   
  1254.   */
  1255.  
  1256. long xcGetWindowAttribute()
  1257.      
  1258. {
  1259.   include_var_builtin(4);
  1260.   ptr_definition types[4];
  1261.   long attr;
  1262.   
  1263.   
  1264.   types[0] = real;
  1265.   types[1] = xwindow;
  1266.   types[2] = real;
  1267.   types[3] = real;
  1268.   
  1269.   begin_builtin(xcGetWindowAttribute,4,3,types);
  1270.   
  1271.   if(GetWindowAttribute(DISP(0),WIND(1),val[2],&attr))
  1272.     {
  1273.       unify_real_result(args[3],(REAL) attr);
  1274.       success = TRUE;
  1275.     }
  1276.   else
  1277.     {
  1278.       Errorline("could not get a window attribute in %P.\n",g);
  1279.       success = FALSE;
  1280.     }
  1281.   
  1282.   end_builtin();
  1283. }
  1284.  
  1285.  
  1286. /*****************************************************************/
  1287. /******** xcSetWindowGeometry
  1288.   
  1289.   xcSetWindowGeometry(+Display,+Window,+X,+Y,+Width,+Height)
  1290.   
  1291.   set the geometry of the window.
  1292.   
  1293.   */
  1294.  
  1295. long xcSetWindowGeometry()
  1296.      
  1297. {
  1298.   include_var_builtin(6);
  1299.   ptr_definition types[6];
  1300.   long j;
  1301.   
  1302.   
  1303.   for(j=0; j<6; j++)
  1304.     types[j] = real;
  1305.   types[1] = xdrawable;
  1306.   
  1307.   begin_builtin(xcSetWindowGeometry,6,6,types);
  1308.   
  1309.   XMoveResizeWindow(DISP(0),DRAW(1),
  1310.              val[2],val[3],val[4],val[5]);
  1311.   
  1312.   /* modify the pixmap */
  1313.   ResizePixmap(args[1],val[0],val[1],val[4],val[5]);
  1314.   
  1315.   success = TRUE;
  1316.   
  1317.   end_builtin();
  1318. }
  1319.  
  1320.  
  1321.  
  1322. /*****************************************************************/
  1323. /******** xcMoveWindow
  1324.   
  1325.   xcMoveWindow(+Display,+Window,+X,+Y)
  1326.   
  1327.   Move a window to a different location.
  1328.   
  1329.   */
  1330.  
  1331. long xcMoveWindow()   /*  RM: May  4 1993  */
  1332.      
  1333. {
  1334.   include_var_builtin(4);
  1335.   ptr_definition types[4];
  1336.   long j;
  1337.   
  1338.   
  1339.   for(j=0; j<4; j++)
  1340.     types[j] = real;
  1341.   types[1] = xdrawable;
  1342.   
  1343.   begin_builtin(xcMoveWindow,4,4,types);
  1344.   
  1345.   XMoveWindow(DISP(0),DRAW(1), val[2],val[3]);
  1346.   
  1347.   success = TRUE;
  1348.   
  1349.   end_builtin();
  1350. }
  1351.  
  1352.  
  1353.  
  1354. /*****************************************************************/
  1355. /******** SetWindowAttribute */
  1356.  
  1357. static long SetWindowAttribute(psi_window,display,window,attributeId,attribute)
  1358.      
  1359.      ptr_psi_term psi_window;
  1360.      Display *display;
  1361.      Drawable window;
  1362.      unsigned long attributeId,attribute;
  1363.      
  1364. {
  1365.   XSetWindowAttributes attributes;
  1366.   XWindowChanges changes;
  1367.   unsigned long attributesMask = 0;
  1368.   unsigned long changesMask = 0;
  1369.   long backgroundChange = FALSE;
  1370.   long sizeChange = FALSE;
  1371.   unsigned int width,height;
  1372.   int x,y;
  1373.   unsigned int bw,d;
  1374.   Window r;
  1375.   
  1376.   switch(attributeId) 
  1377.     {
  1378.     case 0: 
  1379.       changes.x = attribute;
  1380.       changesMask |= CWX;
  1381.       break;
  1382.     case 1:
  1383.       changes.y = attribute;
  1384.       changesMask |= CWY;
  1385.       break;
  1386.     case 2:
  1387.       changes.width = attribute;
  1388.       changesMask |= CWWidth;
  1389.       XGetGeometry(display,window,&r,&x,&y,&width,&height,&bw,&d);
  1390.       width = attribute;
  1391.       sizeChange = TRUE;
  1392.       break;
  1393.     case 3:
  1394.       changes.height = attribute;
  1395.       changesMask |= CWHeight;
  1396.       XGetGeometry(display,window,&r,&x,&y,&width,&height,&bw,&d);
  1397.       height = attribute;
  1398.       sizeChange = TRUE;
  1399.       break;
  1400.     case 4:
  1401.       changes.border_width = attribute;
  1402.       changesMask |= CWBorderWidth;
  1403.       break;
  1404.     case 11:
  1405.       attributes.bit_gravity = attribute;
  1406.       attributesMask |= CWBitGravity;
  1407.       break;
  1408.     case 12:
  1409.       attributes.win_gravity = attribute;
  1410.       attributesMask |= CWWinGravity;
  1411.       break;
  1412.     case 13:
  1413.       attributes.backing_store = attribute;
  1414.       attributesMask |= CWBackingStore;
  1415.       break;
  1416.     case 14:
  1417.       attributes.backing_planes = attribute;
  1418.       attributesMask |= CWBackingPlanes;
  1419.       break;
  1420.     case 15:
  1421.       attributes.backing_pixel = attribute;
  1422.       attributesMask |= CWBackingPixel;
  1423.       break;
  1424.     case 16:
  1425.       attributes.override_redirect = attribute;
  1426.       attributesMask |= CWOverrideRedirect;
  1427.       break;
  1428.     case 17:
  1429.       attributes.save_under = attribute;
  1430.       attributesMask |= CWSaveUnder;
  1431.       break;
  1432.     case 18:
  1433.       attributes.event_mask = attribute;
  1434.       attributesMask |= CWEventMask;
  1435.       break;
  1436.     case 19:
  1437.       attributes.do_not_propagate_mask = attribute;
  1438.       attributesMask |= CWDontPropagate;
  1439.       break;
  1440.     case 20:
  1441.       attributes.colormap = attribute;
  1442.       attributesMask |= CWColormap;
  1443.       break;
  1444.     case 23:
  1445.       changes.sibling = attribute;
  1446.       changesMask |= CWSibling;
  1447.       break;
  1448.     case 24:
  1449.       changes.stack_mode = attribute;
  1450.       changesMask |= CWStackMode;
  1451.       break;
  1452.     case 25:
  1453.       attributes.background_pixmap = attribute;
  1454.       attributesMask |= CWBackPixmap;
  1455.       break;
  1456.     case 26:
  1457.       attributes.background_pixel = attribute;
  1458.       attributesMask |= CWBackPixel;
  1459.       backgroundChange = TRUE;
  1460.       
  1461.       /* change the backing_pixel in order to fill the pixmap with */
  1462.       attributes.backing_pixel = attribute;
  1463.       attributesMask |= CWBackingPixel;
  1464.       break;
  1465.     case 27:
  1466.       attributes.border_pixmap = attribute;
  1467.       attributesMask |= CWBorderPixmap;
  1468.       break;
  1469.     case 28:
  1470.       attributes.border_pixel = attribute;
  1471.       attributesMask |= CWBorderPixel;
  1472.       break;
  1473.     case 29:
  1474.       attributes.cursor = attribute;
  1475.       attributesMask |= CWCursor;
  1476.       break;
  1477.     default: 
  1478.       return FALSE;
  1479.       break;
  1480.     }
  1481.   
  1482.   if(changesMask)
  1483.     XConfigureWindow(display,window,changesMask,&changes);
  1484.   
  1485.   if(attributesMask)
  1486.     XChangeWindowAttributes(display,window,attributesMask,&attributes);
  1487.   
  1488.   if(backgroundChange)
  1489.     XClearArea(display,window,0,0,0,0,True);
  1490.   
  1491.   if(sizeChange)
  1492.     ResizePixmap(psi_window,display,window,width,height);
  1493.   
  1494.   return TRUE;
  1495. }
  1496.  
  1497.  
  1498. /*****************************************************************/
  1499. /******** xcSetWindowAttribute
  1500.   
  1501.   xcSetWindowAttribute(+Display,+Window,+AttributeId,+Value)
  1502.   
  1503.   set the value corresponding to the attribute id.
  1504.   
  1505.   */
  1506.  
  1507. long xcSetWindowAttribute()
  1508.      
  1509. {
  1510.   include_var_builtin(4);
  1511.   ptr_definition types[4];
  1512.   
  1513.   
  1514.   types[0] = real;
  1515.   types[1] = xwindow;
  1516.   types[2] = real;
  1517.   types[3] = real;
  1518.   
  1519.   begin_builtin(xcSetWindowAttribute,4,4,types);
  1520.   
  1521.   if(SetWindowAttribute(args[1],val[0],val[1],val[2],val[3]))
  1522.     {
  1523.       XSync(DISP(0),0);
  1524.       success = TRUE;
  1525.     }
  1526.   else
  1527.     {
  1528.       Errorline("could not set window attribute in %P.\n",g);
  1529.       success = FALSE;
  1530.     }
  1531.   
  1532.   end_builtin();
  1533. }
  1534.  
  1535.  
  1536.  
  1537. /*****************************************************************/
  1538. /******** xcMapWindow
  1539.   
  1540.   xcMapWindow(+Connection,+Window)
  1541.   
  1542.   map the Window on the display Connection.
  1543.   
  1544.   */
  1545.  
  1546. long xcMapWindow()
  1547.      
  1548. {
  1549.   include_var_builtin(2);
  1550.   ptr_definition types[2];
  1551.   
  1552.   
  1553.   types[0] = real;
  1554.   types[1] = real;
  1555.   
  1556.   begin_builtin(xcMapWindow,2,2,types);
  1557.   
  1558.   XMapWindow(DISP(0),WIND(1));
  1559.   XSync(DISP(0),0);
  1560.   
  1561.   push_window(hide_window,DISP(0),val[1]);
  1562.   success = TRUE;
  1563.   
  1564.   end_builtin();
  1565. }
  1566.  
  1567.  
  1568.  
  1569. /*****************************************************************/
  1570. /******** xcRaiseWindow
  1571.   
  1572.   xcRaiseWindow(+Connection,+Window)
  1573.   
  1574.   raise the Window on the display Connection.
  1575.   
  1576.   */
  1577.  
  1578. long xcRaiseWindow()
  1579.      
  1580. {
  1581.   include_var_builtin(2);
  1582.   ptr_definition types[2];
  1583.   
  1584.   
  1585.   types[0] = real;
  1586.   types[1] = real;
  1587.   
  1588.   begin_builtin(xcRaiseWindow,2,2,types);
  1589.   
  1590.   XRaiseWindow(DISP(0),WIND(1));
  1591.   XSync(DISP(0),0);
  1592.   
  1593.   push_window(hide_window,DISP(0),WIND(1));
  1594.   success = TRUE;
  1595.   
  1596.   end_builtin();
  1597. }
  1598.  
  1599.  
  1600.  
  1601. /*****************************************************************/
  1602. /******** xcUnmapWindow
  1603.   
  1604.   xcUnmapWindow(+Connection,+Window)
  1605.   
  1606.   unmap the Window on the display Connection.
  1607.   
  1608.   */
  1609.  
  1610. long xcUnmapWindow()
  1611.      
  1612. {
  1613.   include_var_builtin(2);
  1614.   ptr_definition types[2];
  1615.   
  1616.   
  1617.   types[0] = real;
  1618.   types[1] = real;
  1619.   
  1620.   begin_builtin(xcUnmapWindow,2,2,types);
  1621.   
  1622.   XUnmapWindow(DISP(0),WIND(1));
  1623.   XSync(DISP(0),0);
  1624.   
  1625.   push_window(show_window,DISP(0),WIND(1));
  1626.   success = TRUE;
  1627.   
  1628.   end_builtin();
  1629. }
  1630.  
  1631.  
  1632.  
  1633.  
  1634.  
  1635.  
  1636. /*** RM 8/12/92 START ***/
  1637.  
  1638.  
  1639. /*****************************************************************/
  1640. /******** xcMapSubwindows
  1641.   
  1642.   xcMapSubwindows(+Connection,+Window)
  1643.   
  1644.   map the sub-windows on the display Connection.
  1645.   
  1646.   */
  1647.  
  1648. long xcMapSubwindows()
  1649.      
  1650. {
  1651.   include_var_builtin(2);
  1652.   ptr_definition types[2];
  1653.   
  1654.   
  1655.   types[0] = real;
  1656.   types[1] = real;
  1657.   
  1658.   begin_builtin(xcMapSubwindow,2,2,types);
  1659.   
  1660.   XMapSubwindows(DISP(0),WIND(1));
  1661.   XSync(DISP(0),0);
  1662.   
  1663.   push_window(hide_subwindow,DISP(0),WIND(1));
  1664.   success = TRUE;
  1665.   
  1666.   end_builtin();
  1667. }
  1668.  
  1669.  
  1670.  
  1671. /*****************************************************************/
  1672. /******** xcUnmapSubwindows
  1673.   
  1674.   xcUnmapSubwindows(+Connection,+Window)
  1675.   
  1676.   unmap the sub-windows on the display Connection.
  1677.   
  1678.   */
  1679.  
  1680. long xcUnmapSubwindows()
  1681.      
  1682. {
  1683.   include_var_builtin(2);
  1684.   ptr_definition types[2];
  1685.   
  1686.   
  1687.   types[0] = real;
  1688.   types[1] = real;
  1689.   
  1690.   begin_builtin(xcUnmapSubwindows,2,2,types);
  1691.   
  1692.   XUnmapSubwindows(DISP(0),WIND(1));
  1693.   XSync(DISP(0),0);
  1694.   
  1695.   push_window(show_subwindow,DISP(0),WIND(1));
  1696.   success = TRUE;
  1697.   
  1698.   end_builtin();
  1699. }
  1700.  
  1701.  
  1702. /*** RM 8/12/82 END ***/
  1703.  
  1704.  
  1705.  
  1706.  
  1707.  
  1708. /*****************************************************************/
  1709. /******** xcClearWindow
  1710.   
  1711.   xcClearWindow(+Connection,+Window)
  1712.   
  1713.   clear the Window on the display Connection.
  1714.   
  1715.   */
  1716.  
  1717. long xcClearWindow()
  1718.      
  1719. {
  1720.   include_var_builtin(2);
  1721.   ptr_definition types[2];
  1722.   
  1723.   
  1724.   types[0] = real;
  1725.   types[1] = xwindow;
  1726.   
  1727.   begin_builtin(xcClearWindow,2,2,types);
  1728.   
  1729.   XClearWindow(DISP(0),WIND(1));
  1730. XSync(DISP(0),0);
  1731.   
  1732.   x_free_display_list(WindowDisplayList(args[1]));
  1733.   success = TRUE;
  1734.   
  1735.   end_builtin();
  1736. }
  1737.  
  1738.  
  1739.  
  1740. /*****************************************************************/
  1741. /******** xcResizeWindowPixmap
  1742.   
  1743.   xcResizeWindowPixmap(+Display,+Window,+Width,+Height)
  1744.   
  1745.   resize the pixmap of the window,useful when we caught the resize event
  1746.   eg: the window is resized manualy.
  1747.   
  1748.   */
  1749.  
  1750. long xcResizeWindowPixmap()
  1751.      
  1752. {
  1753.   include_var_builtin(4);
  1754.   ptr_definition types[4];
  1755.   long j;
  1756.   
  1757.   
  1758.   for(j=0; j<4; j++)
  1759.     types[j] = real;
  1760.   types[1] = xdrawable;
  1761.   
  1762.   begin_builtin(xcResizeWindowPixmap,4,4,types);
  1763.   
  1764.   /* modify the pixmap */
  1765.   ResizePixmap(args[1],val[0],val[1],val[2],val[3]);
  1766.   
  1767.   success = TRUE;
  1768.   
  1769.   end_builtin();
  1770. }
  1771.  
  1772.  
  1773.  
  1774. /*****************************************************************/
  1775. /******** xcSelectInput
  1776.   
  1777.   xcSelectInput(+Connection,+Window,+Mask)
  1778.   
  1779.   select the desired event types
  1780.   
  1781.   */
  1782.  
  1783. long xcSelectInput()
  1784.      
  1785. {
  1786.   include_var_builtin(3);
  1787.   ptr_definition types[3];
  1788.   
  1789.   
  1790.   types[0] = real;
  1791.   types[1] = real;
  1792.   types[2] = real;
  1793.   
  1794.   begin_builtin(xcSelectInput,3,3,types);
  1795.   
  1796.   XSelectInput(DISP(0),WIND(1),val[2]);
  1797.   success = TRUE;
  1798.   
  1799.   end_builtin();
  1800. }
  1801.  
  1802.  
  1803.  
  1804. /*****************************************************************/
  1805. /******** xcRefreshWindow
  1806.   
  1807.   
  1808.   xcRefreshWindow(+Connection,+Window)
  1809.   
  1810.   refresh the window
  1811.   
  1812.   */
  1813.  
  1814. long xcRefreshWindow()
  1815.      
  1816. {
  1817.   include_var_builtin(2);
  1818.   ptr_definition types[2];
  1819.   Pixmap pixmap;
  1820.   ptr_psi_term psiPixmap;
  1821.   
  1822.   
  1823.   types[0] = real;
  1824.   types[1] = xwindow;
  1825.   
  1826.   begin_builtin(xcRefreshWindow,2,2,types);
  1827.   
  1828.   psiPixmap = GetPsiAttr(args[1],"pixmap");
  1829.   if((pixmap =(Pixmap) GetIntAttr(psiPixmap,"id")) != 0)
  1830.     x_refresh_window(val[0],val[1],pixmap,
  1831.               DrawableGC(psiPixmap),
  1832.               WindowDisplayList(args[1]));
  1833.   else
  1834.     x_refresh_window(val[0],val[1],val[1],
  1835.               DrawableGC(args[1]),
  1836.               WindowDisplayList(args[1]));
  1837.   
  1838.   success = TRUE;
  1839.   
  1840.   end_builtin();
  1841. }
  1842.  
  1843.  
  1844.  
  1845. /*****************************************************************/
  1846. /******** xcPostScriptWindow
  1847.   
  1848.   
  1849.   xcPostScriptWindow(+Display,+Window,Filename)
  1850.   
  1851.   output the contents of the window in Filename
  1852.   
  1853.   */
  1854.  
  1855. long xcPostScriptWindow()
  1856.      
  1857. {
  1858.   include_var_builtin(3);
  1859.   ptr_definition types[3];
  1860.   
  1861.   
  1862.   types[0] = real;
  1863.   types[1] = xwindow;
  1864.   types[2] = quoted_string;
  1865.   
  1866.   begin_builtin(xcPostScriptWindow,3,3,types);
  1867.   
  1868.   success = x_postscript_window(val[0],val[1],
  1869.                  GetIntAttr(GetPsiAttr(args[1],"display_list"),
  1870.                          "id"),
  1871.                  val[2]);
  1872.   
  1873.   end_builtin();
  1874. }
  1875.  
  1876.  
  1877.  
  1878. /*****************************************************************/
  1879. /******** xcDestroyWindow
  1880.   
  1881.   
  1882.   xcDestroyWindow(+Connection,+Window)
  1883.   
  1884.   Close and destroy the window(unbacktrable).
  1885.   
  1886.   */
  1887.  
  1888. long xcDestroyWindow()
  1889.      
  1890. {
  1891.   include_var_builtin(2);
  1892.   ptr_definition types[2];
  1893.   ptr_psi_term psi;
  1894.   
  1895.   types[0] = real;
  1896.   types[1] = xwindow;
  1897.   
  1898.   begin_builtin(xcDestroyWindow,2,2,types);
  1899.   
  1900.   psi = GetPsiAttr(args[1],"permanent");
  1901.   if(!strcmp(psi->type->keyword->symbol,"true"))
  1902.     {
  1903.       Errorline("cannot destroy a permanent window.\n");
  1904.       exit_life(TRUE); /* was: main_loop_ok=FALSE; - jch */
  1905.       success = FALSE;
  1906.     }
  1907.   else
  1908.     {
  1909.       FreeWindow(val[0],args[1]);
  1910.       XDestroyWindow(DISP(0),WIND(1));
  1911. XSync(DISP(0),0);
  1912.       clean_undo_window(DISP(0),WIND(1));
  1913.       success = TRUE;
  1914.     }
  1915.   
  1916.   end_builtin();
  1917. }
  1918.  
  1919.  
  1920.  
  1921. /*****************************************************************/
  1922. /******** CREATEGC
  1923.   
  1924.   xcCreateGC(+Connection,+Drawable,-GC)
  1925.   
  1926.   create a graphic context.
  1927.   
  1928.   */
  1929.  
  1930. long xcCreateGC()
  1931.      
  1932. {
  1933.   include_var_builtin(3);
  1934.   ptr_definition types[3];
  1935.   GC gc;
  1936.   XGCValues GCvalues;
  1937.   
  1938.   
  1939.   types[0] = real;
  1940.   types[1] = xdrawable;
  1941.   types[2] = real;
  1942.   
  1943.   begin_builtin(xcCreateGC,3,2,types);
  1944.   
  1945.   if(gc = XCreateGC(DISP(0),WIND(1),0,&GCvalues))  /* RM: Feb  7 1994 */
  1946.     {
  1947.       unify_real_result(args[2],(REAL)(unsigned long) gc);
  1948.       success = TRUE;
  1949.     }
  1950.   else
  1951.     {
  1952.       Errorline("could not create gc in %P.\n",g);
  1953.       success = FALSE;
  1954.     }
  1955.   
  1956.   end_builtin();
  1957. }
  1958.  
  1959.  
  1960.  
  1961. /*****************************************************************/
  1962. /******** GETGCATTRIBUTE */
  1963.  
  1964. static long GetGCAttribute(gc,attributeId,attribute)
  1965.      
  1966.      GC gc;
  1967.      long attributeId,*attribute;
  1968.      
  1969. {
  1970. #ifndef __alpha
  1971.   switch(attributeId) 
  1972.     {
  1973.     case 0:
  1974.       *attribute = gc->values.function;
  1975.       break;
  1976.     case 1:
  1977.       *attribute = gc->values.plane_mask;
  1978.       break;
  1979.     case 2:
  1980.       *attribute = gc->values.foreground;
  1981.       break;
  1982.     case 3:
  1983.       *attribute = gc->values.background;
  1984.       break;
  1985.     case 4:
  1986.       *attribute = gc->values.line_width;
  1987.       break;
  1988.     case 5:
  1989.       *attribute = gc->values.line_style;
  1990.       break;
  1991.     case 6:
  1992.       *attribute = gc->values.cap_style;
  1993.       break;
  1994.     case 7:
  1995.       *attribute = gc->values.join_style;
  1996.       break;
  1997.     case 8:
  1998.       *attribute = gc->values.fill_style;
  1999.       break;
  2000.     case 9:
  2001.       *attribute = gc->values.fill_rule;
  2002.       break;
  2003.     case 10:
  2004.       *attribute = gc->values.tile;
  2005.       break;
  2006.     case 11:
  2007.       *attribute = gc->values.stipple;
  2008.       break;
  2009.     case 12:
  2010.       *attribute = gc->values.ts_x_origin;
  2011.       break;
  2012.     case 13:
  2013.       *attribute = gc->values.ts_y_origin;
  2014.       break;
  2015.     case 14:
  2016.       *attribute = gc->values.font;
  2017.       break;
  2018.     case 15:
  2019.       *attribute = gc->values.subwindow_mode;
  2020.       break;
  2021.     case 16:
  2022.       *attribute = gc->values.graphics_exposures;
  2023.       break;
  2024.     case 17:
  2025.       *attribute = gc->values.clip_x_origin;
  2026.       break;
  2027.     case 18:
  2028.       *attribute = gc->values.clip_y_origin;
  2029.       break;
  2030.     case 19:
  2031.       *attribute = gc->values.clip_mask;
  2032.       break;
  2033.     case 20:
  2034.       *attribute = gc->values.dash_offset;
  2035.       break;
  2036.     case 21: 
  2037.       *attribute =(unsigned char)(gc->values.dashes);
  2038.       break;
  2039.     case 22:
  2040.       *attribute = gc->values.arc_mode;
  2041.       break;
  2042.     case 23:
  2043.       *attribute = gc->rects;
  2044.       break;
  2045.     case 24:
  2046.       *attribute = gc->dashes;
  2047.       break;
  2048.     default: 
  2049.       return FALSE;
  2050.       break;
  2051.     }
  2052. #endif
  2053.   return TRUE;
  2054. }
  2055.  
  2056.  
  2057. /*****************************************************************/
  2058. /******** GETGCATTRIBUTE
  2059.   
  2060.   xcGetGCAttribute(+GC,+AttributeId,-Val)
  2061.   
  2062.   get the value of the attribute id of GC.
  2063.   
  2064.   */
  2065.  
  2066. long xcGetGCAttribute()
  2067.      
  2068. {
  2069.   include_var_builtin(3);
  2070.   ptr_definition types[3];
  2071.   long attr;
  2072.   
  2073.   
  2074.   types[0] = real;
  2075.   types[1] = real;
  2076.   types[2] = real;
  2077.   
  2078.   begin_builtin(xcGetGCAttribute,3,2,types);
  2079.   
  2080.   if(GetGCAttribute(DISP(0),GCVAL(1),&attr))
  2081.     {
  2082.       unify_real_result(args[2],(REAL) attr);
  2083.       success = TRUE;
  2084.     }
  2085.   else
  2086.     {
  2087.       Errorline("could not get gc attribute in %P.\n",g);
  2088.       success = FALSE;
  2089.     }
  2090.   
  2091.   end_builtin();
  2092. }
  2093.  
  2094.  
  2095.  
  2096. /*****************************************************************/
  2097. /******** SETGCATTRIBUTE */
  2098.  
  2099. static long SetGCAttribute(display,gc,attributeId,attribute)
  2100.      
  2101.      Display *display;
  2102.      GC gc;
  2103.      long attributeId,attribute;
  2104.      
  2105. {
  2106.   XGCValues attributes;
  2107.   unsigned long attributesMask = 0;
  2108.   
  2109.   
  2110.   switch(attributeId) 
  2111.     {
  2112.     case 0:
  2113.       attributes.function = attribute;
  2114.       attributesMask |= GCFunction;
  2115.       break;
  2116.     case 1:
  2117.       attributes.plane_mask = attribute;
  2118.       attributesMask |= GCPlaneMask;
  2119.       break;
  2120.     case 2:
  2121.       attributes.foreground = attribute;
  2122.       attributesMask |= GCForeground;
  2123.       break;
  2124.     case 3:
  2125.       attributes.background = attribute;
  2126.       attributesMask |= GCBackground;
  2127.       break;
  2128.     case 4:
  2129.       attributes.line_width = attribute;
  2130.       attributesMask |= GCLineWidth;
  2131.       break;
  2132.     case 5:
  2133.       attributes.line_style = attribute;
  2134.       attributesMask |= GCLineStyle;
  2135.       break;
  2136.     case 6:
  2137.       attributes.cap_style = attribute;
  2138.       attributesMask |= GCCapStyle;
  2139.       break;
  2140.     case 7:
  2141.       attributes.join_style = attribute;
  2142.       attributesMask |= GCJoinStyle;
  2143.       break;
  2144.     case 8:
  2145.       attributes.fill_style = attribute;
  2146.       attributesMask |= GCFillStyle;
  2147.       break;
  2148.     case 9:
  2149.       attributes.fill_rule = attribute;
  2150.       attributesMask |= GCFillRule;
  2151.       break;
  2152.     case 10:
  2153.       attributes.tile = attribute;
  2154.       attributesMask |= GCTile;
  2155.       break;
  2156.     case 11:
  2157.       attributes.stipple = attribute;
  2158.       attributesMask |= GCStipple;
  2159.       break;
  2160.     case 12:
  2161.       attributes.ts_x_origin = attribute;
  2162.       attributesMask |= GCTileStipXOrigin;
  2163.       break;
  2164.     case 13:
  2165.       attributes.ts_y_origin = attribute;
  2166.       attributesMask |= GCTileStipYOrigin;
  2167.       break;
  2168.     case 14:
  2169.       attributes.font = attribute;
  2170.       attributesMask |= GCFont;
  2171.       break;
  2172.     case 15:
  2173.       attributes.subwindow_mode = attribute;
  2174.       attributesMask |= GCSubwindowMode;
  2175.       break;
  2176.     case 16:
  2177.       attributes.graphics_exposures = attribute;
  2178.       attributesMask |= GCGraphicsExposures;
  2179.       break;
  2180.     case 17:
  2181.       attributes.clip_x_origin = attribute;
  2182.       attributesMask |= GCClipXOrigin;
  2183.       break;
  2184.     case 18:
  2185.       attributes.clip_y_origin = attribute;
  2186.       attributesMask |= GCClipYOrigin;
  2187.       break;
  2188.     case 19:
  2189.       attributes.clip_mask = attribute;
  2190.       attributesMask |= GCClipMask;
  2191.       break;
  2192.     case 20:
  2193.       attributes.dash_offset = attribute;
  2194.       attributesMask |= GCDashOffset;
  2195.       break;
  2196.     case 21: 
  2197.       attributes.dashes =(char)(0xFF & attribute);
  2198.       attributesMask |= GCDashList;
  2199.       break;
  2200.     case 22:
  2201.       attributes.arc_mode = attribute;
  2202.       attributesMask |= GCArcMode;
  2203.       break;
  2204.     default: 
  2205.       return FALSE;
  2206.       break;
  2207.     }
  2208.   
  2209.   XChangeGC(display,gc,attributesMask,&attributes);
  2210.   return TRUE;
  2211. }
  2212.  
  2213.  
  2214. /*****************************************************************/
  2215. /******** SETGCATTRIBUTE
  2216.   
  2217.   xcSetGCAttribute(+Display,+GC,+AttributeId,+Val)
  2218.   
  2219.   set the value of the attribute id of GC.
  2220.   
  2221.   */
  2222.  
  2223. long xcSetGCAttribute()
  2224.      
  2225. {
  2226.   include_var_builtin(4);
  2227.   ptr_definition types[4];
  2228.   
  2229.   
  2230.   types[0] = real;
  2231.   types[1] = real;
  2232.   types[2] = real;
  2233.   types[3] = real;
  2234.   
  2235.   begin_builtin(xcSetGCAttribute,4,4,types);
  2236.   
  2237.   if(SetGCAttribute(DISP(0),GCVAL(1),val[2],val[3]))
  2238.     success = TRUE;
  2239.   else
  2240.     {
  2241.       Errorline("could not set gc attribute in %P.\n",g);
  2242.       success = FALSE;
  2243.     }
  2244.   
  2245.   end_builtin();
  2246. }
  2247.  
  2248.  
  2249.  
  2250. /*****************************************************************/
  2251. /******** DESTROYGC
  2252.   
  2253.   xcDestroyGC(+Connection,+GC)
  2254.   
  2255.   destroys a graphic context.
  2256.   
  2257.   */
  2258.  
  2259. long xcDestroyGC()
  2260.      
  2261. {
  2262.   include_var_builtin(2);
  2263.   ptr_definition types[2];
  2264.   
  2265.   
  2266.   types[0] = real;
  2267.   types[1] = real;
  2268.   
  2269.   begin_builtin(xcDestroyGC,2,2,types);
  2270.   
  2271.   XFreeGC(DISP(0),GCVAL(1));
  2272.   success = TRUE;
  2273.   
  2274.   end_builtin();
  2275. }
  2276.  
  2277. /*****************************************************************/
  2278. /******** REQUESTCOLOR
  2279.   
  2280.   xcRequestColor(+Connection,+ColorMap,+Red,+Green,+Blue,-Pixel)
  2281.   
  2282.   get the closest color to(Red,Green,Blue) in the ColorMap
  2283.   
  2284.   */
  2285.  
  2286. long xcRequestColor()
  2287.      
  2288. {
  2289.   include_var_builtin(6);
  2290.   ptr_definition types[6];
  2291.   long j;
  2292.   XColor color;
  2293.   
  2294.   
  2295.   for(j=0; j<6; j++)
  2296.     types[j] = real;
  2297.   
  2298.   begin_builtin(xcRequestColor,6,5,types);
  2299.   
  2300.   color.red =(val[2]) << 8;
  2301.   color.green =(val[3]) << 8;
  2302.   color.blue =(val[4]) << 8;
  2303.   color.flags = DoRed|DoGreen|DoBlue;
  2304.   
  2305.   if(XAllocColor(DISP(0),CMAP(1),&color))
  2306.     {
  2307.       unify_real_result(args[5],(REAL) color.pixel);
  2308.       success = TRUE;
  2309.     }
  2310.   else
  2311.     {
  2312.       Errorline("could not request a color in %P.\n",g);
  2313.       success = FALSE;
  2314.     }
  2315.   
  2316.   end_builtin();
  2317. }
  2318.  
  2319.  
  2320. /*****************************************************************/
  2321. /******** REQUESTNAMEDCOLOR
  2322.   
  2323.   xcRequestNamedColor(+Connection,+ColorMap,+Name,-Pixel)
  2324.   
  2325.   get the color corresponding to Name in the ColorMap
  2326.   
  2327.   */
  2328.  
  2329. long xcRequestNamedColor()
  2330.      
  2331. {
  2332.   include_var_builtin(4);
  2333.   ptr_definition types[4];
  2334.   long j;
  2335.   XColor cell,rgb;
  2336.   
  2337.   types[0] = real;
  2338.   types[1] = real;
  2339.   types[2] = quoted_string;
  2340.   types[3] = real;
  2341.   
  2342.   begin_builtin(xcRequestNamedColor,4,3,types);
  2343.   
  2344.   if(XAllocNamedColor(DISP(0),CMAP(1),STRG(2),&cell,&rgb))
  2345.     {
  2346.       unify_real_result(args[3],(REAL) cell.pixel);
  2347.       success = TRUE;
  2348.     }
  2349.   else
  2350.     {
  2351.       Errorline("could not request a named color in %P.\n",g);
  2352.       success = FALSE;
  2353.     }
  2354.   
  2355.   end_builtin();
  2356. }
  2357.  
  2358.  
  2359. /*****************************************************************/
  2360. /******** FREECOLOR
  2361.   
  2362.   xcFreeColor(+Connection,+ColorMap,+Pixel)
  2363.   
  2364.   free the color in the colormap
  2365.   
  2366.   */
  2367.  
  2368. long xcFreeColor()
  2369.      
  2370. {
  2371.   include_var_builtin(3);
  2372.   ptr_definition types[3];
  2373.   long j;
  2374.   unsigned long pixel;
  2375.   
  2376.   
  2377.   for(j=0; j<3; j++)
  2378.     types[j] = real;
  2379.   
  2380.   begin_builtin(xcFreeColor,3,3,types);
  2381.   
  2382.   pixel = val[2];
  2383.   XFreeColors(DISP(0),CMAP(1),&pixel,1,0);
  2384.   success = TRUE;
  2385.   
  2386.   end_builtin();
  2387. }
  2388.  
  2389.  
  2390. /*****************************************************************/
  2391. /******** DrawLine
  2392.   
  2393.   xcDrawLine(+Connection,+Drawable,+X0,+Y0,+X1,+Y1,
  2394.   +Function,+Color,+LineWidth)
  2395.   
  2396.   draw a line(X0,Y0) ->(X1,Y1)
  2397.   
  2398.   */
  2399.  
  2400. long xcDrawLine()
  2401.      
  2402. {
  2403.   include_var_builtin(9);
  2404.   ptr_definition types[9];
  2405.   long j;
  2406.   GC gc;
  2407.   
  2408.   
  2409.   for(j = 0; j < 9; j++)
  2410.     types[j] = real;
  2411.   types[1] = xdrawable;
  2412.   
  2413.   begin_builtin(xcDrawLine,9,9,types);
  2414.   
  2415.   gc = DrawableGC(args[1]);
  2416.   x_set_gc(val[0],gc,val[6],val[7],val[8],xDefaultFont);
  2417.   
  2418.   XDrawLine(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
  2419.          val[2],val[3],val[4],val[5]);         /* X0,Y0,X1,Y1 */
  2420.   
  2421.   x_record_line(WindowDisplayList(args[1]),DRAW_LINE,
  2422.          val[2],val[3],val[4],val[5],
  2423.          val[6],val[7],val[8]);
  2424.   
  2425. XSync(DISP(0),0);
  2426.   success = TRUE;
  2427.   
  2428.   end_builtin();
  2429. }
  2430.  
  2431. /*****************************************************************/
  2432. /******** DrawArc
  2433.   
  2434.   xcDrawArc(+Connection,+Drawable,+X,+Y,+Width,+Height,+StartAngle,+ArcAngle,
  2435.   +Function,+Color,+LineWidth)
  2436.   
  2437.   draw arc(see X Vol.2 page 135 for the meanings of the arguments).
  2438.   
  2439.   */
  2440.  
  2441. long xcDrawArc()
  2442.      
  2443. {
  2444.   include_var_builtin(11);
  2445.   ptr_definition types[11];
  2446.   long j;
  2447.   GC gc;
  2448.   
  2449.   
  2450.   for(j = 0; j < 11; j++)
  2451.     types[j] = real;
  2452.   types[1] = xdrawable;
  2453.   
  2454.   begin_builtin(xcDrawArc,11,11,types);
  2455.   
  2456.   gc = DrawableGC(args[1]);
  2457.   x_set_gc(val[0],gc,val[8],val[9],val[10],xDefaultFont);
  2458.   
  2459.   XDrawArc(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
  2460.         val[2],val[3],val[4],val[5],         /* X,Y,Width,Height */
  2461.         val[6],val[7]);                         /* StartAngle,ArcAngle */
  2462.   
  2463.   x_record_arc(WindowDisplayList(args[1]),DRAW_ARC,
  2464.         val[2],val[3],val[4],val[5],
  2465.         val[6],val[7],val[8],val[9],val[10]);
  2466.   
  2467. XSync(DISP(0),0);
  2468.   success = TRUE;
  2469.   
  2470.   end_builtin();
  2471. }
  2472.  
  2473.  
  2474. /*****************************************************************/
  2475. /******** DrawRectangle
  2476.   
  2477.   xcDrawRectangle(+Connection,+Drawable,+X,+Y,+Width,+Height,
  2478.   +Function,+Color,+LineWidth)
  2479.   
  2480.   draw a rectangle.
  2481.   
  2482.   */
  2483.  
  2484. long xcDrawRectangle()
  2485.      
  2486. {
  2487.   include_var_builtin(9);
  2488.   ptr_definition types[9];
  2489.   long j;
  2490.   GC gc;
  2491.   
  2492.   
  2493.   for(j = 0; j < 9; j++)
  2494.     types[j] = real;
  2495.   types[1] = xdrawable;
  2496.   
  2497.   begin_builtin(xcDrawRectangle,9,9,types);
  2498.   
  2499.   gc = DrawableGC(args[1]);
  2500.   x_set_gc(val[0],gc,val[6],val[7],val[8],xDefaultFont);
  2501.   
  2502.   XDrawRectangle(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
  2503.           val[2],val[3],val[4],val[5]);         /* X,Y,Width,Height */
  2504.   
  2505.   x_record_rectangle(WindowDisplayList(args[1]),DRAW_RECTANGLE,
  2506.               val[2],val[3],val[4],val[5],
  2507.               val[6],val[7],val[8]);
  2508.   
  2509. XSync(DISP(0),0);
  2510.   success = TRUE;
  2511.   
  2512.   end_builtin();
  2513. }
  2514.  
  2515.  
  2516. /*****************************************************************/
  2517. /******** FillRectangle
  2518.   
  2519.   xcFillRectangle(+Connection,+Drawable,+X,+Y,+Width,+Height,
  2520.   +Function,+Color)
  2521.   
  2522.   fill a rectangle.
  2523.   
  2524.   */
  2525.  
  2526. long xcFillRectangle()
  2527.      
  2528. {
  2529.   include_var_builtin(8);
  2530.   ptr_definition types[8];
  2531.   long j;
  2532.   GC gc;
  2533.   
  2534.   
  2535.   for(j = 0; j < 8; j++)
  2536.     types[j] = real;
  2537.   types[1] = xdrawable;
  2538.   
  2539.   begin_builtin(xcFillRectangle,8,8,types);
  2540.   
  2541.   gc = DrawableGC(args[1]);
  2542.   x_set_gc(val[0],gc,val[6],val[7],xDefaultLineWidth,xDefaultFont); 
  2543.   
  2544.   XFillRectangle(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
  2545.           val[2],val[3],val[4],val[5]);         /* X,Y,Width,Height */
  2546.   
  2547.   x_record_rectangle(WindowDisplayList(args[1]),FILL_RECTANGLE,
  2548.               val[2],val[3],val[4],val[5],
  2549.               val[6],val[7],
  2550.               xDefaultLineWidth);
  2551.   
  2552. XSync(DISP(0),0);
  2553.   success = TRUE;
  2554.   
  2555.   end_builtin();
  2556. }
  2557.  
  2558.  
  2559. /*****************************************************************/
  2560. /******** FillArc
  2561.   
  2562.   xcFillArc(+Connection,+Drawable,+X,+Y,+Width,+Height,+StartAngle,+ArcAngle,
  2563.   +Function,+Color)
  2564.   fill an arc.
  2565.   
  2566.   */
  2567.  
  2568. long xcFillArc()
  2569.      
  2570. {
  2571.   include_var_builtin(10);
  2572.   ptr_definition types[10];
  2573.   long j;
  2574.   GC gc;
  2575.   
  2576.   
  2577.   for(j = 0; j < 10; j++)
  2578.     types[j] = real;
  2579.   types[1] = xdrawable;
  2580.   
  2581.   begin_builtin(xcFillArc,10,10,types);
  2582.   
  2583.   gc = DrawableGC(args[1]);
  2584.   x_set_gc(val[0],gc,val[8],val[9],xDefaultLineWidth,xDefaultFont);
  2585.   
  2586.   XFillArc(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
  2587.         val[2],val[3],val[4],val[5],         /* X,Y,Width,Height */
  2588.         val[6],val[7]);                         /* StartAngle,ArcAngle */
  2589.   
  2590.   x_record_arc(WindowDisplayList(args[1]),FILL_ARC,
  2591.         val[2],val[3],val[4],val[5],
  2592.         val[6],val[7],val[8],val[9],
  2593.         xDefaultLineWidth);
  2594.   
  2595. XSync(DISP(0),0);
  2596.   success = TRUE;
  2597.   
  2598.   end_builtin();
  2599. }
  2600.  
  2601.  
  2602. /*****************************************************************/
  2603. /******** PointsAlloc
  2604.   
  2605.   xcPointsAlloc(+NbPoints,-Points)
  2606.   
  2607.   allocate n points
  2608.   */
  2609.  
  2610. long xcPointsAlloc()
  2611.      
  2612. {
  2613.   include_var_builtin(2);
  2614.   ptr_definition types[2];
  2615.   long Points;
  2616.   
  2617.   
  2618.   types[0] = real;
  2619.   types[1] = real;
  2620.   
  2621.   begin_builtin(xcPointsAlloc,2,1,types);
  2622.   Points =(long) malloc((val [0]) * 2 * sizeof(short));
  2623.   unify_real_result(args[1],(REAL) Points);
  2624.   
  2625.   success = TRUE;
  2626.   
  2627.   end_builtin();
  2628. }
  2629.  
  2630.  
  2631. /*****************************************************************/
  2632. /******** CoordPut
  2633.   
  2634.   xcCoordPut(+Points,+N,+Coord)
  2635.   
  2636.   put nth coordinate in Points
  2637.   */
  2638.  
  2639. long xcCoordPut()
  2640.      
  2641. {
  2642.   include_var_builtin(3);
  2643.   ptr_definition types[3];
  2644.   short *Points;
  2645.   
  2646.   types[0] = real;
  2647.   types[1] = real;
  2648.   types[2] = real;
  2649.   
  2650.   begin_builtin(xcCoordPut,3,3,types);
  2651.   
  2652.   Points =(short *) val [0];
  2653.   Points += val[1];
  2654.   *Points = val[2];
  2655.   
  2656.   success = TRUE;
  2657.   
  2658.   end_builtin();
  2659. }
  2660.  
  2661.  
  2662. /*****************************************************************/
  2663. /******** PointsFree
  2664.   
  2665.   xcPointsFree(+Points)
  2666.   
  2667.   free points
  2668.   */
  2669.  
  2670. long xcPointsFree()
  2671.      
  2672. {
  2673.   include_var_builtin(1);
  2674.   ptr_definition types[1];
  2675.   
  2676.   
  2677.   types[0] = real;
  2678.   
  2679.   begin_builtin(xcPointsFree,1,1,types);
  2680.   free((void *)val [0]);
  2681.   success = TRUE;
  2682.   
  2683.   end_builtin();
  2684. }
  2685.  
  2686.  
  2687. /*****************************************************************/
  2688. /******** DrawPolygon
  2689.   
  2690.   xcDrawPolygon(+Connection,+Drawable,+Points,+NbPoints,
  2691.   +Function,+Color,+LineWidth)
  2692.   
  2693.   draw a polygon.
  2694.   
  2695.   */
  2696.  
  2697. long xcDrawPolygon()
  2698.      
  2699. {
  2700.   include_var_builtin(7);
  2701.   ptr_definition types[7];
  2702.   long j;
  2703.   GC gc;
  2704.   
  2705.   
  2706.   for(j = 0; j < 7; j++)
  2707.     types[j] = real;
  2708.   types[1] = xdrawable;
  2709.   
  2710.   begin_builtin(xcDrawPolygon,7,7,types);
  2711.   
  2712.   gc = DrawableGC(args[1]);
  2713.   x_set_gc(val[0],gc,val[4],val[5],val[6],xDefaultFont); 
  2714.   
  2715.   XDrawLines(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
  2716.          (XPoint *)val[2],val[3],CoordModeOrigin);        /* Points,NbPoints,mode */
  2717.   
  2718.   x_record_polygon(WindowDisplayList(args[1]),DRAW_POLYGON,
  2719.             val[2],val[3],val[4],val[5],val[6]);
  2720.   
  2721. XSync(DISP(0),0);
  2722.   success = TRUE;
  2723.   
  2724.   end_builtin();
  2725. }
  2726.  
  2727.  
  2728. /*****************************************************************/
  2729. /******** FillPolygon
  2730.   
  2731.   xcFillPolygon(+Connection,+Drawable,+Points,+NbPoints,+Function,+Color)
  2732.   
  2733.   fill a polygon.
  2734.   
  2735.   */
  2736.  
  2737. long xcFillPolygon()
  2738.      
  2739. {
  2740.   include_var_builtin(6);
  2741.   ptr_definition types[6];
  2742.   long j;
  2743.   GC gc;
  2744.   
  2745.   
  2746.   for(j = 0; j < 6; j++)
  2747.     types[j] = real;
  2748.   types[1] = xdrawable;
  2749.   
  2750.   begin_builtin(xcFillPolygon,6,6,types);
  2751.   
  2752.   gc = DrawableGC(args[1]);
  2753.   x_set_gc(val[0],gc,val[4],val[5],xDefaultLineWidth,xDefaultFont); 
  2754.   
  2755.   XFillPolygon(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
  2756.            (XPoint *)val[2],val[3],   /* Points,NbPoints */
  2757.            Complex,CoordModeOrigin);  /* shape,mode */
  2758.   
  2759.   x_record_polygon(WindowDisplayList(args[1]),FILL_POLYGON,
  2760.             val[2],val[3],val[4],val[5],
  2761.             xDefaultLineWidth);
  2762.   
  2763.   XSync(DISP(0),0);
  2764.   success = TRUE;
  2765.   
  2766.   end_builtin();
  2767. }
  2768.  
  2769.  
  2770. /*****************************************************************/
  2771. /******** LoadFont
  2772.   
  2773.   xcLoadFont(+Connection,+Name,-Font)
  2774.   
  2775.   load a font.
  2776.   
  2777.   */
  2778.  
  2779. long xcLoadFont()
  2780.      
  2781. {
  2782.   include_var_builtin(3);
  2783.   ptr_definition types[3];
  2784.   Font font;
  2785.   
  2786.   
  2787.   types[0] = real;
  2788.   types[1] = quoted_string;
  2789.   types[2] = real;
  2790.   
  2791.   begin_builtin(xcLoadFont,3,2,types);
  2792.   
  2793.   if(font=XLoadFont(DISP(0),STRG(1)))
  2794.     {
  2795.       unify_real_result(args[2],(REAL) font);
  2796.       XSync(DISP(0),0);
  2797.       success = TRUE;
  2798.     }
  2799.   else
  2800.     {
  2801.       Errorline("could not load a font in %P.\n",g);
  2802.       success = FALSE;
  2803.     }
  2804.   
  2805.   end_builtin();
  2806. }
  2807.  
  2808.  
  2809.  
  2810. /*****************************************************************/
  2811. /******** UnloadFont
  2812.   
  2813.   xcUnloadFont(+Connection,+Font)
  2814.   
  2815.   unload a font.
  2816.   
  2817.   */
  2818.  
  2819. long xcUnloadFont()
  2820.      
  2821. {
  2822.   include_var_builtin(2);
  2823.   ptr_definition types[2];
  2824.   
  2825.   
  2826.   types[0] = real;
  2827.   types[1] = real;
  2828.   
  2829.   begin_builtin(xcUnloadFont,2,2,types);
  2830.   
  2831.   XUnloadFont(DISP(0),FONT(1));
  2832.   XSync(DISP(0),0);
  2833.   success = TRUE;
  2834.   
  2835.   end_builtin();
  2836. }
  2837.  
  2838.  
  2839.  
  2840. /*****************************************************************/
  2841. /******** DrawString
  2842.   
  2843.   xcDrawString(+Connection,+Drawable,+X,+Y,String,
  2844.   +Font,+Function,+Color)
  2845.   
  2846.   Print the string(only foreground).
  2847.   
  2848.   */
  2849.  
  2850. long xcDrawString()
  2851. {
  2852.   include_var_builtin(8);
  2853.   ptr_definition types[8];
  2854.   long j;
  2855.   GC gc;
  2856.   
  2857.   
  2858.   for(j = 0; j < 8; j++)
  2859.     types[j] = real;
  2860.   types[1] = xdrawable;
  2861.   types[4] = quoted_string;
  2862.   
  2863.   begin_builtin(xcDrawString,8,8,types);
  2864.   
  2865.   gc = DrawableGC(args[1]);
  2866.   x_set_gc(val[0],gc,val[6],val[7],xDefaultLineWidth,val[5]);
  2867.   
  2868.   XDrawString(DISP(0),(Window) val[1],gc, /* Display,Window,GC */
  2869.            val[2],val[3],STRG(4),                  /* X,Y *//* String */
  2870.            strlen(STRG(4)));                /* Length */
  2871.   
  2872.   x_record_string(WindowDisplayList(args[1]),DRAW_STRING,
  2873.            val[2],val[3],      /* X,Y */
  2874.           STRG(4),     /* String */
  2875.            val[5],              /* Font */
  2876.            val[6],val[7]);      /* Function,Color */
  2877.   
  2878.   XSync(DISP(0),0);
  2879.   success = TRUE;
  2880.   
  2881.   end_builtin();
  2882. }
  2883.  
  2884.  
  2885. /*****************************************************************/
  2886. /******** DrawImageString
  2887.   
  2888.   xcDrawImageString(+Connection,+Drawable,+X,+Y,String,
  2889.   +Font,+Function,+Color)
  2890.   
  2891.   Print the string(foreground+background).
  2892.   
  2893.   */
  2894.  
  2895. long xcDrawImageString()
  2896. {
  2897.   include_var_builtin(8);
  2898.   ptr_definition types[8];
  2899.   long j;
  2900.   GC gc;
  2901.   
  2902.   
  2903.   for(j = 0; j < 8; j++)
  2904.     types[j] = real;
  2905.   types[1] = xdrawable;
  2906.   types[4] = quoted_string;
  2907.   
  2908.   begin_builtin(xcDrawImageString,8,8,types);
  2909.   
  2910.   gc = DrawableGC(args[1]);
  2911.   x_set_gc(val[0],gc,val[6],val[7],xDefaultLineWidth,val[5]);
  2912.   
  2913.   XDrawImageString(DISP(0),WIND(1),gc,          /* Display,Window,GC */
  2914.             val[2],val[3],              /* X,Y */
  2915.             STRG(4),                      /* String */
  2916.             strlen(STRG(4)));    /* Length */
  2917.   
  2918.   x_record_string(WindowDisplayList(args[1]),DRAW_IMAGE_STRING,
  2919.            val[2],val[3],               /* X,Y */
  2920.           STRG(4),              /* String */
  2921.            val[5],                       /* Font */
  2922.            val[6],val[7]);               /* Function,Color */
  2923.   
  2924.   XSync(DISP(0),0);
  2925.   success = TRUE;
  2926.   
  2927.   end_builtin();
  2928. }
  2929.  
  2930.  
  2931. /*****************************************************************/
  2932. /******** StringWidth
  2933.   
  2934.   xcStringWidth(+Connection,+Font,+String)
  2935.   
  2936.   
  2937.   returns the width in pixels of the string in the given font.
  2938.   
  2939.   */
  2940.  
  2941. long xcStringWidth()
  2942. {
  2943.   include_var_builtin(3);
  2944.   ptr_definition types[3];
  2945.   int direction,ascent,descent;
  2946.   XCharStruct overall;
  2947.   
  2948.   
  2949.   types[0] = real;
  2950.   types[1] = real;
  2951.   types[2] = quoted_string;
  2952.   
  2953.   begin_builtin(xcStringWidth,3,3,types);
  2954.   
  2955.   if(XQueryTextExtents(DISP(0),FONT(1),
  2956.                STRG(2),strlen(STRG(2)),/* string,nbchars */
  2957.                &direction,&ascent,&descent,&overall))
  2958.     {
  2959.       unify_real_result(aim->b,(REAL) overall.width);
  2960.       success = TRUE;
  2961.     }
  2962.   else
  2963.     {
  2964.       Errorline("bad font in %P.\n",g);
  2965.       success = FALSE;
  2966.     }
  2967.   
  2968.   end_builtin();
  2969. }
  2970.  
  2971.  
  2972. /*****************************************************************/
  2973. /******** SYNC
  2974.   
  2975.   xcSync(+Connection,+Discard)
  2976.   
  2977.   flush the output of the connection.
  2978.   
  2979.   */
  2980.  
  2981. long xcSync()
  2982.      
  2983. {
  2984.   include_var_builtin(2);
  2985.   ptr_definition types[2];
  2986.   
  2987.   
  2988.   types[0] = real;
  2989.   types[1] = real;
  2990.   
  2991.   begin_builtin(xcSync,2,2,types);
  2992.   
  2993.   XSync(DISP(0),val[1]);
  2994.   success = TRUE;
  2995.   
  2996.   end_builtin();
  2997. }
  2998.  
  2999.  
  3000.  
  3001. /*****************************************************************/
  3002. /******** EVENTtoPSITERM */
  3003.  
  3004. static ptr_psi_term xcEventToPsiTerm(event)
  3005.      
  3006.      XEvent *event;
  3007.      
  3008. {
  3009.   ptr_psi_term psiEvent,psi_str;
  3010.   KeySym keysym;
  3011.   char buffer[10];
  3012.   char tstr[2], *str;
  3013.  
  3014.   str=tstr;
  3015.   tstr[1]=0;
  3016.   
  3017.   psiEvent = stack_psi_term(4);
  3018.   bk_stack_add_int_attr(psiEvent,"display",event->xany.display);
  3019.   bk_stack_add_int_attr(psiEvent,"window",event->xany.window);
  3020.   
  3021.   switch(event->type) {
  3022.   case KeyPress:
  3023.   case KeyRelease:
  3024.     psiEvent->type = xkeyboard_event;
  3025.     bk_stack_add_int_attr(psiEvent,"x",event->xkey.x);
  3026.     bk_stack_add_int_attr(psiEvent,"y",event->xkey.y);
  3027.     bk_stack_add_int_attr(psiEvent,"state",event->xkey.state);
  3028.     
  3029.     buffer[0] = 0;
  3030.     *str = 0;
  3031.     XLookupString((XKeyEvent*)event,buffer,sizeof(buffer),&keysym,NULL);
  3032.     bk_stack_add_int_attr(psiEvent,"keycode",buffer[0]);
  3033.     if(keysym==XK_Return || keysym==XK_KP_Enter || keysym==XK_Linefeed)
  3034.       *str = CR;
  3035.     else
  3036.       if(keysym == XK_BackSpace || keysym == XK_Delete)
  3037.     *str = BS;
  3038.       else
  3039.     if(isascii(buffer[0]))
  3040.       /* if(isalnum(buffer[0]) || isspace(buffer[0])) 8.10 */
  3041.       *str = buffer[0];
  3042.     
  3043.     bk_stack_add_int_attr(psiEvent,"char",*str);
  3044.     break;
  3045.     
  3046.   case ButtonPress:
  3047.   case ButtonRelease:
  3048.     psiEvent->type = xbutton_event;
  3049.     bk_stack_add_int_attr(psiEvent,"x",event->xbutton.x);
  3050.     bk_stack_add_int_attr(psiEvent,"y",event->xbutton.y);
  3051.     bk_stack_add_int_attr(psiEvent,"x_root",event->xbutton.x_root);
  3052.     bk_stack_add_int_attr(psiEvent,"y_root",event->xbutton.y_root);
  3053.     bk_stack_add_int_attr(psiEvent,"state",event->xbutton.state);
  3054.     bk_stack_add_int_attr(psiEvent,"button",event->xbutton.button);
  3055.     break;
  3056.     
  3057.   case Expose:
  3058.     psiEvent->type = xexpose_event;
  3059.     bk_stack_add_int_attr(psiEvent,"width",event->xexpose.width);
  3060.     bk_stack_add_int_attr(psiEvent,"height",event->xexpose.height);
  3061.     break;
  3062.     
  3063.   case DestroyNotify:
  3064.     psiEvent->type = xdestroy_event;
  3065.     break;
  3066.     
  3067.     /*** RM 7/12/92 ***/
  3068.   case MotionNotify:
  3069.     psiEvent->type = xmotion_event;
  3070.     bk_stack_add_int_attr(psiEvent,"x",event->xbutton.x);
  3071.     bk_stack_add_int_attr(psiEvent,"y",event->xbutton.y);
  3072.     bk_stack_add_int_attr(psiEvent,"x_root",event->xbutton.x_root);
  3073.     bk_stack_add_int_attr(psiEvent,"y_root",event->xbutton.y_root);
  3074.     break;
  3075.     
  3076.   case ConfigureNotify:
  3077.     psiEvent->type = xconfigure_event;
  3078.     bk_stack_add_int_attr(psiEvent,"x",event->xconfigure.x);
  3079.     bk_stack_add_int_attr(psiEvent,"y",event->xconfigure.y);
  3080.     bk_stack_add_int_attr(psiEvent,"width",event->xconfigure.width);
  3081.     bk_stack_add_int_attr(psiEvent,"height",event->xconfigure.height);
  3082.     bk_stack_add_int_attr(psiEvent,"border_width",
  3083.                event->xconfigure.border_width);
  3084.     break;
  3085.     /*** RM 7/12/92(END) ***/
  3086.     
  3087.     
  3088.     /*** RM: May 3rd 1993 ***/
  3089.   case EnterNotify:
  3090.     psiEvent->type = xenter_event;
  3091.     goto LeaveEnterCommon;
  3092.     
  3093.   case LeaveNotify:
  3094.     psiEvent->type = xleave_event;
  3095.     
  3096.   LeaveEnterCommon:
  3097.     bk_stack_add_int_attr(psiEvent,"root",     event->xcrossing.root);
  3098.     bk_stack_add_int_attr(psiEvent,"subwindow",event->xcrossing.subwindow);
  3099.     
  3100.     bk_stack_add_int_attr(psiEvent,"x",event->xcrossing.x);
  3101.     bk_stack_add_int_attr(psiEvent,"y",event->xcrossing.y);
  3102.     
  3103.     bk_stack_add_int_attr(psiEvent,"focus",event->xcrossing.focus);
  3104.     bk_stack_add_int_attr(psiEvent,"state",event->xcrossing.state);
  3105.     
  3106.     break;
  3107.     
  3108.     
  3109.   default:
  3110.     psiEvent->type = xmisc_event;
  3111.     bk_stack_add_int_attr(psiEvent,"event_type",event->type);
  3112.     break;
  3113.   }
  3114.   
  3115.   return psiEvent;
  3116. }
  3117.  
  3118.  
  3119.  
  3120. /*****************************************************************/
  3121.  
  3122. /* some stuff to handle a list of psi-terms  */
  3123. /*  RM: Dec 15 1992   Re-written to handle new list structure */
  3124.  
  3125.  
  3126.  
  3127. /*  RM: Dec 15 1992   Test if a list is empty  */
  3128. long list_is_nil(lst)
  3129.      
  3130.      ptr_psi_term(lst);
  3131.      
  3132. {
  3133.   deref_ptr(lst);
  3134.   return lst->type==nil;
  3135. }
  3136.  
  3137.  
  3138.  
  3139. /*  RM: Dec 15 1992   Return the CDR of a list */
  3140. ptr_psi_term list_cdr(lst)
  3141.      
  3142.      ptr_psi_term(lst);
  3143. {
  3144.   ptr_psi_term car;
  3145.   ptr_psi_term cdr;
  3146.   
  3147.   
  3148.   deref_ptr(lst);
  3149.   if(lst->type==alist) {
  3150.     get_two_args(lst->attr_list,&car,&cdr);
  3151.     if(cdr) {
  3152.       deref_ptr(cdr);
  3153.       return cdr;
  3154.     }
  3155.   }
  3156.   
  3157.   Errorline("X event handling error in CDR(%P)\n",lst);
  3158.   return lst;
  3159. }
  3160.  
  3161.  
  3162.  
  3163. /*  RM: Dec 15 1992   Return the CAR of a list */
  3164. ptr_psi_term list_car(lst)
  3165.      
  3166.      ptr_psi_term(lst);
  3167. {
  3168.   ptr_psi_term car;
  3169.   ptr_psi_term cdr;
  3170.   
  3171.   
  3172.   deref_ptr(lst);
  3173.   if(lst->type==alist) {
  3174.     get_two_args(lst->attr_list,&car,&cdr);
  3175.     if(car) {
  3176.       deref_ptr(car);
  3177.       return car;
  3178.     }
  3179.   }
  3180.   
  3181.   Errorline("X event handling error in CAR(%P)\n",lst);
  3182.   return lst;
  3183. }
  3184.  
  3185.  
  3186.  
  3187. /*  RM: Dec 15 1992  Set the CAR of a list */
  3188. void list_set_car(lst,value)
  3189.      
  3190.      ptr_psi_term lst;
  3191.      ptr_psi_term value;
  3192. {
  3193.   deref_ptr(lst);
  3194.   stack_insert(featcmp,one,&(lst->attr_list),value);
  3195. }
  3196.  
  3197.  
  3198. /*  RM: Dec 15 1992  Set the CDR of a list */
  3199. void list_set_cdr(lst,value)
  3200.      
  3201.      ptr_psi_term lst;
  3202.      ptr_psi_term value;
  3203. {
  3204.   deref_ptr(lst);
  3205.   stack_insert(featcmp,two,&(lst->attr_list),value);
  3206. }
  3207.  
  3208.  
  3209.  
  3210. /*  RM: Dec 15 1992  Return the last element of a list */
  3211. ptr_psi_term list_last_cdr(lst)
  3212.      
  3213.      ptr_psi_term lst;
  3214. {
  3215.   while(!list_is_nil(lst))
  3216.     lst=list_cdr(lst);
  3217.   return lst;
  3218. }
  3219.  
  3220.  
  3221.  
  3222. /*  RM: Dec 15 1992  Append an element to a list,return the new CONS cell */
  3223. ptr_psi_term append_to_list(lst,value)
  3224.      
  3225.      ptr_psi_term lst;
  3226.      ptr_psi_term value;
  3227. {
  3228.   ptr_psi_term end;
  3229.   
  3230.   end=list_last_cdr(lst);
  3231.   push_ptr_value_global(psi_term_ptr,&(end->coref));
  3232.   end->coref=stack_cons(value,stack_nil());
  3233.   return end->coref;
  3234. }
  3235.  
  3236.  
  3237. /*  RM: Dec 15 1992
  3238.     Map a function,while TRUE,over the CONS cells of a list */
  3239. long map_funct_over_list(lst,proc,closure)
  3240.      ptr_psi_term lst;
  3241.      long(*proc)();
  3242.      long *closure;
  3243. {
  3244.   long notInterrupted=TRUE;
  3245.   
  3246.   while(notInterrupted && !list_is_nil(lst)) {
  3247.     notInterrupted =(*proc)(lst,closure);
  3248.     lst=list_cdr(lst);
  3249.   }
  3250.   
  3251.   return notInterrupted;
  3252. }
  3253.  
  3254.  
  3255.  
  3256. /*  RM: Dec 15 1992  Same thing,except map over the CARs of the list */
  3257. long map_funct_over_cars(lst,proc,closure)
  3258.      ptr_psi_term lst;
  3259.      long(*proc)();
  3260.      long *closure;
  3261. {
  3262.   ptr_psi_term cdr;
  3263.   int    notInterrupted = TRUE;
  3264.   
  3265.   while(notInterrupted && !list_is_nil(lst)) {
  3266.     /* save the next because the current could be removed
  3267.       (eg: xcFlushEvents) */
  3268.     
  3269.     cdr=list_cdr(lst);
  3270.     notInterrupted=(*proc)(list_car(lst),closure);
  3271.     lst=cdr;
  3272.   }
  3273.   
  3274.   return notInterrupted;
  3275. }
  3276.  
  3277.  
  3278.  
  3279. /*  RM: Dec 15 1992  Re-written for new lists */
  3280. void list_remove_value(lst,value)
  3281.      
  3282.      ptr_psi_term lst;
  3283.      ptr_psi_term value;
  3284. {
  3285.   ptr_psi_term car,cdr;
  3286.   long still_there=TRUE;
  3287.   
  3288.   deref_ptr(value);
  3289.   while(!list_is_nil(lst) && still_there) {
  3290.     car=list_car(lst);
  3291.     cdr=list_cdr(lst);
  3292.     if(car==value) {
  3293.       still_there=FALSE;
  3294.       push_ptr_value_global(psi_term_ptr,&(lst->coref));
  3295.       lst->coref=cdr;
  3296.     }
  3297.     lst=cdr;
  3298.   }
  3299. }
  3300.  
  3301.  
  3302.  
  3303. /*****************************************************************/
  3304. /* Static */
  3305. /* return FALSE if the events match */
  3306.  
  3307. static long x_union_event(psiEvent,closure)
  3308.      
  3309.      ptr_psi_term psiEvent;
  3310.      EventClosure *closure;
  3311.      
  3312. {
  3313.   return !((Display *)GetIntAttr(psiEvent,"display") == closure->display
  3314.        && (Window)GetIntAttr(psiEvent,"window") == closure->window
  3315.        &&(GetIntAttr(psiEvent,"mask") & closure->mask) != 0);
  3316. }
  3317.  
  3318.  
  3319.  
  3320.  
  3321.  
  3322. /*****************************************************************/
  3323. /******** GetEvent
  3324.   
  3325.   xcGetEvent(+Display,+Window,+Mask)
  3326.   
  3327.   return an event matching the mask in the window.
  3328.   if no event residuate the call else return a null event.
  3329.   
  3330.   */
  3331.  
  3332. long xcGetEvent()
  3333.      
  3334. {
  3335.   include_var_builtin(3);
  3336.   ptr_definition types[3];
  3337.   XEvent event;
  3338.   ptr_psi_term psiEvent;
  3339.   ptr_psi_term eventElt;
  3340.   EventClosure eventClosure;
  3341.   ptr_psi_term result;
  3342.   
  3343.   
  3344.   types[0] = real;
  3345.   types[1] = xwindow;
  3346.   types[2] = real;
  3347.  
  3348.   result=aim->b;
  3349.   
  3350.   begin_builtin(xcGetEvent,3,3,types);
  3351.   
  3352.   if(!xevent_existing) {
  3353.         
  3354.     /* warning if a same event is already waiting */
  3355.     eventClosure.display =DISP(0);
  3356.     eventClosure.window  =WIND(1);
  3357.     eventClosure.mask    = val[2];
  3358.     if(!map_funct_over_cars(xevent_list,x_union_event,&eventClosure))
  3359.       Warningline("you have coinciding event handlers on the same window");
  3360.     
  3361.     /* transform the request into a psi-term */
  3362.     eventElt = stack_psi_term(4);
  3363.     bk_stack_add_int_attr(eventElt,"display",val[0]);
  3364.     bk_stack_add_int_attr(eventElt,"window",val[1]);
  3365.     bk_stack_add_int_attr(eventElt,"mask",val[2]);
  3366.  
  3367.     /* stack_insert(featcmp,"event",&(eventElt->attr_list),result); */
  3368.            
  3369.     /* add the request in the list of waiting events */
  3370.     append_to_list(xevent_list,eventElt); /*  RM: Dec 15 1992  */
  3371.       
  3372.     /* residuate the call */
  3373.     residuate(eventElt);  /* RM: May  5 1993  */
  3374.     
  3375.     /* return a psi-term containing an `empty' event */
  3376.     /* psiEvent = stack_psi_term(4);
  3377.        psiEvent->type = xevent;  RM: May  5 1993  */
  3378.   }
  3379.   else {
  3380.     /* get the event built by x_exist_event */
  3381.     psiEvent = GetPsiAttr(xevent_existing,"event");
  3382.     push_ptr_value_global(psi_term_ptr,&xevent_existing);
  3383.     xevent_existing = NULL;
  3384.     push_goal(unify,psiEvent,aim->b,NULL); /*  RM: May  5 1993  */
  3385.   }
  3386.   
  3387.   /* push_goal(unify,psiEvent,aim->b,NULL);   RM: May  5 1993  */
  3388.   
  3389.   success = TRUE;
  3390.   
  3391.   end_builtin();
  3392. }
  3393.  
  3394.  
  3395.  
  3396. /*****************************************************************/
  3397. /* Static */
  3398. /* remove the event from the queue if matching */
  3399.  
  3400. static long x_flush_event(eventElt,closure)
  3401.      ptr_psi_term eventElt;
  3402.      EventClosure *closure;
  3403. {
  3404.   ptr_psi_term psiEvent;
  3405.   
  3406.   
  3407.   psiEvent = list_car(eventElt);
  3408.   if ((Display *)GetIntAttr(psiEvent,"display") == closure->display
  3409.        && (Window)GetIntAttr(psiEvent,"window") ==closure->window
  3410.        && (GetIntAttr(psiEvent,"mask") & closure->mask) != 0)
  3411.     {
  3412.       /* 9.10 */
  3413.       /* if(xevent_list == eventElt) */
  3414.       /*     push_ptr_value_global(psi_term_ptr,&xevent_list); */
  3415.       /* xevent_list = list_remove_value(xevent_list,psiEvent); */
  3416.       list_remove_value(xevent_list,psiEvent); /*  RM: Dec 15 1992  */
  3417.     }
  3418.   
  3419.   return TRUE;
  3420. }
  3421.  
  3422.  
  3423. /*****************************************************************/
  3424. /******** FlushEvents
  3425.   
  3426.   xcFlushEvents(+Display,+Window,+Mask)
  3427.   
  3428.   flush all residuated events matching(display,window,mask).
  3429.   
  3430.   */
  3431.  
  3432. long xcFlushEvents()
  3433.      
  3434. {
  3435.   include_var_builtin(3);
  3436.   ptr_definition types[3];
  3437.   EventClosure eventClosure;
  3438.   
  3439.   
  3440.   types[0] = real;
  3441.   types[1] = xwindow;
  3442.   types[2] = real;
  3443.   
  3444.   begin_builtin(xcFlushEvents,3,3,types);
  3445.   
  3446.   eventClosure.display =DISP(0);
  3447.   eventClosure.window  = val[1];
  3448.   eventClosure.mask    = val[2];
  3449.   map_funct_over_list(xevent_list,x_flush_event,&eventClosure);
  3450.   
  3451.   success = TRUE;
  3452.   
  3453.   end_builtin();
  3454. }
  3455.  
  3456. #if 0
  3457.  
  3458. /*****************************************************************/
  3459. /******** xcSendEvent
  3460.   
  3461.   xcSendEvent(+Display,+Window,+Event)
  3462.   
  3463.   send the event to the specified window
  3464.   
  3465.   */
  3466.  
  3467. long xcSendEvent()
  3468.      
  3469. {
  3470.   include_var_builtin(3);
  3471.   ptr_definition types[3];
  3472.   XEvent event;
  3473.   ptr_psi_term psiEvent;
  3474.   ptr_node nodeAttr;
  3475.   ptr_psi_term psiValue;
  3476.   
  3477.   
  3478.   types[0] = real;
  3479.   types[1] = xwindow;
  3480.   types[2] = xevent;
  3481.   
  3482.   begin_builtin(xcSendEvent,3,3,types);
  3483.   
  3484.   if(xcPsiEventToEvent(val[2],&event))
  3485.     {
  3486.       XSendEvent(DISP(0),WIND(1),False,?,&event);
  3487.       success = TRUE;
  3488.     }
  3489.   else
  3490.     {
  3491.       Errorline("%P is not an event in %P.\n",val[2],g);
  3492.       success = FALSE;
  3493.     }
  3494.   
  3495.   end_builtin();
  3496. }
  3497.  
  3498. #endif
  3499.  
  3500.  
  3501. /*** RM: 7/12/92 ***/
  3502.  
  3503. /*****************************************************************/
  3504. /******** xcQueryPointer
  3505.   
  3506.   xcQueryPointer(+Display,+Window,
  3507.   -root_return,  -child_return,
  3508.   -root_x_return,-root_y_return,
  3509.   -win_x_return, -win_y_return,
  3510.   -mask_return,  -same_screen)
  3511.   
  3512.   this predicate returns a psi-term containing loads of info about where the
  3513.   pointer is at. See 'XQueryPointer' for a complete definition(the boolean
  3514.   result of XQueryPointer is stored as 'same_screen'.
  3515.   */
  3516.  
  3517. long xcQueryPointer()
  3518.      
  3519. {
  3520.   include_var_builtin(10);
  3521.   ptr_definition types[10];
  3522.   Window root_return,child_return;
  3523.   int root_x_return,root_y_return;
  3524.   int win_x_return,win_y_return;
  3525.   unsigned int mask_return;
  3526.   long same_screen;
  3527.   long j;
  3528.   
  3529.   
  3530.   
  3531.   for(j=0; j<10; j++)
  3532.     types[j] = real;
  3533.   
  3534.   types[1] = xdrawable;
  3535.   
  3536.   begin_builtin(xcQueryPointer,10,2,types);
  3537.   
  3538.   
  3539.   same_screen=XQueryPointer(DISP(0),
  3540.                 WIND(1),
  3541.                 &root_return,  &child_return,
  3542.                 &root_x_return,&root_y_return,
  3543.                 &win_x_return, &win_y_return,
  3544.                 &mask_return);
  3545.   
  3546.   
  3547.   unify_real_result(args[2],(REAL)root_return);
  3548.   unify_real_result(args[3],(REAL)child_return);
  3549.   unify_real_result(args[4],(REAL)root_x_return);
  3550.   unify_real_result(args[5],(REAL)root_y_return);
  3551.   unify_real_result(args[6],(REAL)win_x_return);
  3552.   unify_real_result(args[7],(REAL)win_y_return);
  3553.   unify_real_result(args[8],(REAL)mask_return);
  3554.   unify_real_result(args[9],(REAL)same_screen);
  3555.   
  3556.   /* printf("root: %ld\nchild: %ld\n",root_return,child_return); */
  3557.   
  3558.   success = TRUE;
  3559.   
  3560.   end_builtin();
  3561. }
  3562.  
  3563. /*** RM: 7/12/92(END) ***/
  3564.  
  3565.  
  3566.   
  3567.  
  3568. /*****************************************************************/
  3569. /******** SETUPBUILTINS
  3570.   
  3571.   Set up the X built-in predicates.
  3572.   
  3573.   */
  3574.  
  3575. void x_setup_builtins()
  3576.      
  3577. {
  3578.   set_current_module(x_module); /*  RM: Feb  3 1993  */
  3579.   
  3580.   raw_setup_builtins(); /* to move in life.c */
  3581.   
  3582.   XSetErrorHandler(x_handle_error);
  3583.   XSetIOErrorHandler(x_handle_fatal_error);
  3584.   
  3585.   set_current_module(x_module); /*  RM: Feb  3 1993  */
  3586.   xevent = update_symbol(x_module,"event");
  3587.   xkeyboard_event = update_symbol(x_module,"keyboard_event");
  3588.   xbutton_event = update_symbol(x_module,"button_event");
  3589.   xexpose_event = update_symbol(x_module,"expose_event");
  3590.   xdestroy_event = update_symbol(x_module,"destroy_event");
  3591.   
  3592.   /*** RM: 7/12/92 ***/
  3593.   xconfigure_event = update_symbol(x_module,"configure_event");
  3594.   xmotion_event = update_symbol(x_module,"motion_event");
  3595.   /*** RM: 7/12/92 ***/
  3596.   
  3597.   
  3598.   /*** RM: 3 May 92 ***/
  3599.   xenter_event = update_symbol(x_module,"enter_event");
  3600.   xleave_event = update_symbol(x_module,"leave_event");
  3601.   xmisc_event  = update_symbol(x_module,"misc_event");
  3602.   
  3603.   /*** RM: 3 May 92 ***/
  3604.   
  3605.   xdisplay = update_symbol(x_module,"display");
  3606.   xdrawable = update_symbol(x_module,"drawable");
  3607.   xwindow = update_symbol(x_module,"window");
  3608.   xpixmap = update_symbol(x_module,"pixmap");
  3609.   
  3610.   xgc = update_symbol(x_module,"graphic_context");
  3611.   xdisplaylist = update_symbol(x_module,"display_list");
  3612.   
  3613.   new_built_in(x_module,"xcOpenConnection",       predicate,xcOpenConnection);
  3614.   new_built_in(x_module,"xcDefaultRootWindow",    predicate,xcDefaultRootWindow);
  3615.   new_built_in(x_module,"xcGetScreenAttribute",   predicate,xcGetScreenAttribute);
  3616.   new_built_in(x_module,"xcGetConnectionAttribute",predicate,xcGetConnectionAttribute);
  3617.   new_built_in(x_module,"xcCloseConnection",      predicate,xcCloseConnection);
  3618.   
  3619.   new_built_in(x_module,"xcCreateSimpleWindow", predicate,xcCreateSimpleWindow);
  3620. #if 0
  3621.   new_built_in(x_module,"xcCreateWindow",       predicate,xcCreateWindow);
  3622. #endif
  3623.   
  3624.   new_built_in(x_module,"xcSetStandardProperties", predicate,xcSetStandardProperties);
  3625.   new_built_in(x_module,"xcGetWindowGeometry",  predicate,xcGetWindowGeometry);
  3626.   new_built_in(x_module,"xcSetWindowGeometry",  predicate,xcSetWindowGeometry);
  3627.   new_built_in(x_module,"xcGetWindowAttribute", predicate,xcGetWindowAttribute);
  3628.   new_built_in(x_module,"xcSetWindowAttribute", predicate,xcSetWindowAttribute);
  3629.   new_built_in(x_module,"xcMapWindow",          predicate,xcMapWindow);
  3630.   
  3631.   /*  RM: May  6 1993  */
  3632.   new_built_in(x_module,"xcRaiseWindow",          predicate,xcRaiseWindow);
  3633.   
  3634.   new_built_in(x_module,"xcUnmapWindow",        predicate,xcUnmapWindow);
  3635.   
  3636.   /*** RM 8/12/92 ***/
  3637.   new_built_in(x_module,"xcMapSubwindows",          predicate,xcMapSubwindows);
  3638.   new_built_in(x_module,"xcUnmapSubwindows",        predicate,xcUnmapSubwindows);
  3639.   /*** RM 8/12/92 ***/
  3640.   
  3641.   new_built_in(x_module,"xcClearWindow",        predicate,xcClearWindow);
  3642.   new_built_in(x_module,"xcResizeWindowPixmap", predicate,xcResizeWindowPixmap);
  3643.   
  3644.   new_built_in(x_module,"xcSelectInput",        predicate,xcSelectInput);
  3645.   new_built_in(x_module,"xcRefreshWindow",      predicate,xcRefreshWindow);
  3646.   new_built_in(x_module,"xcPostScriptWindow",   predicate,xcPostScriptWindow);
  3647.   new_built_in(x_module,"xcDestroyWindow",      predicate,xcDestroyWindow);
  3648.   
  3649.   new_built_in(x_module,"xcCreateGC",           predicate,xcCreateGC);
  3650.   new_built_in(x_module,"xcGetGCAttribute",     predicate,xcGetGCAttribute);
  3651.   new_built_in(x_module,"xcSetGCAttribute",     predicate,xcSetGCAttribute);
  3652.   new_built_in(x_module,"xcDestroyGC",          predicate,xcDestroyGC);
  3653.   
  3654.   new_built_in(x_module,"xcDrawLine",           predicate,xcDrawLine);
  3655.   new_built_in(x_module,"xcMoveWindow",         predicate,xcMoveWindow);
  3656.   new_built_in(x_module,"xcDrawArc",            predicate,xcDrawArc);
  3657.   new_built_in(x_module,"xcDrawRectangle",      predicate,xcDrawRectangle);
  3658.   new_built_in(x_module,"xcDrawPolygon",        predicate,xcDrawPolygon);
  3659.   
  3660.   new_built_in(x_module,"xcLoadFont",           predicate,xcLoadFont);
  3661.   new_built_in(x_module,"xcUnloadFont",         predicate,xcUnloadFont);
  3662.   new_built_in(x_module,"xcDrawString",         predicate,xcDrawString);
  3663.   new_built_in(x_module,"xcDrawImageString",    predicate,xcDrawImageString);
  3664.   new_built_in(x_module,"xcStringWidth",        function, xcStringWidth);
  3665.   
  3666.   new_built_in(x_module,"xcRequestColor",       predicate,xcRequestColor);
  3667.   new_built_in(x_module,"xcRequestNamedColor",  predicate,xcRequestNamedColor);
  3668.   new_built_in(x_module,"xcFreeColor",          predicate,xcFreeColor);
  3669.   
  3670.   new_built_in(x_module,"xcFillRectangle",      predicate,xcFillRectangle);
  3671.   new_built_in(x_module,"xcFillArc",            predicate,xcFillArc);
  3672.   new_built_in(x_module,"xcFillPolygon",        predicate,xcFillPolygon);
  3673.   
  3674.   new_built_in(x_module,"xcPointsAlloc",        predicate,xcPointsAlloc);
  3675.   new_built_in(x_module,"xcCoordPut",           predicate,xcCoordPut);
  3676.   new_built_in(x_module,"xcPointsFree",         predicate,xcPointsFree);
  3677.   
  3678.   new_built_in(x_module,"xcSync",               predicate,xcSync);
  3679.   new_built_in(x_module,"xcGetEvent",           function, xcGetEvent);
  3680.   new_built_in(x_module,"xcFlushEvents",        predicate,xcFlushEvents);
  3681.   
  3682.   /*** RM: 7/12/92 ***/
  3683.   new_built_in(x_module,"xcQueryPointer",       predicate,xcQueryPointer);
  3684.   /*** RM: 7/12/92 ***/
  3685.   
  3686.   /*  RM: Apr 20 1993  */
  3687.   new_built_in(x_module,"xcQueryTextExtents",predicate,xcQueryTextExtents);
  3688. }
  3689.  
  3690.  
  3691.  
  3692. /*****************************************************************/
  3693. /* not a built-in */
  3694. /* called by what_next_aim in login.c */
  3695.  
  3696. static long WaitNextEvent(ptreventflag)
  3697.      long *ptreventflag;
  3698. {
  3699.   long nfds;
  3700.   fd_set readfd,writefd,exceptfd;
  3701.   struct timeval timeout;
  3702.   long charflag = FALSE,nbchar;
  3703.   char c = 0;
  3704.   
  3705.   
  3706.   *ptreventflag = FALSE;
  3707.   
  3708.   do
  3709.     {
  3710.       FD_ZERO(&readfd);
  3711.       FD_SET(stdin_fileno, &readfd);
  3712.       FD_ZERO(&writefd);
  3713.       FD_ZERO(&exceptfd);
  3714.       timeout.tv_sec = 0;
  3715.       timeout.tv_usec = 100000;
  3716.  
  3717.       nfds = select(32,&readfd,&writefd,&exceptfd,&timeout);
  3718.       if(nfds == -1)
  3719.     {
  3720. #if 0
  3721.       /* not an error,but a signal has been occured */
  3722.       /* handle_interrupt(); does not work */
  3723.       exit();
  3724. #endif
  3725.       if(errno != EINTR) 
  3726.         {
  3727.           Errorline("in select: interruption error.\n");
  3728.           exit_life(TRUE);
  3729.         }
  3730.       else 
  3731.         interrupt();
  3732.     }
  3733.       
  3734.       else
  3735.     if(nfds == 0)
  3736.       {
  3737. #ifdef X11
  3738.         if(x_exist_event())
  3739.           {
  3740.         *ptreventflag = TRUE;
  3741.         start_of_line = TRUE;
  3742.           }        
  3743. #endif
  3744.       }
  3745.     else
  3746.       {
  3747.         if(FD_ISSET(stdin_fileno, &readfd) != 0)
  3748.           {
  3749. #if 0
  3750.         if((nbchar = read(stdin_fileno,&c,1)) == -1)
  3751.           {
  3752.             Errorline("in select: keyboard error.\n");
  3753.             exit_life(TRUE);
  3754.           }
  3755.         
  3756.         /* see manpage of read */
  3757.         if(nbchar == 0)
  3758.           c = EOF;
  3759. #endif
  3760.         c = fgetc(input_stream);
  3761.         charflag = TRUE;
  3762.           }
  3763.         else
  3764.           {
  3765.         Errorline("select error.\n");
  3766.         exit_life(TRUE);
  3767.           }
  3768.       }
  3769.     } while(!(charflag || *ptreventflag));
  3770.   
  3771.   return c;
  3772. }
  3773.  
  3774. /*****************************************/
  3775.  
  3776.  
  3777. long x_read_stdin_or_event(ptreventflag)
  3778.      long *ptreventflag;
  3779. {
  3780.   long c = 0;
  3781.   
  3782.   
  3783.   *ptreventflag = FALSE;
  3784.   
  3785.   if(c = saved_char) /* not an error ;-) */
  3786.     {
  3787.       saved_char = old_saved_char;
  3788.       old_saved_char=0;
  3789.     }
  3790.   else
  3791.     {
  3792.       if(feof(input_stream))
  3793.     c = EOF;
  3794.       else 
  3795.     {
  3796.       if(start_of_line) 
  3797.         {
  3798.           start_of_line = FALSE;
  3799.           line_count ++ ;
  3800.           Infoline("%s",prompt); 
  3801.           fflush(output_stream);
  3802.         }
  3803.       
  3804.       c = WaitNextEvent(ptreventflag);
  3805.       
  3806.       if(*ptreventflag)
  3807.         {
  3808.           if(verbose) printf("<X event>");
  3809.           if(NOTQUIET) printf("\n"); /* 21.1 */
  3810.         }
  3811.       
  3812.       if(c == EOLN)
  3813.         start_of_line = TRUE;
  3814.     }
  3815.     }
  3816.   
  3817.   return c;
  3818. }
  3819.  
  3820.  
  3821. /*****************************************************************/
  3822. /* Static */
  3823. /* returns TRUE if the mask matches the type */
  3824.  
  3825. static long mask_match_type(mask,type)
  3826.      long mask,type;
  3827. {
  3828.   long em;
  3829.  
  3830.   /* printf("mask=%d,type=%d=%s\n",mask,type,xevent_name[type]); */
  3831.  
  3832.   em=xevent_mask[type];
  3833.   if(!em ||(em & mask))
  3834.     return TRUE;
  3835.  
  3836.   /* printf("FALSE\n"); printf("event mask=%d\n",em); */
  3837.   
  3838.   return FALSE;
  3839. }
  3840.  
  3841.  
  3842.  
  3843. /*****************************************************************/
  3844. /* Static */
  3845. /* returns the psi-event of the list corresponding to the existing event */
  3846.  
  3847. static ptr_psi_term x_what_psi_event(beginSpan,endSpan,eventType)
  3848.      ptr_psi_term beginSpan,endSpan;
  3849.      long eventType;
  3850. {
  3851.   if(beginSpan == endSpan)
  3852.     return list_car(beginSpan);
  3853.   else
  3854.     if(mask_match_type(GetIntAttr(list_car(beginSpan),"mask"),
  3855.              eventType))
  3856.       return list_car(beginSpan);
  3857.     else
  3858.       return x_what_psi_event(list_cdr(beginSpan),
  3859.                    endSpan,eventType);
  3860. }
  3861.  
  3862.  
  3863.  
  3864. /*****************************************************************/
  3865. /* Static */
  3866. /* builds xevent_existing */
  3867.  
  3868. static void x_build_existing_event(event,beginSpan,endSpan,eventType)
  3869.      XEvent *event;
  3870.      ptr_psi_term beginSpan,endSpan;
  3871.      long eventType;
  3872. {
  3873.   ptr_psi_term psiEvent;
  3874.   
  3875.  
  3876.   /* printf("building event: type=%s event=%s\n",
  3877.      xevent_name[type],xevent_name[event->type]); */
  3878.   
  3879.   /* get the event from the list */
  3880.   psiEvent = x_what_psi_event(beginSpan,endSpan,eventType);
  3881.   
  3882.   /* put the event on the waiting event */
  3883.   bk_change_psi_attr(psiEvent,"event",xcEventToPsiTerm(event));
  3884.   
  3885.   /* set the global */
  3886.   if(xevent_existing)
  3887.     Warningline("xevent_existing is non-null in x_build_existing_event");
  3888.   push_ptr_value_global(psi_term_ptr,&xevent_existing);
  3889.   xevent_existing = psiEvent;
  3890.   
  3891.   /* remove the event from the list */
  3892.   /* 9.10 */
  3893.   /* if(list_car(xevent_list) == psiEvent) */
  3894.   /*     push_ptr_value_global(psi_term_ptr,&xevent_list); */
  3895.   /* xevent_list = list_remove_value(xevent_list,psiEvent); */
  3896.   list_remove_value(xevent_list,psiEvent); /*  RM: Dec 15 1992  */
  3897. }
  3898.  
  3899.  
  3900.  
  3901. /*****************************************************************/
  3902. /* Static */
  3903. /* get the next span of waiting events */
  3904.  
  3905. static long x_next_event_span(eventElt,eventClosure)
  3906.      ptr_psi_term eventElt;
  3907.      EventClosure *eventClosure;
  3908. {
  3909.   ptr_psi_term psiEvent;
  3910.   Display *display;
  3911.   Window window;
  3912.   long mask;
  3913.   XEvent event;
  3914.  
  3915.   
  3916.   psiEvent = list_car(eventElt);
  3917.   display =(Display *)GetIntAttr(psiEvent,"display");
  3918.   window =(Window)GetIntAttr(psiEvent,"window");
  3919.   mask = GetIntAttr(psiEvent,"mask");
  3920.   
  3921.   if(eventClosure->display == NULL) {
  3922.     /* new span */
  3923.     eventClosure->display = display;
  3924.     eventClosure->window = window;
  3925.     eventClosure->mask = mask;
  3926.     eventClosure->beginSpan = eventElt;
  3927.     return TRUE;
  3928.   }
  3929.   else
  3930.     if(eventClosure->display == display && eventClosure->window == window) {
  3931.       /* same span */
  3932.       eventClosure->mask |= mask;
  3933.       return TRUE;
  3934.     }
  3935.     else {
  3936.       /* a next span begins,check the current span */
  3937.     Repeat:
  3938.       if(XCheckWindowEvent(eventClosure->display,eventClosure->window,
  3939.                  eventClosure->mask,&event)
  3940.       /* && event.xany.window == eventClosure->window */)
  3941.     {
  3942.       /* 9.10 */
  3943.       /* printf("Event type = %ld.\n",event.type); */
  3944.  
  3945.       
  3946.       if((event.type==Expose || event.type==GraphicsExpose)
  3947.           && event.xexpose.count!=0) {
  3948.         /* printf("Expose count = %ld.\n", event.xexpose.count); */
  3949.         goto Repeat;
  3950.       }
  3951.       
  3952.       /* build a psi-term containing the event */
  3953.       
  3954.       /* printf("*** event %d ***\n",event.type); */
  3955.       
  3956.       x_build_existing_event(&event,
  3957.                   eventClosure->beginSpan,
  3958.                   eventElt,event.type);
  3959.  
  3960.       return FALSE; /* stop ! we have an existing event !! */
  3961.     }
  3962.       else
  3963.     {
  3964.       /* init the new span */
  3965.       eventClosure->display = display;
  3966.       eventClosure->window = window;
  3967.       eventClosure->mask = mask;
  3968.       eventClosure->beginSpan = eventElt;
  3969.       return TRUE;
  3970.     }
  3971.     }
  3972. }
  3973.  
  3974.  
  3975.  
  3976. /*****************************************************************/
  3977. /* not a built-in */
  3978. /* used by main_prove() and what_next() */
  3979.  
  3980. long x_exist_event()
  3981. {
  3982.   XEvent event,exposeEvent;
  3983.   ptr_psi_term eventElt;
  3984.   EventClosure eventClosure;
  3985.   
  3986.  
  3987.   /*infoline("xevent_list=%P\n",xevent_list); */
  3988.  
  3989.   if(xevent_existing)
  3990.     return TRUE;
  3991.   
  3992.   if(list_is_nil(xevent_list)) {
  3993.     /* printf("nil event list\n"); */
  3994.     return FALSE;
  3995.   }
  3996.  
  3997.   
  3998.   /* traverse the list of waiting events */
  3999.   eventClosure.display = NULL;
  4000.   if(!map_funct_over_list(xevent_list,x_next_event_span,&eventClosure))
  4001.     return TRUE;
  4002.  
  4003.   /* printf("display=%d,window=%d,mask=%d\n",
  4004.      eventClosure.display,eventClosure.window,eventClosure.mask); */
  4005.   
  4006.  
  4007.   
  4008.   /* check the last span */
  4009.   if(XCheckWindowEvent(eventClosure.display,
  4010.              eventClosure.window,
  4011.              eventClosure.mask,
  4012.              &event)) {
  4013.  
  4014.     /* printf("*** here event %d ***\n",event.xany.type); */
  4015.  
  4016.     if(event.xany.window==eventClosure.window) {
  4017.       if(event.type == Expose)
  4018.     while(XCheckWindowEvent(eventClosure.display,
  4019.                   eventClosure.window,
  4020.                   ExposureMask,
  4021.                   &exposeEvent))
  4022.       ; /* that is continue until no expose event */
  4023.       
  4024.       /* build a psi-term containing the event */
  4025.       x_build_existing_event(&event,
  4026.                   eventClosure.beginSpan,
  4027.                   list_last_cdr(xevent_list),/* RM: Dec 15 1992*/
  4028.                   event.type);
  4029.       return TRUE;
  4030.     }
  4031.   }
  4032.   else
  4033.     return FALSE;
  4034. }
  4035.  
  4036.  
  4037.  
  4038. /*****************************************************************/
  4039. /* used when backtracking a created window in order to destroy the window */
  4040.  
  4041. void x_destroy_window(display,window)
  4042.      
  4043.      Display *display;
  4044.      Window window;
  4045.      
  4046. {
  4047.   /* we need the psi-term window(not the value) to get the display list,the pixmap ...
  4048.      jch - Fri Aug  7 15:29:14 MET DST 1992
  4049.      
  4050.      FreeWindow(display,window);
  4051.      */
  4052.   XDestroyWindow(display,window);
  4053.   XSync(display,0);
  4054. }
  4055.  
  4056.  
  4057. /*****************************************************************/
  4058. /* used when backtracking a xcUnmapWindow in order to show the window */
  4059.  
  4060. void x_show_window(display,window)
  4061.      
  4062.      Display *display;long window;
  4063.      
  4064. {
  4065.   XMapWindow(display,window);
  4066.   XSync(display,0);
  4067. }
  4068.  
  4069.  
  4070. /*****************************************************************/
  4071. /* used when backtracking a xcMapWindow in order to hide the window */
  4072.  
  4073. void x_hide_window(display,window)
  4074.      
  4075.      Display *display; long window;
  4076.      
  4077. {
  4078.   XUnmapWindow(display,window);
  4079.   XSync(display,0);
  4080. }
  4081.  
  4082.  
  4083. /*** RM 8/12/92 ***/
  4084.  
  4085. /*****************************************************************/
  4086. /* used when backtracking a xcUnmapWindow in order to show the window */
  4087.  
  4088. void x_show_subwindow(display,window)
  4089.      
  4090.      Display *display; long window;
  4091.      
  4092. {
  4093.   XMapSubwindows(display,window);
  4094.   XSync(display,0);
  4095. }
  4096.  
  4097.  
  4098. /*****************************************************************/
  4099. /* used when backtracking a xcMapWindow in order to hide the window */
  4100.  
  4101. void x_hide_subwindow(display,window)
  4102.      
  4103.      Display *display; long window;
  4104.      
  4105. {
  4106.   XUnmapSubwindows(display,window);
  4107.   XSync(display,0);
  4108. }
  4109.  
  4110. /*** RM 8/12/92 ***/
  4111.  
  4112.  
  4113.  
  4114. /***  RM: Apr 20 1993 ***/
  4115.  
  4116.  
  4117. /*
  4118.   xcQueryTextExtents(display,font,string,
  4119.   direction,font-ascent,font-descent,
  4120.   left-bearing,right-bearing,width,ascent,descent)
  4121.   */
  4122.  
  4123. long xcQueryTextExtents()
  4124.      
  4125. {
  4126.   include_var_builtin(11);
  4127.   ptr_definition types[11];
  4128.   Font font;
  4129.   XCharStruct over;
  4130.   int i;
  4131.   int direction,ascent,descent; /* RM: 28 Jan 94 */
  4132.   
  4133.   types[0] = real;   /* +Display       */
  4134.   types[1] = real;   /* +Font ID       */
  4135.   types[2] = quoted_string; /* +String        */
  4136.   types[3] = real;   /* -Direction     */
  4137.   types[4] = real;   /* -Font-ascent   */
  4138.   types[5] = real;   /* -Font-descent  */
  4139.   types[6] = real;   /* -left bearing  */
  4140.   types[7] = real;   /* -right bearing */
  4141.   types[8] = real;   /* -width         */
  4142.   types[9] = real;   /* -ascent        */
  4143.   types[10]= real;   /* -descent       */
  4144.   
  4145.   
  4146.   
  4147.   begin_builtin(xcLoadFont,11,3,types);
  4148.   
  4149.  
  4150.   XQueryTextExtents(DISP(0),
  4151.             (XID)val[1],
  4152.             STRG(2),
  4153.             strlen(STRG(2)),
  4154.             &direction,
  4155.             &ascent,
  4156.             &descent,
  4157.             &over);
  4158.  
  4159.   val[3]=direction;
  4160.   val[4]=ascent;
  4161.   val[5]=descent;
  4162.   
  4163.   val[6] =over.lbearing;
  4164.   val[7] =over.rbearing;
  4165.   val[8] =over.width;
  4166.   val[9] =over.ascent;
  4167.   val[10]=over.descent;
  4168.   
  4169.   for(i=3;i<11;i++)
  4170.     unify_real_result(args[i],(REAL)val[i]);
  4171.   
  4172.   end_builtin();
  4173. }
  4174. /***  RM: Apr 20 1993  ***/
  4175.  
  4176.  
  4177. /*****************************************************************/
  4178. /* not used anymore, but interesting */
  4179.  
  4180. ptr_goal GoalFromPsiTerm(psiTerm)
  4181.      
  4182.      ptr_psi_term psiTerm;
  4183.      
  4184. {
  4185.   ptr_residuation resid;
  4186.   ptr_goal aim;
  4187.   
  4188.   
  4189.   if(psiTerm == NULL)
  4190.     {
  4191.       Errorline("X error in GoalFromPsiTerm: psiTerm is null\n");
  4192.       return FALSE;
  4193.     }
  4194.   
  4195.   if((resid = psiTerm->resid) == NULL)
  4196.     {
  4197.       Errorline("X error in GoalFromPsiTerm: psiTerm has no residuating functions\n");
  4198.       return FALSE;
  4199.     }
  4200.   
  4201.   if(resid->next != NULL)
  4202.     {
  4203.       Errorline("X error in GoalFromPsiTerm: psiTerm has more than one residuating function\n");
  4204.       return FALSE;
  4205.     }
  4206.   
  4207.   if((aim = resid->goal) == NULL)
  4208.     {
  4209.       Errorline("X error in GoalFromPsiTerm: psiTerm has no goal\n");
  4210.       return FALSE;
  4211.     }
  4212.   
  4213.   return aim;
  4214. }
  4215.  
  4216.  
  4217. #endif
  4218.