migrated to scheme48.
This commit is contained in:
		
							parent
							
								
									68ded3c442
								
							
						
					
					
						commit
						6fffd9346a
					
				
							
								
								
									
										254
									
								
								c/xlib/wm.c
								
								
								
								
							
							
						
						
									
										254
									
								
								c/xlib/wm.c
								
								
								
								
							| 
						 | 
				
			
			@ -1,172 +1,148 @@
 | 
			
		|||
#include "xlib.h"
 | 
			
		||||
#include "scheme48.h"
 | 
			
		||||
 | 
			
		||||
static s48_value Sym_Pointer_Root;
 | 
			
		||||
 | 
			
		||||
static s48_value P_Reparent_Window (w, parent, x, y) s48_value w, parent, x, y; {
 | 
			
		||||
    Check_Type (w, T_Window);
 | 
			
		||||
    Check_Type (parent, T_Window);
 | 
			
		||||
    XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win,
 | 
			
		||||
	(int)s48_extract_integer (x), (int)s48_extract_integer (y));
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Reparent_Window(s48_value Xdisplay, s48_value Xwindow, 
 | 
			
		||||
			  s48_value Xwindow_parent, s48_value x,
 | 
			
		||||
			  s48_value y) {
 | 
			
		||||
  XReparentWindow(EXTRACT_DISPLAY(Xdisplay),
 | 
			
		||||
		  EXTRACT_WINDOW(Xwindow),
 | 
			
		||||
		  EXTRACT_WINDOW(Xwindow_parent),
 | 
			
		||||
		  (int)s48_extract_integer (x), (int)s48_extract_integer (y));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Install_Colormap (c) s48_value c; {
 | 
			
		||||
    Check_Type (c, T_Colormap);
 | 
			
		||||
    XInstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Install_Colormap(s48_value Xdisplay, s48_value Xcolormap) {
 | 
			
		||||
  XInstallColormap(EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Uninstall_Colormap (c) s48_value c; {
 | 
			
		||||
    Check_Type (c, T_Colormap);
 | 
			
		||||
    XUninstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Uninstall_Colormap(s48_value Xdisplay, s48_value Xcolormap) {
 | 
			
		||||
  XUninstallColormap(EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_List_Installed_Colormaps (w) s48_value w; {
 | 
			
		||||
    int i, n;
 | 
			
		||||
    Colormap *ret;
 | 
			
		||||
    s48_value v;
 | 
			
		||||
    S48_DECLARE_GC_PROTECT(1);
 | 
			
		||||
s48_value List_Installed_Colormaps(s48_value Xdisplay, s48_value Xwindow) {
 | 
			
		||||
  int i, n;
 | 
			
		||||
  Colormap *ret;
 | 
			
		||||
  s48_value v;
 | 
			
		||||
  S48_DECLARE_GC_PROTECT(1);
 | 
			
		||||
 | 
			
		||||
    Check_Type (w, T_Window);
 | 
			
		||||
    ret = XListInstalledColormaps (WINDOW(w)->dpy, WINDOW(w)->win, &n);
 | 
			
		||||
    v = s48_make_vector (n, S48_NULL);
 | 
			
		||||
    S48_GC_PROTECT_1 (v);
 | 
			
		||||
    for (i = 0; i < n; i++) {
 | 
			
		||||
	s48_value c;
 | 
			
		||||
	
 | 
			
		||||
	c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]);
 | 
			
		||||
	S48_VECTOR_SET(v, i, c;)
 | 
			
		||||
    }
 | 
			
		||||
    XFree ((char *)ret);
 | 
			
		||||
    S48_GC_UNPROTECT;
 | 
			
		||||
    return v;
 | 
			
		||||
  ret = XListInstalledColormaps(EXTRACT_DISPLAY(Xdisplay),
 | 
			
		||||
				EXTRACT_WINDOW(Xwindow),
 | 
			
		||||
				&n);
 | 
			
		||||
  v = s48_make_vector (n, S48_FALSE);
 | 
			
		||||
  S48_GC_PROTECT_1 (v);
 | 
			
		||||
  for (i = 0; i < n; i++) {
 | 
			
		||||
    S48_VECTOR_SET(v, i, ENTER_COLORMAP(ret[i]));
 | 
			
		||||
  }
 | 
			
		||||
  XFree ((char *)ret);
 | 
			
		||||
  S48_GC_UNPROTECT();
 | 
			
		||||
  return v;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Set_Input_Focus (d, win, revert_to, time) s48_value d, win,
 | 
			
		||||
    revert_to, time; {
 | 
			
		||||
    Window focus = PointerRoot;
 | 
			
		||||
 | 
			
		||||
    Check_Type (d, T_Display);
 | 
			
		||||
    if (!S48_EQ_P(win, Sym_Pointer_Root))
 | 
			
		||||
	focus = Get_Window (win);
 | 
			
		||||
    XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0,
 | 
			
		||||
	Revert_Syms), Get_Time (time));
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Set_Input_Focus(s48_value Xdisplay, s48_value Xwindow, 
 | 
			
		||||
			  s48_value revert_to, s48_value time) {
 | 
			
		||||
  Window focus = PointerRoot;
 | 
			
		||||
  
 | 
			
		||||
  if (!S48_SYMBOL_P(Xwindow))
 | 
			
		||||
    focus = EXTRACT_WINDOW(Xwindow);
 | 
			
		||||
  
 | 
			
		||||
  XSetInputFocus (EXTRACT_DISPLAY(Xdisplay), focus, 
 | 
			
		||||
		  Symbol_To_Bit (revert_to, Revert_Syms), 
 | 
			
		||||
		  EXTRACT_TIME(time));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Input_Focus (d) s48_value d; {
 | 
			
		||||
    Window win;
 | 
			
		||||
    int revert_to;
 | 
			
		||||
    s48_value ret, x;
 | 
			
		||||
    S48_DECLARE_GC_PROTECT(1);
 | 
			
		||||
s48_value Input_Focus (s48_value Xdisplay) {
 | 
			
		||||
  Window win;
 | 
			
		||||
  int revert_to;
 | 
			
		||||
  s48_value ret, x;
 | 
			
		||||
  S48_DECLARE_GC_PROTECT(1);
 | 
			
		||||
 | 
			
		||||
    Check_Type (d, T_Display);
 | 
			
		||||
    XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to);
 | 
			
		||||
    ret = s48_cons (S48_NULL, S48_NULL);
 | 
			
		||||
    S48_GC_PROTECT_1 (ret);
 | 
			
		||||
    x = Make_Window (0, DISPLAY(d)->dpy, win);
 | 
			
		||||
    S48_CAR (ret) = x;
 | 
			
		||||
    x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms);
 | 
			
		||||
    S48_CDR (ret) = x;
 | 
			
		||||
    S48_GC_UNPROTECT;
 | 
			
		||||
    return ret;
 | 
			
		||||
  XGetInputFocus (EXTRACT_DISPLAY(Xdisplay), &win, &revert_to);
 | 
			
		||||
  ret = s48_cons (S48_NULL, S48_NULL);
 | 
			
		||||
  S48_GC_PROTECT_1 (ret);
 | 
			
		||||
  x = ENTER_WINDOW(win);  S48_SET_CAR(ret, x);
 | 
			
		||||
  x = Bit_To_Symbol((unsigned long)revert_to, Revert_Syms);
 | 
			
		||||
  S48_SET_CDR(ret, x);
 | 
			
		||||
 | 
			
		||||
  S48_GC_UNPROTECT();
 | 
			
		||||
  return ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy,
 | 
			
		||||
	srcw, srch) s48_value dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; {
 | 
			
		||||
    Check_Type (dpy, T_Display);
 | 
			
		||||
    XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst),
 | 
			
		||||
	(int)s48_extract_integer (srcx), (int)s48_extract_integer (srcy), (int)s48_extract_integer (srcw),
 | 
			
		||||
	(int)s48_extract_integer (srch), (int)s48_extract_integer (dstx), (int)s48_extract_integer (dsty));
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value General_Warp_Pointer(s48_value dpy, s48_value dst, s48_value dstx, 
 | 
			
		||||
			       s48_value dsty, s48_value src, s48_value srcx, 
 | 
			
		||||
			       s48_value srcy, s48_value srcw, s48_value srch) {
 | 
			
		||||
  XWarpPointer (EXTRACT_DISPLAY(dpy), 
 | 
			
		||||
		EXTRACT_WINDOW(src), EXTRACT_WINDOW(dst),
 | 
			
		||||
		(int)s48_extract_integer (srcx), 
 | 
			
		||||
		(int)s48_extract_integer (srcy), 
 | 
			
		||||
		(int)s48_extract_integer (srcw),
 | 
			
		||||
		(int)s48_extract_integer (srch), 
 | 
			
		||||
		(int)s48_extract_integer (dstx), 
 | 
			
		||||
		(int)s48_extract_integer (dsty));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Bell (argc, argv) s48_value *argv; {
 | 
			
		||||
    register percent = 0;
 | 
			
		||||
 | 
			
		||||
    Check_Type (argv[0], T_Display);
 | 
			
		||||
    if (argc == 2) {
 | 
			
		||||
	percent = (int)s48_extract_integer (argv[1]);
 | 
			
		||||
	if (percent < -100 || percent > 100)
 | 
			
		||||
	    Range_Error (argv[1]);
 | 
			
		||||
    }
 | 
			
		||||
    XBell (DISPLAY(argv[0])->dpy, percent);
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Bell(s48_value Xdisplay, s48_value percent) {
 | 
			
		||||
  int p = (int)s48_extract_integer(percent);
 | 
			
		||||
  XBell (EXTRACT_DISPLAY(Xdisplay), p);
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Set_Access_Control (dpy, on) s48_value dpy, on; {
 | 
			
		||||
    Check_Type (dpy, T_Display);
 | 
			
		||||
    Check_Type (on, T_Boolean);
 | 
			
		||||
    XSetAccessControl (DISPLAY(dpy)->dpy, S48_EQ_P(on, S48_TRUE));
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Set_Access_Control(s48_value Xdisplay, s48_value on) {
 | 
			
		||||
  XSetAccessControl (EXTRACT_DISPLAY(Xdisplay), !S48_FALSE_P(on));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Change_Save_Set (win, mode) s48_value win, mode; {
 | 
			
		||||
    Check_Type (win, T_Window);
 | 
			
		||||
    XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win,
 | 
			
		||||
	Symbols_To_Bits (mode, 0, Saveset_Syms));
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Change_Save_Set(s48_value Xdisplay, s48_value win, s48_value mode) {
 | 
			
		||||
  XChangeSaveSet(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(win),
 | 
			
		||||
		 Symbol_To_Bit(mode, Saveset_Syms));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Set_Close_Down_Mode (dpy, mode) s48_value dpy, mode; {
 | 
			
		||||
    Check_Type (dpy, T_Display);
 | 
			
		||||
    XSetCloseDownMode (DISPLAY(dpy)->dpy,
 | 
			
		||||
	Symbols_To_Bits (mode, 0, Closemode_Syms));
 | 
			
		||||
    return Void;
 | 
			
		||||
s48_value Set_Close_Down_Mode(s48_value Xdisplay, s48_value mode) {
 | 
			
		||||
  XSetCloseDownMode(EXTRACT_DISPLAY(Xdisplay),
 | 
			
		||||
		    Symbol_To_Bit (mode, Closemode_Syms));
 | 
			
		||||
  return S48_UNSPECIFIC;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Get_Pointer_Mapping (dpy) s48_value dpy; {
 | 
			
		||||
    unsigned char map[256];
 | 
			
		||||
    register i, n;
 | 
			
		||||
    s48_value ret;
 | 
			
		||||
static s48_value Get_Pointer_Mapping(s48_value Xdisplay) {
 | 
			
		||||
  unsigned char map[256];
 | 
			
		||||
  int i, n;
 | 
			
		||||
  s48_value ret;
 | 
			
		||||
 | 
			
		||||
    Check_Type (dpy, T_Display);
 | 
			
		||||
    n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256);
 | 
			
		||||
    ret = s48_make_vector (n, S48_NULL);
 | 
			
		||||
    for (i = 0; i < n; i++)
 | 
			
		||||
	S48_VECTOR_SET(ret, i, s48_enter_integer (map[i]);)
 | 
			
		||||
    return ret;
 | 
			
		||||
  n = XGetPointerMapping (EXTRACT_DISPLAY(Xdisplay), map, 256);
 | 
			
		||||
  ret = s48_make_vector (n, S48_NULL);
 | 
			
		||||
  for (i = 0; i < n; i++)
 | 
			
		||||
    S48_VECTOR_SET(ret, i, s48_enter_integer (map[i]));
 | 
			
		||||
  return ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
static s48_value P_Set_Pointer_Mapping (dpy, map) s48_value dpy, map; {
 | 
			
		||||
    register i, n;
 | 
			
		||||
    register unsigned char *p;
 | 
			
		||||
    s48_value ret;
 | 
			
		||||
    Alloca_Begin;
 | 
			
		||||
s48_value Set_Pointer_Mapping (s48_value Xdisplay, s48_value map) {
 | 
			
		||||
  int i, n = S48_VECTOR_LENGTH(map);
 | 
			
		||||
  unsigned char p[n];
 | 
			
		||||
  int ret;
 | 
			
		||||
 | 
			
		||||
    Check_Type (dpy, T_Display);
 | 
			
		||||
    Check_Type (map, T_Vector);
 | 
			
		||||
    n = S48_VECTOR_LENGTH(map);
 | 
			
		||||
    Alloca (p, unsigned char*, n);
 | 
			
		||||
    for (i = 0; i < n; i++)
 | 
			
		||||
	p[i] = (int)s48_extract_integer (VECTOR(map)->data[i]);
 | 
			
		||||
    ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ?
 | 
			
		||||
	S48_TRUE : S48_FALSE;
 | 
			
		||||
    Alloca_End;
 | 
			
		||||
    return ret;
 | 
			
		||||
  for (i = 0; i < n; i++)
 | 
			
		||||
    p[i] = (int)s48_extract_integer(S48_VECTOR_REF(map, i));
 | 
			
		||||
 | 
			
		||||
  ret = XSetPointerMapping (EXTRACT_DISPLAY(Xdisplay), p, n);
 | 
			
		||||
  return (ret == MappingSuccess) ? S48_TRUE : S48_FALSE;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
elk_init_xlib_wm () {
 | 
			
		||||
    Define_Primitive (P_Reparent_Window,  "reparent-window",  4, 4, EVAL);
 | 
			
		||||
    Define_Primitive (P_Install_Colormap, "install-colormap", 1, 1, EVAL);
 | 
			
		||||
    Define_Primitive (P_Uninstall_Colormap,
 | 
			
		||||
			"uninstall-colormap",                 1, 1, EVAL);
 | 
			
		||||
    Define_Primitive (P_List_Installed_Colormaps,
 | 
			
		||||
			"list-installed-colormaps",           1, 1, EVAL);
 | 
			
		||||
    Define_Primitive (P_Set_Input_Focus,  "set-input-focus",  4, 4, EVAL);
 | 
			
		||||
    Define_Primitive (P_Input_Focus,      "input-focus",      1, 1, EVAL);
 | 
			
		||||
    Define_Primitive (P_General_Warp_Pointer,
 | 
			
		||||
			"general-warp-pointer",               9, 9, EVAL);
 | 
			
		||||
    Define_Primitive (P_Bell,             "bell",             1, 2, VARARGS);
 | 
			
		||||
    Define_Primitive (P_Set_Access_Control,
 | 
			
		||||
			"set-access-control",                 2, 2, EVAL);
 | 
			
		||||
    Define_Primitive (P_Change_Save_Set,  "change-save-set",  2, 2, EVAL);
 | 
			
		||||
    Define_Primitive (P_Set_Close_Down_Mode,
 | 
			
		||||
			"set-close-down-mode",                2, 2, EVAL);
 | 
			
		||||
    Define_Primitive (P_Get_Pointer_Mapping,
 | 
			
		||||
			"get-pointer-mapping",                1, 1, EVAL);
 | 
			
		||||
    Define_Primitive (P_Set_Pointer_Mapping,
 | 
			
		||||
			"set-pointer-mapping",                2, 2, EVAL);
 | 
			
		||||
    Define_Symbol(&Sym_Pointer_Root, "pointer-root");
 | 
			
		||||
void s48_init_wm(void) { 
 | 
			
		||||
  S48_EXPORT_FUNCTION(Reparent_Window);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Install_Colormap);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Uninstall_Colormap);
 | 
			
		||||
  S48_EXPORT_FUNCTION(List_Installed_Colormaps);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Set_Input_Focus);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Input_Focus);
 | 
			
		||||
  S48_EXPORT_FUNCTION(General_Warp_Pointer);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Bell);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Set_Access_Control);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Change_Save_Set);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Set_Close_Down_Mode);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Get_Pointer_Mapping);
 | 
			
		||||
  S48_EXPORT_FUNCTION(Set_Pointer_Mapping);
 | 
			
		||||
}
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue