#include "xlib.h"

Object Sym_Pointer_Root;

static Display_Visit (dp, f) Object *dp; int (*f)(); {
    (*f)(&DISPLAY(*dp)->after);
}

Generic_Predicate (Display);

Generic_Equal (Display, DISPLAY, dpy);

static Display_Print (d, port, raw, depth, length) Object d, port; {
    Printf (port, "#[display %u %s]", (unsigned)DISPLAY(d)->dpy,
	DisplayString (DISPLAY(d)->dpy));
}

Object Make_Display (finalize, dpy) Display *dpy; {
    char *p;
    Object d;

    d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj);
    if (Nullp (d)) {
	p = Get_Bytes (sizeof (struct S_Display));
	SET (d, T_Display, (struct S_Display *)p);
	DISPLAY(d)->dpy = dpy;
	DISPLAY(d)->free = 0;
	DISPLAY(d)->after = False;
	Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display :
	    (PFO)0, 1);
    }
    return d;
}

static Object P_Open_Display (argc, argv) Object *argv; {
    register char *s;
    Object name;
    Display *dpy;

    if (argc == 1) {
	name = argv[0];
	Make_C_String (name, s);
	if ((dpy = XOpenDisplay (s)) == 0)
	    Primitive_Error ("cannot open display ~s", name);
    } else if ((dpy = XOpenDisplay ((char *)0)) == 0)
	Primitive_Error ("cannot open display");
    return Make_Display (1, dpy);
}

Object P_Close_Display (d) Object d; {
    register struct S_Display *p;

    Check_Type (d, T_Display);
    p = DISPLAY(d);
    if (!p->free) {
	Terminate_Group ((GENERIC)p->dpy);
	XCloseDisplay (p->dpy);
    }
    Deregister_Object (d);
    p->free = 1;
    return Void;
}

static Object P_Display_Root_Window (d) Object d; {
    Check_Type (d, T_Display);
    return Make_Window (0, DISPLAY(d)->dpy,
	DefaultRootWindow (DISPLAY(d)->dpy));
}

static Object P_Display_Colormap (d) Object d; {
    register Display *dpy;

    Check_Type (d, T_Display);
    dpy = DISPLAY(d)->dpy;
    return Make_Colormap (0, dpy, DefaultColormap (dpy, DefaultScreen (dpy)));
}

static Object P_Display_Default_Gcontext (d) Object d; {
    register Display *dpy;

    Check_Type (d, T_Display);
    dpy = DISPLAY(d)->dpy;
    return Make_Gc (0, dpy, DefaultGC (dpy, DefaultScreen (dpy)));
}

static Object P_Display_Width (d) Object d; {
    Check_Type (d, T_Display);
    return Make_Fixnum (DisplayWidth (DISPLAY(d)->dpy,
	DefaultScreen (DISPLAY(d)->dpy)));
}

static Object P_Display_Height (d) Object d; {
    Check_Type (d, T_Display);
    return Make_Fixnum (DisplayHeight (DISPLAY(d)->dpy,
	DefaultScreen (DISPLAY(d)->dpy)));
}

static Object P_Display_Flush_Output (d) Object d; {
    Check_Type (d, T_Display);
    XFlush (DISPLAY(d)->dpy);
    return Void;
}

static Object P_Display_Wait_Output (d, discard) Object d, discard; {
    Check_Type (d, T_Display);
    Check_Type (discard, T_Boolean);
    XSync (DISPLAY(d)->dpy, EQ(discard, True));
    return Void;
}

static Object P_Set_Input_Focus (d, win, revert_to, time) Object d, win,
    revert_to, time; {
    Window focus = PointerRoot;

    Check_Type (d, T_Display);
    if (!EQ(win, Sym_Pointer_Root))
	focus = Get_Window (win);
    XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0,
	Revert_Syms), Get_Time (time));
    return Void;
}

static Object P_Input_Focus (d) Object d; {
    Window win;
    int revert_to;
    Object ret, x;
    GC_Node;

    Check_Type (d, T_Display);
    XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to);
    ret = Cons (Null, Null);
    GC_Link (ret);
    x = Make_Window (0, DISPLAY(d)->dpy, win);
    Car (ret) = x;
    x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms);
    Cdr (ret) = x;
    GC_Unlink;
    return ret;
}

init_xlib_display () {
    Define_Symbol (&Sym_Pointer_Root, "pointer-root");
    T_Display = Define_Type (0, "display", NOFUNC, sizeof (struct S_Display),
	Display_Equal, Display_Equal, Display_Print, Display_Visit);
    Define_Primitive (P_Displayp,        "display?",        1, 1, EVAL);
    Define_Primitive (P_Open_Display,    "open-display",    0, 1, VARARGS);
    Define_Primitive (P_Close_Display,   "close-display",   1, 1, EVAL);
    Define_Primitive (P_Display_Root_Window,     "display-root-window",
							    1, 1, EVAL);
    Define_Primitive (P_Display_Colormap,        "display-colormap",
							    1, 1, EVAL);
    Define_Primitive (P_Display_Default_Gcontext,"display-default-gcontext",
							    1, 1, EVAL);
    Define_Primitive (P_Display_Width,   "display-width",   1, 1, EVAL);
    Define_Primitive (P_Display_Height,  "display-height",  1, 1, EVAL);
    Define_Primitive (P_Display_Flush_Output,    "display-flush-output",
							    1, 1, EVAL);
    Define_Primitive (P_Display_Wait_Output,     "display-wait-output",
							    2, 2, EVAL);
    Define_Primitive (P_Set_Input_Focus,  "set-input-focus",4, 4, EVAL);
    Define_Primitive (P_Input_Focus,      "input-focus",    1, 1, EVAL);
    P_Provide (Intern ("xlib.o"));
}