/* Stuff needed to drive the screens (== X-windows) */
/*
   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.  */

#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 "window.h"
#include "dispextern.h"
#include "cm.h"
#include "screen.h"
#include "screenW.h"
#include "screenX.h"
#include "xdefault.h"
#include "xresource.h"

extern int in_display;
extern int interrupt_input;
void DEBUG();

/* variables first */

struct X_Screen *cur_Xscreen;                   /* current active screen */
struct W_Screen *cur_Wscreen;
struct Root_Block *cur_root;

/* Default values - set up Lisp Objects later to point into these */
Display *XD_display;                    /* default display */
int XD_plane;			/* x screen to work with */
char XD_is_color;			/* color display? */
char * XD_display_name;                 /* its name */
char * XD_resource_name;                /* process resource name */
char * XD_resource_class;		/* resource class */
char * XD_command_line;		/* original command line string */

extern GC buttonGC[];
extern GC cursorGC[];

Atom XA_current;			/* current property atom */
Atom XA_screen_id;			/* root block sequence # */
Atom XA_wm_change_state;	/* change state atom for iconification */
Atom XA_resource_manager;	/* Resource manager property atom */

/* mini buffer statics -
 * The mini buff serves as an anchor for the whole display structure.
 * Minibuff->root is the root structure for the minibuff, and it has
 * pointers into a ring of all the other root blocks
 */
struct Root_Block *mini_root;
Lisp_Object minibuf_rootblock;

Lisp_Object Vx_screen_properties;
Lisp_Object Vx_global_update;
Lisp_Object Qepoch_screenp;
int screen_changed;	/* set if there are screens that need updating */

static long root_seq;		/* root block sequence # */

static char first_time;		/* flag for when things are done at init */

/* external object */
extern Lisp_Object minibuf_window;
extern Lisp_Object selected_window;

extern int xargc;
extern char ** xargv;

extern char *getenv();

#define MIN(a,b) ( (a) < (b) ? (a) : (b) )
#define MAX(a,b) ( (a) > (b) ? (a) : (b) )

