migrated to scheme48.

This commit is contained in:
frese 2001-07-31 13:15:32 +00:00
parent 68ded3c442
commit 6fffd9346a
1 changed files with 115 additions and 139 deletions

View File

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