#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); }