/* CODE */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static char *
strdup(s)
        char * s;       /* string to duplicate */
    {
    extern char * strcpy();
    return strcpy(xmalloc(strlen(s)+1),s);
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* set starting X-windows defaults */
#include "xd.h"
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void
x_init_defaults()
    {
    /* set up global defaults for things not specified by the user */
    XD_screen.plane = XD_screen.plane = -1;
    XD_screen.font = XD_minibuf.font = "fixed";
    XD_screen.name = "Edit"; XD_minibuf.name = "Minibuffer";
    XD_screen.class = XD_minibuf.class = (char *)0;
    XD_screen.resource = XD_minibuf.resource = (char *)0;
    XD_screen.in_border = XD_minibuf.in_border = 2;
    XD_screen.out_border = XD_minibuf.out_border = 2;
    XD_screen.default_geometry = "80x24+0+64";
    XD_minibuf.default_geometry = "80x1+0+0";
    XD_screen.initial_state = XD_minibuf.initial_state = 1;

    XD_screen.min_width = XD_minibuf.min_width = 4;
    XD_screen.min_height = 2;
    XD_minibuf.min_height = 1;

    /* these defaults need to be dealt with specially during screen creation */
    XD_screen.requested_geometry = XD_minibuf.requested_geometry = "";
    XD_screen.foreground = XD_minibuf.foreground = (char *)0;
    XD_screen.background = XD_minibuf.background = (char *)0;
    XD_screen.cursor = XD_minibuf.cursor = (char *)0;
    XD_screen.xfcursor = XD_minibuf.xfcursor =
	XD_screen.xbcursor = XD_minibuf.xbcursor = (char *)0;
    XD_screen.cursor_glyph = XD_minibuf.cursor_glyph = XC_pencil;
    XD_screen.color_border = XD_minibuf.color_border = (char *)0;
    XD_screen.update_screen = XD_minibuf.update_screen = 0;
    XD_screen.motion_hints = XD_minibuf.motion_hints = 0;

    XD_screen.class = XD_minibuf.class = (char *)0;
    XD_screen.resource = XD_minibuf.resource = (char *)0;
    XD_screen.icon_name = XD_minibuf.icon_name = (char *)0;

    XD_screen.parent =  XD_minibuf.parent = 0;

    /* set some other globals */
#if 0 /* [cjl] - do this in x_load_defaults() to establish things earlier */   
    XD_resource_name = xargv[0];                /* name invoked under */
    XD_resource_class = "Emacs";
    if ( (ptr=rindex(XD_resource_name,'/')))
        XD_resource_name = ptr+1;  /* clip path */
#endif    

    /* call and get user specified defaults */
    x_get_defaults(xdef,xdef_size,&xargc,xargv);
   
    /* if the resource/class names weren't set by the defaults, set them to
     * the global names */
    if (!XD_screen.resource) XD_screen.resource = XD_resource_name;
    if (!XD_minibuf.resource) XD_minibuf.resource = XD_resource_name;
    if (!XD_screen.class) XD_screen.class = XD_resource_class;
    if (!XD_minibuf.class) XD_minibuf.class = XD_resource_class;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
Lisp_Object
make_root_block()
    {
    int i;
    Lisp_Object val;
    struct Root_Block *rb;
    struct W_Screen *ws;
    struct X_Screen *xs;
    struct display_line **phys,**desired;

    val = Fmake_vector(make_number(
            (sizeof(struct Root_Block) - sizeof(struct Lisp_Vector)
             + sizeof(Lisp_Object)) / sizeof(Lisp_Object)),Qnil);

    XSETTYPE(val,Lisp_Root_Block);
    rb = XROOT(val);

    rb->next = val;
    rb->prev = val;
    rb->ewin = Qnil;

    XSET(rb->x11,Lisp_Raw_Data,xmalloc(sizeof(struct X_Screen)));
    XSET(rb->win,Lisp_Raw_Data,xmalloc(sizeof(struct W_Screen)));
    ws = XWSCREEN(rb->win);
    xs = XXSCREEN(rb->x11);

    XSET(rb->seq,Lisp_Int,root_seq++);
    rb->select = Qnil;

    /* need to make sure the line structure pointers are 0 to start */
    for (i=0,phys=ws->phys_line,desired=ws->desired_line
	 ; i < MScreenLength
	 ; ++i )
	{
	*phys++ = 0; *desired++ = 0;
	}
    ws->cursor_x = ws->cursor_y = 0;

    xs->vis_x = xs->vis_y = 0;
    xs->highlight = 0;
    xs->font_id = 0;			/* mark as no font here */

    ws->size_change_pending = 0;
    xs->configure_pending = 0;
    xs->mapped = 0;
	
    return val;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
x_set_wm_hints(xs,istate)
	struct X_Screen *xs;	/* screen descriptor */
	int istate;		/* initial state */
    {
    XWMHints wm_hints;

    /* window manager hints */
    wm_hints.initial_state = istate;
    wm_hints.window_group = XXSCREEN(mini_root->x11)->xid;
    wm_hints.input = True;
    wm_hints.flags = InputHint | StateHint | WindowGroupHint;
    HOLD_INPUT(XSetWMHints(xs->display,xs->xid,&wm_hints));
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
x_set_hints(rb,xd,gmask)
	struct Root_Block *rb;
	struct Default_Set *xd;
	unsigned int gmask;
    {
    XS_DEF; WS_DEF;
    XSizeHints size_hints;
    XClassHint class_hint;

    /* set the window name */
    if (xd->name)
      HOLD_INPUT(XStoreName(xs->display,xs->xid,xd->name))
    if (xd->icon_name)
      HOLD_INPUT(XSetIconName(xs->display,xs->xid,xd->icon_name))

    /* set sizing hints */
#ifdef PBaseSize
    size_hints.base_width = 0;
    size_hints.base_height = 0;
#endif
    size_hints.width = xs->pixwidth;
    size_hints.height = xs->pixheight;
    size_hints.x = xs->basex;
    size_hints.y = xs->basey;
    size_hints.width_inc = xs->font_width;
    size_hints.height_inc = xs->font_height;
    size_hints.min_width = xd->min_width*xs->font_width + 2*xs->in_border;
    size_hints.min_height = xd->min_height*xs->font_height + 2*xs->in_border;
#ifdef PBaseSize
    size_hints.flags = PMinSize | PResizeInc | PBaseSize;
#else
    size_hints.flags = PMinSize | PResizeInc;
#endif
    size_hints.flags |= (gmask & (XValue|YValue)) ? USPosition : PPosition;
    size_hints.flags |= (gmask & (WidthValue|HeightValue)) ? USSize : PSize;
    HOLD_INPUT(XSetNormalHints(xs->display,xs->xid,&size_hints));

    /* resource and class names */
    class_hint.res_name = xd->resource;
    class_hint.res_class = xd->class;
    HOLD_INPUT(XSetClassHint(xs->display,xs->xid,&class_hint));

    x_set_wm_hints(xs, xd->initial_state ? NormalState : IconicState);
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
int
SetScreenFont(root,font_name)
	struct Root_Block * root;
	char * font_name;
    {
    int dx,dy;
    struct X_Screen *xs = XXSCREEN(root->x11);
    struct W_Screen *ws = XWSCREEN(root->win);
    XFontStruct *font;
    BLOCK_INPUT_DECLARE();
    
    /* deal with the font */
    BLOCK_INPUT();
    font = XLoadQueryFont(xs->display,font_name);
    UNBLOCK_INPUT();
    /* the font structure is freed at the end of this function */

    if (!font) return 0;

    xs->font_name = strdup(font_name);
    xs->font_width = font->max_bounds.width;
    xs->font_height = font->ascent + font->descent;
    xs->font_base = font->ascent;
    xs->font_id = font->fid;

    BLOCK_INPUT();
    XFreeFontInfo((char *) 0, font, 1);
    UNBLOCK_INPUT();
    return 1;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* give the defaults, create a screen */
static void
x_create_screen(root,xdbase,alist)
        struct Root_Block * root;	/* structure to fill in */
        struct Default_Set *xdbase;	/* user specified values */
	Lisp_Object alist;
    {
    unsigned int gmask;             /* geometry parse return */
    int x,y,dx,dy;                  /* base and size */
    int i;			/* scratch index */
    unsigned long xcursor_color; /* X cursor color */
    struct X_Screen *xs = XXSCREEN(root->x11);
    struct W_Screen *ws = XWSCREEN(root->win);
    struct Default_Set xd;
    XFontStruct *font;
    XColor color,xcf,xcb;	/* scratch, x-cursor-fore/back */
    char xcfflag,xcbflag;	/* successful parsing? */
    Colormap cmap;
    XGCValues gc;
    BLOCK_INPUT_DECLARE();

    xs->display = XD_display; xs->plane = DefaultScreen(xs->display);
    cmap = DefaultColormap(xs->display,xs->plane);
    xs->colormap = cmap;

    /* get the values from the alists */
    memcpy(&xd,xdbase,sizeof(xd));
    x_read_screen_alist(&xd,Vx_screen_properties);
    x_read_screen_alist(&xd,alist);

    root->update = xd.update_screen ? Qt : Qnil; /* set update flag */

    /* deal with the font */
    if (!SetScreenFont(root,xd.font))
	if (first_time)
	    {
	    fprintf(stderr,"Cannot load font `%s'\n",xd.font);
	    exit(1);
	    }
	else
	    {
	    free(xs); free(ws);	/* this should be all that's allocated now */
	    error("Bad font '%s'",xd.font);
	    }

    /* set up the geometry */
    /* the value returned is a mask of what was actually changed. We don't
     * worry about it since we know that default_geometry contains
     * enough info to fill them all in.
     * The original version is much different, and makes no sense to me.
     * It used XGeometry() with bizarre parameters, and appeared to be
     * confused about whether it meant pixels or characters. I have chosen
     * to arrange things to interpret AxB as characters, not pixels.
     * I believe the original was bogus, and was corrected by a call
     * to change the window size before the end of all initializations
     * (runs with dbx support this hypothesis).
     * I have changed the code to work in what I believe to the be
     * correct way.
     */
    /* XGeometry is not used because it assumes the specs are in pixels,
     * not in characters.
     */
    gmask = XParseGeometry(xd.default_geometry,&x,&y,&dx,&dy);
    gmask = XParseGeometry(xd.requested_geometry,&x,&y,&dx,&dy);

    /* clip to proper range */
    dx = MIN(MAX(dx,xd.min_width), MScreenWidth);
    dy = MIN(MAX(dy,xd.min_height), MScreenLength);

    xs->out_border = xd.out_border;
    xs->in_border = xd.in_border;

    xs->pixwidth = dx*xs->font_width + 2*xs->in_border;
    xs->pixheight = dy*xs->font_height + 2*xs->in_border;
    ws->width = dx; ws->height = dy;

    /* check for "relative" specifications, and adjust the values. */
    if (gmask & XNegative)
	x += DisplayWidth(xs->display,xs->plane)
	    - xs->pixwidth - 2*xs->out_border;
    if (gmask & YNegative)
	y += DisplayHeight(xs->display,xs->plane)
	    - xs->pixheight - 2*xs->out_border;

    xs->basex = x; xs->basey = y;

    /* now, do the colors */
    BLOCK_INPUT();		/* server queries here, have to block */
    /* have to do the colors one by one, yay */
    xs->foreground = (xd.foreground
		      && XParseColor(xs->display,cmap,xd.foreground,&color)
		      && XAllocColor(xs->display,cmap,&color)
		      ) ? color.pixel : BlackPixel(xs->display,xs->plane);
    xs->background = (xd.background
		      && XParseColor(xs->display,cmap,xd.background,&color)
		      && XAllocColor(xs->display,cmap,&color)
		      ) ? color.pixel : WhitePixel(xs->display,xs->plane);
    xs->border_color = (xd.color_border
			&& XParseColor(xs->display,cmap,xd.color_border,&color)
			&& XAllocColor(xs->display,cmap,&color)
			) ? color.pixel : BlackPixel(xs->display,xs->plane);
    xs->cursor_color = (xd.cursor
			&& XParseColor(xs->display,cmap,xd.cursor,&color)
			&& XAllocColor(xs->display,cmap,&color)
			) ? color.pixel : xs->foreground;

    /* cursor colors are strange, since we must have both fore/back
     * in order to recolor the cursor, and we want to be able to flip colors
     * in case the reverse flag is set. What we will do is try to get
     * any user specified colors first, but if that fails we'll use the
     * text foreground/background values. The flag variables are true if
     * the user specified a color AND it was successful parsed.
     */
    if (xd.xfcursor && XParseColor(xs->display,cmap,xd.xfcursor,&xcf))
	xcfflag = 1;
    else
	{
	xcf.pixel = xs->foreground;
	XQueryColor(xs->display,cmap,&xcf);
	xcfflag = 0;
	}
    if (xd.xfcursor && XParseColor(xs->display,cmap,xd.xbcursor,&xcb))
	xcbflag = 1;
    else
	{
	xcb.pixel = xs->background;
	XQueryColor(xs->display,cmap,&xcb);
	xcbflag = 0;
	}
    UNBLOCK_INPUT();

    if (xd.reverse)		/* want reversed colors */
	{
	color.pixel = xs->foreground;
	xs->foreground = xs->background;
	xs->background = color.pixel;
	if (!xd.cursor) xs->cursor_color = xs->foreground;

	memcpy(&color,&xcf,sizeof(color));
	memcpy(&xcf,&xcb,sizeof(color));
	memcpy(&xcb,&color,sizeof(color));
	}

    /* make sure the cursor is visible */
    if (xs->cursor_color == xs->background && !xd.cursor)
	xs->cursor_color = xs->foreground;
    /* make visible border unless explicitly set */
    if (xs->border_color == xs->background && !xd.background)
	xs->border_color = xs->foreground;

    /* time to make the window */
    BLOCK_INPUT();
    xs->xid = XCreateSimpleWindow(
	           xs->display,
		   xd.parent ? xd.parent : RootWindow(xs->display,xs->plane),
                   /* put it the root window on the current display */
                   xs->basex,xs->basey,                /* upper left */
                   xs->pixwidth,xs->pixheight,         /* size */
                   xs->out_border,xs->border_color,
                   xs->background);
    UNBLOCK_INPUT();
    if (xs->xid == 0)
	{
	/* all that's been done is mallocing the substructures and
	 * creating the lisp RootBlock. Free the substructures, and the
	 * garbage collector will take care of the RootBlock
	 */
	free(xs); free(ws);
	error("Unable to create new screen");
	}

    BLOCK_INPUT();
    XFlush(xs->display);

    gc.font = xs->font_id;

    gc.foreground = xs->foreground;
    gc.background = xs->background;
    xs->gc_norm = XCreateGC(xs->display, xs->xid,
                          GCFont|GCForeground|GCBackground,
                          &gc);
    xs->gc_inverse = XCreateGC(xs->display, xs->xid,
			     GCFont | GCForeground | GCBackground,
			     &gc);
    gc.foreground = xs->background;
    gc.background = xs->foreground;
    xs->gc_rev = XCreateGC(xs->display, xs->xid,
                         GCFont|GCForeground|GCBackground,
                         &gc);
    xs->gc_style = XCreateGC(xs->display, xs->xid,
			     GCFont | GCForeground | GCBackground,
			     &gc);
    gc.foreground = xs->background;
    gc.background = xs->cursor_color;
    xs->gc_curs = XCreateGC(XD_display, xs->xid,
                          GCFont|GCForeground|GCBackground,
                          &gc);

    xs->the_cursor = XCreateFontCursor(xs->display, xd.cursor_glyph);

    XDefineCursor (xs->display, xs->xid, xs->the_cursor);
    if (xcfflag || xcbflag || xd.reverse)
	XRecolorCursor(xs->display,xs->the_cursor,&xcf,&xcb);
    memcpy(&(xs->xfcursor),&xcf,sizeof(xcf));
    memcpy(&(xs->xbcursor),&xcb,sizeof(xcb));

    xs->cursor_glyph = xd.cursor_glyph;
    xs->cursor_exists = 0;              /* cursor hasn't been plotted */
    xs->vis_x = 0;                   /* and it isn't anywhere yet */
    xs->vis_y = 0;

    x_set_hints(root,&xd,gmask);	/* set window-manager hints */

    root->motion_hints = xd.motion_hints ? Qt : Qnil;

    XSelectInput(xs->display, xs->xid,
		 NORMAL_INPUT | (xd.motion_hints ? MOTION_INPUT : 0));

    /* export the root block sequence number */
    x = XFASTINT(root->seq);
    XChangeProperty(xs->display,xs->xid,
		    XA_screen_id,XA_INTEGER,32,	/* 32 is magic */
		    PropModeReplace,&x,1);

    screen_changed++;
    root->needs_update = Qt;

/*  Leaving this out for ICCCM reasons. Need to be able to set properties on
    it before it gets mapped.
*/
#if 0
    XMapWindow (xs->display, xs->xid);
    XFlush (xs->display);
#endif
    UNBLOCK_INPUT();
    }

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* creates the data structures for the base and minibuff screens */
void
x_init_roots()
    {
    struct window *w;
    struct W_Screen *ws;

    /* set up the minibuffer */
    mini_root = XROOT(make_root_block());
    ws = XWSCREEN(mini_root->win);

    /* make the base root structure */
    cur_root = XROOT(make_root_block());
    cur_Xscreen = XXSCREEN(cur_root->x11);
    cur_Wscreen = XWSCREEN(cur_root->win);

    /* this depends on mini_root and cur_root being 1-cycles */
    cur_root->next = mini_root->next;
    mini_root->next = cur_root->prev;
    mini_root->prev = cur_root->prev;
    cur_root->prev = cur_root->next;

    /* need to set the root-window root value to the root system we
     * made for it
     */
    w = XWINDOW(XWINDOW(minibuf_window)->prev);
    XSET(w->root,Lisp_Root_Block,cur_root);
    cur_root->ewin = XWINDOW(minibuf_window)->prev;
    cur_root->select = cur_root->ewin;;
    XSET(minibuf_rootblock,Lisp_Root_Block,mini_root);

    w = XWINDOW(minibuf_window);
    XSET(w->root,Lisp_Root_Block,mini_root);
    mini_root->ewin = minibuf_window;
    mini_root->select = minibuf_window;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Set up the X-window system and init all the defaults. Also, set up
 * a screen for the base window and for the minibuff
 */
void
x_init_display()
    {
    struct X_Screen *xs;

    root_seq = 0;		/* because we can't have initialized statics */
    screen_changed = 0;		/* start not needing */
    
    /* open the Display / connect to X-server */
    /* XD_display_name is set by the default loader as a special case */
    
    XD_display = XOpenDisplay(XD_display_name);
    if (XD_display == 0)
        {
        fprintf(stderr,"Cannot connect to X-server");
        if (XD_display_name == 0 || *XD_display_name == '\0')
	    XD_display_name = getenv("DISPLAY");
        if (XD_display_name == 0 || *XD_display_name == '\0')
            fprintf(stderr," - no DISPLAY set\n");
        else
            fprintf(stderr," on DISPLAY %s\n",XD_display_name);
        exit(37);
        }
    XD_plane = DefaultScreen(XD_display);
    XD_is_color = DisplayCells(XD_display,DefaultScreen(XD_display)) > 2;

    /* set up special properties */
    XA_current = XInternAtom(XD_display,XA_EPOCH_CURRENT,False);
    XA_screen_id = XInternAtom(XD_display,XA_EPOCH_SCREEN_ID,False);
    XA_wm_change_state = XInternAtom(XD_display,"WM_CHANGE_STATE",False);
    XA_resource_manager = XInternAtom(XD_display,"RESOURCE_MANAGER",False);

    /* set up the default values */
    x_init_defaults();

    first_time = 1;		/* mark as initialization time */
    /* create the structures to hold the initial screens */
    x_init_roots();
    /* now make the X-windows */
    x_create_screen(mini_root,&XD_minibuf,Qnil);
    x_create_screen(XROOT(mini_root->prev),&XD_screen,Qnil);
    first_time = 0;

    /* set the global pointers */
    cur_root = XROOT(mini_root->prev);
    cur_Xscreen = XXSCREEN(cur_root->x11);
    cur_Wscreen = XWSCREEN(cur_root->win);

    /* have to fix up the miniroot property and base screen specially */
    xs = XXSCREEN(mini_root->x11);
    XChangeProperty(xs->display,xs->xid,XA_current,XA_STRING,8,
		    PropModeReplace,"minibuf",8);
    XChangeProperty(xs->display,xs->xid,XA_WM_COMMAND,XA_STRING,8,
		    PropModeReplace,XD_command_line,strlen(XD_command_line)+1);
    XMapWindow(xs->display,xs->xid); /* force the minibuffer to be mapped */

    /* this would normally be handled in x_select_screen */
    xs = XXSCREEN(cur_root->x11);
    XChangeProperty(xs->display,xs->xid,XA_current,XA_STRING,8,
		    PropModeReplace,"yes",4);
    }

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* returns the root_block that points to the temp
 * XW_Screen structs, or NULL if it couldn't find it.
 */
struct Root_Block *
x_find_screen(wid)
	Window wid;		/* window id of the event */
    {
    struct Root_Block *rb;

    /* search the list, anchored at mini-buf */
    rb = mini_root;
    do
	{
	if (XXSCREEN(rb->x11)->xid == wid) return rb;
	rb = XROOT(rb->next);
	} while (rb != mini_root);
    return 0;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* returns the root_block given the sequence #, or Qnil if not found */
Lisp_Object
x_find_screen_seq(seq)
	Lisp_Object seq;
    {
    Lisp_Object block = minibuf_rootblock;

    /* search the list, anchored at mini-buf */
    do
	{
	if (EQ(XROOT(block)->seq,seq)) return block;
	block = XROOT(block)->next;
	} while (!EQ(block,minibuf_rootblock));
    return Qnil;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screen-p",Fscreen_p,Sscreen_p,1,1,0,
      "Return t if the argument is a screen, nil otherwise")
	(screen) Lisp_Object screen;
    { return XTYPE(screen) == Lisp_Root_Block ? Qt : Qnil ; }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::current-screen",Fcurrent_screen,Scurrent_screen,0,0,0,
      "Return the ID of the current screen.") ()
    { return EDIT_SCREEN; }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::minibuf-screen",Fminibuf_screen,Sminibuf_screen,0,0,0,
      "Return the ID of the minibuf screen.") ()
    { return minibuf_rootblock; }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* replacement for prvious version. What we'll do is step through the
 * screen list, and call the previous version (now 'update_a_screen') for
 * each one.
 */
int update_screen(force,inhibit_hairy_id)
	int force;
	int inhibit_hairy_id;
    {
    int paused = 0, tpaused;
    int update_all = !NULL(Vx_global_update) && !EQ(Qt,Vx_global_update);
    struct Root_Block *rb,*cur_edit = XROOT(EDIT_SCREEN);

    /* always force a minibuffer update */
    paused = update_a_screen(1,inhibit_hairy_id,mini_root);

    /* Ugly - the problem is, it may be that mini_root == cur_root, in
     * which case the primary screen doesn't get updated, and things break.
     * we need to have an update on the non-minibuf screen every time we
     * come in here, even if the minibuf is the selected window+screen
     */
    paused |= update_a_screen(force,inhibit_hairy_id,cur_edit);

    /* Now, we need to step through all the other screens to update them
     * if necessary. Abort the process if we get a paused condition.
     */
    if (screen_changed || buffer_shared || !EQ(Qnil,Vx_global_update))
	{
	for ( rb = XROOT(mini_root->next)
	     ; rb != mini_root
	     ; rb = XROOT(rb->next))
	    if (rb != cur_edit &&
		(update_all || !NULL(rb->needs_update) || !NULL(rb->update))
		)
		{
		if (force == 0 && paused) force = -1;
		tpaused = update_a_screen(force,inhibit_hairy_id,rb);
		rb->needs_update = (tpaused && force <= 0) ? Qt : Qnil;
		paused |= tpaused;
		}

	screen_changed = paused; /* try to do it next time around */
	}

    return paused;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void clear_display_records()
    {
    /* clear the screen records of the minibuf and the current screen */
    Cclear_screen_records(mini_root);
    Cclear_screen_records(cur_root);
    }

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
int change_screen_size(height,width,rb)
	int height,width;
	struct Root_Block *rb;
    {
    struct W_Screen *ws = XWSCREEN(rb->win);
    extern int RedoModes;		/* redraw mode lines flag */

    if (rb == (struct Root_Block *)0) return 0;

    if (in_display)
	{
	ws->size_change_pending = 1;
	ws->new_width = width;
	ws->new_height = height;
	return 0;
	}

    ws->size_change_pending = 0;
    /* do we have to do anything? */
    if ( (height == 0 || height == ws->height)
	&& (width == 0 || width == ws->width))
	return 1;		/* we successfully did nothing */

    /* fix up the window pointer in the root block */
    RW_FIXUP(rb)
    /* switch into this screen temporarily */

    /* change the height of the screen first */
    if (height != 0 && height != ws->height)
	{
	if (height > MScreenLength) height = MScreenLength;  /* bound it */
	set_window_height(rb->ewin,height,1);
	ws->height = ScreenRows = height;
	CXTset_terminal_window(0, rb);
	}
    if (width != 0 && width != ws->width)
	{
	if (width > MScreenWidth) width = MScreenWidth;
	set_window_width(rb->ewin,width,1);
	ws->width = ScreenCols = width;
	}

    rb->needs_update = Qt;
    screen_changed++;
    DoDsp(1);

    return 1;				/* hopefully, we did it this time */
    }
	    
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* window size changes are held up during critical regions. afterwards,
 * we want to deal with any delayed changes
 */
void unhold_window_change()
    {
    struct Root_Block *rb = mini_root;
    struct W_Screen *ws;

    in_display = 0;
    do
	{
	ws = XWSCREEN(rb->win);
	if (ws->size_change_pending)
	    change_screen_size(ws->new_height,ws->new_width,rb);
	rb = XROOT(rb->next);
	} while (rb != mini_root);
    }
	
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* for each root block except the mini_root, call the passed function on
 * the root window of that block. The current root is handled specially so
 * that the return value for that block can be returned
 */
Lisp_Object do_windows_of_screens(func,obj)
	Lisp_Object (*func)();
	Lisp_Object obj;
    {
    struct Root_Block *rb = cur_root;
    Lisp_Object value = Qnil;

    do
	{
	RW_FIXUP(rb)
	if (rb != mini_root) value = func(rb->ewin,obj);
	} while ((rb=XROOT(rb->next)) != cur_root && NULL(value));

    return value;
    }
	
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* return the screen if the buffer is in the window or child-window */
static Lisp_Object
epoch_buffer_in_window_p(w,obj)
	Lisp_Object w;
	Lisp_Object obj;
    {
    Lisp_Object tem;
    struct window *p;

    for ( ; !NULL(w) && !EQ(w,minibuf_window) ; w = XWINDOW(w)->next )
	{
	p = XWINDOW(w);
	if (EQ (p->buffer, obj)) return p->root;
	if (!NULL(p->vchild) && !NULL(epoch_buffer_in_window_p(p->vchild,obj)))
	    return p->root;
	if (!NULL(p->hchild) && !NULL(epoch_buffer_in_window_p(p->hchild,obj)))
	    return p->root;
	}
    return Qnil;		/* indicate not done yet */
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screens-of-buffer",
       Fepoch_screens_of_buffer,Sepoch_screens_of_buffer,
       0,1,"b",
       "Return a list of screens for which BUFFER is displayed in a window.")
        (buffer) Lisp_Object buffer;
    {
    struct Root_Block *rb;
    Lisp_Object screen;
    Lisp_Object value = Qnil;

    if (NULL(buffer)) buffer = Fcurrent_buffer();
    else buffer = Fget_buffer(buffer);

    if (NULL(buffer)) return Qnil;

    for (rb = XROOT(mini_root->next) ; rb != mini_root ; rb = XROOT(rb->next))
	{
	RW_FIXUP(rb);
	screen = epoch_buffer_in_window_p(rb->ewin,buffer);
	if (!NULL(screen))
	    value = Fcons(screen,value);
	}

    return value;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::create-screen",Fcreate_screen,Screate_screen,0,2,0,
      "Create a new X11 screen using association list ALIST.\
Optional argument is buffer to put in the screen.\
If non-existent or nil, a new one is created.")
	(buff,alist) Lisp_Object buff,alist;
    {
    Lisp_Object new_root;
    struct Root_Block *rb;
    struct W_Screen *ws;
    struct window *w;

    /* verify buffer argument before doing anything else */
    if (!NULL(buff)) buff = Fget_buffer(buff);

    new_root = make_root_block();
    rb = XROOT(new_root);
    ws = XWSCREEN(rb->win);

    /* need a screen now */
    x_create_screen(rb,&XD_screen,alist);

    /* link it in in front of the minibuf */
    rb->prev = mini_root->prev;
    XROOT(mini_root->prev)->next = new_root;
    mini_root->prev = new_root;
    rb->next = minibuf_rootblock;

    /* make a window to attach */
    rb->ewin = make_window(0);
    rb->select = rb->ewin;
    w = XWINDOW(rb->ewin);
    w->root = new_root;
    set_window_height(rb->ewin,ws->height,1);
    XFASTINT( w->width ) = ws->width;
    XFASTINT( w->top ) = 0;
    w->next = minibuf_window;

    /* set the buffer */
    Fset_window_buffer(rb->ewin,
		       NULL(buff)
		       ? Fget_buffer_create(build_string("*scratch*"))
		       : buff);

    return new_root;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
Lisp_Object
    find_block(seq) Lisp_Object seq;
    {
    Lisp_Object block;

    if (NULL(seq)) block = EDIT_SCREEN;
    else if (ROOTP(seq))
	/* make sure it's a live screen */
	block = EQ(Qnil,XROOT(seq)->next) ? Qnil : seq;
    else if (XTYPE(seq) != Lisp_Int)
	error("Need screen or int argument");
    else
	block = x_find_screen_seq(seq);

    return NULL(block) ? Qnil : block;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* return the next or previous screen, depending on the flag */
x_another_screen(seq,map,dir)
	Lisp_Object seq,map;
	int dir;
    {
    Lisp_Object block, start;

    block = find_block(seq);
    if (NULL(block)) return Qnil;

    start = block;		/* don't go around in circles */
    do
	{
	if (dir) block = XROOT(block)->next;
	else block = XROOT(block)->prev;

	/* if it's not the minibuf and we can find unmapped screens or
	 * it's mapped, return it
	 */
	if (!EQ(block,minibuf_rootblock)
	    && (!NULL(map) || XXSCREEN(XROOT(block)->x11)->mapped))
	    return block;
	} while (!EQ(block,start));
    return Qnil;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::next-screen",Fnext_screen,Snext_screen,0,2,0,
      "return the ID of the \"next\" screen. The minibuf is excepted, and\
unmapped windows are also. The first optional argument is the ID of the screen\
to start at - if omitted, the current screen is assumed. The second optional\
argument if not nil indicates that unmapped screens should be found.")
	(seq,map) Lisp_Object seq,map; /* next from this one */
    { return x_another_screen(seq,map,1); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::prev-screen",Fprev_screen,Sprev_screen,0,2,0,
      "return the ID of the \"previous\" screen. The minibuf is excepted, and\
unmapped windows are also. The first optional argument is the ID of the screen\
to start at - if omitted, the current screen is assumed. The second optional\
argument if not nil indicates that unmapped screens should be found.")
	(seq,map) Lisp_Object seq,map; /* next from this one */
    { return x_another_screen(seq,map,0); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::select-screen", Fselect_screen, Sselect_screen, 0, 1, 0,
      "Change the selected screen to the screen whose ID is passed as the\
first argument. If omitted, the \"next\" screen is selected.")
	(seq) Lisp_Object seq;
    {
    Lisp_Object block = Qnil;
    struct Root_Block *rb;
    char *msg = "Holy PH Batman, the buffer's missing!\n";
    char *msg2 = "Holy Panes Batman, the window's missing!\n";

    /* find out where we're going, first */
    if (NULL(seq))
      {
	/* look for a mapped screen, first, and if none, any screen */
	block = Fnext_screen(Qnil,Qnil);
	if (NULL(block)) block = Fnext_screen(Qnil,Qt);
      }
    else block = find_block(seq);

    if (NULL(block)) return Qnil;
    if (EQ(block,minibuf_rootblock)) return Qnil;

    if (XTYPE(XROOT(block)->select) != Lisp_Window)
	{ write(2,msg2,strlen(msg2)); abort(); }

    if (XTYPE(XWINDOW(XROOT(block)->select)->buffer) != Lisp_Buffer)
	{ write(2,msg,strlen(msg)); abort(); }

    /*selecting the window fixes everything */
    if (selected_window == minibuf_window)
	{
	/* need to get back to the minibuf in this case */
	Fselect_window(XROOT(block)->select);
	Fselect_window(minibuf_window);
	}
    else
	Fselect_window(XROOT(block)->select);

    return block;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* select a screen. this is called from Fselect_window, to make sure that
 * whenever a window is selected, the screen it's on is also selected. We
 * have to do some checks about the minibuf to make sure that the window
 * pointers go to the right places
 */
Lisp_Object
x_select_screen(screen)
	Lisp_Object screen;
    {
    struct Root_Block *rb,*oldrb;
    Lisp_Object old_screen;
    char same_edit = 0;
    char *msg = "SELECT ERROR : NOT A SCREEN!\n";
    extern char X_focus;	/* set by x11term.c */
    BLOCK_INPUT_DECLARE();

    if (!ROOTP(screen)) { write(2,msg,strlen(msg)); abort(); }
    rb = XROOT(screen);

    if (rb == cur_root)		/* selecting current screen */
      {
	cur_Wscreen = XWSCREEN(rb->win); /* make sure that all pointers are */
	cur_Xscreen = XXSCREEN(rb->x11); /* up to date - inexpensive to do */
	return screen;
      }

    /* check for dead screens : */
    if (EQ(Qnil,rb->seq))	/* it's dead, don't select it */
	{
	Fselect_window(cur_root->select);
	error("Attempt to select dead screen");
	}

    /* remove cursor from the old screen */
    if (cur_Xscreen->cursor_exists)
      {
	BLOCK_INPUT();
	CCursorToggle(cur_root);
	UNBLOCK_INPUT();
      }

    /* if it's just switch back from the minibuff to the edit screen,
     * don't do the redisplay and all that */
    if (screen == EDIT_SCREEN) same_edit = 1;

    /* set this screen up as the edit screen */
    cur_root = rb;
    cur_Xscreen = XXSCREEN(rb->x11);
    cur_Wscreen = XWSCREEN(rb->win);

    /* if selecting minibuf or the same edit screen, that's all */
    if (rb == mini_root || same_edit) return screen;

    RW_FIXUP(rb);		/* make sure we have root-window */
	
    /* need to do things to the old screen */
    old_screen = EDIT_SCREEN;
    oldrb = XROOT(old_screen);

    /* tell WM that it's not current anymore */
    BLOCK_INPUT();
    XChangeProperty(XXSCREEN(oldrb->x11)->display,
		    XXSCREEN(oldrb->x11)->xid,
		    XA_current,XA_STRING,8,
		    PropModeReplace,"no",3);
    UNBLOCK_INPUT();

    /* fix up the current screen before we leave, so that the garbage
     * collect doesn't zap parent windows */
    RW_FIXUP(oldrb);

    /* tell the WM that this screen is current */
    BLOCK_INPUT();
    XChangeProperty(cur_Xscreen->display,cur_Xscreen->xid,
		    XA_current,XA_STRING,8,
		    PropModeReplace,"yes",4);
    UNBLOCK_INPUT();

    /* attach screen to window tree */
    XWINDOW(minibuf_window)->prev = rb->ewin;

    Fset_screen_modified(old_screen);	/* in case of garbage */
    return screen;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static Lisp_Object
delete_screen(block)
	Lisp_Object block;
    {
    Lisp_Object dest;
    struct Root_Block *rb;
    struct X_Screen *xs;
    struct W_Screen *ws;
    int i;

    if (EQ(block,minibuf_rootblock))
	error ("Attempt to delete minibuffer");

    /* if we're deleting the current screen, we need to go elsewhere */
    if (EQ(block,EDIT_SCREEN)) /* yep, current screen is toast */
	{
	  /* look for a mapped screen first. If we can't find one, use an
	   * unmapped one.
	   */
	dest = Fnext_screen(Qnil,Qnil);
	if (!ROOTP(dest) || EQ(dest,block)) dest = Fnext_screen(Qnil,Qt);
	if (EQ(dest,block) || !ROOTP(dest))
	    error ("Attempt to delete only edit screen");
	Fselect_screen(dest);		/* now go there */
	}

    rb = XROOT(block);

    /* clip it out of the list */
    XROOT(rb->next)->prev = rb->prev;
    XROOT(rb->prev)->next = rb->next;

    RW_FIXUP(rb)
    destroy_window_tree(rb->ewin);
    xs = XXSCREEN(rb->x11);
    /* free up the graphics contexts */
    XFreeGC(xs->display,xs->gc_norm);
    XFreeGC(xs->display,xs->gc_rev);
    XFreeGC(xs->display,xs->gc_curs);
    XFreeGC(xs->display,xs->gc_style);
    XFreeGC(xs->display,xs->gc_inverse);

    XFreeCursor(xs->display,xs->the_cursor);
    XDestroyWindow(xs->display,xs->xid);

    /* have to free up the x block storage */
    free(xs);

    /* take care of w block storage */
    ws = XWSCREEN(rb->win);
    Cclear_screen_records(rb);	/* free up the physical display lines */
    Cclear_desired_lines(rb);	/* and desired lines */
    free(ws);			/* now we can relase the W block */

    /* the root is collected by the garbage collector */
    rb->next = rb->prev = Qnil;		/* mark as dead */

    return dest;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static Lisp_Object
x_internal_block_handler(seq,action)
	Lisp_Object seq;
	int action;
{
  Lisp_Object screen;
  struct X_Screen *xs = 0;
  Display *dpy;
  Window win;
  int plane;
  Lisp_Object result = Qt;
  XEvent message;

  if (XRESOURCEP(seq))
    {
      if (XXRESOURCE(seq)->type != XA_WINDOW)
	error("Screen resource must be of type WINDOW");
      dpy = XXRESOURCE(seq)->dpy;
      win = XXRESOURCE(seq)->id;
      plane = XXRESOURCE(seq)->plane;
      screen = seq;
    }
  else
    {
      screen = find_block(seq);
      if (NULL(screen)) return Qnil;
      dpy = XXSCREEN(XROOT(screen)->x11)->display;
      win = XXSCREEN(XROOT(screen)->x11)->xid;
      plane = XXSCREEN(XROOT(screen)->x11)->plane;
      xs = XXSCREEN(XROOT(screen)->x11);
    }

  result = screen;
  switch (action)
    {
    case 1 : HOLD_INPUT(XRaiseWindow(dpy,win)); break;
    /* 2 unused */
    case 3 : if (xs) result = XROOT(screen)->seq; break;
    case 4 : if (xs) result = delete_screen(screen); break;
    case 5 : HOLD_INPUT(XLowerWindow(dpy,win)); break;
    case 6 : /* Map == Go to NormalState */
      if (xs) x_set_wm_hints(xs,NormalState); /* in case of Withdrawn */
      HOLD_INPUT(XMapWindow(dpy,win))
      break;
    case 7 : /* Unmap == Go to WithdrawnState */
      HOLD_INPUT(XUnmapWindow(dpy,win)) /* normal unmap first */
      /* now a synthetic unmap */
      message.xany.type = UnmapNotify;
      message.xunmap.event = RootWindow(dpy,plane);
      message.xunmap.window = win;
      message.xunmap.from_configure = False;
      HOLD_INPUT(XSendEvent(dpy,message.xunmap.event,
			    False,	/* don't propagate */
			    SubstructureRedirectMask|SubstructureNotifyMask,
			    &message)	/* event to send */
		 )
      break;
    case 14 :		/* Iconify == Go to IconicState */
      /* requires a screen */
      if (xs && xs->mapped)	/* now in normal state */
	{
	  message.xany.type = ClientMessage;
	  message.xclient.window = win;
	  message.xclient.message_type = XA_wm_change_state;
	  message.xclient.format = 32;
	  message.xclient.data.l[0] = IconicState;
	  HOLD_INPUT(XSendEvent(dpy,RootWindow(dpy,plane),
			False,	/* don't propagate */
			SubstructureRedirectMask|SubstructureNotifyMask,
			&message)	/* event to send */
		     )
	}
      else if (xs)		/* was withdrawn or iconic */
	{
	  x_set_wm_hints(xs,IconicState);
	  HOLD_INPUT(XMapWindow(xs->display,xs->xid))
	}
      break;

    case 8 : result = xs ? screen : Qnil; break;
    case 9 : if (xs) result = xs->mapped ? Qt : Qnil ; break;
    case 10 : if (xs) result = XWSCREEN(XROOT(screen)->win)->height; break;
    case 11 : if (xs) result = XWSCREEN(XROOT(screen)->win)->width; break;
    case 12 : if (xs) result = XROOT(screen)->update; break;
    case 13 :
      if (xs) x_set_wm_hints(xs,NormalState); /* in case of Withdrawn */
      HOLD_INPUT(XMapRaised(dpy,win))
      break;
      /* 14 is used */
    case 15 : if (xs) result = XROOT(screen)->motion_hints; break;
    }

  HOLD_INPUT(XFlush(dpy))
  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
 * [cjl] primitives epoch::raise-screen and epoch::mapraised-screen now return
 *	 screen objects or nil
 */
DEFUN ("epoch::raise-screen",Fraise_screen,Sraise_screen, 0, 1, 0,
      "Raise the screen to the top of the display. The argument is the\
ID of the screen - if absent, the current screen is raised. Returns the \
screen if it was raised, nil otherwise.")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,1); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::mapraised-screen",Fmapraised_screen,Smapraised_screen, 0, 1, 0,
      "Map and raise the screen to the top of the display. The argument is the\
ID of the screen - if absent, the current screen is raised. Returns the\
screen if it was raised, nil otherwise.")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,13); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::iconify-screen",Ficonify_screen,Siconify_screen, 0, 1, 0,
      "Map and raise the screen to the top of the display. The argument is the\
ID of the screen - if absent, the current screen is raised. Returns t if\
the screen was raised, nil otherwise.")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,14); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::get-screen-id",Fget_screen_id,Sget_screen_id,0,1,0,"Convert a screen or id to an id")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,3); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::get-screen",Fget_screen,Sget_screen,0,1,0,
      "Convert an ID or screen to a screen")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,8); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::delete-screen",Fdelete_screen,Sdelete_screen,0,1,0,
      "Delete a screen. A screen cannot be deleted if it is the last mapped\
editing screen.") (seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,4); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::lower-screen",Flower_screen,Slower_screen,0,1,0,
      "Lower the screen to the bottom of the display")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,5); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::map-screen",Fmap_screen,Smap_screen,0,1,0,
      "Map the screen onto the display")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,6); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::unmap-screen",Funmap_screen,Sunmap_screen,0,1,0,
      "Unmap the screen")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,7); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screen-mapped-p",Fscreen_mapped_p,Sscreen_mapped_p,0,1,0,
      "Return t if the screen exists and is mapped, nil otherwise")
	(seq) Lisp_Object seq;
    { return x_internal_block_handler(seq,9); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screen-height",Fx_screen_height,Sx_screen_height,0,1,0,
      "Return the height of the screen")
	(screen) Lisp_Object screen;
    { return x_internal_block_handler(screen,10); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screen-width",Fx_screen_width,Sx_screen_width,0,1,0,
      "Return the width of the screen")
	(screen) Lisp_Object screen;
    { return x_internal_block_handler(screen,11); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::update-p",Fx_update_p,Sx_update_p,0,1,0,
      "Return t if the screen is updated when not current, nil otherwise")
	(screen) Lisp_Object screen;
    { return x_internal_block_handler(screen,12); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::set-update",Fx_set_update,Sx_set_update,1,2,0,
      "Set the update when not current flag. Returns the previous value.")
	(flag,screen) Lisp_Object flag,screen;
    {
    Lisp_Object result;
    Lisp_Object block;
    struct Root_Block *rb;

    block = find_block(screen);
    if (NULL(block)) return Qnil;

    rb = XROOT(block);

    result = rb->update;
    rb->update = EQ(Qnil,flag) ? Qnil : Qt; /* normalize */
    return result;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::motion-hints-p",Fx_motion_hints_p,Sx_motion_hints_p,0,1,0,
      "Return t if the screen has motion hints enabled, nil if disabled.")
	(screen) Lisp_Object screen;
    { return x_internal_block_handler(screen,15); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::set-motion-hints",Fx_set_motion_hints,Sx_set_motion_hints,1,2,0,
      "Enable/Disable motion hints for a screen. Returns the previous value")
	(flag,screen) Lisp_Object flag,screen;
    {
    Lisp_Object result;
    Lisp_Object block;
    struct Root_Block *rb;
    struct X_Screen *xs;
    BLOCK_INPUT_DECLARE();

    block = find_block(screen);
    if (NULL(block)) return Qnil;

    rb = XROOT(block);

    result = rb->motion_hints;
    rb->motion_hints = EQ(Qnil,flag) ? Qnil : Qt; /* normalize */
    xs = XXSCREEN(rb->x11);

    BLOCK_INPUT();
    if (EQ(Qnil,flag))
	XSelectInput(xs->display, xs->xid, NORMAL_INPUT);
    else
	XSelectInput(xs->display, xs->xid, NORMAL_INPUT|MOTION_INPUT);
    UNBLOCK_INPUT();

    return result;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* look for a buffer in the windows of a screen */
static Lisp_Object
find_buffer_in_window(w,obj)
	Lisp_Object w;
	Lisp_Object obj;
    {
    struct window *p;
    Lisp_Object tem;

    for ( ; !NULL(w) && !EQ(w,minibuf_window) ; w = XWINDOW(w)->next )
	{
	p = XWINDOW(w);
	if ( EQ ( p->buffer , obj ) )
	    return w;

	if (!NULL(p->vchild)
	    && !NULL(tem=find_buffer_in_window(p->vchild,obj)) )
		return tem;
	if (!NULL(p->hchild)
	    && !NULL(tem=find_buffer_in_window(p->hchild,obj)) )
		return tem;
	}
    return Qnil;		/* failure */
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::get-buffer-window",Fx_get_buffer_window,Sx_get_buffer_window,
      1,1,0,
      "Return a window displaying BUFFER, even in another screen, or\
nil if none")
	(buffer) Lisp_Object buffer;
    {
    buffer = Fget_buffer(buffer);
    return XTYPE(buffer) == Lisp_Buffer
	? do_windows_of_screens(find_buffer_in_window,buffer)
	: Qnil;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screen-list",Fscreen_list,Sscreen_list,0,1,0,
      "Return a list of screens. If the argument is present and not nil\
then unmapped screens are returned in the list. The minibuf screen is _never_\
in the list") (unmap) Lisp_Object unmap;
    {
    Lisp_Object block;
    Lisp_Object list = Qnil;
    struct Root_Block *rb;
    struct gcpro gcpro1;

    GCPRO1(list)
    for ( block = mini_root->next ; !EQ(block,minibuf_rootblock)
	 ; block = XROOT(block)->next )
	{
	if (XXSCREEN(XROOT(block)->x11)->mapped || !NULL(unmap))
	    list = Fcons(block,list);
	}
    UNGCPRO;
    return list;
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::screen-of-window",Fscreen_of_window,Sscreen_of_window,0,1,0,
      "Return the screen that a window is on")
	(window) Lisp_Object window;
    {
    if (NULL(window)) window = selected_window;
    CHECK_WINDOW(window,0);
    return XWINDOW(window)->root;
    }
/* ------------------------------------------------------------------------ */
DEFUN ("epoch::first-window",Fepoch_first_window,Sepoch_first_window,0,1,0,
       "Return the first window in the canonical order of SCREEN")
     (screen) Lisp_Object screen;
{
  struct Root_Block *rb;
  Lisp_Object win;
  struct window *w;

  screen = find_block(screen);
  if (NULL(screen)) return Qnil;
  rb = XROOT(screen);

  RW_FIXUP(rb);
  win = rb->ewin;
  while(1)
    {
      w = XWINDOW(win);
      if (!NULL(w->vchild)) win = w->vchild;
      else if (!NULL(w->hchild)) win = w->hchild;
      else break;		/* hit bottom */
    }

  return win;
}
/* ------------------------------------------------------------------------ */
DEFUN ("epoch::selected-window",Fepoch_selected_window,Sepoch_selected_window,
       0,1,0,
       "Return the selected window in on SCREEN")
     (screen) Lisp_Object screen;
{
  screen = find_block(screen);
  if (NULL(screen)) return Qnil;

  return XROOT(screen)->select;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::change-screen-size",Fchange_screen_size,Schange_screen_size,
      0,3,0,
      "Change the size of a screen. Arguments are the new width and \
height. The third optional argument is the screen")
	(col,row,screen) Lisp_Object col,row,screen;
    {
    struct X_Screen *xs;
    struct W_Screen *ws;
    unsigned int dx,dy;
    unsigned int height,width;

    screen = find_block(screen);
    if (NULL(screen)) return Qnil;
    xs = XXSCREEN(XROOT(screen)->x11);
    ws = XWSCREEN(XROOT(screen)->win);

    if (NULL(col)) col = make_number(ws->width);
    else CHECK_NUMBER(col,0);
    width = MIN( MAX(XFASTINT(col), 4), MScreenWidth);

    if (NULL(row)) row = make_number(ws->height);
    else CHECK_NUMBER(row,0);
    height = MIN( MAX(XFASTINT(row), 2 - (XROOT(screen) == mini_root)),
		  MScreenLength);

    dx = 2*xs->in_border + XFASTINT(col)*xs->font_width;
    dy = 2*xs->in_border + XFASTINT(row)*xs->font_height;
    return Success == XResizeWindow(xs->display,xs->xid,dx,dy) ? Qt : Qnil;
    }
    
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::move-screen",Fmove_screen,Smove_screen,
      2,3,0,
      "Move the screen on the root window. Argumnents are X, Y [ screen ], with X,Y in pixels.")
	(X,Y,screen) Lisp_Object X,Y,screen;
    {
    struct Lisp_Xresource *xr;
    unsigned int dx,dy;
    BLOCK_INPUT_DECLARE();

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

    CHECK_NUMBER(X,0);
    CHECK_NUMBER(Y,0);

    BLOCK_INPUT();
    XMoveWindow(xr->dpy,xr->id,XFASTINT(X),XFASTINT(Y));
    UNBLOCK_INPUT();
    return Qt;
    }
    
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN("dbx",Fdbx,Sdbx,0,0,"","Call DEBUG for debugger trap") ()
    { DEBUG(); }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
