C:/Users/Dennis/src/lang/Life_start/Life/life-1.02/source/xpred.c

Go to the documentation of this file.

/* Copyright 1991 Digital Equipment Corporation.
 ** Distributed only by permission.
 **
 ** Last modified on Wed Mar  2 11:32:59 MET 1994 by rmeyer
 **      modified on Fri Jan 28 14:24:13 MET 1994 by dumant
 **      modified on Thu Jun 24 06:55:40 1993 by Rmeyer
 **      modified on Thu Nov 26 20:13:50 1992 by herve
 *****************************************************************/
/*      $Id: xpred.c,v 1.3 1995/07/27 19:28:45 duchier Exp $     */

#ifndef lint
static char vcid[] = "$Id: xpred.c,v 1.3 1995/07/27 19:28:45 duchier Exp $";
#endif /* lint */


#ifdef X11



#include <stdio.h>
#include <ctype.h>
#include <malloc.h>
#include <sys/types.h>
#include <sys/time.h>
#include <sys/ioctl.h>

#ifndef NEEDXLIBINT
#include <X11/Xlib.h>
#else
#include <X11/Xlibint.h>
#endif
#include <X11/Xutil.h>
#include <X11/keysym.h>

#include "extern.h"
#include "token.h"
#include "print.h"
#include "built_ins.h"
#include "types.h"
#include "trees.h"
#include "lefun.h"
#include "login.h"
#include "error.h"
#include "memory.h"
#include "templates.h"
#include "modules.h"
#include "xpred.h"
#include "xdisplaylist.h"

#include "life_icon"


/*****************************************/


#define stdin_fileno fileno(stdin)
#define CR 0x0d
#define BS 0x08


/* a closure for enum xevents_list */
typedef struct wl_EventClosure
{
  Display *display;
  Window window;
  long mask;
  ptr_psi_term beginSpan;
} EventClosure;


/*****************************************/


ptr_psi_term xevent_existing = NULL;
ptr_psi_term xevent_list = NULL;

ptr_definition xevent,xkeyboard_event,xbutton_event,/* RM: 7/12/92 */
  xexpose_event,xdestroy_event,xmotion_event,
  
  xenter_event,xleave_event,xmisc_event,/* RM: 3rd May 93 */
  
  xdisplay,xdrawable,xwindow,xpixmap,xconfigure_event,
  xgc,xdisplaylist;


long x_window_creation = FALSE;

/*****************************************/

static long xevent_mask[] = {
0,                              /* ???                   0 */
0,                              /* ???                   1 */
KeyPressMask,                   /* KeyPress              2 */
KeyReleaseMask,                 /* KeyRelease            3 */
ButtonPressMask,                /* ButtonPress           4 */ 
ButtonReleaseMask,              /* ButtonRelease         5 */

PointerMotionMask |     PointerMotionHintMask | ButtonMotionMask |
Button1MotionMask |     Button2MotionMask |     Button3MotionMask |
Button4MotionMask |     Button5MotionMask,
                                /* MotionNotify          6 */
EnterWindowMask,                /* EnterNotify           7 */
LeaveWindowMask,                /* LeaveNotify           8 */
FocusChangeMask,                /* FocusIn               9 */
FocusChangeMask,                /* FocusOut             10 */
KeymapStateMask,                /* KeymapNotify         11 */
ExposureMask,                   /* Expose               12 */
0,                              /* GraphicsExpose       13 */
0,                              /* NoExpose             14 */
VisibilityChangeMask,           /* VisibilityNotify     15 */
SubstructureNotifyMask,         /* CreateNotify         16 */
SubstructureNotifyMask,         /* DestroyNotify        17 */
StructureNotifyMask,            /* UnmapNotify          18 */
StructureNotifyMask,            /* MapNotify            19 */
SubstructureRedirectMask,       /* MapRequest           20 */
SubstructureNotifyMask,         /* ReparentNotify       21 */
StructureNotifyMask,            /* ConfigureNotify      22 */
SubstructureRedirectMask,       /* ConfigureRequest     23 */
StructureNotifyMask,            /* GravityNotify        24 */
ResizeRedirectMask,             /* ResizeRequest        25 */
StructureNotifyMask,            /* CirculateNotify      26 */
SubstructureRedirectMask,       /* CirculateRequest     27 */
PropertyChangeMask,             /* PropertyNotify       28 */
0,                              /* SelectionClear       29 */
0,                              /* SelectionRequest     30 */
0,                              /* SelectionNotify      31 */
ColormapChangeMask,             /* ColormapNotify       32 */
0,                              /* ClientMessage        33 */
0                               /* MappingNotify        34 */
};



static char* xevent_name[] = {
  "???",
  "???",
  "KeyPress",
  "KeyRelease",
  "ButtonPress",
  "ButtonRelease",
  "MotionNotify",
  "EnterNotify",
  "LeaveNotify",
  "FocusIn",
  "FocusOut",
  "KeymapNotify",
  "Expose",
  "GraphicsExpose",
  "NoExpose",
  "VisibilityNotify",
  "CreateNotify",
  "DestroyNotify",
  "UnmapNotify",
  "MapNotify",
  "MapRequest",
  "ReparentNotify",
  "ConfigureNotify",
  "ConfigureRequest",
  "GravityNotify",
  "ResizeRequest",
  "CirculateNotify",
  "CirculateRequest",
  "PropertyNotify",
  "SelectionClear",
  "SelectionRequest",
  "SelectionNotify",
  "ColormapNotify",
  "ClientMessage",
  "MappingNotify"
};




/*****************************************************************/
/* Macros */

#define DrawableGC(w)(GC)GetIntAttr(GetPsiAttr(w,"graphic_context"),"id")
#define WindowDisplayList(w) GetIntAttr(GetPsiAttr(w,"display_list"),"id")

/* Macros to keep GCC happy. RM: Feb  9 1994  */
#define DISP(X)(Display *)val[X]
#define DRAW(X)(Drawable)val[X]
#define WIND(X)(Window)val[X]
#define GCVAL(X)(GC)val[X]
#define FONT(X)(Font)val[X]
#define CMAP(X)(Colormap)val[X]  
#define STRG(X)(char *)val[X]

  
  
/*****************************************************************/
/* Static */
/* handle the errors X */


static int x_handle_error(display,x_error)
     Display *display;
     XErrorEvent *x_error;
{
  char msg[128];
  XGetErrorText(display,x_error->error_code,msg,128);
  Errorline("X error message: %s.\n",msg);
  /* don't use abort_life(TRUE) because it tries to destroy windows ...
     and loops because the window is yet in the stack !!
     jch - Fri Aug  7 17:58:27 MET DST 1992
     */
  exit_life(TRUE);
}


static int x_handle_fatal_error(display)
     Display *display;
{
  Errorline("fatal X Error.\n");
  exit_life(TRUE);
}


/*  RM: Jun 24 1993  */
/* JCH didn't understand ANYTHING about trailing! */

void bk_stack_add_int_attr(t,attrname,value)
     ptr_psi_term t;
     char *attrname;
     long value;
{
  ptr_psi_term t1;
  ptr_node n;
  char *perm;
  

  perm=heap_copy_string(attrname);
  n=find(featcmp,perm,t->attr_list);
  if(n) {
    t1=(ptr_psi_term)n->data;
    deref_ptr(t1);
    if(!t1->value) {
      push_ptr_value(int_ptr,&(t1->value));
      t1->value=heap_alloc(sizeof(REAL));
    }
    *(REAL *)t1->value =(REAL) value;
  }
  else {
    t1=stack_psi_term(4);
    t1->type=integer;
    t1->value=heap_alloc(sizeof(REAL));
    *(REAL *)t1->value =(REAL) value;
    bk_stack_insert(featcmp,perm,&(t->attr_list),t1);
  }
}


void bk_change_psi_attr(t,attrname,value)
     ptr_psi_term t;
     char *attrname;
     ptr_psi_term value;
{
  ptr_psi_term t1;
  ptr_node n;
  char *perm;
  

  perm=heap_copy_string(attrname);
  n=find(featcmp,perm,t->attr_list);
  if(n) {
    t1=(ptr_psi_term)n->data;
    deref_ptr(t1);
    *t1= *value;
    /*push_ptr_value(psi_term_ptr,&(t1->coref));*/
    if(value!=t1)
      value->coref=t1;
  }
  else
    bk_stack_insert(featcmp,perm,&(t->attr_list),value);
}





/*****************************************************************/
/* Utility */
/* unify psi_term T to the integer value V */
/* could be in builtins.c */

long unify_int_result(t,v)
     ptr_psi_term t;
     long v;
{
  long smaller;
  long success=TRUE;
  
  
  deref_ptr(t);
  push_ptr_value(int_ptr,&(t->value));
  t->value = heap_alloc(sizeof(REAL));
  *(REAL *) t->value = v;
  
  matches(t->type,integer,&smaller);
  
  if(!smaller) 
    {
      push_ptr_value(def_ptr,&(t->type));
      t->type = integer;
      t->status = 0;
    }
  else
    success = FALSE;
  
  if(success) 
    {
      i_check_out(t);
      if(t->resid)
        release_resid(t);
    }
  
  return success;
}


/*****************************************************************/
/* Static */
/* build a psi-term of type t with a feature f of value v */

static ptr_psi_term NewPsi(t,f,v)
     ptr_definition t;
     char * f;
     long v;
{
  ptr_psi_term p;
  
  p = stack_psi_term(4);
  p->type = t;
  bk_stack_add_int_attr(p,f,v);
  return p;
}


/*****************************************************************/
/* Utilities */
/* return the value of the attribute attributeName on the psi-term psiTerm */

long GetIntAttr(psiTerm,attributeName)
     
     ptr_psi_term psiTerm;
     char *attributeName;
{
  ptr_node nodeAttr;
  ptr_psi_term psiValue;
  
  
  deref_ptr(psiTerm);
  nodeAttr=find(featcmp,attributeName,psiTerm->attr_list);
  if(!nodeAttr) {
    Errorline("in GetIntAttr: didn't find %s on %P\n",
               attributeName,
               psiTerm);
    exit_life(TRUE);
  }
  
  psiValue=(ptr_psi_term)nodeAttr->data;
  deref_ptr(psiValue);
  if(psiValue->value)
    return *(REAL *) psiValue->value;
  else {
    /* Errorline("in GetIntAttr: no value!\n"); */
    return -34466; /* Real nasty hack for now  RM: Apr 23 1993  */
  }
}



/*****************************************************************/
/* Utilities */
/* return the psi-term of the attribute attributeName on the psi-term psiTerm */

ptr_psi_term GetPsiAttr(psiTerm,attributeName)
     
     ptr_psi_term psiTerm;
     char *attributeName;
{
  ptr_node nodeAttr;
  ptr_psi_term psiValue;
  
  
  if((nodeAttr = find(featcmp,attributeName,psiTerm->attr_list)) == NULL)
    {
      Errorline("in GetPsiAttr: no attribute name on psi-term ?\n");
      exit_life(TRUE);
    }
  
  if((psiValue =(ptr_psi_term) nodeAttr->data) == NULL)
    {
      Errorline("in GetPsiAttr: no value on psi-term ?\n");
      exit_life(TRUE);
    }
  
  return psiValue;
}

/*****************************************************************/
/* Static */
/* resize the pixmap of the window */

