389 lines
12 KiB
C
389 lines
12 KiB
C
#include "xlib.h"
|
|
#include "scheme48.h"
|
|
|
|
static s48_value window_record_type_binding = S48_FALSE;
|
|
|
|
unsigned long AList_To_XSetWindowAttributes(s48_value attrAlist,
|
|
XSetWindowAttributes* Xattrs) {
|
|
unsigned long mask = 0;
|
|
s48_value l;
|
|
char* cname;
|
|
s48_value name, value;
|
|
|
|
for (l = attrAlist; !S48_NULL_P(l); l = S48_CDR(l)) {
|
|
name = S48_CAR(l);
|
|
value = S48_CDR(l);
|
|
cname = s48_extract_string(S48_SYMBOL_TO_STRING(name));
|
|
|
|
if (cname == "background-pixmap") {
|
|
Xattrs->background_pixmap = extract_background(value);
|
|
mask |= CWBackPixmap;
|
|
} else if (cname == "background-pixel") {
|
|
Xattrs->background_pixel = s48_extract_integer(value);
|
|
mask |= CWBackPixel;
|
|
} else if (cname == "border-pixmap") {
|
|
Xattrs->border_pixmap = extract_border(value);
|
|
mask |= CWBorderPixmap;
|
|
} else if (cname == "border-pixel") {
|
|
Xattrs->border_pixel = s48_extract_integer(value);
|
|
mask |= CWBorderPixel;
|
|
} else if (cname == "bit-gravity") {
|
|
Xattrs->bit_gravity = Symbols_To_Bits(value, 0, Bit_Grav_Syms);
|
|
mask |= CWBitGravity;
|
|
} else if (cname == "gravity") {
|
|
Xattrs->win_gravity = Symbols_To_Bits(value, 0, Grav_Syms);
|
|
mask |= CWWinGravity;
|
|
} else if (cname == "backing-store") {
|
|
Xattrs->backing_store = Symbols_To_Bits(value, 0, Backing_Store_Syms);
|
|
mask |= CWBackingStore;
|
|
} else if (cname == "backing-planes") {
|
|
Xattrs->backing_planes = s48_extract_integer(value);
|
|
mask |= CWBackingPlanes;
|
|
} else if (cname == "backing-pixel") {
|
|
Xattrs->backing_pixel = s48_extract_integer(value);
|
|
mask |= CWBackingPixel;
|
|
} else if (cname == "save-under") {
|
|
Xattrs->save_under = !S48_FALSE_P(value);
|
|
mask |= CWSaveUnder;
|
|
} else if (cname == "event-mask") {
|
|
Xattrs->event_mask = Symbols_To_Bits(value, 1, Event_Syms);
|
|
mask |= CWEventMask;
|
|
} else if (cname == "do-not-propagate-mask") {
|
|
Xattrs->do_not_propagate_mask = Symbols_To_Bits(value, 1, Event_Syms);
|
|
mask |= CWDontPropagate;
|
|
} else if (cname == "override-redirect") {
|
|
Xattrs->override_redirect = !S48_FALSE_P(value);
|
|
mask |= CWOverrideRedirect;
|
|
} else if (cname == "colormap") {
|
|
Xattrs->colormap = s48_extract_integer(value);
|
|
mask |= CWColormap;
|
|
} else if (cname == "cursor") {
|
|
Xattrs->cursor = s48_extract_integer(value);
|
|
mask |= CWCursor;
|
|
} // else error
|
|
} /* for */
|
|
return mask;
|
|
}
|
|
|
|
int extract_background(s48_value value) {
|
|
if (S48_SYMBOL_P(value)) {
|
|
char* v = s48_extract_string(S48_SYMBOL_TO_STRING(value));
|
|
if (v == "none")
|
|
return None;
|
|
else if (v == "parent-relative")
|
|
return ParentRelative;
|
|
//else // error ...
|
|
}
|
|
return EXTRACT_PIXMAP(value);
|
|
}
|
|
|
|
int extract_border(s48_value value) {
|
|
if (S48_SYMBOL_P(value)) {
|
|
char* v = s48_extract_string(S48_SYMBOL_TO_STRING(value));
|
|
if (v == "copy-from-parent")
|
|
return CopyFromParent;
|
|
// else error
|
|
} else
|
|
return s48_extract_integer(value);
|
|
}
|
|
|
|
s48_value Create_Window (s48_value Xdisplay, s48_value Xparent, s48_value x,
|
|
s48_value y, s48_value width, s48_value height,
|
|
s48_value border_width, s48_value attrAlist) {
|
|
|
|
XSetWindowAttributes Xattrs;
|
|
unsigned long mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs );
|
|
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window parent = EXTRACT_WINDOW(Xparent);
|
|
|
|
Window win;
|
|
win = XCreateWindow( dpy, parent, (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,
|
|
&Xattrs );
|
|
return ENTER_WINDOW(win);
|
|
}
|
|
|
|
s48_value Destroy_Window (s48_value Xdisplay, s48_value Xwindow) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XDestroyWindow (dpy, win);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Change_Window_Attributes(s48_value Xwindow, s48_value Xdisplay,
|
|
s48_value attrAlist) {
|
|
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XSetWindowAttributes Xattrs;
|
|
unsigned long mask = 0;
|
|
|
|
mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs );
|
|
|
|
XChangeWindowAttributes(dpy, win, mask, &Xattrs);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XWindowAttributes WA;
|
|
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
s48_value res = S48_NULL;
|
|
S48_GC_PROTECT_1(res);
|
|
|
|
XGetWindowAttributes(dpy, win, &WA);
|
|
|
|
// ... usw.
|
|
res = s48_cons( s48_enter_integer(WA.backing_planes), res);
|
|
res = s48_cons( Bits_To_Symbols(WA.backing_store, 1, Backing_Store_Syms),
|
|
res);
|
|
res = s48_cons( Bits_To_Symbols(WA.win_gravity, 1, Grav_Syms),
|
|
res);
|
|
res = s48_cons( Bits_To_Symbols(WA.bit_gravity, 1, Bit_Grav_Syms), res);
|
|
res = s48_cons( Bits_To_Symbols(WA.class, 1, Class_Syms), res);
|
|
res = s48_cons( s48_enter_integer(WA.root), res); // a Window !
|
|
res = s48_cons( s48_enter_integer((long)WA.visual), res); // a Visual* !
|
|
res = s48_cons( s48_enter_integer(WA.depth), res);
|
|
res = s48_cons( s48_enter_integer(WA.border_width), res);
|
|
res = s48_cons( s48_enter_integer(WA.height), res);
|
|
res = s48_cons( s48_enter_integer(WA.width), res);
|
|
res = s48_cons( s48_enter_integer(WA.y), res);
|
|
res = s48_cons( s48_enter_integer(WA.x), res);
|
|
|
|
S48_GC_UNPROTECT();
|
|
return res;
|
|
}
|
|
|
|
s48_value Configure_Window (s48_value Xwindow, s48_value Xdisplay,
|
|
s48_value alist) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
|
|
unsigned long mask = 0;
|
|
XWindowChanges WC;
|
|
s48_value l;
|
|
char* cname;
|
|
int cvalue;
|
|
s48_value name, value;
|
|
|
|
for (l = alist; !S48_NULL_P(l); l = S48_CDR(l)) {
|
|
name = S48_CAR(l);
|
|
value = S48_CDR(l);
|
|
cname = s48_extract_string(S48_SYMBOL_TO_STRING(name));
|
|
cvalue = (int)s48_extract_integer(value); // only ints here
|
|
|
|
if (cname == "x") {
|
|
WC.x = cvalue;
|
|
mask |= CWX;
|
|
} else if (cname == "y") {
|
|
WC.y = cvalue;
|
|
mask |= CWY;
|
|
} else if (cname == "width") {
|
|
WC.width = cvalue;
|
|
mask |= CWWidth;
|
|
} else if (cname == "height") {
|
|
WC.height = cvalue;
|
|
mask |= CWHeight;
|
|
} else if (cname == "border-width") {
|
|
WC.border_width = cvalue;
|
|
mask |= CWBorderWidth;
|
|
} else if (cname == "sibling") {
|
|
WC.sibling = (Window)s48_extract_integer(value);
|
|
mask |= CWSibling;
|
|
} else if (cname == "stack-mode") {
|
|
WC.stack_mode = cvalue;
|
|
mask |= CWStackMode;
|
|
}
|
|
} // for
|
|
|
|
XConfigureWindow (dpy, win, mask, &WC);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Map_Window(s48_value Xwindow, s48_value Xdisplay) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XMapWindow(dpy, win);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Unmap_Window(s48_value Xwindow, s48_value Xdisplay) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XUnmapWindow(dpy, win);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Destroy_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XDestroySubwindows(dpy, win);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Map_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XMapSubwindows(dpy, win);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Unmap_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
XUnmapSubwindows(dpy, win);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Circulate_Subwindows(s48_value Xwindow, s48_value Xdisplay,
|
|
s48_value dir) {
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
Window win = EXTRACT_WINDOW(Xwindow);
|
|
long direction = s48_extract_integer(dir);
|
|
XCirculateSubwindows(dpy, win, direction ? LowerHighest : RaiseLowest);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
|
|
|
|
/*
|
|
}
|
|
|
|
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_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_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;
|
|
}
|
|
|
|
*/
|
|
|
|
void s48_init_window(void) {
|
|
S48_GC_PROTECT_GLOBAL(window_record_type_binding);
|
|
window_record_type_binding = s48_get_imported_binding("window-record-type");
|
|
|
|
S48_EXPORT_FUNCTION(Create_Window);
|
|
S48_EXPORT_FUNCTION(Destroy_Window);
|
|
S48_EXPORT_FUNCTION(Change_Window_Attributes);
|
|
S48_EXPORT_FUNCTION(Get_Window_Attributes);
|
|
S48_EXPORT_FUNCTION(Configure_Window);
|
|
S48_EXPORT_FUNCTION(Map_Window);
|
|
S48_EXPORT_FUNCTION(Unmap_Window);
|
|
S48_EXPORT_FUNCTION(Destroy_Subwindows);
|
|
S48_EXPORT_FUNCTION(Map_Subwindows);
|
|
S48_EXPORT_FUNCTION(Unmap_Subwindows);
|
|
S48_EXPORT_FUNCTION(Circulate_Subwindows);
|
|
|
|
}
|