Lisp_Object Vepoch_version;
Lisp_Object Vepoch_bell_volume;
Lisp_Object Vepoch_function_key_mapping;
/* list of symbols recognized for screen property alist */
Lisp_Object Qx_cursor_glyph;
Lisp_Object Qx_title;
Lisp_Object Qx_name,Qx_icon_name;
Lisp_Object Qx_class;
Lisp_Object Qx_font;
Lisp_Object Qx_geometry;
Lisp_Object Qx_foreground,Qx_background,Qx_border_color;
Lisp_Object Qx_cursor_foreground,Qx_cursor_background;
Lisp_Object Qx_cursor_color;
Lisp_Object Qx_initial_state,Qx_update;
Lisp_Object Qx_reverse,Qx_in_border_width,Qx_ex_border_width;
Lisp_Object Qx_motion_hints,Qx_parent;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void syms_of_screen()
    {
    staticpro(&minibuf_rootblock);

    staticpro(&Qepoch_screenp);
    Qepoch_screenp = intern("epoch::screen-p");

    defsubr(&Screate_screen);
    defsubr(&Sraise_screen);
    defsubr(&Smapraised_screen);
    defsubr(&Siconify_screen);
    defsubr(&Scurrent_screen);
    defsubr(&Sminibuf_screen);
    defsubr(&Snext_screen);
    defsubr(&Sprev_screen);
    defsubr(&Sselect_screen);
    defsubr(&Sdelete_screen);
    defsubr(&Sget_screen_id);
    defsubr(&Sget_screen);
    defsubr(&Slower_screen);
    defsubr(&Smap_screen);
    defsubr(&Sunmap_screen);
    defsubr(&Sscreen_list);
    defsubr(&Sscreen_mapped_p);
    defsubr(&Sscreen_p);
    defsubr(&Sscreen_of_window);
    defsubr(&Sepoch_first_window);
    defsubr(&Sepoch_selected_window);
    defsubr(&Schange_screen_size);
    defsubr(&Smove_screen);
    defsubr(&Sx_screen_height);
    defsubr(&Sx_screen_width);

    defsubr(&Sx_get_buffer_window);
    defsubr(&Sepoch_screens_of_buffer);

    defsubr(&Sx_update_p);
    defsubr(&Sx_set_update);

    defsubr(&Sx_motion_hints_p);
    defsubr(&Sx_set_motion_hints);

    defsubr(&Sdbx);

    DEFVAR_LISP("epoch::version",&Vepoch_version,
		"Version number of Epoch");
    Vepoch_version = build_string("Epoch 3.2");

    DEFVAR_LISP("epoch::bell-volume", &Vepoch_bell_volume, "X bell volume");
    Vepoch_bell_volume = make_number(50);

    DEFVAR_LISP("epoch::function-key-mapping", &Vepoch_function_key_mapping,
		"Cause Epoch to map X function keysym to extended sequences");
    Vepoch_function_key_mapping = Qt;

    DEFVAR_LISP("epoch::global-update",&Vx_global_update,
		"If not nil, update screens with update flag set during normal updates");
    Vx_global_update = Qnil;

    DEFVAR_LISP("epoch::screen-properties",&Vx_screen_properties,
"Alist of symbol, value pairs of defaults for creating a new screen.\n\
To have new screens have the title 'Fred', you would use\n\
(setq epoch::screen-properties (list (cons 'title \"Fred\")))\n\
Recognized symbols are\n\
title : title\n\
name : resource name\n\
class : resource class\n\
icon-name : icon name\n\
foreground : foreground color\n\
background : background color\n\
font : font name\n\
geometry : geometry specification string\n\
initial-state : Start normal or iconic\n\
reverse : reverse foreground/background colors\n\
update : set global update flag for this screen\n\
cursor-color : text cursor color");
    Vx_screen_properties = Qnil;

    /* screen property alist symbols */
    Qx_cursor_glyph = intern("cursor-glyph");		staticpro(&Qx_cursor_glyph);
    Qx_title = intern("title");				staticpro(&Qx_title);
    Qx_name = intern("name");				staticpro(&Qx_name);
    Qx_class = intern("class");				staticpro(&Qx_class);
    Qx_icon_name = intern("icon-name");			staticpro(&Qx_icon_name);
    Qx_foreground = intern("foreground");		staticpro(&Qx_foreground);
    Qx_background = intern("background");		staticpro(&Qx_background);
    Qx_cursor_foreground = intern("cursor-foreground");	staticpro(&Qx_cursor_foreground);
    Qx_cursor_background = intern("cursor-background");	staticpro(&Qx_cursor_background);
    Qx_border_color = intern("border-color");		staticpro(&Qx_border_color);
    Qx_font = intern("font");				staticpro(&Qx_font);
    Qx_geometry = intern("geometry");			staticpro(&Qx_geometry);
    Qx_cursor_color = intern("cursor-color");		staticpro(&Qx_cursor_color);
    Qx_in_border_width = intern("in-border-width");	staticpro(&Qx_in_border_width);
    Qx_ex_border_width = intern("ex-border-width");	staticpro(&Qx_ex_border_width);
    Qx_initial_state = intern("initial-state");		staticpro(&Qx_initial_state);
    Qx_reverse = intern("reverse");			staticpro(&Qx_reverse);
    Qx_update = intern("update");			staticpro(&Qx_update);
    Qx_motion_hints = intern("motion-hints");		staticpro(&Qx_motion_hints);
    Qx_parent = intern("parent");			staticpro(&Qx_parent);

#ifdef BUTTON
    syms_of_button();
#endif
    syms_of_xutil();
    syms_of_xevent();
    syms_of_xresource();
    syms_of_property();
    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void DEBUG() { int debug = 0; }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* this is all debugging code from here on */
static char *tabs[] = { "\t","\t\t","\t\t\t","\t\t\t\t","\t\t\t\t\t" };

/* print out the window tree. Used in dumps and debugging runs */
void
print_window_tree(w,l)
Lisp_Object w; int l;
    {
    struct window *p;

    fprintf(stderr,"%s",tabs[l]);
    if (NULL(w)) fprintf(stderr,"nil\n");
    else if (XTYPE(w) != Lisp_Window) fprintf(stderr,"###\n");
    else if (EQ(w,minibuf_window)) fprintf(stderr,"minibuf\n");
    else
	{
	p = XWINDOW(w);
	fprintf(stderr,"%d (parent ",w);
	if (NULL(p->parent)) fprintf(stderr,"nil)\n");
	else fprintf(stderr,"%d)\n",p->parent);
	print_window_tree(p->hchild,l+1);
	print_window_tree(p->vchild,l+1);
	print_window_tree(p->next,l);
	}
    }

/* print the window tree for every screen */	
void
print_all_windows()
    {
    Lisp_Object screen = minibuf_rootblock;
    struct Root_Block *rb;

    do
	{
	screen = XROOT(screen)->next;
	rb = XROOT(screen);
	RW_FIXUP(rb);
	fprintf(stderr,"Screen %d\n",rb->seq);
	print_window_tree(rb->ewin,0);
	} while (!EQ(screen,minibuf_rootblock));
    }
