263 lines
8.5 KiB
C
263 lines
8.5 KiB
C
#include "xlib.h"
|
|
|
|
static s48_value Sym_Set_Attr, Sym_Get_Attr, Sym_Geo;
|
|
s48_value Sym_Conf;
|
|
|
|
Generic_Predicate (Window)
|
|
|
|
Generic_Equal_Dpy (Window, WINDOW, win)
|
|
|
|
Generic_Print (Window, "#[window %lu]", WINDOW(x)->win)
|
|
|
|
Generic_Get_Display (Window, WINDOW)
|
|
|
|
s48_value Make_Window (finalize, dpy, win) Display *dpy; Window win; {
|
|
s48_value w;
|
|
|
|
if (win == None)
|
|
return Sym_None;
|
|
if (win == PointerRoot)
|
|
return Intern ("pointer-root");
|
|
w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win);
|
|
if (S48_NULL_P (w)) {
|
|
w = Alloc_Object (sizeof (struct S_Window), T_Window, 0);
|
|
WINDOW(w)->tag = S48_NULL;
|
|
WINDOW(w)->win = win;
|
|
WINDOW(w)->dpy = dpy;
|
|
WINDOW(w)->free = 0;
|
|
WINDOW(w)->finalize = finalize;
|
|
Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window :
|
|
(PFO)0, 0);
|
|
}
|
|
return w;
|
|
}
|
|
|
|
Window Get_Window (w) s48_value w; {
|
|
if (S48_EQ_P(w, Sym_None))
|
|
return None;
|
|
Check_Type (w, T_Window);
|
|
return WINDOW(w)->win;
|
|
}
|
|
|
|
Drawable Get_Drawable (d, dpyp) s48_value d; Display **dpyp; {
|
|
if (TYPE(d) == T_Window) {
|
|
*dpyp = WINDOW(d)->dpy;
|
|
return (Drawable)WINDOW(d)->win;
|
|
} else if (TYPE(d) == T_Pixmap) {
|
|
*dpyp = PIXMAP(d)->dpy;
|
|
return (Drawable)PIXMAP(d)->pm;
|
|
}
|
|
Wrong_Type_Combination (d, "drawable");
|
|
/*NOTREACHED*/
|
|
}
|
|
|
|
static s48_value P_Create_Window (parent, x, y, width, height, border_width, attr)
|
|
s48_value parent, x, y, width, height, border_width, attr; {
|
|
unsigned long mask;
|
|
Window win;
|
|
|
|
Check_Type (parent, T_Window);
|
|
mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
|
|
if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win,
|
|
(int)s48_extract_integer (x), (int)s48_extract_integer (y), (int)s48_extract_integer (width),
|
|
(int)s48_extract_integer (height), (int)s48_extract_integer (border_width),
|
|
CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0)
|
|
Primitive_Error ("cannot create window");
|
|
return Make_Window (1, WINDOW(parent)->dpy, win);
|
|
}
|
|
|
|
static s48_value P_Configure_Window (w, conf) s48_value w, conf; {
|
|
unsigned long mask;
|
|
|
|
Check_Type (w, T_Window);
|
|
mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec);
|
|
XConfigureWindow (WINDOW(w)->dpy, WINDOW(w)->win, mask, &WC);
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Change_Window_Attributes (w, attr) s48_value w, attr; {
|
|
unsigned long mask;
|
|
|
|
Check_Type (w, T_Window);
|
|
mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
|
|
XChangeWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, mask, &SWA);
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Get_Window_Attributes (w) s48_value w; {
|
|
Check_Type (w, T_Window);
|
|
XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA);
|
|
return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr,
|
|
WINDOW(w)->dpy, ~0L);
|
|
}
|
|
|
|
static s48_value P_Get_Geometry (d) s48_value d; {
|
|
Display *dpy;
|
|
Drawable dr = Get_Drawable (d, &dpy);
|
|
|
|
/* GEO.width, GEO.height, etc. should really be unsigned, not int.
|
|
*/
|
|
XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, (unsigned *)&GEO.width,
|
|
(unsigned *)&GEO.height, (unsigned *)&GEO.border_width,
|
|
(unsigned *)&GEO.depth);
|
|
return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L);
|
|
}
|
|
|
|
static s48_value P_Map_Window (w) s48_value w; {
|
|
Check_Type (w, T_Window);
|
|
XMapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Unmap_Window (w) s48_value w; {
|
|
Check_Type (w, T_Window);
|
|
XUnmapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
|
|
return Void;
|
|
}
|
|
|
|
s48_value P_Destroy_Window (w) s48_value w; {
|
|
Check_Type (w, T_Window);
|
|
if (!WINDOW(w)->free)
|
|
XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win);
|
|
Deregister_Object (w);
|
|
WINDOW(w)->free = 1;
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Destroy_Subwindows (w) s48_value w; {
|
|
Check_Type (w, T_Window);
|
|
XDestroySubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Map_Subwindows (w) s48_value w; {
|
|
Check_Type (w, T_Window);
|
|
XMapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Unmap_Subwindows (w) s48_value w; {
|
|
Check_Type (w, T_Window);
|
|
XUnmapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Circulate_Subwindows (w, dir) s48_value w, dir; {
|
|
Check_Type (w, T_Window);
|
|
XCirculateSubwindows (WINDOW(w)->dpy, WINDOW(w)->win,
|
|
Symbols_To_Bits (dir, 0, Circulate_Syms));
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Query_Tree (w) s48_value w; {
|
|
Window root, parent, *children;
|
|
Display *dpy;
|
|
int i;
|
|
unsigned n;
|
|
s48_value v, ret;
|
|
S48_DECLARE_GC_PROTECT(2);
|
|
|
|
Check_Type (w, T_Window);
|
|
dpy = WINDOW(w)->dpy;
|
|
Disable_Interrupts;
|
|
XQueryTree (dpy, WINDOW(w)->win, &root, &parent, &children, &n);
|
|
Enable_Interrupts;
|
|
v = ret = S48_NULL;
|
|
S48_GC_PROTECT_2 (v, ret);
|
|
v = Make_Window (0, dpy, root);
|
|
ret = s48_cons (v, S48_NULL);
|
|
v = Make_Window (0, dpy, parent);
|
|
ret = s48_cons (v, ret);
|
|
v = s48_make_vector (n, S48_NULL);
|
|
for (i = 0; i < n; i++) {
|
|
s48_value x;
|
|
|
|
x = Make_Window (0, dpy, children[i]);
|
|
S48_VECTOR_SET(v, i, x;)
|
|
}
|
|
ret = s48_cons (v, ret);
|
|
S48_GC_UNPROTECT;
|
|
return ret;
|
|
}
|
|
|
|
static s48_value P_Translate_Coordinates (src, x, y, dst) s48_value src, x, y, dst; {
|
|
int rx, ry;
|
|
Window child;
|
|
s48_value l, t, z;
|
|
S48_DECLARE_GC_PROTECT(3);
|
|
|
|
Check_Type (src, T_Window);
|
|
Check_Type (dst, T_Window);
|
|
if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win,
|
|
WINDOW(dst)->win, (int)s48_extract_integer (x), (int)s48_extract_integer (y), &rx, &ry,
|
|
&child))
|
|
return S48_FALSE;
|
|
l = t = P_Make_List (s48_enter_integer (3), S48_NULL);
|
|
S48_GC_PROTECT_3 (l, t, dst);
|
|
S48_CAR (t) = s48_enter_integer (rx); t = S48_CDR (t);
|
|
S48_CAR (t) = s48_enter_integer (ry), t = S48_CDR (t);
|
|
z = Make_Window (0, WINDOW(dst)->dpy, child);
|
|
S48_CAR (t) = z;
|
|
S48_GC_UNPROTECT;
|
|
return l;
|
|
}
|
|
|
|
static s48_value P_Query_Pointer (win) s48_value win; {
|
|
s48_value l, t, z;
|
|
Bool ret;
|
|
Window root, child;
|
|
int r_x, r_y, x, y;
|
|
unsigned int mask;
|
|
S48_DECLARE_GC_PROTECT(3);
|
|
|
|
Check_Type (win, T_Window);
|
|
ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child,
|
|
&r_x, &r_y, &x, &y, &mask);
|
|
t = l = P_Make_List (s48_enter_integer (8), S48_NULL);
|
|
S48_GC_PROTECT_3 (l, t, win);
|
|
S48_CAR (t) = s48_enter_integer (x); t = S48_CDR (t);
|
|
S48_CAR (t) = s48_enter_integer (y); t = S48_CDR (t);
|
|
S48_CAR (t) = ret ? S48_TRUE : S48_FALSE; t = S48_CDR (t);
|
|
z = Make_Window (0, WINDOW(win)->dpy, root);
|
|
S48_CAR (t) = z; t = S48_CDR (t);
|
|
S48_CAR (t) = s48_enter_integer (r_x); t = S48_CDR (t);
|
|
S48_CAR (t) = s48_enter_integer (r_y); t = S48_CDR (t);
|
|
z = Make_Window (0, WINDOW(win)->dpy, child);
|
|
S48_CAR (t) = z; t = S48_CDR (t);
|
|
z = Bits_To_Symbols ((unsigned long)mask, 1, State_Syms);
|
|
S48_CAR (t) = z;
|
|
S48_GC_UNPROTECT;
|
|
return l;
|
|
}
|
|
|
|
elk_init_xlib_window () {
|
|
Define_Symbol (&Sym_Set_Attr, "set-window-attributes");
|
|
Define_Symbol (&Sym_Get_Attr, "get-window-attributes");
|
|
Define_Symbol (&Sym_Conf, "window-configuration");
|
|
Define_Symbol (&Sym_Geo, "geometry");
|
|
Generic_Define (Window, "window", "window?");
|
|
Define_Primitive (P_Window_Display, "window-display", 1, 1, EVAL);
|
|
Define_Primitive (P_Create_Window,
|
|
"xlib-create-window", 7, 7, EVAL);
|
|
Define_Primitive (P_Configure_Window,
|
|
"xlib-configure-window", 2, 2, EVAL);
|
|
Define_Primitive (P_Change_Window_Attributes,
|
|
"xlib-change-window-attributes", 2, 2, EVAL);
|
|
Define_Primitive (P_Get_Window_Attributes,
|
|
"xlib-get-window-attributes", 1, 1, EVAL);
|
|
Define_Primitive (P_Get_Geometry, "xlib-get-geometry",1, 1, EVAL);
|
|
Define_Primitive (P_Map_Window, "map-window", 1, 1, EVAL);
|
|
Define_Primitive (P_Unmap_Window, "unmap-window", 1, 1, EVAL);
|
|
Define_Primitive (P_Circulate_Subwindows,
|
|
"circulate-subwindows", 2, 2, EVAL);
|
|
Define_Primitive (P_Destroy_Window, "destroy-window", 1, 1, EVAL);
|
|
Define_Primitive (P_Destroy_Subwindows,
|
|
"destroy-subwindows", 1, 1, EVAL);
|
|
Define_Primitive (P_Map_Subwindows, "map-subwindows", 1, 1, EVAL);
|
|
Define_Primitive (P_Unmap_Subwindows, "unmap-subwindows", 1, 1, EVAL);
|
|
Define_Primitive (P_Query_Tree, "query-tree", 1, 1, EVAL);
|
|
Define_Primitive (P_Translate_Coordinates,
|
|
"translate-coordinates", 4, 4, EVAL);
|
|
Define_Primitive (P_Query_Pointer, "query-pointer", 1, 1, EVAL);
|
|
}
|