#include "xlib.h"

static s48_value Sym_Pointer_Root;

static s48_value P_Reparent_Window (w, parent, x, y) s48_value w, parent, x, y; {
    Check_Type (w, T_Window);
    Check_Type (parent, T_Window);
    XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win,
	(int)s48_extract_integer (x), (int)s48_extract_integer (y));
    return Void;
}

static s48_value P_Install_Colormap (c) s48_value c; {
    Check_Type (c, T_Colormap);
    XInstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
    return Void;
}

static s48_value P_Uninstall_Colormap (c) s48_value c; {
    Check_Type (c, T_Colormap);
    XUninstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
    return Void;
}

static s48_value P_List_Installed_Colormaps (w) s48_value w; {
    int i, n;
    Colormap *ret;
    s48_value v;
    S48_DECLARE_GC_PROTECT(1);

    Check_Type (w, T_Window);
    ret = XListInstalledColormaps (WINDOW(w)->dpy, WINDOW(w)->win, &n);
    v = s48_make_vector (n, S48_NULL);
    S48_GC_PROTECT_1 (v);
    for (i = 0; i < n; i++) {
	s48_value c;
	
	c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]);
	S48_VECTOR_SET(v, i, c;)
    }
    XFree ((char *)ret);
    S48_GC_UNPROTECT;
    return v;
}

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

    Check_Type (d, T_Display);
    if (!S48_EQ_P(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 s48_value P_Input_Focus (d) s48_value d; {
    Window win;
    int revert_to;
    s48_value ret, x;
    S48_DECLARE_GC_PROTECT(1);

    Check_Type (d, T_Display);
    XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to);
    ret = s48_cons (S48_NULL, S48_NULL);
    S48_GC_PROTECT_1 (ret);
    x = Make_Window (0, DISPLAY(d)->dpy, win);
    S48_CAR (ret) = x;
    x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms);
    S48_CDR (ret) = x;
    S48_GC_UNPROTECT;
    return ret;
}

static s48_value P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy,
	srcw, srch) s48_value dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; {
    Check_Type (dpy, T_Display);
    XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst),
	(int)s48_extract_integer (srcx), (int)s48_extract_integer (srcy), (int)s48_extract_integer (srcw),
	(int)s48_extract_integer (srch), (int)s48_extract_integer (dstx), (int)s48_extract_integer (dsty));
    return Void;
}

static s48_value P_Bell (argc, argv) s48_value *argv; {
    register percent = 0;

    Check_Type (argv[0], T_Display);
    if (argc == 2) {
	percent = (int)s48_extract_integer (argv[1]);
	if (percent < -100 || percent > 100)
	    Range_Error (argv[1]);
    }
    XBell (DISPLAY(argv[0])->dpy, percent);
    return Void;
}

static s48_value P_Set_Access_Control (dpy, on) s48_value dpy, on; {
    Check_Type (dpy, T_Display);
    Check_Type (on, T_Boolean);
    XSetAccessControl (DISPLAY(dpy)->dpy, S48_EQ_P(on, S48_TRUE));
    return Void;
}

static s48_value P_Change_Save_Set (win, mode) s48_value win, mode; {
    Check_Type (win, T_Window);
    XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win,
	Symbols_To_Bits (mode, 0, Saveset_Syms));
    return Void;
}

static s48_value P_Set_Close_Down_Mode (dpy, mode) s48_value dpy, mode; {
    Check_Type (dpy, T_Display);
    XSetCloseDownMode (DISPLAY(dpy)->dpy,
	Symbols_To_Bits (mode, 0, Closemode_Syms));
    return Void;
}

static s48_value P_Get_Pointer_Mapping (dpy) s48_value dpy; {
    unsigned char map[256];
    register i, n;
    s48_value ret;

    Check_Type (dpy, T_Display);
    n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256);
    ret = s48_make_vector (n, S48_NULL);
    for (i = 0; i < n; i++)
	S48_VECTOR_SET(ret, i, s48_enter_integer (map[i]);)
    return ret;
}

static s48_value P_Set_Pointer_Mapping (dpy, map) s48_value dpy, map; {
    register i, n;
    register unsigned char *p;
    s48_value ret;
    Alloca_Begin;

    Check_Type (dpy, T_Display);
    Check_Type (map, T_Vector);
    n = S48_VECTOR_LENGTH(map);
    Alloca (p, unsigned char*, n);
    for (i = 0; i < n; i++)
	p[i] = (int)s48_extract_integer (VECTOR(map)->data[i]);
    ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ?
	S48_TRUE : S48_FALSE;
    Alloca_End;
    return ret;
}

elk_init_xlib_wm () {
    Define_Primitive (P_Reparent_Window,  "reparent-window",  4, 4, EVAL);
    Define_Primitive (P_Install_Colormap, "install-colormap", 1, 1, EVAL);
    Define_Primitive (P_Uninstall_Colormap,
			"uninstall-colormap",                 1, 1, EVAL);
    Define_Primitive (P_List_Installed_Colormaps,
			"list-installed-colormaps",           1, 1, EVAL);
    Define_Primitive (P_Set_Input_Focus,  "set-input-focus",  4, 4, EVAL);
    Define_Primitive (P_Input_Focus,      "input-focus",      1, 1, EVAL);
    Define_Primitive (P_General_Warp_Pointer,
			"general-warp-pointer",               9, 9, EVAL);
    Define_Primitive (P_Bell,             "bell",             1, 2, VARARGS);
    Define_Primitive (P_Set_Access_Control,
			"set-access-control",                 2, 2, EVAL);
    Define_Primitive (P_Change_Save_Set,  "change-save-set",  2, 2, EVAL);
    Define_Primitive (P_Set_Close_Down_Mode,
			"set-close-down-mode",                2, 2, EVAL);
    Define_Primitive (P_Get_Pointer_Mapping,
			"get-pointer-mapping",                1, 1, EVAL);
    Define_Primitive (P_Set_Pointer_Mapping,
			"set-pointer-mapping",                2, 2, EVAL);
    Define_Symbol(&Sym_Pointer_Root, "pointer-root");
}