/*
   Copyright (C) 1985, 1986, 1987, 1988, 1989, 1990
                 Free Software Foundation, Inc.

This file is part of Epoch, a modified version of GNU Emacs.

Epoch is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY.  No author or distributor
accepts responsibility to anyone for the consequences of using it
or for whether it serves any particular purpose or works at all,
unless he says so in writing.  Refer to the GNU Emacs General Public
License for full details.

Everyone is granted permission to copy, modify and redistribute
Epoch, but only under the conditions described in the
GNU Emacs General Public License.   A copy of this license is
supposed to have been given to you along with Epoch so you
can know your rights and responsibilities.  It should be in a
file named COPYING.  Among other things, the copyright notice
and this notice must be preserved on all copies.  */

/*
 * $Revision: 1.26 $
 * $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/xutil.c,v $
 * $Date: 92/06/02 02:18:28 $
 * $Author: marca $
 */
#ifndef LINT
static char rcsid[] = "$Author: marca $ $Date: 92/06/02 02:18:28 $ $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/xutil.c,v $ $Revision: 1.26 $";
#endif

#include <stdio.h>
#undef NULL

#include <signal.h>
#include <sys/ioctl.h>
/* load sys/types.h, but make sure we haven't done it twice */
#ifndef makedev
#include <sys/types.h>
#endif

#include "config.h"
#include "lisp.h"
#include "x11term.h"
#include "buffer.h"
#include "window.h"
#include "screen.h"
#include "screenW.h"
#include "screenX.h"
#include "dispepoch.h"
#include "xdefault.h"
#include "xresource.h"
#include "button.h"

/* X11 includes used; use NIL rather than NULL from lisp.h */

extern int in_display;
extern int font_change;
extern int interrupt_input;
extern char *epoch_get_default();
extern char *strdup();
extern struct Root_Block *x_find_screen();
extern int distinct_minibuffer;
extern int replot_attributes;

void DEBUG();

extern Lisp_Object Fepoch_load_bitmap ();

/* variables first */

extern struct X_Screen *cur_Xscreen;    /* current active screen */
extern struct W_Screen *cur_Wscreen;
extern struct Root_Block *cur_root,*root,*mini_root;
extern Lisp_Object minibuf_rootblock,rootblock;

/* Default values - set up Lisp Objects later to point into these */
extern Display *XD_display;                    /* default display */
extern char XD_is_color;                        /* color display? */
extern char * XD_display_name;                 /* its name */
extern char * XD_resource_name;                /* process resource name */
extern char * XD_resource_class;                /* resource class */
extern int XD_plane;
extern char XD_use_defaults;	/* Read the .Xdefaults file? */

extern Atom XA_current;                 /* current property atom */
extern Atom XA_rootblock;                       /* root block sequence # */

extern Lisp_Object Vx_screen_properties;

/* external object */

/* CODE */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* list of symbols recognized for screen property alist */
extern Lisp_Object Qx_cursor_glyph;
extern Lisp_Object Qx_title;
extern Lisp_Object Qx_name,Qx_icon_name;
extern Lisp_Object Qx_class;
extern Lisp_Object Qx_font;
extern Lisp_Object Qx_geometry;
extern Lisp_Object Qx_foreground,Qx_background,Qx_border_color;
extern Lisp_Object Qx_cursor_foreground,Qx_cursor_background;
extern Lisp_Object Qx_cursor_color;
extern Lisp_Object Qx_initial_state,Qx_update;
extern Lisp_Object Qx_reverse,Qx_in_border_width,Qx_ex_border_width;
extern Lisp_Object Qx_motion_hints;
extern Lisp_Object Qx_parent;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
struct Alist_Entry
{
  Lisp_Object *symbol;
  char *name;
  VOID *slot;
  XDefaultType type;
} ;

/* static variables for use in alist reader */

static struct Default_Set alist_xd;

static struct Alist_Entry alistkey[] = {
    { &Qx_cursor_glyph, "Cursor glyph", (VOID *) &alist_xd.cursor_glyph, XDT_Int } ,
    { &Qx_title, "Title", (VOID *) &alist_xd.name, XDT_String } ,
    { &Qx_name, "Name", (VOID *) &alist_xd.resource, XDT_String } ,
    { &Qx_class, "Class", (VOID *) &alist_xd.class, XDT_String },
    { &Qx_icon_name, "Icon Name", (VOID *) &alist_xd.icon_name, XDT_String },
    { &Qx_geometry, "Geometry", (VOID *) &alist_xd.requested_geometry, XDT_String } ,
    { &Qx_foreground, "Foreground", (VOID *) &alist_xd.foreground, XDT_String } ,
    { &Qx_background, "Background", (VOID *) &alist_xd.background, XDT_String } ,
    { &Qx_cursor_color, "Text cursor color", (VOID *) &alist_xd.cursor, XDT_String } ,
    { &Qx_border_color, "Border Color", (VOID *) &alist_xd.color_border, XDT_String },
    { &Qx_cursor_foreground, "Cursor Foreground Color", (VOID *) &alist_xd.xfcursor, XDT_String } ,
    { &Qx_cursor_background, "Cursor Background Color", (VOID *) &alist_xd.xbcursor, XDT_String } ,
    { &Qx_in_border_width, "In border width", (VOID *) &alist_xd.in_border, XDT_Int },
    { &Qx_ex_border_width, "Ex border width", (VOID *) &alist_xd.out_border, XDT_Int },
    { &Qx_initial_state, "Initial State", (VOID *) &alist_xd.initial_state, XDT_Flag },
    { &Qx_reverse, "Reverse", (VOID *) &alist_xd.reverse, XDT_Flag },
    { &Qx_font, "Font", (VOID *) &alist_xd.font, XDT_String },
    { &Qx_update, "Update", (VOID *) &alist_xd.update_screen, XDT_Flag },
    { &Qx_motion_hints, "Motion Hints", (VOID *) &alist_xd.motion_hints, XDT_Flag },
    { &Qx_parent, "Parent Window", (VOID *) &alist_xd.parent, XDT_Window },
    };
