#include "xlib.h"

extern XFetchName(), XStoreName(), XGetIconName(), XSetIconName();

static Object Sym_Wm_Hints, Sym_Size_Hints, Sym_Icon_Size;

static Object Get_Name (w, f) Object w; int (*f)(); {
    char *ret;
    Object s;

    Check_Type (w, T_Window);
    Disable_Interrupts;
    if (!(*f) (WINDOW(w)->dpy, WINDOW(w)->win, &ret) || ret == 0) {
	Enable_Interrupts;
	return False;
    }
    Enable_Interrupts;
    s = Make_String (ret, strlen (ret));
    XFree (ret);
    return s;
}

static Object P_Wm_Name (w) Object w; {
    return Get_Name (w, XFetchName);
}

static Object P_Wm_Icon_Name (w) Object w; {
    return Get_Name (w, XGetIconName);
}

static Object Set_Name (w, name, f) Object w, name; int (*f)(); {
    register char *s;

    Check_Type (w, T_Window);
    Make_C_String (name, s);
    (*f) (WINDOW(w)->dpy, WINDOW(w)->win, s);
    return Void;
}

static Object P_Set_Wm_Name (w, name) Object w, name; {
    return Set_Name (w, name, XStoreName);
}

static Object P_Set_Wm_Icon_Name (w, name) Object w, name; {
    return Set_Name (w, name, XSetIconName);
}

static Object P_Wm_Class (w) Object w; {
    Object ret, x;
    XClassHint c;
    GC_Node;

    Check_Type (w, T_Window);
    /*
     * In X11.2 XGetClassHint() returns either 0 or Success, which happens
     * to be defined as 0.  So until this bug is fixed, we must
     * explicitly check whether the XClassHint structure has been filled.
     */
     c.res_name = c.res_class = 0;
    Disable_Interrupts;
    (void)XGetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
    Enable_Interrupts;
    ret = Cons (False, False);
    GC_Link (ret);
    if (c.res_name) {
	x = Make_String (c.res_name, strlen (c.res_name));
	Car (ret) = x;
    }
    if (c.res_class) {
	x = Make_String (c.res_class, strlen (c.res_class));
	Cdr (ret) = x;
    }
    GC_Unlink;
    return ret;
}

static Object P_Set_Wm_Class (w, name, class) Object w, name, class; {
    XClassHint c;

    Check_Type (w, T_Window);
    Make_C_String (name, c.res_name);
    Make_C_String (class, c.res_class);
    XSetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
    return Void;
}

static Object P_Set_Wm_Command (w, cmd) Object w, cmd; {
    register i, n;
    register char **argv;
    Object c;

    Check_Type (w, T_Window);
    Check_List (cmd);
    n = Internal_Length (cmd);
    argv = (char **)alloca (n * sizeof (char *));
    for (i = 0; i < n; i++, cmd = Cdr (cmd)) {
	c = Car (cmd);
	Make_C_String (c, argv[i]);
    }
    XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n);
    return Void;
}

static Object P_Wm_Hints (w) Object w; {
    XWMHints *p;

    Check_Type (w, T_Window);
    Disable_Interrupts;
    p = XGetWMHints (WINDOW(w)->dpy, WINDOW(w)->win);
    Enable_Interrupts;
    if (p)
	WMH = *p;
    else
	WMH.flags = 0;
    return Record_To_Vector (Wm_Hints_Rec, Wm_Hints_Size, Sym_Wm_Hints,
	WINDOW(w)->dpy, (unsigned long)WMH.flags);
}

static Object P_Set_Wm_Hints (w, h) Object w, h; {
    register unsigned long mask;

    Check_Type (w, T_Window);
    mask = Vector_To_Record (h, Wm_Hints_Size, Sym_Wm_Hints, Wm_Hints_Rec);
    WMH.flags = mask;
    XSetWMHints (WINDOW(w)->dpy, WINDOW(w)->win, &WMH);
    return Void;
}

static Object P_Size_Hints (w, a) Object w, a; {
    Check_Type (w, T_Window);
    Check_Type (a, T_Atom);
    Disable_Interrupts;
    if (!XGetSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom))
	SZH.flags = 0;
    Enable_Interrupts;
    if ((SZH.flags & (PPosition|USPosition)) == (PPosition|USPosition))
	SZH.flags &= ~PPosition;
    if ((SZH.flags & (PSize|USSize)) == (PSize|USSize))
	SZH.flags &= ~PSize;
    return Record_To_Vector (Size_Hints_Rec, Size_Hints_Size, Sym_Size_Hints,
	WINDOW(w)->dpy, (unsigned long)SZH.flags);
}

