/* wm.c * * $Id$ * * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin * Copyright 2002, 2003 Sam Hocevar , Paris * * This software was derived from Elk 1.2, which was Copyright 1987, 1988, * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project * between TELES and Nixdorf Microprocessor Engineering, Berlin). * * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co- * owners or individual owners of copyright in this software, grant to any * person or company a worldwide, royalty free, license to * * i) copy this software, * ii) prepare derivative works based on this software, * iii) distribute copies of this software or derivative works, * iv) perform this software, or * v) display this software, * * provided that this notice is not removed and that neither Oliver Laumann * nor Teles nor Nixdorf are deemed to have made any representations as to * the suitability of this software for any purpose nor are held responsible * for any defects of this software. * * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE. */ #include "xlib.h" static Object Sym_Pointer_Root; static Object P_Reparent_Window (Object w, Object parent, Object x, Object y) { Check_Type (w, T_Window); Check_Type (parent, T_Window); XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win, Get_Integer (x), Get_Integer (y)); return Void; } static Object P_Install_Colormap (Object c) { Check_Type (c, T_Colormap); XInstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); return Void; } static Object P_Uninstall_Colormap (Object c) { Check_Type (c, T_Colormap); XUninstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); return Void; } static Object P_List_Installed_Colormaps (Object w) { int i, n; Colormap *ret; Object v; GC_Node; Check_Type (w, T_Window); ret = XListInstalledColormaps (WINDOW(w)->dpy, WINDOW(w)->win, &n); v = Make_Vector (n, Null); GC_Link (v); for (i = 0; i < n; i++) { Object c; c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]); VECTOR(v)->data[i] = c; } XFree ((char *)ret); GC_Unlink; return v; } static Object P_Set_Input_Focus (Object d, Object win, Object revert_to, Object time) { Window focus = PointerRoot; Check_Type (d, T_Display); if (!EQ(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; } static Object P_Input_Focus (Object d) { Window win; int revert_to; Object ret, x; GC_Node; Check_Type (d, T_Display); XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to); ret = Cons (Null, Null); GC_Link (ret); x = Make_Window (0, DISPLAY(d)->dpy, win); Car (ret) = x; x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms); Cdr (ret) = x; GC_Unlink; return ret; } static Object P_General_Warp_Pointer (Object dpy, Object dst, Object dstx, Object dsty, Object src, Object srcx, Object srcy, Object srcw, Object srch) { Check_Type (dpy, T_Display); XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst), Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw), Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty)); return Void; } static Object P_Bell (int argc, Object *argv) { register int percent = 0; Check_Type (argv[0], T_Display); if (argc == 2) { percent = Get_Integer (argv[1]); if (percent < -100 || percent > 100) Range_Error (argv[1]); } XBell (DISPLAY(argv[0])->dpy, percent); return Void; } static Object P_Set_Access_Control (Object dpy, Object on) { Check_Type (dpy, T_Display); Check_Type (on, T_Boolean); XSetAccessControl (DISPLAY(dpy)->dpy, EQ(on, True)); return Void; } static Object P_Change_Save_Set (Object win, Object mode) { Check_Type (win, T_Window); XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win, Symbols_To_Bits (mode, 0, Saveset_Syms)); return Void; } static Object P_Set_Close_Down_Mode (Object dpy, Object mode) { Check_Type (dpy, T_Display); XSetCloseDownMode (DISPLAY(dpy)->dpy, Symbols_To_Bits (mode, 0, Closemode_Syms)); return Void; } static Object P_Get_Pointer_Mapping (Object dpy) { unsigned char map[256]; register int i, n; Object ret; Check_Type (dpy, T_Display); n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256); ret = Make_Vector (n, Null); for (i = 0; i < n; i++) VECTOR(ret)->data[i] = Make_Integer (map[i]); return ret; } static Object P_Set_Pointer_Mapping (Object dpy, Object map) { register int i, n; register unsigned char *p; Object ret; Alloca_Begin; Check_Type (dpy, T_Display); Check_Type (map, T_Vector); n = VECTOR(map)->size; Alloca (p, unsigned char*, n); for (i = 0; i < n; i++) p[i] = Get_Integer (VECTOR(map)->data[i]); ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ? True : False; Alloca_End; return ret; } void 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"); }