371 lines
12 KiB
C
371 lines
12 KiB
C
#include "xlib.h"
|
|
#include "scheme48.h"
|
|
|
|
unsigned long AList_To_XSetWindowAttributes(s48_value attrAlist,
|
|
XSetWindowAttributes* Xattrs) {
|
|
unsigned long mask = 0;
|
|
s48_value l;
|
|
s48_value p;
|
|
char* cname;
|
|
s48_value name, value;
|
|
|
|
for (l = attrAlist; !S48_NULL_P(l); l = S48_CDR(l)) {
|
|
p = S48_CAR(l);
|
|
name = S48_CAR(p);
|
|
value = S48_CDR(p);
|
|
cname = s48_extract_symbol(name);
|
|
|
|
if (strcmp(cname, "background-pixmap") == 0) {
|
|
Xattrs->background_pixmap = extract_background(value);
|
|
mask |= CWBackPixmap;
|
|
} else if (strcmp(cname, "background-pixel") == 0) {
|
|
Xattrs->background_pixel = s48_extract_integer(value);
|
|
mask |= CWBackPixel;
|
|
} else if (strcmp(cname, "border-pixmap") == 0) {
|
|
Xattrs->border_pixmap = extract_border(value);
|
|
mask |= CWBorderPixmap;
|
|
} else if (strcmp(cname, "border-pixel") == 0) {
|
|
Xattrs->border_pixel = s48_extract_integer(value);
|
|
mask |= CWBorderPixel;
|
|
} else if (strcmp(cname, "bit-gravity") == 0) {
|
|
Xattrs->bit_gravity = Symbol_To_Bit(value, Bit_Grav_Syms);
|
|
mask |= CWBitGravity;
|
|
} else if (strcmp(cname, "gravity") == 0) {
|
|
Xattrs->win_gravity = Symbol_To_Bit(value, Grav_Syms);
|
|
mask |= CWWinGravity;
|
|
} else if (strcmp(cname, "backing-store") == 0) {
|
|
Xattrs->backing_store = Symbol_To_Bit(value, Backing_Store_Syms);
|
|
mask |= CWBackingStore;
|
|
} else if (strcmp(cname, "backing-planes") == 0) {
|
|
Xattrs->backing_planes = s48_extract_integer(value);
|
|
mask |= CWBackingPlanes;
|
|
} else if (strcmp(cname, "backing-pixel") == 0) {
|
|
Xattrs->backing_pixel = s48_extract_integer(value);
|
|
mask |= CWBackingPixel;
|
|
} else if (strcmp(cname, "save-under") == 0) {
|
|
Xattrs->save_under = !S48_FALSE_P(value);
|
|
mask |= CWSaveUnder;
|
|
} else if (strcmp(cname, "event-mask") == 0) {
|
|
Xattrs->event_mask = Symbols_To_Bits(value, Event_Mask_Syms);
|
|
mask |= CWEventMask;
|
|
} else if (strcmp(cname, "do-not-propagate-mask") == 0) {
|
|
Xattrs->do_not_propagate_mask = Symbols_To_Bits(value, Event_Mask_Syms);
|
|
mask |= CWDontPropagate;
|
|
} else if (strcmp(cname, "override-redirect") == 0) {
|
|
Xattrs->override_redirect = !S48_FALSE_P(value);
|
|
mask |= CWOverrideRedirect;
|
|
} else if (strcmp(cname, "colormap") == 0) {
|
|
Xattrs->colormap = s48_extract_integer(value);
|
|
mask |= CWColormap;
|
|
} else if (strcmp(cname, "cursor") == 0) {
|
|
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 (strcmp(v, "none") == 0)
|
|
return None;
|
|
else if (strcmp(v, "parent-relative") == 0)
|
|
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 (strcmp(v, "copy-from-parent") == 0)
|
|
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 );
|
|
|
|
Window win;
|
|
win = XCreateWindow( EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xparent),
|
|
(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) {
|
|
XDestroyWindow (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Change_Window_Attributes(s48_value Xwindow, s48_value Xdisplay,
|
|
s48_value attrAlist) {
|
|
|
|
XSetWindowAttributes Xattrs;
|
|
unsigned long mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs );
|
|
|
|
XChangeWindowAttributes(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
|
|
mask, &Xattrs);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
|
|
XWindowAttributes WA;
|
|
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
s48_value res = S48_NULL;
|
|
|
|
if (!XGetWindowAttributes(EXTRACT_DISPLAY(Xdisplay),EXTRACT_WINDOW(Xwindow),
|
|
&WA))
|
|
res = S48_FALSE;
|
|
else {
|
|
S48_GC_PROTECT_1(res);
|
|
|
|
res = s48_make_vector(23, S48_FALSE);
|
|
|
|
S48_VECTOR_SET(res, 0, s48_enter_integer(WA.x));
|
|
S48_VECTOR_SET(res, 1, s48_enter_integer(WA.y));
|
|
S48_VECTOR_SET(res, 2, s48_enter_integer(WA.width));
|
|
S48_VECTOR_SET(res, 3, s48_enter_integer(WA.height));
|
|
S48_VECTOR_SET(res, 4, s48_enter_integer(WA.border_width));
|
|
S48_VECTOR_SET(res, 5, s48_enter_integer(WA.depth));
|
|
S48_VECTOR_SET(res, 6, ENTER_VISUAL(WA.visual));
|
|
S48_VECTOR_SET(res, 7, ENTER_WINDOW(WA.root));
|
|
S48_VECTOR_SET(res, 8, Bit_To_Symbol(WA.class, Class_Syms));
|
|
S48_VECTOR_SET(res, 9, Bit_To_Symbol(WA.bit_gravity, Bit_Grav_Syms));
|
|
S48_VECTOR_SET(res, 10, Bit_To_Symbol(WA.win_gravity, Grav_Syms));
|
|
S48_VECTOR_SET(res, 11, Bit_To_Symbol(WA.backing_store,
|
|
Backing_Store_Syms));
|
|
S48_VECTOR_SET(res, 12, s48_enter_integer(WA.backing_planes));
|
|
S48_VECTOR_SET(res, 13, ENTER_PIXEL(WA.backing_pixel));
|
|
S48_VECTOR_SET(res, 14, WA.save_under ? S48_TRUE : S48_FALSE );
|
|
S48_VECTOR_SET(res, 15, ENTER_COLORMAP( WA.colormap ));
|
|
S48_VECTOR_SET(res, 16, WA.map_installed ? S48_TRUE : S48_FALSE);
|
|
S48_VECTOR_SET(res, 17, Bit_To_Symbol( WA.map_state, Map_State_Syms));
|
|
S48_VECTOR_SET(res, 18, Bits_To_Symbols( WA.all_event_masks,
|
|
Event_Mask_Syms ));
|
|
S48_VECTOR_SET(res, 19, Bits_To_Symbols( WA.your_event_mask,
|
|
Event_Mask_Syms ));
|
|
S48_VECTOR_SET(res, 20, Bits_To_Symbols( WA.do_not_propagate_mask,
|
|
Event_Mask_Syms ));
|
|
S48_VECTOR_SET(res, 21, WA.override_redirect ? S48_TRUE : S48_FALSE);
|
|
S48_VECTOR_SET(res, 22, s48_enter_integer((long)WA.screen)); //??
|
|
// WA.screen - ignored/not supported in Elk
|
|
}
|
|
|
|
S48_GC_UNPROTECT();
|
|
return res;
|
|
}
|
|
|
|
s48_value Configure_Window (s48_value Xwindow, s48_value Xdisplay,
|
|
s48_value alist) {
|
|
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 (strcmp(cname, "x") == 0) {
|
|
WC.x = cvalue;
|
|
mask |= CWX;
|
|
} else if (strcmp(cname, "y") == 0) {
|
|
WC.y = cvalue;
|
|
mask |= CWY;
|
|
} else if (strcmp(cname, "width") == 0) {
|
|
WC.width = cvalue;
|
|
mask |= CWWidth;
|
|
} else if (strcmp(cname, "height") == 0) {
|
|
WC.height = cvalue;
|
|
mask |= CWHeight;
|
|
} else if (strcmp(cname, "border-width") == 0) {
|
|
WC.border_width = cvalue;
|
|
mask |= CWBorderWidth;
|
|
} else if (strcmp(cname, "sibling") == 0) {
|
|
WC.sibling = (Window)s48_extract_integer(value);
|
|
mask |= CWSibling;
|
|
} else if (strcmp(cname, "stack-mode") == 0) {
|
|
WC.stack_mode = cvalue;
|
|
mask |= CWStackMode;
|
|
}
|
|
} // for
|
|
|
|
XConfigureWindow (EXTRACT_DISPLAY(Xdisplay),EXTRACT_WINDOW(Xwindow),
|
|
mask, &WC);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Map_Window(s48_value Xwindow, s48_value Xdisplay) {
|
|
XMapWindow(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Unmap_Window(s48_value Xwindow, s48_value Xdisplay) {
|
|
XUnmapWindow(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Destroy_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
|
|
XDestroySubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Map_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
|
|
XMapSubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Unmap_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
|
|
XUnmapSubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Circulate_Subwindows(s48_value Xwindow, s48_value Xdisplay,
|
|
s48_value dir) {
|
|
XCirculateSubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
|
|
S48_FALSE_P(dir) ? RaiseLowest : LowerHighest);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
/*
|
|
|
|
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);
|
|
}
|
|
|
|
*/
|
|
|
|
s48_value Query_Tree (s48_value Xwindow, s48_value Xdisplay) {
|
|
Window root, parent, *children;
|
|
int i;
|
|
unsigned n;
|
|
|
|
s48_value v, ret;
|
|
S48_DECLARE_GC_PROTECT(2);
|
|
|
|
XQueryTree (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
|
|
&root, &parent, &children, &n);
|
|
|
|
S48_GC_PROTECT_2 (v, ret);
|
|
|
|
ret = S48_NULL;
|
|
|
|
// vector of child-windows
|
|
v = s48_make_vector (n, S48_FALSE);
|
|
for (i = 0; i < n; i++) {
|
|
S48_VECTOR_SET(v, i, ENTER_WINDOW(children[i]));
|
|
}
|
|
ret = s48_cons(v, ret);
|
|
|
|
ret = s48_cons(ENTER_WINDOW(parent), ret);
|
|
ret = s48_cons(ENTER_WINDOW(root), ret);
|
|
|
|
S48_GC_UNPROTECT();
|
|
return ret;
|
|
}
|
|
|
|
s48_value Translate_Coordinates (s48_value Xdisplay, s48_value srcXwindow,
|
|
s48_value x, s48_value y,
|
|
s48_value dstXwindow) {
|
|
int rx, ry;
|
|
Window child;
|
|
s48_value l;
|
|
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
if (!XTranslateCoordinates (EXTRACT_DISPLAY(Xdisplay),
|
|
EXTRACT_WINDOW(srcXwindow),
|
|
EXTRACT_WINDOW(dstXwindow),
|
|
(int)s48_extract_integer (x),
|
|
(int)s48_extract_integer (y),
|
|
&rx, &ry, &child))
|
|
return S48_FALSE;
|
|
|
|
S48_GC_PROTECT_1 (l);
|
|
|
|
l = S48_NULL;
|
|
l = s48_cons( ENTER_WINDOW(child), l );
|
|
l = s48_cons( s48_enter_integer(ry), l );
|
|
l = s48_cons( s48_enter_integer(rx), l );
|
|
|
|
S48_GC_UNPROTECT();
|
|
return l;
|
|
}
|
|
|
|
s48_value Query_Pointer (s48_value Xdisplay, s48_value Xwindow) {
|
|
|
|
s48_value l;
|
|
Bool ret;
|
|
Window root, child;
|
|
int r_x, r_y, x, y;
|
|
unsigned int mask;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
ret = XQueryPointer (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
|
|
&root, &child, &r_x, &r_y, &x, &y, &mask);
|
|
|
|
S48_GC_PROTECT_1(l);
|
|
|
|
l = S48_NULL;
|
|
l = s48_cons(Bits_To_Symbols ((unsigned long)mask, State_Syms), l);
|
|
l = s48_cons(ENTER_WINDOW(child), l);
|
|
l = s48_cons(s48_enter_integer(r_y), l);
|
|
l = s48_cons(s48_enter_integer(r_x), l);
|
|
l = s48_cons(ENTER_WINDOW(root), l);
|
|
l = ret ? S48_TRUE : S48_FALSE;
|
|
l = s48_cons(s48_enter_integer(y), l);
|
|
l = s48_cons(s48_enter_integer(x), l);
|
|
|
|
S48_GC_UNPROTECT();
|
|
return l;
|
|
}
|
|
|
|
void s48_init_window(void) {
|
|
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);
|
|
S48_EXPORT_FUNCTION(Query_Tree);
|
|
S48_EXPORT_FUNCTION(Translate_Coordinates);
|
|
S48_EXPORT_FUNCTION(Query_Pointer);
|
|
|
|
}
|