static Object P_Set_Size_Hints (w, a, h) Object w, a, h; {
    register unsigned long mask;

    Check_Type (w, T_Window);
    Check_Type (a, T_Atom);
    bzero ((char *)&SZH, sizeof (SZH));        /* Not portable? */
    mask = Vector_To_Record (h, Size_Hints_Size, Sym_Size_Hints,
	Size_Hints_Rec);
    if ((mask & (PPosition|USPosition)) == (PPosition|USPosition))
	mask &= ~PPosition;
    if ((mask & (PSize|USSize)) == (PSize|USSize))
	mask &= ~PSize;
    SZH.flags = mask;
    XSetSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom);
    return Void;
}

static Object P_Icon_Sizes (w) Object w; {
    XIconSize *p;
    int i, n;
    Object v, x;
    GC_Node2;
    
    Check_Type (w, T_Window);
    Disable_Interrupts;
    if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
	n = 0;
    Enable_Interrupts;
    v = Make_Vector (n, Null);
    GC_Link2 (v, w);
    for (i = 0; i < n; i++) {
	ISZ = p[i];
	x = Record_To_Vector (Icon_Size_Rec, Icon_Size_Size, Sym_Icon_Size,
	    WINDOW(w)->dpy, ~0L);
	VECTOR(v)->data[i] = x;
    }
    GC_Unlink;
    return v;
}

static Object P_Set_Icon_Sizes (w, v) Object w, v; {
    register i, n;
    XIconSize *p;

    Check_Type (w, T_Window);
    Check_Type (v, T_Vector);
    n = VECTOR(v)->size;
    p = (XIconSize *)alloca (n * sizeof (XIconSize));
    for (i = 0; i < n; i++) {
	(void)Vector_To_Record (VECTOR(v)->data[i], Icon_Size_Size,
	    Sym_Icon_Size, Icon_Size_Rec);
	p[i] = ISZ;
    }
    XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n);
    return Void;
}

static Object P_Transient_For (w) Object w; {
    Window win;

    Disable_Interrupts;
    if (!XGetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, &win))
	win = None;
    Enable_Interrupts;
    return Make_Window (0, WINDOW(w)->dpy, win);
}

static Object P_Set_Transient_For (w, pw) Object w, pw; {
    Check_Type (w, T_Window);
    XSetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, Get_Window (pw));
    return Void;
}

init_xlib_wm () {
    Define_Symbol (&Sym_Wm_Hints, "wm-hints");
    Define_Symbol (&Sym_Size_Hints, "size-hints");
    Define_Symbol (&Sym_Icon_Size, "icon-size");
    Define_Primitive (P_Wm_Name,          "wm-name",           1, 1, EVAL);
    Define_Primitive (P_Wm_Icon_Name,     "wm-icon-name",      1, 1, EVAL);
    Define_Primitive (P_Set_Wm_Name,      "set-wm-name!",      2, 2, EVAL);
    Define_Primitive (P_Set_Wm_Icon_Name, "set-wm-icon-name!", 2, 2, EVAL);
    Define_Primitive (P_Wm_Class,         "wm-class",          1, 1, EVAL);
    Define_Primitive (P_Set_Wm_Class,     "set-wm-class!",     3, 3, EVAL);
    Define_Primitive (P_Set_Wm_Command,   "set-wm-command!",   2, 2, EVAL);
    Define_Primitive (P_Wm_Hints,         "wm-hints",          1, 1, EVAL);
    Define_Primitive (P_Set_Wm_Hints,     "set-wm-hints!",     2, 2, EVAL);
    Define_Primitive (P_Size_Hints,       "size-hints",        2, 2, EVAL);
    Define_Primitive (P_Set_Size_Hints,   "set-size-hints!",   3, 3, EVAL);
    Define_Primitive (P_Icon_Sizes,       "icon-sizes",        1, 1, EVAL);
    Define_Primitive (P_Set_Icon_Sizes,   "set-icon-sizes!",   2, 2, EVAL);
    Define_Primitive (P_Transient_For,    "transient-for",     1, 1, EVAL);
    Define_Primitive (P_Set_Transient_For,"set-transient-for!",2, 2, EVAL);
}