static void ResizePixmap(psi_window,display,window,width,height)
     
     ptr_psi_term psi_window;
     Display *display;
     Window window;
     unsigned long width,height;
{
  Pixmap pixmap;
  GC pixmapGC;
  ptr_psi_term psiPixmap,psiPixmapGC;
  XGCValues gcvalues;
  XWindowAttributes attr;
  ptr_psi_term psi_gc;
  
    
  /* free the old pixmap */
  psiPixmap = GetPsiAttr(psi_window,"pixmap");
  psiPixmapGC=NULL;
  
  if((pixmap = GetIntAttr(psiPixmap,"id")) != 0)
    {
      /* change the pixmap */
      XFreePixmap(display,pixmap);
      /* change the pixmap'gc too,because the gc is created on the pixmap ! */

      psiPixmapGC = GetPsiAttr(psiPixmap,"graphic_context");

      /*  RM: Jun 24 1993  */
      pixmapGC=(GC)GetIntAttr(psiPixmapGC,"id");
      if(pixmapGC)
        XFreeGC(display,pixmapGC);
      
      bk_stack_add_int_attr(psiPixmap,"id",NULL);
      bk_stack_add_int_attr(psiPixmapGC,"id",NULL);
    }
  
  /* init a new pixmap on the window */
  XGetWindowAttributes(display,window,&attr);
  if((pixmap = XCreatePixmap(display,window,
                               attr.width+1,attr.height+1,
                               attr.depth)) != 0)
    {
      bk_stack_add_int_attr(psiPixmap,"id",pixmap);
      gcvalues.cap_style = CapRound;
      gcvalues.join_style = JoinRound;
      pixmapGC = XCreateGC(display,pixmap,
                            GCJoinStyle|GCCapStyle,&gcvalues);

      /*  RM: Jun 24 1993  */
      if(psiPixmapGC)
        bk_stack_add_int_attr(psiPixmapGC,"id",pixmapGC);
      else
        psiPixmapGC=NewPsi(xgc,"id",pixmapGC);
      bk_change_psi_attr(psiPixmap,"graphic_context",psiPixmapGC);
    }
}


/*****************************************************************/
/* Static */
/* free all attributes of a window,that is: its display list,its gc,
   its pixmap ... */

static void FreeWindow(display,psi_window)
     
     Display *display;
     ptr_psi_term psi_window;
     
{
  ptr_psi_term psiPixmap;
  
  
  XFreeGC(display,DrawableGC(psi_window));
  x_free_display_list(WindowDisplayList(psi_window));
  
  psiPixmap = GetPsiAttr(psi_window,"pixmap");
  XFreeGC(display,DrawableGC(psiPixmap));
  XFreePixmap(display,GetIntAttr(psiPixmap,"id"));
}


/*****************************************************************/
/******** xcOpenConnection
  
  xcOpenConnection(+Name,-Connection)
  
  open a connection to the X server.
  
  */