#define alist_size (sizeof(alistkey)/sizeof(struct Alist_Entry))

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* given a default set, read the passed alist and
 * put the values set into the default structure
 */
void x_read_screen_alist(xd,alist)
        struct Default_Set *xd;     
        Lisp_Object alist;
{
  register int ai;
  register struct Alist_Entry *ap;
  Lisp_Object cpair,cvalue,ckey;
  char aflag[alist_size];

  memset(aflag,0,sizeof(aflag)); /* clear flags */

  /* because we need to store the address of the members, we have to
   * copy the structure over, fill it in, and then copy it back
   */
  memcpy(&alist_xd,xd,sizeof(alist_xd));

  for (; !EQ(Qnil,alist) && XTYPE(alist) == Lisp_Cons ; alist = Fcdr(alist))
    {

      QUIT;			/* allow emergency exit */

      cpair = XCONS(alist)->car;
      if (XTYPE(cpair) != Lisp_Cons) continue;
      ckey = XCONS(cpair)->car;
      cvalue = XCONS(cpair)->cdr;

      for (ai = 0 , ap = alistkey; ai < alist_size ; ++ai, ++ap)
	{
	  if (EQ(ckey,*(ap->symbol)) && !aflag[ai])
	    {
	      switch (ap->type)
		{
		case XDT_Int :
		  if (XTYPE(cvalue) != Lisp_Int)
		    error("%s must be an integer",ap->name);
		  *( (int *) (ap->slot) ) = XFASTINT(cvalue);
		  break;
		case XDT_String :
		  if (XTYPE(cvalue) != Lisp_String)
		    error("%s must be a string",ap->name);
		  *( (unsigned char **) (ap->slot) )
		    = XSTRING(cvalue)->data;
		  break;
		case XDT_Flag :
		  *((char *)(ap->slot)) = EQ(Qnil,cvalue) ? 0 : 1;
		  break;
		case XDT_Window :
		  if (XTYPE(cvalue) != Lisp_Xresource ||
		      XXRESOURCE(cvalue)->type != XA_WINDOW)
		    error("Parent must be X-resource window");
		  *((Window *)(ap->slot)) = XXRESOURCE(cvalue)->id;
		  break;
		}
	      aflag[ai] = 1;
	      break;		/* leave the for loop */
	    }
	}
    }

  /* one bit of special handling */

  memcpy(xd,&alist_xd,sizeof(alist_xd));
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* various utility functions to change the attributes of a screen */
extern Lisp_Object Fepoch_get_color();
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::color-components",
       Fepoch_color_components,Sepoch_color_components,
       1,1,0, "Return a 3-vector containing the red, green and blue components of the COLOR, which should be an X-cardinal resource")
     (color) Lisp_Object color;
{
  XColor c;
  Lisp_Object result;
  BLOCK_INPUT_DECLARE();
  
  if (!XRESOURCEP(color) || XXRESOURCE(color)->type != XA_CARDINAL)
    error("Color argument should be an X-cardinal resource");

  c.pixel = XXRESOURCE(color)->id;
  BLOCK_INPUT();
  XQueryColor(XXRESOURCE(color)->dpy,
	      DefaultColormap(XXRESOURCE(color)->dpy,
			      XXRESOURCE(color)->plane), &c);
  UNBLOCK_INPUT();
  result = Fmake_vector(make_number(3),Qnil);
  XVECTOR(result)->contents[0] = make_number(c.red);
  XVECTOR(result)->contents[1] = make_number(c.green);
  XVECTOR(result)->contents[2] = make_number(c.blue);
  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::foreground",Fx_foreground,Sx_foreground,0,2,0,
"Set / get the foreground color of a screen")
        (color,seq) Lisp_Object color,seq;
{
  Lisp_Object block;
  struct X_Screen *xs;
  struct Lisp_Vector *v;
  unsigned long pixel;
  Lisp_Object result = Qnil;

  block = find_block(seq);
  if (EQ(block,Qnil)) return Qnil;
  xs = XXSCREEN(XROOT(block)->x11);

  if (EQ(Qnil,color))
    return XSTYLE(XROOT(block)->stylenorm)->foreground;

  color = Fepoch_get_color(color);
  if (EQ(Qnil,color)) return Qnil;
  pixel = XXRESOURCE(color)->id;
        
  XSetForeground(xs->display,xs->gc_norm,pixel);
  XSetBackground(xs->display,xs->gc_rev,pixel);
  result = Qt;
  XSTYLE(XROOT(block)->stylenorm)->foreground =
    make_Xresource(xs->display,xs->plane,pixel,XA_CARDINAL);
  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::background",Fx_background,Sx_background,0,2,0,
"Set the background color of a screen") (color,seq) Lisp_Object color,seq;
{
  Lisp_Object block;
  struct X_Screen *xs;
  struct Lisp_Vector *v;
  Lisp_Object result = Qnil;
  XSetWindowAttributes attribs;
  unsigned long pixel;

  block = find_block(seq);
  if (EQ(block,Qnil)) return Qnil;
  xs = XXSCREEN(XROOT(block)->x11);

  if (EQ(Qnil,color))
    return XSTYLE(XROOT(block)->stylenorm)->background;

  color = Fepoch_get_color(color);
  if (EQ(Qnil,color)) return Qnil;
  pixel = XXRESOURCE(color)->id;

  XSetBackground(xs->display,xs->gc_norm,pixel);
  XSetForeground(xs->display,xs->gc_rev,pixel);
  XSetForeground(xs->display,xs->gc_curs,pixel);
  attribs.background_pixel = pixel;
  XChangeWindowAttributes(xs->display,xs->xid,CWBackPixel,&attribs);
  result = Qt;
  XSTYLE(XROOT(block)->stylenorm)->background =
    make_Xresource(xs->display,xs->plane,pixel,XA_CARDINAL);
  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::cursor-background",
       Fx_cursor_background,Sx_cursor_background,0,2,0,
       "Set the background color of the text cursor.")
     (color,seq) Lisp_Object color, seq;
{
  Lisp_Object block;
  struct X_Screen *xs;
  struct Lisp_Vector *v;
  Lisp_Object result = Qnil;
  unsigned long pixel;

  block = find_block(seq);
  if (EQ(block,Qnil)) return Qnil;
  xs = XXSCREEN(XROOT(block)->x11);

  if (EQ(Qnil,color))
    return XSTYLE(XROOT(block)->stylecursor)->cursor_background;
    
  color = Fepoch_get_color(color);
  if (EQ(Qnil,color)) return Qnil;
  pixel = XXRESOURCE(color)->id;

  XSetBackground(xs->display,xs->gc_curs,pixel);
  result = Qt;
  XSTYLE(XROOT(block)->stylecursor)->cursor_background = make_Xresource
    (xs->display,xs->plane,pixel,XA_CARDINAL);

  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::cursor-foreground",
       Fx_cursor_foreground,Sx_cursor_foreground,0,2,0,
       "Set the foreground color of the text cursor.")
     (color,seq) Lisp_Object color, seq;
{
  Lisp_Object block;
  struct X_Screen *xs;
  struct Lisp_Vector *v;
  Lisp_Object result = Qnil;
  unsigned long pixel;

  block = find_block(seq);
  if (EQ(block,Qnil)) return Qnil;
  xs = XXSCREEN(XROOT(block)->x11);

  if (EQ(Qnil,color))
    return XSTYLE(XROOT(block)->stylecursor)->cursor_foreground;
    
  color = Fepoch_get_color(color);
  if (EQ(Qnil,color)) return Qnil;
  pixel = XXRESOURCE(color)->id;

  XSetForeground(xs->display,xs->gc_curs,pixel);
  result = Qt;
  XSTYLE(XROOT(block)->stylecursor)->cursor_foreground = make_Xresource
    (xs->display,xs->plane,pixel,XA_CARDINAL);

  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::cursor-glyph",Fx_cursor_glyph,Sx_cursor_glyph,0,2,0,
"Set the cursor glyph of a screen") (glyph,seq) Lisp_Object glyph,seq;
{
  Lisp_Object block;
  struct X_Screen *xs;
  BLOCK_INPUT_DECLARE();

  block = find_block(seq);
  if (EQ(block,Qnil)) return Qnil;
  xs = XXSCREEN(XROOT(block)->x11);

  if (EQ(Qnil,glyph))
    {
      return make_number(xs->cursor_glyph);
    }

  CHECK_NUMBER(glyph,0);

  BLOCK_INPUT();
  XFreeCursor(xs->display,xs->the_cursor);
  xs->the_cursor = XCreateFontCursor(xs->display, XFASTINT(glyph));
  xs->cursor_glyph = XFASTINT(glyph);

  XDefineCursor (xs->display, xs->xid, xs->the_cursor);
  XRecolorCursor(xs->display,xs->the_cursor,&(xs->xfcursor),&(xs->xbcursor));
  UNBLOCK_INPUT();

  return Qt;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::title",Fx_title,Sx_title,0,2,0,
"Set the title of a screen") (title,seq) Lisp_Object title,seq;
    {
    Lisp_Object block;
    struct X_Screen *xs;
    Lisp_Object result = Qnil;
    char *t;
    BLOCK_INPUT_DECLARE();

    block = find_block(seq);
    if (EQ(block,Qnil)) return Qnil;
    xs = XXSCREEN(XROOT(block)->x11);

    if (EQ(Qnil,title))
        {
        BLOCK_INPUT();
        XFetchName(xs->display,xs->xid,&t);
        UNBLOCK_INPUT();
        result = t ? build_string(t) : build_string("");
        if (t) XFree(t);
        }
    else
        {
        CHECK_STRING(title,0);
        BLOCK_INPUT();
        XStoreName(xs->display,xs->xid,XSTRING(title)->data);
        UNBLOCK_INPUT();
        result = Qt;
        }
    
    return result;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::icon-pixmap",Fx_icon_pixmap,Sx_icon_pixmap,1,3,0,
       "Set the icon pixmap of a screen to PIXMAP.\n\
PIXMAP should be a string for a bitmap name, or an Xresource\n\
of type BITMAP.  Returns t if successful.")
     (pixmap,seq) Lisp_Object pixmap,seq;
{
  Lisp_Object block,bitmap;
  struct X_Screen *xs;
  XWMHints *wm_hints;
  Pixmap b,m = None;

  block = find_block(seq);
  if (EQ(block,Qnil)) return Qnil;
  xs = XXSCREEN(XROOT(block)->x11);

  if (STRINGP(pixmap))
    {
      /* Load it by name */
      bitmap = Fepoch_load_bitmap(pixmap);
      if (NIL(bitmap)) return Qnil;

      b = XXRESOURCE(bitmap)->id;
    }
  else if (XRESOURCEP(pixmap) &&
	   (XXRESOURCE(pixmap)->type == XA_BITMAP ||
	    XXRESOURCE(pixmap)->type == XA_PIXMAP))
    {
      b = XXRESOURCE(pixmap)->id;
    }
  else return Qnil;

  /* Now reset WM_HINTS for screen with this new icon bitmap */
  HOLD_INPUT(wm_hints = XGetWMHints(xs->display,xs->xid));

  if (wm_hints)
    {
      wm_hints->icon_pixmap = b;
      wm_hints->flags |= IconPixmapHint;

      HOLD_INPUT(XSetWMHints(xs->display,xs->xid,wm_hints));
      XFree(wm_hints);
      return Qt;      
    }
  return Qnil;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::icon-name",Fx_icon_name,Sx_icon_name,0,2,0,
"Set / get the icon name of a screen")
        (icon_name,seq) Lisp_Object icon_name,seq;
    {
    Lisp_Object block;
    struct X_Screen *xs;
    Lisp_Object result = Qnil;
    char *t;
    BLOCK_INPUT_DECLARE();

    block = find_block(seq);
    if (EQ(block,Qnil)) return Qnil;
    xs = XXSCREEN(XROOT(block)->x11);

    if (EQ(Qnil,icon_name))
        {
        BLOCK_INPUT();
        XGetIconName(xs->display,xs->xid,&t);
        UNBLOCK_INPUT();
        result = t ? build_string(t) : build_string("");
        if (t) XFree(t);
        }
    else
        {
        CHECK_STRING(icon_name,0);
        BLOCK_INPUT();
        XSetIconName(xs->display,xs->xid,XSTRING(icon_name)->data);
        UNBLOCK_INPUT();
        result = Qt;
        }
    
    return result;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::ungrab-pointer", Fepoch_ungrab_pointer, Sepoch_ungrab_pointer,
       0,0,0,
       "Ungrab the pointer. Useful only after a mouse down event, so that another X client can act before the mouse up event.") ()
{
  XUngrabPointer(XD_display,CurrentTime);
  return Qnil;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
char *
x_make_command_line(argc, argv)
     int argc;
     char *argv[];
{
  char * cmd_line;
  int  cmd_length = 0;
  int  i;
  int  offset  = 0;

  /* Initialize these to zero, and see of cmd line args set them */
  XD_resource_class = 0;
  XD_resource_name = 0;
  XD_use_defaults = 0;

  for (i = 0; i < argc; i++)
    cmd_length += strlen(argv[i]) + 1; /* space for word and space */

  cmd_line = (char *) xmalloc(cmd_length + 1);

  for (i = 0; i < argc; i++)
    {
      sprintf(cmd_line+offset, "%s ", argv[i]);
      offset += strlen(argv[i]) + 1;

      if ((!strcmp(argv[i],"-rn") || !strcmp(argv[i],"-resource") ||
	   !strcmp(argv[i],"-name")) &&
	  i < argc - 1)
	{
	  XD_resource_name = argv[i+1];
	}

      if ((!strcmp(argv[i],"-cn") || !strcmp(argv[i],"-class")) &&
	  i < argc - 1)
	{
	  XD_resource_class = argv[i+1];
	}

      if ((!strcmp(argv[i],"-ud")))
	{
	  XD_use_defaults = 1;
	}
    }
  cmd_line[cmd_length-1] = '\0';
  return cmd_line;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screen-information",Fx_screen_information,Sx_screen_information,
      0,1,0,
      "Returns a list consisting of (x y width height border-width map-state)")
        (screen) Lisp_Object screen;
{
  Lisp_Object block;
  struct Lisp_Xresource *xr;
  struct Root_Block *rb;
  XWindowAttributes data;
  int real_x,real_y;
  Window child;
  BLOCK_INPUT_DECLARE();

  if (! (xr = ResourceOrScreen(screen,&rb))) return Qnil;

  BLOCK_INPUT();
  XGetWindowAttributes(xr->dpy,xr->id,&data);
  /* x,y returned are relative to parent, but we want root co-ords */
  XTranslateCoordinates(xr->dpy,xr->id,
                        RootWindow(xr->dpy,xr->plane),
                        0,0,&real_x,&real_y,&child);
  UNBLOCK_INPUT();

  /* now we have to create the list of the items */
  return Fcons(make_number(real_x),
               Fcons(make_number(real_y),
                     Fcons(make_number(data.width),
                           Fcons(make_number(data.height),
                                 Fcons(make_number(data.border_width),
                                       Fcons(make_number(rb ? XWSCREEN(rb->win)->in_border : 0),
                                             Fcons(data.map_state == IsUnmapped ? Qnil : Qt,
                                                   Qnil)))))));
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::plane-size",Fx_plane_size,Sx_plane_size,0,0,0,
      "Return the size of the display plane in pixels") ()
{
  return Fcons(make_number(DisplayWidth(XD_display,XD_plane)),
               make_number(DisplayHeight(XD_display,XD_plane)));
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::font",Fx_font,Sx_font,0,2,0,
"Takes optional arguments of FONT-NAME and SCREEN. If FONT-NAME is nil,\
 returns current font information. If not nil, it should be string naming\
 a font to load. If SCREEN is nil, the current screen is used, otherwise the\
 screen specified is used.")
        (font_name,seq) Lisp_Object font_name,seq;
{
  Lisp_Object block;
  struct X_Screen *xs;
  struct W_Screen *ws;
  XSizeHints size_hints;
#if defined(PBaseSize) && !defined(NO_WM_NORMAL_HINTS)
  long size_hints_flags;
#endif
  int minx,miny,z,i;
  BLOCK_INPUT_DECLARE();
  struct X_font *font;
  int dx, dy;

  block = find_block(seq);
  if (EQ(block,Qnil)) return Qnil;
  xs = XXSCREEN(XROOT(block)->x11);
  ws = XWSCREEN(XROOT(block)->win);


  RW_FIXUP(XROOT(block));

  /* New check: make sure we're given a string.  If not, just
     bounce back the base. */
  if (NIL(font_name) || !STRINGP(font_name))
    {
      /* Return base font for current screen */
      font = XXFONT(XSTYLE(XROOT(block)->stylenorm)->font);
    }
  else
    {
      /* stash the current hints for later re-use */
      BLOCK_INPUT();
#if defined(PBaseSize) && !defined(NO_WM_NORMAL_HINTS)
      z = XGetWMNormalHints(xs->display,xs->xid,&size_hints,&size_hints_flags);
#else      
      z = XGetNormalHints(xs->display,xs->xid,&size_hints);
#endif      
      UNBLOCK_INPUT();
      if (!z) error("No normal size hints! Can't change font.");

      if (!(font = load_font(XSTRING(font_name)->data)))      
	error("Bad font name");
      
      minx = (size_hints.min_width - ws->in_border) / XFWIDTH(font);
      miny = (size_hints.min_height - ws->in_border) / XFHEIGHT(font);

      /* Set screen's styles to use this font. */
      XSET(XSTYLE(XROOT(block)->stylenorm)->font,Lisp_Raw_Data,font);
#if 0      
      XSET(XSTYLE(XROOT(block)->stylerev)->font,Lisp_Raw_Data,font);
      XSET(XSTYLE(XROOT(block)->stylecursor)->font,Lisp_Raw_Data,font);
#endif
      /* xs->pixwidth */
      dx = ws->width* XFWIDTH(font) + 2*ws->in_border;
      /* xs->pixheight */
      dy = ws->height* XFHEIGHT(font) + 2*ws->in_border;

      /* set new size hints */
      size_hints.width = dx; /* xs->pixwidth; */
      size_hints.height = dy; /* xs->pixheight; */
      if (XFVARIABLE(font))
	{
	  size_hints.width_inc = 1;
	  size_hints.height_inc = 1;
	}
      else
	{
	  size_hints.width_inc = XFWIDTH(font);
	  size_hints.height_inc = XFHEIGHT(font);
	}
      size_hints.min_width = minx * XFWIDTH(font) + 2*ws->in_border;
      size_hints.min_height = miny * XFHEIGHT(font) + 2*ws->in_border;

      ws->size_change = 1;

      /*
       * Ugly:  We can't get interrupted while doing this.
       */
      BLOCK_INPUT();

      update_all_attributes (XROOT(block)->ewin);
      if (!distinct_minibuffer)
	update_all_attributes (XROOT(block)->minibuf_window);

#if defined(PBaseSize) && !defined(NO_WM_NORMAL_HINTS)
      XSetWMNormalHints(xs->display,xs->xid,&size_hints);
#else      
      XSetNormalHints(xs->display,xs->xid,&size_hints);
#endif      

      /* Update all of the GC's hanging about on the screen */
      XSetFont(xs->display,xs->gc_norm,XFID(font));
      XSetFont(xs->display,xs->gc_rev,XFID(font));
      XSetFont(xs->display,xs->gc_curs,XFID(font));

      /*
       * Ugly:  if resize request will be blown off due to no size change,
       * or the screen is not currently mapped, resize it and send off the
       * ConfigureNotify and Expose events anyway, which will kick off all
       * other required processing.
       */
      if (((dx == xs->pixwidth) && (dy == xs->pixheight)) || !xs->mapped)
	{
	  XEvent event;

          if (!xs->mapped)
	    XResizeWindow(xs->display,xs->xid,dx,dy);	  

	  event.type = ConfigureNotify;
	  event.xconfigure.window = xs->xid;
	  event.xconfigure.width = dx;
	  event.xconfigure.height = dy;

	  XSendEvent(xs->display,xs->xid,False,StructureNotifyMask,&event);

	  event.type = Expose;
	  event.xexpose.window = xs->xid;
	  event.xexpose.count = 0;

	  XSendEvent(xs->display,xs->xid,False,ExposureMask,&event);
	}
      else
	XResizeWindow(xs->display,xs->xid,dx,dy);
      UNBLOCK_INPUT();      
    }

  return Fcons(build_string(XFNAME(font)),
	       Fcons(make_number(XFWIDTH(font)),
		     Fcons(make_number(XFHEIGHT(font)),
			   Qnil)));
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::get-font", Fepoch_get_font, Sepoch_get_font, 1, 1, 0,
       "Get the FONT by name")
     (name) Lisp_Object name;
{
  struct X_font *f;
  BLOCK_INPUT_DECLARE();

  if (XRESOURCEP(name) && XXRESOURCE(name)->type == XA_FONT) return name;

  CHECK_STRING(name,0);

  f = load_font(XSTRING(name)->data);
  
  return f ? make_Xresource(XD_display,XD_plane,XFID(f),XA_FONT) : Qnil;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::make-bitmap", Fepoch_make_bitmap, Sepoch_make_bitmap,
       3,3,0,
       "Create an X-bitmap, WIDTH by HEIGHT, with DATA.\n\
DATA should be a string (char vector)")
     (width,height,data) Lisp_Object width,height,data;
{
  Pixmap b;
  BLOCK_INPUT_DECLARE();

  CHECK_STRING(data,2);
  CHECK_NUMBER(width,0);
  CHECK_NUMBER(height,0);

  BLOCK_INPUT();
  b = XCreateBitmapFromData(XD_display,cur_Xscreen->xid,
			    XSTRING(data)->data,
			    XFASTINT(width),XFASTINT(height));
  UNBLOCK_INPUT();

  return b == None ? Qnil : make_Xresource(XD_display, XD_plane, b, XA_BITMAP);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::load-bitmap", Fepoch_load_bitmap, Sepoch_load_bitmap, 1, 1, 0,
       "Create an X-bitmap, based on the information in FILE.")
     (file) Lisp_Object file;
{
  Pixmap b;
  int status,xh,yh;
  unsigned int width, height;
  char *name;
  
  BLOCK_INPUT_DECLARE();

  CHECK_STRING(file,0);
  name = (char *) strdup(XSTRING(file)->data);

  BLOCK_INPUT();
  status = XReadBitmapFile(XD_display,cur_Xscreen->xid,name,
			   &width, &height, &b, &xh, &yh);
  UNBLOCK_INPUT();

  return status == BitmapSuccess ? make_Xresource(XD_display,XD_plane,b,XA_BITMAP)
    : Qnil;
}  
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::free-bitmap", Fepoch_free_bitmap, Sepoch_free_bitmap, 1, 1, 0,
       "Free BITMAP in the X server")
     (bitmap) Lisp_Object bitmap;
{
  extern Lisp_Object QXbitmapp;
  if (!XRESOURCEP(bitmap) || XXRESOURCE(bitmap)->type != XA_BITMAP)
    bitmap = wrong_type_argument(QXbitmapp,bitmap);
  XFreePixmap(XXRESOURCE(bitmap)->dpy, XXRESOURCE(bitmap)->id);
  return Qnil;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
raw_query_pointer(dpy,win,plane,xs,rb)
     Display *dpy;
     Window win;
     int plane;
     struct X_Screen *xs;		/* if not-0, use to convert to chars */
     struct Root_Block *rb;
{
  Lisp_Object result = Qnil;
  Bool z;
  Window root_win, child_win;
  int rx,ry,x,y;
  unsigned int bstate;
  BLOCK_INPUT_DECLARE();

  BLOCK_INPUT();
  z = XQueryPointer(dpy,win,&root_win, &child_win, &rx, &ry,&x,&y,&bstate);
  UNBLOCK_INPUT();

  if (z == True)
    {
      if (xs)
	{
	  Lisp_Object window,screen;
	  struct window *w;
	  struct buffer *b;
	  register int cx = 0, cy = 0;
	  register struct line_header *l;
	  register struct char_block *cb;
	  screen = x_find_screen_seq(rb->seq);
	  window = Fepoch_first_window(screen);

	  while (!NIL(window))
	    {
	      w = XWINDOW(window);
	      if (NIL(w->buffer)) continue; /* no buffer, not valid */
	      if (x >= w->pixleft && x < (w->pixleft + w->pixwidth)
		  && y >= w->pixtop && y < (w->pixtop + w->pixheight))
		break;
	      /* Looks stupid, but the problem is that we have to allow the
	       * minibuf as a valid window the _first_ time through here,
	       * but not else when, and we can't go on if the first window
	       * was the minibuffer
	       */
	      if (!EQ(window,rb->minibuf_window))
		window = Fnext_window(window,Qt);
	      if (distinct_minibuffer && 
		  EQ(window,rb->minibuf_window)) window = Qnil;
	    }

	  /* WRONG!!!!!!!!!!!!!! */
	  if (NIL(window)) return Qnil;

	  /* found the window */

	  b = XBUFFER(w->buffer);	  
	  
	  /* Here the fun starts.  We must find character positions */
	  if (!NIL(w->modeline))
	    {
	      l = XLINE(w->modeline);
	      if (l && l->ypos - l->ascent <= y && y < l->ypos + l->descent)
		{
		  cy = window_char_height(w);
		  cx = 0;
		}
	    }
	  l = XLINE(w->lines);
	  while (l)
	    {
	      if (l->ypos - l->ascent <= y && y < l->ypos + l->descent)
		break;
	      l = l->next; cy++;
	    }
	  if (l)
	    {
	      cb = l->body;
	      while (cb != l->end)
		{
		  if (cb->xpos <= x && x < cb->xpos + cb->width)
		    break;
		  cb = cb->next; cx++;
		}
	    }
	  x = cx; y = cy;
	}
      result = Fcons(make_number(x),
		     Fcons(make_number(y),
			   Fcons(make_number(bstate),
				 Fcons(make_Xresource(dpy,
						      plane,
						      win,
						      XA_WINDOW),Qnil))));
    }

  return result;
}
/* - - */
DEFUN ("epoch::query-pointer",Fepoch_query_pointer,Sepoch_query_pointer,0,1,0,
"Query the location of the X-window cursor.\n\
 Returns the list (X Y MOD-STATE X-WINDOW).\n\
 X,Y X-window pixel coordinates\n\
 MOD-STATE bitmask of keyboard modifier state\n\
 X-WINDOW X-window resource of the window containing the pointer")
	(screen) Lisp_Object screen;
{
  struct Root_Block *rb;
  struct X_Screen *xs;
  Display *dpy;
  Window win;
  int plane;
  
  if (XRESOURCEP(screen))
    {
      if (XXRESOURCE(screen)->type != XA_WINDOW)
	error("Screen resource must be of type WINDOW");
      dpy = XXRESOURCE(screen)->dpy;
      win = XXRESOURCE(screen)->id;
      rb = x_find_screen(win);      
      plane = XXRESOURCE(screen)->plane;
    }
  else
    {
      screen = find_block(screen);
      if (NIL (screen)) return Qnil;
      rb = XROOT(screen);
      xs = XXSCREEN(rb->x11);
      dpy = xs->display;
      win = xs->xid;
      plane = xs->plane;
    }

  return raw_query_pointer(dpy,win,plane,0,rb);
}
/* - - */
DEFUN ("epoch::query-mouse",Fepoch_query_mouse,Sepoch_query_mouse,0,1,0,
"Query the location of the X-window cursor within SCREEN.\
 If not specified, current edit screen is used.\n\
 Returns the list (X Y MOD-STATE X-WINDOW).\n\
 X,Y Epoch screen character coordinates\n\
 MOD-STATE bitmask of keyboard modifier state\n\
 X-WINDOW X-window resource of the window containing the pointer\n\
 If cursor is outside the specified SCREEN, return nil.")
	(screen) Lisp_Object screen;
{
  struct X_Screen *xs;
  Display *dpy;
  Window win;
  int plane;
  struct Root_Block *rb;
  
  if (XRESOURCEP(screen))
    {
      if (XXRESOURCE(screen)->type != XA_WINDOW)
	error("Screen resource must be of type WINDOW");
      dpy = XXRESOURCE(screen)->dpy;
      win = XXRESOURCE(screen)->id;
      rb = x_find_screen(win);      
      plane = XXRESOURCE(screen)->plane;
    }
  else
    {
      screen = find_block(screen);
      if (NIL(screen)) return Qnil;
      rb = XROOT(screen);
      xs = XXSCREEN(rb->x11);
      dpy = xs->display;
      win = xs->xid;
      plane = xs->plane;
    }

  return raw_query_pointer(dpy,win,plane,xs,rb);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
raw_warp_pointer(dpy,win,x,y,xs,rb)
     Display *dpy;
     Window win;
     int x,y;
     struct X_Screen *xs;		/* if not-0, use to convert to chars */
     struct Root_Block *rb;
{
  struct X_font *font = XXFONT(XSTYLE(rb->stylenorm)->font);
  
  if (xs)
    {
      struct W_Screen *ws = XWSCREEN(rb->win);
      x = ws->in_border + XINT(x)*XFWIDTH(font)
	+ XFWIDTH(font)/2;
      y = ws->in_border + XINT(y)*XFHEIGHT(font)
	+ XFHEIGHT(font)/2;
    }
  XWarpPointer(dpy,None,win,0,0,0,0,x,y);
  return Qt;
}
/* - - */
DEFUN ("epoch::warp-pointer",Fepoch_warp_pointer,Sepoch_warp_pointer,2,3,0,
"Warp the X pointer to X, Y (in pixels) relative to SCREEN.")
        (x,y,screen) Lisp_Object x,y,screen;
{
  struct Root_Block *rb;
  struct X_Screen *xs;

  CHECK_NUMBER(x,0); CHECK_NUMBER(y,0);

  screen = find_block(screen);
  if (NIL(screen)) return Qnil;
  rb = XROOT(screen);
  xs = XXSCREEN(rb->x11);
  return raw_warp_pointer(xs->display,xs->xid,XINT(x),XINT(y),0,rb);
}
/* - - */
DEFUN("epoch::warp-mouse",Fepoch_warp_mouse,Sepoch_warp_mouse,2,3,0,
"Warp the X pointer to X,Y (in characters) relative to SCREEN.")
	(x,y,screen) Lisp_Object x,y,screen;
{
  struct Root_Block *rb;
  struct X_Screen *xs;

  CHECK_NUMBER(x,0);  CHECK_NUMBER(y,0);

  screen = find_block(screen);
  if (NIL(screen)) return Qnil;
  rb = XROOT(screen);
  xs = XXSCREEN(rb->x11);
  return raw_warp_pointer(xs->display,xs->xid,XINT(x),XINT(y),xs,rb);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::query-cursor",Fepoch_query_cursor,Sepoch_query_cursor,0,1,0,
"Return the X, Y character location of the Epoch cursor in a cons pair.\n\
The argument is an optional SCREEN. This location generally corresponds to \n\
point for the selected window on the SCREEN, if it has been updated.")
	(screen) Lisp_Object screen;
{
  struct W_Screen *ws;

  screen = find_block(screen);
  if (NIL(screen)) return Qnil;
  ws = XWSCREEN(XROOT(screen)->win);
  return Fcons(make_number(ws->vis_xpos),make_number(ws->vis_ypos));
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::query-cursor-pixels",Fquery_cursor_pixels,Squery_cursor_pixels,0,1,0,
       "Return the X, Y pixel location of the Epoch cursor in a cons pair.\n\
The argument is an optional SCREEN.  This location generally corresponds to\n\
point for the selected window on the SCREEN, if it has been updated.")
	(screen) Lisp_Object screen;
{
  struct W_Screen *ws;

  screen = find_block(screen);
  if (NIL(screen)) return Qnil;
  ws = XWSCREEN(XROOT(screen)->win);
  return Fcons(make_number(ws->cur_char->xpos - XFASTINT(ws->cur_w->pixleft)),
	       make_number(ws->cur_line->ypos -
			   ws->cur_line->ascent -
			   XFASTINT(ws->cur_w->pixtop)));
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::get-default",Fepoch_get_default,Sepoch_get_default,1,2,0,
       "Get resource definition associated with NAME.  If specified, also use CLASS for lookup.")
     (name,class) Lisp_Object name,class;
{
  char *tmp,bob = 0;
  
  CHECK_STRING(name,0);

  tmp = (char *) epoch_get_default(XSTRING(name)->data,
				   (NIL(class) ?
				    (char *) 0 :
				    (char *) XSTRING(class)->data));

  return (tmp ? build_string(tmp) : Qnil);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::send-client-message",
       Fx_send_client_message, Sx_send_client_message, 1,5,0,
"Send a client message to DEST, marking it as being from SOURCE (nil->current screen), with [ DATA ] of [ TYPE ], with [ FORMAT ]. If TYPE and FORMAT are omitted, they are deduced from DATA.")
        (dest,source,data,type,format)
	Lisp_Object dest,source,type,format,data;
{
  int actual_format = 0;
  Atom actual_type;
  unsigned long count;
  VOID * addr;
  int free_storage;
  XEvent ev;
  struct Lisp_Xresource *xr;
  Lisp_Object result;

  /* find our destination first */
  if (! (xr = ResourceOrScreen(dest,0))) return Qnil;

  /* find our source - all we need from this is the window id */
  if (XRESOURCEP(source))
    {
      if (XXRESOURCE(source)->type != XA_WINDOW)
	error("X-resource must be a WINDOW");
      ev.xclient.window = XXRESOURCE(source)->id;
    }
  else
    {
      source = find_block(source);
      if (NIL(source)) error("Source must be screen or X-window resource");
      ev.xclient.window = XXSCREEN(XROOT(source)->x11)->xid;
    }

  /* check format before data, because it can cause the data format to vary */
  if (!NIL(format))
    {
      CHECK_NUMBER(format,2);
      actual_format = XFASTINT(format);
      if (actual_format != 8 && actual_format != 16 && actual_format != 32)
	error("Format must be 8, 16, or 32, or nil");
    }

  /* clear out any cruft */
  bzero((char *) &ev.xclient.data,20);

  /* look for the data */
  if (!NIL(data))
    {
      ConvertEtoX(data,&addr,&count,&actual_type,&actual_format,&free_storage);
      if ((count * actual_format) > 20*8)
	{
	  if (free_storage) free(addr);
	  error("Data is too big to fit in a client message");
	}
      bcopy((char *)addr,&ev.xclient.data,count * (actual_format/8));
      if (free_storage) free(addr);
    }

  if (!NIL(type))
    {
      CHECK_XRESOURCE(type,2);
      if (XXRESOURCE(type)->type != XA_ATOM)
        error("Resource for message type must be an atom");
      actual_type = XXRESOURCE(type)->id;
    }
      
  ev.xany.type = ClientMessage;
  ev.xclient.message_type = actual_type;
  ev.xclient.format = actual_format;
  /* There's no better way to set the mask than to hard code the correct
   * width bit pattern. 1L<<24 == OwnerGrabButtonMask, is the largest
   * This is the word from the X-consortium.
   */
  result = XSendEvent(xr->dpy,xr->id,False,(1L<<25)-1L,&ev) ? Qt : Qnil;
  XFlush(xr->dpy);
  return result;
}

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::query-tree",Fepoch_query_tree,Sepoch_query_tree,0,1,0,
       "Return the portion of the window tree adjacent to SCREEN. Value is the list ( ROOT PARENT . CHILDREN ).")
    (screen) Lisp_Object screen;
{
  Lisp_Object block;
  Display *dpy;
  Window win;
  int plane;
  Window root,parent,*children;
  unsigned int count;
  int zret;
  Lisp_Object value;
  
  BLOCK_INPUT_DECLARE();
  
  if (XRESOURCEP(screen))
    {
      if (XXRESOURCE(screen)->type != XA_WINDOW)
	error("Screen resource must be of type WINDOW");
      dpy = XXRESOURCE(screen)->dpy;
      plane = XXRESOURCE(screen)->plane;
      win = XXRESOURCE(screen)->id;
    }
  else
    {
      block = find_block(screen);
      if (NIL(block)) return Qnil;
      dpy = XXSCREEN(XROOT(block)->x11)->display;
      plane = XXSCREEN(XROOT(block)->x11)->plane;
      win = XXSCREEN(XROOT(block)->x11)->xid;
    }

  BLOCK_INPUT();
  zret = XQueryTree(dpy,win,&root,&parent,&children,&count);
  UNBLOCK_INPUT();
  /* Thank you, X-Consortium. XQueryTree doesn't return Success like everyone
   * else, it returns 1. (Success is defined to be 0 in the standard header
   * files)
   */

  if (!zret) return Qnil;

  value = Qnil;
  while (count)
    value = Fcons(make_Xresource(dpy,plane,children[--count],XA_WINDOW),value);

  XFree(children);

  return Fcons(make_Xresource(dpy,plane,root,XA_WINDOW),
	       Fcons(parent ?
		     make_Xresource(dpy,plane,parent,XA_WINDOW) : Qnil,
		     value));
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifdef HAVE_TIMEVAL
#include <sys/time.h>
#define TIMEMODULO 8388607L /* 2^23 - 1 */
DEFUN ("the-time",Fthe_time,Sthe_time,0,0,0,
       "an integer denoting the current time in milliseconds (modulo 2^23 - 1).")
     ()
{
  struct timeval tv;
  unsigned long time;
  gettimeofday(&tv,0);
  time = tv.tv_sec*1000 + tv.tv_usec/1000;
  return (make_number(time % TIMEMODULO));
}
#endif /* HAVE_TIMEVAL */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void syms_of_xutil()

{
  defsubr(&Sepoch_get_default);
  defsubr(&Sepoch_color_components);
  defsubr(&Sx_foreground);
  defsubr(&Sx_background);
  defsubr(&Sx_cursor_background);
  defsubr(&Sx_cursor_foreground);
  defsubr(&Sx_cursor_glyph);
  defsubr(&Sx_title);
  defsubr(&Sx_icon_name);
  defsubr(&Sx_icon_pixmap);
  defsubr(&Sepoch_ungrab_pointer);
  defsubr(&Sx_font);
  defsubr(&Sepoch_get_font);
  defsubr(&Sepoch_make_bitmap);
  defsubr(&Sepoch_load_bitmap);
  defsubr(&Sepoch_free_bitmap);
  defsubr(&Sx_screen_information);
  defsubr(&Sx_plane_size);
  defsubr(&Sepoch_query_pointer);
  defsubr(&Sepoch_query_mouse);
  defsubr(&Sepoch_warp_pointer);
  defsubr(&Sepoch_warp_mouse);
  defsubr(&Sepoch_query_cursor);
  defsubr(&Squery_cursor_pixels);
  defsubr(&Sx_send_client_message);
#ifdef HAVE_TIMEVAL
  defsubr(&Sthe_time);
#endif
  defsubr(&Sepoch_query_tree);
}