scx/c/xlib/window.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);

}