long xcOpenConnection()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  char *display;
  Display * connection;
  ptr_psi_term psiConnection;
  
  
  types[0] = quoted_string;
  types[1] = xdisplay;
  
  
  begin_builtin(xcOpenConnection,2,1,types);
  
  if(strcmp(STRG(0),""))
    display =STRG(0);
  else
    display = NULL; 
  
  if(connection = XOpenDisplay(display))
    {
      psiConnection = NewPsi(xdisplay,"id",connection);
      push_goal(unify,psiConnection,args[1],NULL);
      
      success = TRUE;
    }
  else
    {
      Errorline("could not open connection in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** xcDefaultRootWindow
  
  xcDefaultRootWindow(+Display,-Root)
  
  return the root window of the given display
  
  */

long xcDefaultRootWindow()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  Display *display;
  ptr_psi_term psiRoot;
  
  
  types[0] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcDefaultRootWindow,2,1,types);
  
  display = DISP(0);
  
  psiRoot = NewPsi(xwindow,"id",DefaultRootWindow(display));
  
  push_goal(unify,psiRoot,args[1],NULL);
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** static GetConnectionAttribute */

static long GetConnectionAttribute(display,attributeId,attribute)
     
     Display *display;
     long attributeId,*attribute;
     
{
  switch(attributeId) 
    {
    case 0: 
      *attribute =(unsigned long) ConnectionNumber(display);
      break;
    case 1: 
#ifndef __alpha
      *attribute =(unsigned long)(display->proto_major_version);
#endif
      break;
    case 2: 
#ifndef __alpha
      *attribute =(unsigned long)(display->proto_minor_version);
#endif
      break;
    case 3: 
      *attribute =(unsigned long) ServerVendor(display);
      break;
    case 4: 
      *attribute =(unsigned long) ImageByteOrder(display);
      break;
    case 5: 
      *attribute =(unsigned long) BitmapUnit(display);
      break;
    case 6: 
      *attribute =(unsigned long) BitmapPad(display);
      break;
    case 7: 
      *attribute =(unsigned long) BitmapBitOrder(display);
      break;
    case 8: 
      *attribute =(unsigned long) VendorRelease(display);
      break;
    case 9:
#ifndef __alpha
      *attribute =(unsigned long)(display->qlen);
#endif
      break;
    case 10: 
      *attribute =(unsigned long) LastKnownRequestProcessed(display);
      break;
    case 11: 
#ifndef __alpha
      *attribute =(unsigned long)(display->request);
#endif
      break;
    case 12: 
      *attribute =(unsigned long) DisplayString(display); 
      break;
    case 13: 
      *attribute =(unsigned long) DefaultScreen(display); 
      break;
    case 14: 
#ifndef __alpha
      *attribute =(unsigned long)(display->min_keycode);
#endif
      break;
    case 15: 
#ifndef __alpha
      *attribute =(unsigned long)(display->max_keycode);
#endif
      break;
    default: 
      return FALSE;
      break;
    }
  
  return TRUE;
}


long xcQueryTextExtents(); /*  RM: Apr 20 1993  */


/*****************************************************************/
/******** xcGetConnectionAttribute
  
  xcGetConnectionAttribute(+Display,+AttributeId,-Value)
  
  returns the value corresponding to the attribute id.
  
  */

long xcGetConnectionAttribute()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  long attr;
  
  
  types[0] = real;
  types[1] = real;
  types[2] = real;
  
  begin_builtin(xcGetConnectionAttribute,3,2,types);
  
  if(GetConnectionAttribute(DISP(0),DRAW(1),&attr))
    {
      unify_real_result(args[2],(REAL) attr);
      success = TRUE;
    }
  else
    {
      Errorline("could not get connection attribute in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** GetScreenAttribute */

static long GetScreenAttribute(display,screen,attributeId,attribute)
     
     Display *display;
     long screen,attributeId,*attribute;
     
{
  Screen *s;
  
  
  s = ScreenOfDisplay(display,screen);
  switch(attributeId) 
    {
    case 0: 
      *attribute =(unsigned long) DisplayOfScreen(s);
      break;
    case 1: 
      *attribute =(unsigned long) RootWindowOfScreen(s);
      break;
    case 2: 
      *attribute =(unsigned long) WidthOfScreen(s);
      break;
    case 3: 
      *attribute =(unsigned long) HeightOfScreen(s);
      break;
    case 4: 
      *attribute =(unsigned long) WidthMMOfScreen(s);
      break;
    case 5: 
      *attribute =(unsigned long) HeightMMOfScreen(s);
      break;
    case 6: 
      *attribute =(unsigned long) DefaultDepthOfScreen(s);
      break;
    case 7: 
      *attribute =(unsigned long) DefaultVisualOfScreen(s);
      break;
    case 8: 
      *attribute =(unsigned long) DefaultGCOfScreen(s);
      break;
    case 9: 
      *attribute =(unsigned long) DefaultColormapOfScreen(s);
      break;
    case 10: 
      *attribute =(unsigned long) WhitePixelOfScreen(s);
      break;
    case 11: 
      *attribute =(unsigned long) BlackPixelOfScreen(s);
      break;
    case 12: 
      *attribute =(unsigned long) MaxCmapsOfScreen(s);
      break;
    case 13: 
      *attribute =(unsigned long) MinCmapsOfScreen(s);
      break;
    case 14: 
      *attribute =(unsigned long) DoesBackingStore(s);
      break;
    case 15: 
      *attribute =(unsigned long) DoesSaveUnders(s);
      break;
    case 16: 
      *attribute =(unsigned long) EventMaskOfScreen(s);
      break;
    default: 
      return FALSE;
      break;
    }
  
  return TRUE;
}


/*****************************************************************/
/******** xcGetScreenAttribute
  
  xcGetScreenAttribute(+Display,+Screen,+AttributeId,-Value)
  
  returns the value corresponding to the attribute id.
  
  */

long xcGetScreenAttribute()
     
{
  include_var_builtin(4);
  ptr_definition types[4];
  long attr;
  
  
  types[0] = real;
  types[1] = real;
  types[2] = real;
  types[3] = real;
  
  begin_builtin(xcGetScreenAttribute,4,3,types);
  
  if(GetScreenAttribute(DISP(0),DRAW(1),val[2],&attr))
    {
      unify_real_result(args[3],(REAL) attr);
      success = TRUE;
    }
  else
    {
      Errorline("could not get screen attribute in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** xcCloseConnection
  
  xcCloseConnection(+Connection)
  
  Close the connection.
  
  */

long xcCloseConnection()
     
{
  include_var_builtin(1);
  ptr_definition types[1];
  
  
  types[0] = real;
  
  begin_builtin(xcCloseConnection,1,1,types);
  
  XCloseDisplay(DISP(0));
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcCreateSimpleWindow
  
  xcCreateSimpleWindow(+Display,+Parent,+X,+Y,+Width,+Height,
  +BackGroundColor,+WindowTitle,+IconTitle,
  +BorderWidth,+BorderColor,
  +Permanent,+Show,-Window)
  
  create a simple window.
  
  */

long xcCreateSimpleWindow()
     
{
  include_var_builtin(14);
  ptr_definition types[14];
  Window window;
  Pixmap life_icon;
  XSizeHints hints;
  XWindowChanges changes;
  unsigned long changesMask;
  XSetWindowAttributes attributes;
  unsigned long attributesMask;
  long j;
  long permanent,show;
  Display *display;
  GC gc;
  XGCValues gcvalues;
  ptr_psi_term psiWindow;
  
  
  for(j = 0; j < 14; j++)
    types[j] = real;
  types[7]= quoted_string;
  types[8]= quoted_string;
  types[11]= boolean;
  types[12]= boolean;
  
  begin_builtin(xcCreateSimpleWindow,14,13,types);
  
  permanent = val[11];
  show = val[12];
  
  if(window = XCreateSimpleWindow(DISP(0),WIND(1),/* display,parent */
                                    val[2],val[3],/* X,Y */
                                    val[4],val[5],/* Width,Height */
                                    val[9],val[10],/* BorderWidth,BorderColor */
                                    val[6]))        /* BackGround */
    {
      psiWindow = stack_psi_term(4);
      psiWindow->type = xwindow;
      bk_stack_add_int_attr(psiWindow,"id",window);
      
      /* attach the icon of life */
      life_icon = XCreateBitmapFromData(DISP(0),window,life_icon_bits,
                                         life_icon_width,life_icon_height);
      /* set properties */
#if 0
      hints.x = val[2];
      hints.y = val[3];
      hints.width =val[4] ;
      hints.height = val[5];
      hints.flags = PPosition | PSize;
#endif
      hints.flags = 0;
      XSetStandardProperties(DISP(0),window,
                             STRG(7),STRG(8),
                             life_icon,arg_v,arg_c,
                             &hints);   
#if 0
      changes.x = val[2];
      changes.y = val[3];
      changes.width =val[4] ;
      changes.height = val[5];
      changesMask = CWX | CWY | CWWidth | CWHeight;
      display = DISP(0);
      XReconfigureWMWindow(DISP(0),window,DefaultScreen(display),
                            changesMask,&changes);
#endif
      /* set the background color */
      XSetWindowBackground(DISP(0),window,val[6]);
#if 0
      /* set the geometry before to show the window */
      XMoveResizeWindow(DISP(0),window,
                         val[2],val[3],val[4],val[5]);
#endif
      /* set the back pixel in order to have the color when deiconify */
      attributes.background_pixel = val[6];
      attributes.backing_pixel = val[6];
      attributesMask = CWBackingPixel|CWBackPixel;
      XChangeWindowAttributes(DISP(0),window,
                               attributesMask,&attributes);
      
      if(!permanent)
        {
          push_window(destroy_window,DISP(0),window);
          x_window_creation = TRUE;
        }
      else
        if(show)
          push_window(show_window,DISP(0),window);
      
#if 0
      /* map window is made in xCreateWindow(see xpred.lf) */
      /* due to the flag overrideRedirect */
      if(show)
        x_show_window(DISP(0),window);
#endif
      
      /* create a GC on the window for the next outputs */
      gcvalues.cap_style = CapRound;
      gcvalues.join_style = JoinRound;
      gc = XCreateGC(DISP(0),window,GCJoinStyle|GCCapStyle,&gcvalues);
      bk_change_psi_attr(psiWindow,"graphic_context",
                          NewPsi(xgc,"id",gc));
      
      /* init a display list on the window for the refresh window */
      bk_change_psi_attr(psiWindow,"display_list",
                          NewPsi(xdisplaylist,"id",x_display_list()));
      
      /* init a pixmap on the window for the refresh mechanism */
      bk_change_psi_attr(psiWindow,"pixmap",
                          NewPsi(xpixmap,"id",NULL));
      ResizePixmap(psiWindow,DISP(0),window,val[4],val[5]);
      
      push_goal(unify,psiWindow,args[13],NULL);
      success = TRUE;
    }
  else
    {
      Errorline("could not create a simple window in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
#if 0

xcCreateWindow is not used anymore since we use xcCreateSimpleWindow.
  I just keep this code in case - jch - Thu Aug  6 16:11:23 MET DST 1992
  
  /******** xcCreateWindow
    
    xcCreateWindow(+Connection,+Parent,+X,+Y,+Width,+Height,
    +BorderWidth,+Depth,+Class,+Visual,
    +Permanent,+Show,-Window)
    
    create a window on the display Connection.
    
    */
  
  long xcCreateWindow()

{
  include_var_builtin(13);
  ptr_definition types[13];
  Window window;
  XWindowChanges changes;
  unsigned long changesMask;
  XSizeHints hints;
  long j,permanent,show;
  GC gc;
  XGCValues gcvalues;
  
  
  for(j = 0; j < 13; j++)
    types[j] = real;
  
  begin_builtin(xcCreateWindow,13,12,types);
  
  permanent = val[10];
  show = val[11];
  
  if(window = XCreateWindow(DISP(0),WIND(1),/* display,parent */
                              val[2],val[3],/* X,Y */
                              val[4],val[5],/* Width,Height */
                              val[6],val[7],/* BorderWidth,Depth */
                              val[8],val[9],/* Class,Visual */
                              0,(XSetWindowAttributes *) NULL))
    {
      unify_real_result(args[12],(REAL) window);
      
      changes.x = val[2];
      changes.y = val[3];
      changes.width =val[4] ;
      changes.height = val[5];
      changesMask = CWX | CWY | CWWidth | CWHeight;
      XConfigureWindow(DISP(0),window,changesMask,&changes);
      
      hints.x = val[2];
      hints.y = val[3];
      hints.width =val[4] ;
      hints.height = val[5];
      hints.flags = PPosition | PSize;
      XSetNormalHints(DISP(0),window,&hints);
      
      if(!permanent)
        {
          push_window(destroy_window,DISP(0),window);
          x_window_creation = TRUE;
        }
      else
        if(show)
          push_window(show_window,DISP(0),window);
      
      if(show)
        x_show_window(DISP(0),window);
      
      /* create a GC on the window for the next outputs */
      gcvalues.cap_style = CapRound;
      gcvalues.join_style = JoinRound;
      gc = XCreateGC(DISP(0),window,GCJoinStyle|GCCapStyle,&gcvalues);
      bk_stack_add_int_attr(args[12],"gc",gc);
      
      /* init a display list on the window for the refresh window */
      bk_stack_add_int_attr(args[12],"display_list",NULL);
      
      success = TRUE;
    }
  else
    {
      Errorline("could not create window in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}

#endif


/*****************************************************************/
/******** xcSetStandardProperties
  
  xcSetStandardProperties(+Display,+Window,+WindowTitle,+IconTitle,
  +X,+Y,+Width,+Height)
  
  */

long xcSetStandardProperties()
{
  include_var_builtin(8);
  ptr_definition types[8];
  long j;
  XSizeHints hints;
  
  
  for(j=0; j<8; j++)
    types[j] = real;
  types[1] = xwindow;
  types[2] = quoted_string;
  types[3] = quoted_string;
  
  begin_builtin(xcSetStandardProperties,8,8,types);
  
  hints.x = val[4];
  hints.y = val[5];
  hints.width = val[6] ;
  hints.height = val[7];
  hints.flags = PPosition | PSize; 
  
  XSetStandardProperties(DISP(0),WIND(1),
                        (char*)val[2],(char*)val[3],/* window title,icon title */
                         None,              /* icon pixmap */
                        (char **) NULL,0, /* argv,argc */
                         &hints); 
  
  ResizePixmap(args[1],val[0],val[1],val[6],val[7]);
  
  success = TRUE;
  
  end_builtin();
  
}



/*****************************************************************/
/******** xcGetWindowGeometry
  
  xcGetWindowGeometry(+Display,+Window,-X,-Y,-Width,-Height)
  
  returns the geometry of the window.
  
  */

long xcGetWindowGeometry()
     
{
  include_var_builtin(6);
  ptr_definition types[6];
  int j,x,y;
  unsigned int w,h,bw,d;
  Window r;
  
  
  for(j=0; j<6; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcGetWindowGeometry,6,2,types);
  
  if(XGetGeometry(DISP(0),DRAW(1),
                    &r,&x,&y,&w,&h,&bw,&d))
    {
      unify_real_result(args[2],(REAL) x);
      unify_real_result(args[3],(REAL) y);
      unify_real_result(args[4],(REAL) w);
      unify_real_result(args[5],(REAL) h);
      success = TRUE;
    }
  else
    {
      Errorline("could not get the geometry in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** GetWindowAttribute */

static long GetWindowAttribute(display,window,attributeId,attribute)
     
     Display *display; long window,attributeId,*attribute;
{
  XWindowAttributes windowAttributes;
  
  
  XGetWindowAttributes(display,window,&windowAttributes);
  switch(attributeId) 
    {
    case 0: 
      *attribute = windowAttributes.x;  
      break;
    case 1: 
      *attribute = windowAttributes.y;
      break;
    case 2: 
      *attribute = windowAttributes.width;
      break;
    case 3: 
      *attribute = windowAttributes.height;
      break;
    case 4: 
      *attribute = windowAttributes.border_width;
      break;
    case 5: 
      *attribute = windowAttributes.depth;
      break;
    case 6: 
      *attribute = windowAttributes.root;
      break;
    case 7: 
      *attribute =(unsigned long)windowAttributes.screen;
      break;
    case 8: 
      *attribute =(unsigned long)windowAttributes.visual;
      break;
    case 9: 
      *attribute = windowAttributes.class;
      break;
    case 10: 
      *attribute = windowAttributes.all_event_masks;
      break;
    case 11: 
      *attribute = windowAttributes.bit_gravity;
      break;
    case 12: 
      *attribute = windowAttributes.win_gravity;
      break;
    case 13: 
      *attribute = windowAttributes.backing_store;
      break;
    case 14: 
      *attribute = windowAttributes.backing_planes;
      break;
    case 15: 
      *attribute = windowAttributes.backing_pixel;
      break;
    case 16: 
      *attribute = windowAttributes.override_redirect;
      break;
    case 17: 
      *attribute = windowAttributes.save_under;
      break;
    case 18: 
      *attribute = windowAttributes.your_event_mask;
      break;
    case 19: 
      *attribute = windowAttributes.do_not_propagate_mask;
      break;
    case 20: 
      *attribute = windowAttributes.colormap;
      break;
    case 21: 
      *attribute = windowAttributes.map_installed;
      break;
    case 22: 
      *attribute = windowAttributes.map_state;
      break;
    default: 
      return FALSE;
      break;
    }
  return TRUE;
}


/*****************************************************************/
/******** xcGetWindowAttribute
  
  xcGetWindowAttribute(+Display,+Window,+AttributeId,-Value)
  
  returns the value corresponding to the attribute id of the window.
  
  */

long xcGetWindowAttribute()
     
{
  include_var_builtin(4);
  ptr_definition types[4];
  long attr;
  
  
  types[0] = real;
  types[1] = xwindow;
  types[2] = real;
  types[3] = real;
  
  begin_builtin(xcGetWindowAttribute,4,3,types);
  
  if(GetWindowAttribute(DISP(0),WIND(1),val[2],&attr))
    {
      unify_real_result(args[3],(REAL) attr);
      success = TRUE;
    }
  else
    {
      Errorline("could not get a window attribute in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** xcSetWindowGeometry
  
  xcSetWindowGeometry(+Display,+Window,+X,+Y,+Width,+Height)
  
  set the geometry of the window.
  
  */

long xcSetWindowGeometry()
     
{
  include_var_builtin(6);
  ptr_definition types[6];
  long j;
  
  
  for(j=0; j<6; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcSetWindowGeometry,6,6,types);
  
  XMoveResizeWindow(DISP(0),DRAW(1),
                     val[2],val[3],val[4],val[5]);
  
  /* modify the pixmap */
  ResizePixmap(args[1],val[0],val[1],val[4],val[5]);
  
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcMoveWindow
  
  xcMoveWindow(+Display,+Window,+X,+Y)
  
  Move a window to a different location.
  
  */

long xcMoveWindow()   /*  RM: May  4 1993  */
     
{
  include_var_builtin(4);
  ptr_definition types[4];
  long j;
  
  
  for(j=0; j<4; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcMoveWindow,4,4,types);
  
  XMoveWindow(DISP(0),DRAW(1), val[2],val[3]);
  
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** SetWindowAttribute */

static long SetWindowAttribute(psi_window,display,window,attributeId,attribute)
     
     ptr_psi_term psi_window;
     Display *display;
     Drawable window;
     unsigned long attributeId,attribute;
     
{
  XSetWindowAttributes attributes;
  XWindowChanges changes;
  unsigned long attributesMask = 0;
  unsigned long changesMask = 0;
  long backgroundChange = FALSE;
  long sizeChange = FALSE;
  unsigned int width,height;
  int x,y;
  unsigned int bw,d;
  Window r;
  
  switch(attributeId) 
    {
    case 0: 
      changes.x = attribute;
      changesMask |= CWX;
      break;
    case 1:
      changes.y = attribute;
      changesMask |= CWY;
      break;
    case 2:
      changes.width = attribute;
      changesMask |= CWWidth;
      XGetGeometry(display,window,&r,&x,&y,&width,&height,&bw,&d);
      width = attribute;
      sizeChange = TRUE;
      break;
    case 3:
      changes.height = attribute;
      changesMask |= CWHeight;
      XGetGeometry(display,window,&r,&x,&y,&width,&height,&bw,&d);
      height = attribute;
      sizeChange = TRUE;
      break;
    case 4:
      changes.border_width = attribute;
      changesMask |= CWBorderWidth;
      break;
    case 11:
      attributes.bit_gravity = attribute;
      attributesMask |= CWBitGravity;
      break;
    case 12:
      attributes.win_gravity = attribute;
      attributesMask |= CWWinGravity;
      break;
    case 13:
      attributes.backing_store = attribute;
      attributesMask |= CWBackingStore;
      break;
    case 14:
      attributes.backing_planes = attribute;
      attributesMask |= CWBackingPlanes;
      break;
    case 15:
      attributes.backing_pixel = attribute;
      attributesMask |= CWBackingPixel;
      break;
    case 16:
      attributes.override_redirect = attribute;
      attributesMask |= CWOverrideRedirect;
      break;
    case 17:
      attributes.save_under = attribute;
      attributesMask |= CWSaveUnder;
      break;
    case 18:
      attributes.event_mask = attribute;
      attributesMask |= CWEventMask;
      break;
    case 19:
      attributes.do_not_propagate_mask = attribute;
      attributesMask |= CWDontPropagate;
      break;
    case 20:
      attributes.colormap = attribute;
      attributesMask |= CWColormap;
      break;
    case 23:
      changes.sibling = attribute;
      changesMask |= CWSibling;
      break;
    case 24:
      changes.stack_mode = attribute;
      changesMask |= CWStackMode;
      break;
    case 25:
      attributes.background_pixmap = attribute;
      attributesMask |= CWBackPixmap;
      break;
    case 26:
      attributes.background_pixel = attribute;
      attributesMask |= CWBackPixel;
      backgroundChange = TRUE;
      
      /* change the backing_pixel in order to fill the pixmap with */
      attributes.backing_pixel = attribute;
      attributesMask |= CWBackingPixel;
      break;
    case 27:
      attributes.border_pixmap = attribute;
      attributesMask |= CWBorderPixmap;
      break;
    case 28:
      attributes.border_pixel = attribute;
      attributesMask |= CWBorderPixel;
      break;
    case 29:
      attributes.cursor = attribute;
      attributesMask |= CWCursor;
      break;
    default: 
      return FALSE;
      break;
    }
  
  if(changesMask)
    XConfigureWindow(display,window,changesMask,&changes);
  
  if(attributesMask)
    XChangeWindowAttributes(display,window,attributesMask,&attributes);
  
  if(backgroundChange)
    XClearArea(display,window,0,0,0,0,True);
  
  if(sizeChange)
    ResizePixmap(psi_window,display,window,width,height);
  
  return TRUE;
}


/*****************************************************************/
/******** xcSetWindowAttribute
  
  xcSetWindowAttribute(+Display,+Window,+AttributeId,+Value)
  
  set the value corresponding to the attribute id.
  
  */

long xcSetWindowAttribute()
     
{
  include_var_builtin(4);
  ptr_definition types[4];
  
  
  types[0] = real;
  types[1] = xwindow;
  types[2] = real;
  types[3] = real;
  
  begin_builtin(xcSetWindowAttribute,4,4,types);
  
  if(SetWindowAttribute(args[1],val[0],val[1],val[2],val[3]))
    {
      XSync(DISP(0),0);
      success = TRUE;
    }
  else
    {
      Errorline("could not set window attribute in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}



/*****************************************************************/
/******** xcMapWindow
  
  xcMapWindow(+Connection,+Window)
  
  map the Window on the display Connection.
  
  */

long xcMapWindow()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcMapWindow,2,2,types);
  
  XMapWindow(DISP(0),WIND(1));
  XSync(DISP(0),0);
  
  push_window(hide_window,DISP(0),val[1]);
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcRaiseWindow
  
  xcRaiseWindow(+Connection,+Window)
  
  raise the Window on the display Connection.
  
  */

long xcRaiseWindow()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcRaiseWindow,2,2,types);
  
  XRaiseWindow(DISP(0),WIND(1));
  XSync(DISP(0),0);
  
  push_window(hide_window,DISP(0),WIND(1));
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcUnmapWindow
  
  xcUnmapWindow(+Connection,+Window)
  
  unmap the Window on the display Connection.
  
  */

long xcUnmapWindow()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcUnmapWindow,2,2,types);
  
  XUnmapWindow(DISP(0),WIND(1));
  XSync(DISP(0),0);
  
  push_window(show_window,DISP(0),WIND(1));
  success = TRUE;
  
  end_builtin();
}






/*** RM 8/12/92 START ***/


/*****************************************************************/
/******** xcMapSubwindows
  
  xcMapSubwindows(+Connection,+Window)
  
  map the sub-windows on the display Connection.
  
  */

long xcMapSubwindows()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcMapSubwindow,2,2,types);
  
  XMapSubwindows(DISP(0),WIND(1));
  XSync(DISP(0),0);
  
  push_window(hide_subwindow,DISP(0),WIND(1));
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcUnmapSubwindows
  
  xcUnmapSubwindows(+Connection,+Window)
  
  unmap the sub-windows on the display Connection.
  
  */

long xcUnmapSubwindows()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcUnmapSubwindows,2,2,types);
  
  XUnmapSubwindows(DISP(0),WIND(1));
  XSync(DISP(0),0);
  
  push_window(show_subwindow,DISP(0),WIND(1));
  success = TRUE;
  
  end_builtin();
}


/*** RM 8/12/82 END ***/





/*****************************************************************/
/******** xcClearWindow
  
  xcClearWindow(+Connection,+Window)
  
  clear the Window on the display Connection.
  
  */

long xcClearWindow()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = xwindow;
  
  begin_builtin(xcClearWindow,2,2,types);
  
  XClearWindow(DISP(0),WIND(1));
XSync(DISP(0),0);
  
  x_free_display_list(WindowDisplayList(args[1]));
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcResizeWindowPixmap
  
  xcResizeWindowPixmap(+Display,+Window,+Width,+Height)
  
  resize the pixmap of the window,useful when we caught the resize event
  eg: the window is resized manualy.
  
  */

long xcResizeWindowPixmap()
     
{
  include_var_builtin(4);
  ptr_definition types[4];
  long j;
  
  
  for(j=0; j<4; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcResizeWindowPixmap,4,4,types);
  
  /* modify the pixmap */
  ResizePixmap(args[1],val[0],val[1],val[2],val[3]);
  
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcSelectInput
  
  xcSelectInput(+Connection,+Window,+Mask)
  
  select the desired event types
  
  */

long xcSelectInput()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  
  
  types[0] = real;
  types[1] = real;
  types[2] = real;
  
  begin_builtin(xcSelectInput,3,3,types);
  
  XSelectInput(DISP(0),WIND(1),val[2]);
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcRefreshWindow
  
  
  xcRefreshWindow(+Connection,+Window)
  
  refresh the window
  
  */

long xcRefreshWindow()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  Pixmap pixmap;
  ptr_psi_term psiPixmap;
  
  
  types[0] = real;
  types[1] = xwindow;
  
  begin_builtin(xcRefreshWindow,2,2,types);
  
  psiPixmap = GetPsiAttr(args[1],"pixmap");
  if((pixmap =(Pixmap) GetIntAttr(psiPixmap,"id")) != 0)
    x_refresh_window(val[0],val[1],pixmap,
                      DrawableGC(psiPixmap),
                      WindowDisplayList(args[1]));
  else
    x_refresh_window(val[0],val[1],val[1],
                      DrawableGC(args[1]),
                      WindowDisplayList(args[1]));
  
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** xcPostScriptWindow
  
  
  xcPostScriptWindow(+Display,+Window,Filename)
  
  output the contents of the window in Filename
  
  */

long xcPostScriptWindow()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  
  
  types[0] = real;
  types[1] = xwindow;
  types[2] = quoted_string;
  
  begin_builtin(xcPostScriptWindow,3,3,types);
  
  success = x_postscript_window(val[0],val[1],
                                 GetIntAttr(GetPsiAttr(args[1],"display_list"),
                                             "id"),
                                 val[2]);
  
  end_builtin();
}



/*****************************************************************/
/******** xcDestroyWindow
  
  
  xcDestroyWindow(+Connection,+Window)
  
  Close and destroy the window(unbacktrable).
  
  */

long xcDestroyWindow()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  ptr_psi_term psi;
  
  types[0] = real;
  types[1] = xwindow;
  
  begin_builtin(xcDestroyWindow,2,2,types);
  
  psi = GetPsiAttr(args[1],"permanent");
  if(!strcmp(psi->type->keyword->symbol,"true"))
    {
      Errorline("cannot destroy a permanent window.\n");
      exit_life(TRUE); /* was: main_loop_ok=FALSE; - jch */
      success = FALSE;
    }
  else
    {
      FreeWindow(val[0],args[1]);
      XDestroyWindow(DISP(0),WIND(1));
XSync(DISP(0),0);
      clean_undo_window(DISP(0),WIND(1));
      success = TRUE;
    }
  
  end_builtin();
}



/*****************************************************************/
/******** CREATEGC
  
  xcCreateGC(+Connection,+Drawable,-GC)
  
  create a graphic context.
  
  */

long xcCreateGC()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  GC gc;
  XGCValues GCvalues;
  
  
  types[0] = real;
  types[1] = xdrawable;
  types[2] = real;
  
  begin_builtin(xcCreateGC,3,2,types);
  
  if(gc = XCreateGC(DISP(0),WIND(1),0,&GCvalues))  /* RM: Feb  7 1994 */
    {
      unify_real_result(args[2],(REAL)(unsigned long) gc);
      success = TRUE;
    }
  else
    {
      Errorline("could not create gc in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}



/*****************************************************************/
/******** GETGCATTRIBUTE */

static long GetGCAttribute(gc,attributeId,attribute)
     
     GC gc;
     long attributeId,*attribute;
     
{
#ifndef __alpha
  switch(attributeId) 
    {
    case 0:
      *attribute = gc->values.function;
      break;
    case 1:
      *attribute = gc->values.plane_mask;
      break;
    case 2:
      *attribute = gc->values.foreground;
      break;
    case 3:
      *attribute = gc->values.background;
      break;
    case 4:
      *attribute = gc->values.line_width;
      break;
    case 5:
      *attribute = gc->values.line_style;
      break;
    case 6:
      *attribute = gc->values.cap_style;
      break;
    case 7:
      *attribute = gc->values.join_style;
      break;
    case 8:
      *attribute = gc->values.fill_style;
      break;
    case 9:
      *attribute = gc->values.fill_rule;
      break;
    case 10:
      *attribute = gc->values.tile;
      break;
    case 11:
      *attribute = gc->values.stipple;
      break;
    case 12:
      *attribute = gc->values.ts_x_origin;
      break;
    case 13:
      *attribute = gc->values.ts_y_origin;
      break;
    case 14:
      *attribute = gc->values.font;
      break;
    case 15:
      *attribute = gc->values.subwindow_mode;
      break;
    case 16:
      *attribute = gc->values.graphics_exposures;
      break;
    case 17:
      *attribute = gc->values.clip_x_origin;
      break;
    case 18:
      *attribute = gc->values.clip_y_origin;
      break;
    case 19:
      *attribute = gc->values.clip_mask;
      break;
    case 20:
      *attribute = gc->values.dash_offset;
      break;
    case 21: 
      *attribute =(unsigned char)(gc->values.dashes);
      break;
    case 22:
      *attribute = gc->values.arc_mode;
      break;
    case 23:
      *attribute = gc->rects;
      break;
    case 24:
      *attribute = gc->dashes;
      break;
    default: 
      return FALSE;
      break;
    }
#endif
  return TRUE;
}


/*****************************************************************/
/******** GETGCATTRIBUTE
  
  xcGetGCAttribute(+GC,+AttributeId,-Val)
  
  get the value of the attribute id of GC.
  
  */

long xcGetGCAttribute()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  long attr;
  
  
  types[0] = real;
  types[1] = real;
  types[2] = real;
  
  begin_builtin(xcGetGCAttribute,3,2,types);
  
  if(GetGCAttribute(DISP(0),GCVAL(1),&attr))
    {
      unify_real_result(args[2],(REAL) attr);
      success = TRUE;
    }
  else
    {
      Errorline("could not get gc attribute in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}



/*****************************************************************/
/******** SETGCATTRIBUTE */

static long SetGCAttribute(display,gc,attributeId,attribute)
     
     Display *display;
     GC gc;
     long attributeId,attribute;
     
{
  XGCValues attributes;
  unsigned long attributesMask = 0;
  
  
  switch(attributeId) 
    {
    case 0:
      attributes.function = attribute;
      attributesMask |= GCFunction;
      break;
    case 1:
      attributes.plane_mask = attribute;
      attributesMask |= GCPlaneMask;
      break;
    case 2:
      attributes.foreground = attribute;
      attributesMask |= GCForeground;
      break;
    case 3:
      attributes.background = attribute;
      attributesMask |= GCBackground;
      break;
    case 4:
      attributes.line_width = attribute;
      attributesMask |= GCLineWidth;
      break;
    case 5:
      attributes.line_style = attribute;
      attributesMask |= GCLineStyle;
      break;
    case 6:
      attributes.cap_style = attribute;
      attributesMask |= GCCapStyle;
      break;
    case 7:
      attributes.join_style = attribute;
      attributesMask |= GCJoinStyle;
      break;
    case 8:
      attributes.fill_style = attribute;
      attributesMask |= GCFillStyle;
      break;
    case 9:
      attributes.fill_rule = attribute;
      attributesMask |= GCFillRule;
      break;
    case 10:
      attributes.tile = attribute;
      attributesMask |= GCTile;
      break;
    case 11:
      attributes.stipple = attribute;
      attributesMask |= GCStipple;
      break;
    case 12:
      attributes.ts_x_origin = attribute;
      attributesMask |= GCTileStipXOrigin;
      break;
    case 13:
      attributes.ts_y_origin = attribute;
      attributesMask |= GCTileStipYOrigin;
      break;
    case 14:
      attributes.font = attribute;
      attributesMask |= GCFont;
      break;
    case 15:
      attributes.subwindow_mode = attribute;
      attributesMask |= GCSubwindowMode;
      break;
    case 16:
      attributes.graphics_exposures = attribute;
      attributesMask |= GCGraphicsExposures;
      break;
    case 17:
      attributes.clip_x_origin = attribute;
      attributesMask |= GCClipXOrigin;
      break;
    case 18:
      attributes.clip_y_origin = attribute;
      attributesMask |= GCClipYOrigin;
      break;
    case 19:
      attributes.clip_mask = attribute;
      attributesMask |= GCClipMask;
      break;
    case 20:
      attributes.dash_offset = attribute;
      attributesMask |= GCDashOffset;
      break;
    case 21: 
      attributes.dashes =(char)(0xFF & attribute);
      attributesMask |= GCDashList;
      break;
    case 22:
      attributes.arc_mode = attribute;
      attributesMask |= GCArcMode;
      break;
    default: 
      return FALSE;
      break;
    }
  
  XChangeGC(display,gc,attributesMask,&attributes);
  return TRUE;
}


/*****************************************************************/
/******** SETGCATTRIBUTE
  
  xcSetGCAttribute(+Display,+GC,+AttributeId,+Val)
  
  set the value of the attribute id of GC.
  
  */

long xcSetGCAttribute()
     
{
  include_var_builtin(4);
  ptr_definition types[4];
  
  
  types[0] = real;
  types[1] = real;
  types[2] = real;
  types[3] = real;
  
  begin_builtin(xcSetGCAttribute,4,4,types);
  
  if(SetGCAttribute(DISP(0),GCVAL(1),val[2],val[3]))
    success = TRUE;
  else
    {
      Errorline("could not set gc attribute in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}



/*****************************************************************/
/******** DESTROYGC
  
  xcDestroyGC(+Connection,+GC)
  
  destroys a graphic context.
  
  */

long xcDestroyGC()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcDestroyGC,2,2,types);
  
  XFreeGC(DISP(0),GCVAL(1));
  success = TRUE;
  
  end_builtin();
}

/*****************************************************************/
/******** REQUESTCOLOR
  
  xcRequestColor(+Connection,+ColorMap,+Red,+Green,+Blue,-Pixel)
  
  get the closest color to(Red,Green,Blue) in the ColorMap
  
  */

long xcRequestColor()
     
{
  include_var_builtin(6);
  ptr_definition types[6];
  long j;
  XColor color;
  
  
  for(j=0; j<6; j++)
    types[j] = real;
  
  begin_builtin(xcRequestColor,6,5,types);
  
  color.red =(val[2]) << 8;
  color.green =(val[3]) << 8;
  color.blue =(val[4]) << 8;
  color.flags = DoRed|DoGreen|DoBlue;
  
  if(XAllocColor(DISP(0),CMAP(1),&color))
    {
      unify_real_result(args[5],(REAL) color.pixel);
      success = TRUE;
    }
  else
    {
      Errorline("could not request a color in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** REQUESTNAMEDCOLOR
  
  xcRequestNamedColor(+Connection,+ColorMap,+Name,-Pixel)
  
  get the color corresponding to Name in the ColorMap
  
  */

long xcRequestNamedColor()
     
{
  include_var_builtin(4);
  ptr_definition types[4];
  long j;
  XColor cell,rgb;
  
  types[0] = real;
  types[1] = real;
  types[2] = quoted_string;
  types[3] = real;
  
  begin_builtin(xcRequestNamedColor,4,3,types);
  
  if(XAllocNamedColor(DISP(0),CMAP(1),STRG(2),&cell,&rgb))
    {
      unify_real_result(args[3],(REAL) cell.pixel);
      success = TRUE;
    }
  else
    {
      Errorline("could not request a named color in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** FREECOLOR
  
  xcFreeColor(+Connection,+ColorMap,+Pixel)
  
  free the color in the colormap
  
  */

long xcFreeColor()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  long j;
  unsigned long pixel;
  
  
  for(j=0; j<3; j++)
    types[j] = real;
  
  begin_builtin(xcFreeColor,3,3,types);
  
  pixel = val[2];
  XFreeColors(DISP(0),CMAP(1),&pixel,1,0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** DrawLine
  
  xcDrawLine(+Connection,+Drawable,+X0,+Y0,+X1,+Y1,
  +Function,+Color,+LineWidth)
  
  draw a line(X0,Y0) ->(X1,Y1)
  
  */

long xcDrawLine()
     
{
  include_var_builtin(9);
  ptr_definition types[9];
  long j;
  GC gc;
  
  
  for(j = 0; j < 9; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcDrawLine,9,9,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[6],val[7],val[8],xDefaultFont);
  
  XDrawLine(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
             val[2],val[3],val[4],val[5]);         /* X0,Y0,X1,Y1 */
  
  x_record_line(WindowDisplayList(args[1]),DRAW_LINE,
                 val[2],val[3],val[4],val[5],
                 val[6],val[7],val[8]);
  
XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}

/*****************************************************************/
/******** DrawArc
  
  xcDrawArc(+Connection,+Drawable,+X,+Y,+Width,+Height,+StartAngle,+ArcAngle,
  +Function,+Color,+LineWidth)
  
  draw arc(see X Vol.2 page 135 for the meanings of the arguments).
  
  */

long xcDrawArc()
     
{
  include_var_builtin(11);
  ptr_definition types[11];
  long j;
  GC gc;
  
  
  for(j = 0; j < 11; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcDrawArc,11,11,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[8],val[9],val[10],xDefaultFont);
  
  XDrawArc(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
            val[2],val[3],val[4],val[5],         /* X,Y,Width,Height */
            val[6],val[7]);                         /* StartAngle,ArcAngle */
  
  x_record_arc(WindowDisplayList(args[1]),DRAW_ARC,
                val[2],val[3],val[4],val[5],
                val[6],val[7],val[8],val[9],val[10]);
  
XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** DrawRectangle
  
  xcDrawRectangle(+Connection,+Drawable,+X,+Y,+Width,+Height,
  +Function,+Color,+LineWidth)
  
  draw a rectangle.
  
  */

long xcDrawRectangle()
     
{
  include_var_builtin(9);
  ptr_definition types[9];
  long j;
  GC gc;
  
  
  for(j = 0; j < 9; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcDrawRectangle,9,9,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[6],val[7],val[8],xDefaultFont);
  
  XDrawRectangle(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
                  val[2],val[3],val[4],val[5]);         /* X,Y,Width,Height */
  
  x_record_rectangle(WindowDisplayList(args[1]),DRAW_RECTANGLE,
                      val[2],val[3],val[4],val[5],
                      val[6],val[7],val[8]);
  
XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** FillRectangle
  
  xcFillRectangle(+Connection,+Drawable,+X,+Y,+Width,+Height,
  +Function,+Color)
  
  fill a rectangle.
  
  */

long xcFillRectangle()
     
{
  include_var_builtin(8);
  ptr_definition types[8];
  long j;
  GC gc;
  
  
  for(j = 0; j < 8; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcFillRectangle,8,8,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[6],val[7],xDefaultLineWidth,xDefaultFont); 
  
  XFillRectangle(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
                  val[2],val[3],val[4],val[5]);         /* X,Y,Width,Height */
  
  x_record_rectangle(WindowDisplayList(args[1]),FILL_RECTANGLE,
                      val[2],val[3],val[4],val[5],
                      val[6],val[7],
                      xDefaultLineWidth);
  
XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** FillArc
  
  xcFillArc(+Connection,+Drawable,+X,+Y,+Width,+Height,+StartAngle,+ArcAngle,
  +Function,+Color)
  fill an arc.
  
  */

long xcFillArc()
     
{
  include_var_builtin(10);
  ptr_definition types[10];
  long j;
  GC gc;
  
  
  for(j = 0; j < 10; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcFillArc,10,10,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[8],val[9],xDefaultLineWidth,xDefaultFont);
  
  XFillArc(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
            val[2],val[3],val[4],val[5],         /* X,Y,Width,Height */
            val[6],val[7]);                         /* StartAngle,ArcAngle */
  
  x_record_arc(WindowDisplayList(args[1]),FILL_ARC,
                val[2],val[3],val[4],val[5],
                val[6],val[7],val[8],val[9],
                xDefaultLineWidth);
  
XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** PointsAlloc
  
  xcPointsAlloc(+NbPoints,-Points)
  
  allocate n points
  */

long xcPointsAlloc()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  long Points;
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcPointsAlloc,2,1,types);
  Points =(long) malloc((val [0]) * 2 * sizeof(short));
  unify_real_result(args[1],(REAL) Points);
  
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** CoordPut
  
  xcCoordPut(+Points,+N,+Coord)
  
  put nth coordinate in Points
  */

long xcCoordPut()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  short *Points;
  
  types[0] = real;
  types[1] = real;
  types[2] = real;
  
  begin_builtin(xcCoordPut,3,3,types);
  
  Points =(short *) val [0];
  Points += val[1];
  *Points = val[2];
  
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** PointsFree
  
  xcPointsFree(+Points)
  
  free points
  */

long xcPointsFree()
     
{
  include_var_builtin(1);
  ptr_definition types[1];
  
  
  types[0] = real;
  
  begin_builtin(xcPointsFree,1,1,types);
  free((void *)val [0]);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** DrawPolygon
  
  xcDrawPolygon(+Connection,+Drawable,+Points,+NbPoints,
  +Function,+Color,+LineWidth)
  
  draw a polygon.
  
  */

long xcDrawPolygon()
     
{
  include_var_builtin(7);
  ptr_definition types[7];
  long j;
  GC gc;
  
  
  for(j = 0; j < 7; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcDrawPolygon,7,7,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[4],val[5],val[6],xDefaultFont); 
  
  XDrawLines(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
             (XPoint *)val[2],val[3],CoordModeOrigin);        /* Points,NbPoints,mode */
  
  x_record_polygon(WindowDisplayList(args[1]),DRAW_POLYGON,
                    val[2],val[3],val[4],val[5],val[6]);
  
XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** FillPolygon
  
  xcFillPolygon(+Connection,+Drawable,+Points,+NbPoints,+Function,+Color)
  
  fill a polygon.
  
  */

long xcFillPolygon()
     
{
  include_var_builtin(6);
  ptr_definition types[6];
  long j;
  GC gc;
  
  
  for(j = 0; j < 6; j++)
    types[j] = real;
  types[1] = xdrawable;
  
  begin_builtin(xcFillPolygon,6,6,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[4],val[5],xDefaultLineWidth,xDefaultFont); 
  
  XFillPolygon(DISP(0),(Window) val[1],gc,/* Display,Window,GC */
               (XPoint *)val[2],val[3],   /* Points,NbPoints */
               Complex,CoordModeOrigin);  /* shape,mode */
  
  x_record_polygon(WindowDisplayList(args[1]),FILL_POLYGON,
                    val[2],val[3],val[4],val[5],
                    xDefaultLineWidth);
  
  XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** LoadFont
  
  xcLoadFont(+Connection,+Name,-Font)
  
  load a font.
  
  */

long xcLoadFont()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  Font font;
  
  
  types[0] = real;
  types[1] = quoted_string;
  types[2] = real;
  
  begin_builtin(xcLoadFont,3,2,types);
  
  if(font=XLoadFont(DISP(0),STRG(1)))
    {
      unify_real_result(args[2],(REAL) font);
      XSync(DISP(0),0);
      success = TRUE;
    }
  else
    {
      Errorline("could not load a font in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}



/*****************************************************************/
/******** UnloadFont
  
  xcUnloadFont(+Connection,+Font)
  
  unload a font.
  
  */

long xcUnloadFont()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcUnloadFont,2,2,types);
  
  XUnloadFont(DISP(0),FONT(1));
  XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** DrawString
  
  xcDrawString(+Connection,+Drawable,+X,+Y,String,
  +Font,+Function,+Color)
  
  Print the string(only foreground).
  
  */

long xcDrawString()
{
  include_var_builtin(8);
  ptr_definition types[8];
  long j;
  GC gc;
  
  
  for(j = 0; j < 8; j++)
    types[j] = real;
  types[1] = xdrawable;
  types[4] = quoted_string;
  
  begin_builtin(xcDrawString,8,8,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[6],val[7],xDefaultLineWidth,val[5]);
  
  XDrawString(DISP(0),(Window) val[1],gc, /* Display,Window,GC */
               val[2],val[3],STRG(4),                  /* X,Y *//* String */
               strlen(STRG(4)));                /* Length */
  
  x_record_string(WindowDisplayList(args[1]),DRAW_STRING,
                   val[2],val[3],      /* X,Y */
                  STRG(4),     /* String */
                   val[5],              /* Font */
                   val[6],val[7]);      /* Function,Color */
  
  XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** DrawImageString
  
  xcDrawImageString(+Connection,+Drawable,+X,+Y,String,
  +Font,+Function,+Color)
  
  Print the string(foreground+background).
  
  */

long xcDrawImageString()
{
  include_var_builtin(8);
  ptr_definition types[8];
  long j;
  GC gc;
  
  
  for(j = 0; j < 8; j++)
    types[j] = real;
  types[1] = xdrawable;
  types[4] = quoted_string;
  
  begin_builtin(xcDrawImageString,8,8,types);
  
  gc = DrawableGC(args[1]);
  x_set_gc(val[0],gc,val[6],val[7],xDefaultLineWidth,val[5]);
  
  XDrawImageString(DISP(0),WIND(1),gc,          /* Display,Window,GC */
                    val[2],val[3],              /* X,Y */
                    STRG(4),                      /* String */
                    strlen(STRG(4)));    /* Length */
  
  x_record_string(WindowDisplayList(args[1]),DRAW_IMAGE_STRING,
                   val[2],val[3],               /* X,Y */
                  STRG(4),              /* String */
                   val[5],                       /* Font */
                   val[6],val[7]);               /* Function,Color */
  
  XSync(DISP(0),0);
  success = TRUE;
  
  end_builtin();
}


/*****************************************************************/
/******** StringWidth
  
  xcStringWidth(+Connection,+Font,+String)
  
  
  returns the width in pixels of the string in the given font.
  
  */

long xcStringWidth()
{
  include_var_builtin(3);
  ptr_definition types[3];
  int direction,ascent,descent;
  XCharStruct overall;
  
  
  types[0] = real;
  types[1] = real;
  types[2] = quoted_string;
  
  begin_builtin(xcStringWidth,3,3,types);
  
  if(XQueryTextExtents(DISP(0),FONT(1),
                       STRG(2),strlen(STRG(2)),/* string,nbchars */
                       &direction,&ascent,&descent,&overall))
    {
      unify_real_result(aim->b,(REAL) overall.width);
      success = TRUE;
    }
  else
    {
      Errorline("bad font in %P.\n",g);
      success = FALSE;
    }
  
  end_builtin();
}


/*****************************************************************/
/******** SYNC
  
  xcSync(+Connection,+Discard)
  
  flush the output of the connection.
  
  */

long xcSync()
     
{
  include_var_builtin(2);
  ptr_definition types[2];
  
  
  types[0] = real;
  types[1] = real;
  
  begin_builtin(xcSync,2,2,types);
  
  XSync(DISP(0),val[1]);
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/******** EVENTtoPSITERM */

static ptr_psi_term xcEventToPsiTerm(event)
     
     XEvent *event;
     
{
  ptr_psi_term psiEvent,psi_str;
  KeySym keysym;
  char buffer[10];
  char tstr[2], *str;

  str=tstr;
  tstr[1]=0;
  
  psiEvent = stack_psi_term(4);
  bk_stack_add_int_attr(psiEvent,"display",event->xany.display);
  bk_stack_add_int_attr(psiEvent,"window",event->xany.window);
  
  switch(event->type) {
  case KeyPress:
  case KeyRelease:
    psiEvent->type = xkeyboard_event;
    bk_stack_add_int_attr(psiEvent,"x",event->xkey.x);
    bk_stack_add_int_attr(psiEvent,"y",event->xkey.y);
    bk_stack_add_int_attr(psiEvent,"state",event->xkey.state);
    
    buffer[0] = 0;
    *str = 0;
    XLookupString((XKeyEvent*)event,buffer,sizeof(buffer),&keysym,NULL);
    bk_stack_add_int_attr(psiEvent,"keycode",buffer[0]);
    if(keysym==XK_Return || keysym==XK_KP_Enter || keysym==XK_Linefeed)
      *str = CR;
    else
      if(keysym == XK_BackSpace || keysym == XK_Delete)
        *str = BS;
      else
        if(isascii(buffer[0]))
          /* if(isalnum(buffer[0]) || isspace(buffer[0])) 8.10 */
          *str = buffer[0];
    
    bk_stack_add_int_attr(psiEvent,"char",*str);
    break;
    
  case ButtonPress:
  case ButtonRelease:
    psiEvent->type = xbutton_event;
    bk_stack_add_int_attr(psiEvent,"x",event->xbutton.x);
    bk_stack_add_int_attr(psiEvent,"y",event->xbutton.y);
    bk_stack_add_int_attr(psiEvent,"x_root",event->xbutton.x_root);
    bk_stack_add_int_attr(psiEvent,"y_root",event->xbutton.y_root);
    bk_stack_add_int_attr(psiEvent,"state",event->xbutton.state);
    bk_stack_add_int_attr(psiEvent,"button",event->xbutton.button);
    break;
    
  case Expose:
    psiEvent->type = xexpose_event;
    bk_stack_add_int_attr(psiEvent,"width",event->xexpose.width);
    bk_stack_add_int_attr(psiEvent,"height",event->xexpose.height);
    break;
    
  case DestroyNotify:
    psiEvent->type = xdestroy_event;
    break;
    
    /*** RM 7/12/92 ***/
  case MotionNotify:
    psiEvent->type = xmotion_event;
    bk_stack_add_int_attr(psiEvent,"x",event->xbutton.x);
    bk_stack_add_int_attr(psiEvent,"y",event->xbutton.y);
    bk_stack_add_int_attr(psiEvent,"x_root",event->xbutton.x_root);
    bk_stack_add_int_attr(psiEvent,"y_root",event->xbutton.y_root);
    break;
    
  case ConfigureNotify:
    psiEvent->type = xconfigure_event;
    bk_stack_add_int_attr(psiEvent,"x",event->xconfigure.x);
    bk_stack_add_int_attr(psiEvent,"y",event->xconfigure.y);
    bk_stack_add_int_attr(psiEvent,"width",event->xconfigure.width);
    bk_stack_add_int_attr(psiEvent,"height",event->xconfigure.height);
    bk_stack_add_int_attr(psiEvent,"border_width",
                       event->xconfigure.border_width);
    break;
    /*** RM 7/12/92(END) ***/
    
    
    /*** RM: May 3rd 1993 ***/
  case EnterNotify:
    psiEvent->type = xenter_event;
    goto LeaveEnterCommon;
    
  case LeaveNotify:
    psiEvent->type = xleave_event;
    
  LeaveEnterCommon:
    bk_stack_add_int_attr(psiEvent,"root",     event->xcrossing.root);
    bk_stack_add_int_attr(psiEvent,"subwindow",event->xcrossing.subwindow);
    
    bk_stack_add_int_attr(psiEvent,"x",event->xcrossing.x);
    bk_stack_add_int_attr(psiEvent,"y",event->xcrossing.y);
    
    bk_stack_add_int_attr(psiEvent,"focus",event->xcrossing.focus);
    bk_stack_add_int_attr(psiEvent,"state",event->xcrossing.state);
    
    break;
    
    
  default:
    psiEvent->type = xmisc_event;
    bk_stack_add_int_attr(psiEvent,"event_type",event->type);
    break;
  }
  
  return psiEvent;
}



/*****************************************************************/

/* some stuff to handle a list of psi-terms  */
/*  RM: Dec 15 1992   Re-written to handle new list structure */



/*  RM: Dec 15 1992   Test if a list is empty  */
long list_is_nil(lst)
     
     ptr_psi_term(lst);
     
{
  deref_ptr(lst);
  return lst->type==nil;
}



/*  RM: Dec 15 1992   Return the CDR of a list */
ptr_psi_term list_cdr(lst)
     
     ptr_psi_term(lst);
{
  ptr_psi_term car;
  ptr_psi_term cdr;
  
  
  deref_ptr(lst);
  if(lst->type==alist) {
    get_two_args(lst->attr_list,&car,&cdr);
    if(cdr) {
      deref_ptr(cdr);
      return cdr;
    }
  }
  
  Errorline("X event handling error in CDR(%P)\n",lst);
  return lst;
}



/*  RM: Dec 15 1992   Return the CAR of a list */
ptr_psi_term list_car(lst)
     
     ptr_psi_term(lst);
{
  ptr_psi_term car;
  ptr_psi_term cdr;
  
  
  deref_ptr(lst);
  if(lst->type==alist) {
    get_two_args(lst->attr_list,&car,&cdr);
    if(car) {
      deref_ptr(car);
      return car;
    }
  }
  
  Errorline("X event handling error in CAR(%P)\n",lst);
  return lst;
}



/*  RM: Dec 15 1992  Set the CAR of a list */
void list_set_car(lst,value)
     
     ptr_psi_term lst;
     ptr_psi_term value;
{
  deref_ptr(lst);
  stack_insert(featcmp,one,&(lst->attr_list),value);
}


/*  RM: Dec 15 1992  Set the CDR of a list */
void list_set_cdr(lst,value)
     
     ptr_psi_term lst;
     ptr_psi_term value;
{
  deref_ptr(lst);
  stack_insert(featcmp,two,&(lst->attr_list),value);
}



/*  RM: Dec 15 1992  Return the last element of a list */
ptr_psi_term list_last_cdr(lst)
     
     ptr_psi_term lst;
{
  while(!list_is_nil(lst))
    lst=list_cdr(lst);
  return lst;
}



/*  RM: Dec 15 1992  Append an element to a list,return the new CONS cell */
ptr_psi_term append_to_list(lst,value)
     
     ptr_psi_term lst;
     ptr_psi_term value;
{
  ptr_psi_term end;
  
  end=list_last_cdr(lst);
  push_ptr_value_global(psi_term_ptr,&(end->coref));
  end->coref=stack_cons(value,stack_nil());
  return end->coref;
}


/*  RM: Dec 15 1992
    Map a function,while TRUE,over the CONS cells of a list */
long map_funct_over_list(lst,proc,closure)
     ptr_psi_term lst;
     long(*proc)();
     long *closure;
{
  long notInterrupted=TRUE;
  
  while(notInterrupted && !list_is_nil(lst)) {
    notInterrupted =(*proc)(lst,closure);
    lst=list_cdr(lst);
  }
  
  return notInterrupted;
}



/*  RM: Dec 15 1992  Same thing,except map over the CARs of the list */
long map_funct_over_cars(lst,proc,closure)
     ptr_psi_term lst;
     long(*proc)();
     long *closure;
{
  ptr_psi_term cdr;
  int   notInterrupted = TRUE;
  
  while(notInterrupted && !list_is_nil(lst)) {
    /* save the next because the current could be removed
      (eg: xcFlushEvents) */
    
    cdr=list_cdr(lst);
    notInterrupted=(*proc)(list_car(lst),closure);
    lst=cdr;
  }
  
  return notInterrupted;
}



/*  RM: Dec 15 1992  Re-written for new lists */
void list_remove_value(lst,value)
     
     ptr_psi_term lst;
     ptr_psi_term value;
{
  ptr_psi_term car,cdr;
  long still_there=TRUE;
  
  deref_ptr(value);
  while(!list_is_nil(lst) && still_there) {
    car=list_car(lst);
    cdr=list_cdr(lst);
    if(car==value) {
      still_there=FALSE;
      push_ptr_value_global(psi_term_ptr,&(lst->coref));
      lst->coref=cdr;
    }
    lst=cdr;
  }
}



/*****************************************************************/
/* Static */
/* return FALSE if the events match */

static long x_union_event(psiEvent,closure)
     
     ptr_psi_term psiEvent;
     EventClosure *closure;
     
{
  return !((Display *)GetIntAttr(psiEvent,"display") == closure->display
           && (Window)GetIntAttr(psiEvent,"window") == closure->window
           &&(GetIntAttr(psiEvent,"mask") & closure->mask) != 0);
}





/*****************************************************************/
/******** GetEvent
  
  xcGetEvent(+Display,+Window,+Mask)
  
  return an event matching the mask in the window.
  if no event residuate the call else return a null event.
  
  */

long xcGetEvent()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  XEvent event;
  ptr_psi_term psiEvent;
  ptr_psi_term eventElt;
  EventClosure eventClosure;
  ptr_psi_term result;
  
  
  types[0] = real;
  types[1] = xwindow;
  types[2] = real;

  result=aim->b;
  
  begin_builtin(xcGetEvent,3,3,types);
  
  if(!xevent_existing) {
        
    /* warning if a same event is already waiting */
    eventClosure.display =DISP(0);
    eventClosure.window  =WIND(1);
    eventClosure.mask    = val[2];
    if(!map_funct_over_cars(xevent_list,x_union_event,&eventClosure))
      Warningline("you have coinciding event handlers on the same window");
    
    /* transform the request into a psi-term */
    eventElt = stack_psi_term(4);
    bk_stack_add_int_attr(eventElt,"display",val[0]);
    bk_stack_add_int_attr(eventElt,"window",val[1]);
    bk_stack_add_int_attr(eventElt,"mask",val[2]);

    /* stack_insert(featcmp,"event",&(eventElt->attr_list),result); */
                   
    /* add the request in the list of waiting events */
    append_to_list(xevent_list,eventElt); /*  RM: Dec 15 1992  */
      
    /* residuate the call */
    residuate(eventElt);  /* RM: May  5 1993  */
    
    /* return a psi-term containing an `empty' event */
    /* psiEvent = stack_psi_term(4);
       psiEvent->type = xevent;  RM: May  5 1993  */
  }
  else {
    /* get the event built by x_exist_event */
    psiEvent = GetPsiAttr(xevent_existing,"event");
    push_ptr_value_global(psi_term_ptr,&xevent_existing);
    xevent_existing = NULL;
    push_goal(unify,psiEvent,aim->b,NULL); /*  RM: May  5 1993  */
  }
  
  /* push_goal(unify,psiEvent,aim->b,NULL);   RM: May  5 1993  */
  
  success = TRUE;
  
  end_builtin();
}



/*****************************************************************/
/* Static */
/* remove the event from the queue if matching */

static long x_flush_event(eventElt,closure)
     ptr_psi_term eventElt;
     EventClosure *closure;
{
  ptr_psi_term psiEvent;
  
  
  psiEvent = list_car(eventElt);
  if ((Display *)GetIntAttr(psiEvent,"display") == closure->display
       && (Window)GetIntAttr(psiEvent,"window") ==closure->window
       && (GetIntAttr(psiEvent,"mask") & closure->mask) != 0)
    {
      /* 9.10 */
      /* if(xevent_list == eventElt) */
      /*     push_ptr_value_global(psi_term_ptr,&xevent_list); */
      /* xevent_list = list_remove_value(xevent_list,psiEvent); */
      list_remove_value(xevent_list,psiEvent); /*  RM: Dec 15 1992  */
    }
  
  return TRUE;
}


/*****************************************************************/
/******** FlushEvents
  
  xcFlushEvents(+Display,+Window,+Mask)
  
  flush all residuated events matching(display,window,mask).
  
  */

long xcFlushEvents()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  EventClosure eventClosure;
  
  
  types[0] = real;
  types[1] = xwindow;
  types[2] = real;
  
  begin_builtin(xcFlushEvents,3,3,types);
  
  eventClosure.display =DISP(0);
  eventClosure.window  = val[1];
  eventClosure.mask    = val[2];
  map_funct_over_list(xevent_list,x_flush_event,&eventClosure);
  
  success = TRUE;
  
  end_builtin();
}

#if 0

/*****************************************************************/
/******** xcSendEvent
  
  xcSendEvent(+Display,+Window,+Event)
  
  send the event to the specified window
  
  */

long xcSendEvent()
     
{
  include_var_builtin(3);
  ptr_definition types[3];
  XEvent event;
  ptr_psi_term psiEvent;
  ptr_node nodeAttr;
  ptr_psi_term psiValue;
  
  
  types[0] = real;
  types[1] = xwindow;
  types[2] = xevent;
  
  begin_builtin(xcSendEvent,3,3,types);
  
  if(xcPsiEventToEvent(val[2],&event))
    {
      XSendEvent(DISP(0),WIND(1),False,?,&event);
      success = TRUE;
    }
  else
    {
      Errorline("%P is not an event in %P.\n",val[2],g);
      success = FALSE;
    }
  
  end_builtin();
}

#endif


/*** RM: 7/12/92 ***/

/*****************************************************************/
/******** xcQueryPointer
  
  xcQueryPointer(+Display,+Window,
  -root_return,  -child_return,
  -root_x_return,-root_y_return,
  -win_x_return, -win_y_return,
  -mask_return,  -same_screen)
  
  this predicate returns a psi-term containing loads of info about where the
  pointer is at. See 'XQueryPointer' for a complete definition(the boolean
  result of XQueryPointer is stored as 'same_screen'.
  */

long xcQueryPointer()
     
{
  include_var_builtin(10);
  ptr_definition types[10];
  Window root_return,child_return;
  int root_x_return,root_y_return;
  int win_x_return,win_y_return;
  unsigned int mask_return;
  long same_screen;
  long j;
  
  
  
  for(j=0; j<10; j++)
    types[j] = real;
  
  types[1] = xdrawable;
  
  begin_builtin(xcQueryPointer,10,2,types);
  
  
  same_screen=XQueryPointer(DISP(0),
                            WIND(1),
                            &root_return,  &child_return,
                            &root_x_return,&root_y_return,
                            &win_x_return, &win_y_return,
                            &mask_return);
  
  
  unify_real_result(args[2],(REAL)root_return);
  unify_real_result(args[3],(REAL)child_return);
  unify_real_result(args[4],(REAL)root_x_return);
  unify_real_result(args[5],(REAL)root_y_return);
  unify_real_result(args[6],(REAL)win_x_return);
  unify_real_result(args[7],(REAL)win_y_return);
  unify_real_result(args[8],(REAL)mask_return);
  unify_real_result(args[9],(REAL)same_screen);
  
  /* printf("root: %ld\nchild: %ld\n",root_return,child_return); */
  
  success = TRUE;
  
  end_builtin();
}

/*** RM: 7/12/92(END) ***/


  

/*****************************************************************/
/******** SETUPBUILTINS
  
  Set up the X built-in predicates.
  
  */

void x_setup_builtins()
     
{
  set_current_module(x_module); /*  RM: Feb  3 1993  */
  
  raw_setup_builtins(); /* to move in life.c */
  
  XSetErrorHandler(x_handle_error);
  XSetIOErrorHandler(x_handle_fatal_error);
  
  set_current_module(x_module); /*  RM: Feb  3 1993  */
  xevent = update_symbol(x_module,"event");
  xkeyboard_event = update_symbol(x_module,"keyboard_event");
  xbutton_event = update_symbol(x_module,"button_event");
  xexpose_event = update_symbol(x_module,"expose_event");
  xdestroy_event = update_symbol(x_module,"destroy_event");
  
  /*** RM: 7/12/92 ***/
  xconfigure_event = update_symbol(x_module,"configure_event");
  xmotion_event = update_symbol(x_module,"motion_event");
  /*** RM: 7/12/92 ***/
  
  
  /*** RM: 3 May 92 ***/
  xenter_event = update_symbol(x_module,"enter_event");
  xleave_event = update_symbol(x_module,"leave_event");
  xmisc_event  = update_symbol(x_module,"misc_event");
  
  /*** RM: 3 May 92 ***/
  
  xdisplay = update_symbol(x_module,"display");
  xdrawable = update_symbol(x_module,"drawable");
  xwindow = update_symbol(x_module,"window");
  xpixmap = update_symbol(x_module,"pixmap");
  
  xgc = update_symbol(x_module,"graphic_context");
  xdisplaylist = update_symbol(x_module,"display_list");
  
  new_built_in(x_module,"xcOpenConnection",       predicate,xcOpenConnection);
  new_built_in(x_module,"xcDefaultRootWindow",    predicate,xcDefaultRootWindow);
  new_built_in(x_module,"xcGetScreenAttribute",   predicate,xcGetScreenAttribute);
  new_built_in(x_module,"xcGetConnectionAttribute",predicate,xcGetConnectionAttribute);
  new_built_in(x_module,"xcCloseConnection",      predicate,xcCloseConnection);
  
  new_built_in(x_module,"xcCreateSimpleWindow", predicate,xcCreateSimpleWindow);
#if 0
  new_built_in(x_module,"xcCreateWindow",       predicate,xcCreateWindow);
#endif
  
  new_built_in(x_module,"xcSetStandardProperties", predicate,xcSetStandardProperties);
  new_built_in(x_module,"xcGetWindowGeometry",  predicate,xcGetWindowGeometry);
  new_built_in(x_module,"xcSetWindowGeometry",  predicate,xcSetWindowGeometry);
  new_built_in(x_module,"xcGetWindowAttribute", predicate,xcGetWindowAttribute);
  new_built_in(x_module,"xcSetWindowAttribute", predicate,xcSetWindowAttribute);
  new_built_in(x_module,"xcMapWindow",          predicate,xcMapWindow);
  
  /*  RM: May  6 1993  */
  new_built_in(x_module,"xcRaiseWindow",          predicate,xcRaiseWindow);
  
  new_built_in(x_module,"xcUnmapWindow",        predicate,xcUnmapWindow);
  
  /*** RM 8/12/92 ***/
  new_built_in(x_module,"xcMapSubwindows",          predicate,xcMapSubwindows);
  new_built_in(x_module,"xcUnmapSubwindows",        predicate,xcUnmapSubwindows);
  /*** RM 8/12/92 ***/
  
  new_built_in(x_module,"xcClearWindow",        predicate,xcClearWindow);
  new_built_in(x_module,"xcResizeWindowPixmap", predicate,xcResizeWindowPixmap);
  
  new_built_in(x_module,"xcSelectInput",        predicate,xcSelectInput);
  new_built_in(x_module,"xcRefreshWindow",      predicate,xcRefreshWindow);
  new_built_in(x_module,"xcPostScriptWindow",   predicate,xcPostScriptWindow);
  new_built_in(x_module,"xcDestroyWindow",      predicate,xcDestroyWindow);
  
  new_built_in(x_module,"xcCreateGC",           predicate,xcCreateGC);
  new_built_in(x_module,"xcGetGCAttribute",     predicate,xcGetGCAttribute);
  new_built_in(x_module,"xcSetGCAttribute",     predicate,xcSetGCAttribute);
  new_built_in(x_module,"xcDestroyGC",          predicate,xcDestroyGC);
  
  new_built_in(x_module,"xcDrawLine",           predicate,xcDrawLine);
  new_built_in(x_module,"xcMoveWindow",         predicate,xcMoveWindow);
  new_built_in(x_module,"xcDrawArc",            predicate,xcDrawArc);
  new_built_in(x_module,"xcDrawRectangle",      predicate,xcDrawRectangle);
  new_built_in(x_module,"xcDrawPolygon",        predicate,xcDrawPolygon);
  
  new_built_in(x_module,"xcLoadFont",           predicate,xcLoadFont);
  new_built_in(x_module,"xcUnloadFont",         predicate,xcUnloadFont);
  new_built_in(x_module,"xcDrawString",         predicate,xcDrawString);
  new_built_in(x_module,"xcDrawImageString",    predicate,xcDrawImageString);
  new_built_in(x_module,"xcStringWidth",        function, xcStringWidth);
  
  new_built_in(x_module,"xcRequestColor",       predicate,xcRequestColor);
  new_built_in(x_module,"xcRequestNamedColor",  predicate,xcRequestNamedColor);
  new_built_in(x_module,"xcFreeColor",          predicate,xcFreeColor);
  
  new_built_in(x_module,"xcFillRectangle",      predicate,xcFillRectangle);
  new_built_in(x_module,"xcFillArc",            predicate,xcFillArc);
  new_built_in(x_module,"xcFillPolygon",        predicate,xcFillPolygon);
  
  new_built_in(x_module,"xcPointsAlloc",        predicate,xcPointsAlloc);
  new_built_in(x_module,"xcCoordPut",           predicate,xcCoordPut);
  new_built_in(x_module,"xcPointsFree",         predicate,xcPointsFree);
  
  new_built_in(x_module,"xcSync",               predicate,xcSync);
  new_built_in(x_module,"xcGetEvent",           function, xcGetEvent);
  new_built_in(x_module,"xcFlushEvents",        predicate,xcFlushEvents);
  
  /*** RM: 7/12/92 ***/
  new_built_in(x_module,"xcQueryPointer",       predicate,xcQueryPointer);
  /*** RM: 7/12/92 ***/
  
  /*  RM: Apr 20 1993  */
  new_built_in(x_module,"xcQueryTextExtents",predicate,xcQueryTextExtents);
}



/*****************************************************************/
/* not a built-in */
/* called by what_next_aim in login.c */

static long WaitNextEvent(ptreventflag)
     long *ptreventflag;
{
  long nfds;
  fd_set readfd,writefd,exceptfd;
  struct timeval timeout;
  long charflag = FALSE,nbchar;
  char c = 0;
  
  
  *ptreventflag = FALSE;
  
  do
    {
      FD_ZERO(&readfd);
      FD_SET(stdin_fileno, &readfd);
      FD_ZERO(&writefd);
      FD_ZERO(&exceptfd);
      timeout.tv_sec = 0;
      timeout.tv_usec = 100000;

      nfds = select(32,&readfd,&writefd,&exceptfd,&timeout);
      if(nfds == -1)
        {
#if 0
          /* not an error,but a signal has been occured */
          /* handle_interrupt(); does not work */
          exit();
#endif
          if(errno != EINTR) 
            {
              Errorline("in select: interruption error.\n");
              exit_life(TRUE);
            }
          else 
            interrupt();
        }
      
      else
        if(nfds == 0)
          {
#ifdef X11
            if(x_exist_event())
              {
                *ptreventflag = TRUE;
                start_of_line = TRUE;
              }         
#endif
          }
        else
          {
            if(FD_ISSET(stdin_fileno, &readfd) != 0)
              {
#if 0
                if((nbchar = read(stdin_fileno,&c,1)) == -1)
                  {
                    Errorline("in select: keyboard error.\n");
                    exit_life(TRUE);
                  }
                
                /* see manpage of read */
                if(nbchar == 0)
                  c = EOF;
#endif
                c = fgetc(input_stream);
                charflag = TRUE;
              }
            else
              {
                Errorline("select error.\n");
                exit_life(TRUE);
              }
          }
    } while(!(charflag || *ptreventflag));
  
  return c;
}

/*****************************************/


long x_read_stdin_or_event(ptreventflag)
     long *ptreventflag;
{
  long c = 0;
  
  
  *ptreventflag = FALSE;
  
  if(c = saved_char) /* not an error ;-) */
    {
      saved_char = old_saved_char;
      old_saved_char=0;
    }
  else
    {
      if(feof(input_stream))
        c = EOF;
      else 
        {
          if(start_of_line) 
            {
              start_of_line = FALSE;
              line_count ++ ;
              Infoline("%s",prompt); 
              fflush(output_stream);
            }
          
          c = WaitNextEvent(ptreventflag);
          
          if(*ptreventflag)
            {
              if(verbose) printf("<X event>");
              if(NOTQUIET) printf("\n"); /* 21.1 */
            }
          
          if(c == EOLN)
            start_of_line = TRUE;
        }
    }
  
  return c;
}


/*****************************************************************/
/* Static */
/* returns TRUE if the mask matches the type */

static long mask_match_type(mask,type)
     long mask,type;
{
  long em;

  /* printf("mask=%d,type=%d=%s\n",mask,type,xevent_name[type]); */

  em=xevent_mask[type];
  if(!em ||(em & mask))
    return TRUE;

  /* printf("FALSE\n"); printf("event mask=%d\n",em); */
  
  return FALSE;
}



/*****************************************************************/
/* Static */
/* returns the psi-event of the list corresponding to the existing event */

static ptr_psi_term x_what_psi_event(beginSpan,endSpan,eventType)
     ptr_psi_term beginSpan,endSpan;
     long eventType;
{
  if(beginSpan == endSpan)
    return list_car(beginSpan);
  else
    if(mask_match_type(GetIntAttr(list_car(beginSpan),"mask"),
                         eventType))
      return list_car(beginSpan);
    else
      return x_what_psi_event(list_cdr(beginSpan),
                               endSpan,eventType);
}



/*****************************************************************/
/* Static */
/* builds xevent_existing */

static void x_build_existing_event(event,beginSpan,endSpan,eventType)
     XEvent *event;
     ptr_psi_term beginSpan,endSpan;
     long eventType;
{
  ptr_psi_term psiEvent;
  

  /* printf("building event: type=%s event=%s\n",
     xevent_name[type],xevent_name[event->type]); */
  
  /* get the event from the list */
  psiEvent = x_what_psi_event(beginSpan,endSpan,eventType);
  
  /* put the event on the waiting event */
  bk_change_psi_attr(psiEvent,"event",xcEventToPsiTerm(event));
  
  /* set the global */
  if(xevent_existing)
    Warningline("xevent_existing is non-null in x_build_existing_event");
  push_ptr_value_global(psi_term_ptr,&xevent_existing);
  xevent_existing = psiEvent;
  
  /* remove the event from the list */
  /* 9.10 */
  /* if(list_car(xevent_list) == psiEvent) */
  /*     push_ptr_value_global(psi_term_ptr,&xevent_list); */
  /* xevent_list = list_remove_value(xevent_list,psiEvent); */
  list_remove_value(xevent_list,psiEvent); /*  RM: Dec 15 1992  */
}



/*****************************************************************/
/* Static */
/* get the next span of waiting events */

static long x_next_event_span(eventElt,eventClosure)
     ptr_psi_term eventElt;
     EventClosure *eventClosure;
{
  ptr_psi_term psiEvent;
  Display *display;
  Window window;
  long mask;
  XEvent event;

  
  psiEvent = list_car(eventElt);
  display =(Display *)GetIntAttr(psiEvent,"display");
  window =(Window)GetIntAttr(psiEvent,"window");
  mask = GetIntAttr(psiEvent,"mask");
  
  if(eventClosure->display == NULL) {
    /* new span */
    eventClosure->display = display;
    eventClosure->window = window;
    eventClosure->mask = mask;
    eventClosure->beginSpan = eventElt;
    return TRUE;
  }
  else
    if(eventClosure->display == display && eventClosure->window == window) {
      /* same span */
      eventClosure->mask |= mask;
      return TRUE;
    }
    else {
      /* a next span begins,check the current span */
    Repeat:
      if(XCheckWindowEvent(eventClosure->display,eventClosure->window,
                             eventClosure->mask,&event)
          /* && event.xany.window == eventClosure->window */)
        {
          /* 9.10 */
          /* printf("Event type = %ld.\n",event.type); */

          
          if((event.type==Expose || event.type==GraphicsExpose)
              && event.xexpose.count!=0) {
            /* printf("Expose count = %ld.\n", event.xexpose.count); */
            goto Repeat;
          }
          
          /* build a psi-term containing the event */
          
          /* printf("*** event %d ***\n",event.type); */
          
          x_build_existing_event(&event,
                                  eventClosure->beginSpan,
                                  eventElt,event.type);

          return FALSE; /* stop ! we have an existing event !! */
        }
      else
        {
          /* init the new span */
          eventClosure->display = display;
          eventClosure->window = window;
          eventClosure->mask = mask;
          eventClosure->beginSpan = eventElt;
          return TRUE;
        }
    }
}



/*****************************************************************/
/* not a built-in */
/* used by main_prove() and what_next() */

long x_exist_event()
{
  XEvent event,exposeEvent;
  ptr_psi_term eventElt;
  EventClosure eventClosure;
  

  /*infoline("xevent_list=%P\n",xevent_list); */

  if(xevent_existing)
    return TRUE;
  
  if(list_is_nil(xevent_list)) {
    /* printf("nil event list\n"); */
    return FALSE;
  }

  
  /* traverse the list of waiting events */
  eventClosure.display = NULL;
  if(!map_funct_over_list(xevent_list,x_next_event_span,&eventClosure))
    return TRUE;

  /* printf("display=%d,window=%d,mask=%d\n",
     eventClosure.display,eventClosure.window,eventClosure.mask); */
  

  
  /* check the last span */
  if(XCheckWindowEvent(eventClosure.display,
                         eventClosure.window,
                         eventClosure.mask,
                         &event)) {

    /* printf("*** here event %d ***\n",event.xany.type); */

    if(event.xany.window==eventClosure.window) {
      if(event.type == Expose)
        while(XCheckWindowEvent(eventClosure.display,
                                  eventClosure.window,
                                  ExposureMask,
                                  &exposeEvent))
          ; /* that is continue until no expose event */
      
      /* build a psi-term containing the event */
      x_build_existing_event(&event,
                              eventClosure.beginSpan,
                              list_last_cdr(xevent_list),/* RM: Dec 15 1992*/
                              event.type);
      return TRUE;
    }
  }
  else
    return FALSE;
}



/*****************************************************************/
/* used when backtracking a created window in order to destroy the window */

void x_destroy_window(display,window)
     
     Display *display;
     Window window;
     
{
  /* we need the psi-term window(not the value) to get the display list,the pixmap ...
     jch - Fri Aug  7 15:29:14 MET DST 1992
     
     FreeWindow(display,window);
     */
  XDestroyWindow(display,window);
  XSync(display,0);
}


/*****************************************************************/
/* used when backtracking a xcUnmapWindow in order to show the window */

void x_show_window(display,window)
     
     Display *display;long window;
     
{
  XMapWindow(display,window);
  XSync(display,0);
}


/*****************************************************************/
/* used when backtracking a xcMapWindow in order to hide the window */

void x_hide_window(display,window)
     
     Display *display; long window;
     
{
  XUnmapWindow(display,window);
  XSync(display,0);
}


/*** RM 8/12/92 ***/

/*****************************************************************/
/* used when backtracking a xcUnmapWindow in order to show the window */

void x_show_subwindow(display,window)
     
     Display *display; long window;
     
{
  XMapSubwindows(display,window);
  XSync(display,0);
}


/*****************************************************************/
/* used when backtracking a xcMapWindow in order to hide the window */

void x_hide_subwindow(display,window)
     
     Display *display; long window;
     
{
  XUnmapSubwindows(display,window);
  XSync(display,0);
}

/*** RM 8/12/92 ***/



/***  RM: Apr 20 1993 ***/


/*
  xcQueryTextExtents(display,font,string,
  direction,font-ascent,font-descent,
  left-bearing,right-bearing,width,ascent,descent)
  */

long xcQueryTextExtents()
     
{
  include_var_builtin(11);
  ptr_definition types[11];
  Font font;
  XCharStruct over;
  int i;
  int direction,ascent,descent; /* RM: 28 Jan 94 */
  
  types[0] = real;   /* +Display       */
  types[1] = real;   /* +Font ID       */
  types[2] = quoted_string; /* +String        */
  types[3] = real;   /* -Direction     */
  types[4] = real;   /* -Font-ascent   */
  types[5] = real;   /* -Font-descent  */
  types[6] = real;   /* -left bearing  */
  types[7] = real;   /* -right bearing */
  types[8] = real;   /* -width         */
  types[9] = real;   /* -ascent        */
  types[10]= real;   /* -descent       */
  
  
  
  begin_builtin(xcLoadFont,11,3,types);
  

  XQueryTextExtents(DISP(0),
                    (XID)val[1],
                    STRG(2),
                    strlen(STRG(2)),
                    &direction,
                    &ascent,
                    &descent,
                    &over);

  val[3]=direction;
  val[4]=ascent;
  val[5]=descent;
  
  val[6] =over.lbearing;
  val[7] =over.rbearing;
  val[8] =over.width;
  val[9] =over.ascent;
  val[10]=over.descent;
  
  for(i=3;i<11;i++)
    unify_real_result(args[i],(REAL)val[i]);
  
  end_builtin();
}
/***  RM: Apr 20 1993  ***/


/*****************************************************************/
/* not used anymore, but interesting */

ptr_goal GoalFromPsiTerm(psiTerm)
     
     ptr_psi_term psiTerm;
     
{
  ptr_residuation resid;
  ptr_goal aim;
  
  
  if(psiTerm == NULL)
    {
      Errorline("X error in GoalFromPsiTerm: psiTerm is null\n");
      return FALSE;
    }
  
  if((resid = psiTerm->resid) == NULL)
    {
      Errorline("X error in GoalFromPsiTerm: psiTerm has no residuating functions\n");
      return FALSE;
    }
  
  if(resid->next != NULL)
    {
      Errorline("X error in GoalFromPsiTerm: psiTerm has more than one residuating function\n");
      return FALSE;
    }
  
  if((aim = resid->goal) == NULL)
    {
      Errorline("X error in GoalFromPsiTerm: psiTerm has no goal\n");
      return FALSE;
    }
  
  return aim;
}


#endif

---