1 /* wm.c
2  *
3  * $Id$
4  *
5  * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
6  * Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, Paris
7  *
8  * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
9  * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
10  * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
11  * between TELES and Nixdorf Microprocessor Engineering, Berlin).
12  *
13  * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
14  * owners or individual owners of copyright in this software, grant to any
15  * person or company a worldwide, royalty free, license to
16  *
17  *    i) copy this software,
18  *   ii) prepare derivative works based on this software,
19  *  iii) distribute copies of this software or derivative works,
20  *   iv) perform this software, or
21  *    v) display this software,
22  *
23  * provided that this notice is not removed and that neither Oliver Laumann
24  * nor Teles nor Nixdorf are deemed to have made any representations as to
25  * the suitability of this software for any purpose nor are held responsible
26  * for any defects of this software.
27  *
28  * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
29  */
30 
31 #include "xlib.h"
32 
33 static Object Sym_Pointer_Root;
34 
P_Reparent_Window(Object w,Object parent,Object x,Object y)35 static Object P_Reparent_Window (Object w, Object parent, Object x,
36                                  Object y) {
37     Check_Type (w, T_Window);
38     Check_Type (parent, T_Window);
39     XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win,
40         Get_Integer (x), Get_Integer (y));
41     return Void;
42 }
43 
P_Install_Colormap(Object c)44 static Object P_Install_Colormap (Object c) {
45     Check_Type (c, T_Colormap);
46     XInstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
47     return Void;
48 }
49 
P_Uninstall_Colormap(Object c)50 static Object P_Uninstall_Colormap (Object c) {
51     Check_Type (c, T_Colormap);
52     XUninstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
53     return Void;
54 }
55 
P_List_Installed_Colormaps(Object w)56 static Object P_List_Installed_Colormaps (Object w) {
57     int i, n;
58     Colormap *ret;
59     Object v;
60     GC_Node;
61 
62     Check_Type (w, T_Window);
63     ret = XListInstalledColormaps (WINDOW(w)->dpy, WINDOW(w)->win, &n);
64     v = Make_Vector (n, Null);
65     GC_Link (v);
66     for (i = 0; i < n; i++) {
67         Object c;
68 
69         c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]);
70         VECTOR(v)->data[i] = c;
71     }
72     XFree ((char *)ret);
73     GC_Unlink;
74     return v;
75 }
76 
P_Set_Input_Focus(Object d,Object win,Object revert_to,Object time)77 static Object P_Set_Input_Focus (Object d, Object win, Object revert_to,
78                                  Object time) {
79     Window focus = PointerRoot;
80 
81     Check_Type (d, T_Display);
82     if (!EQ(win, Sym_Pointer_Root))
83         focus = Get_Window (win);
84     XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0,
85         Revert_Syms), Get_Time (time));
86     return Void;
87 }
88 
P_Input_Focus(Object d)89 static Object P_Input_Focus (Object d) {
90     Window win;
91     int revert_to;
92     Object ret, x;
93     GC_Node;
94 
95     Check_Type (d, T_Display);
96     XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to);
97     ret = Cons (Null, Null);
98     GC_Link (ret);
99     x = Make_Window (0, DISPLAY(d)->dpy, win);
100     Car (ret) = x;
101     x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms);
102     Cdr (ret) = x;
103     GC_Unlink;
104     return ret;
105 }
106 
P_General_Warp_Pointer(Object dpy,Object dst,Object dstx,Object dsty,Object src,Object srcx,Object srcy,Object srcw,Object srch)107 static Object P_General_Warp_Pointer (Object dpy, Object dst, Object dstx,
108                                       Object dsty, Object src, Object srcx,
109                                       Object srcy, Object srcw, Object srch) {
110     Check_Type (dpy, T_Display);
111     XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst),
112         Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw),
113         Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty));
114     return Void;
115 }
116 
P_Bell(int argc,Object * argv)117 static Object P_Bell (int argc, Object *argv) {
118     register int percent = 0;
119 
120     Check_Type (argv[0], T_Display);
121     if (argc == 2) {
122         percent = Get_Integer (argv[1]);
123         if (percent < -100 || percent > 100)
124             Range_Error (argv[1]);
125     }
126     XBell (DISPLAY(argv[0])->dpy, percent);
127     return Void;
128 }
129 
P_Set_Access_Control(Object dpy,Object on)130 static Object P_Set_Access_Control (Object dpy, Object on) {
131     Check_Type (dpy, T_Display);
132     Check_Type (on, T_Boolean);
133     XSetAccessControl (DISPLAY(dpy)->dpy, EQ(on, True));
134     return Void;
135 }
136 
P_Change_Save_Set(Object win,Object mode)137 static Object P_Change_Save_Set (Object win, Object mode) {
138     Check_Type (win, T_Window);
139     XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win,
140         Symbols_To_Bits (mode, 0, Saveset_Syms));
141     return Void;
142 }
143 
P_Set_Close_Down_Mode(Object dpy,Object mode)144 static Object P_Set_Close_Down_Mode (Object dpy, Object mode) {
145     Check_Type (dpy, T_Display);
146     XSetCloseDownMode (DISPLAY(dpy)->dpy,
147         Symbols_To_Bits (mode, 0, Closemode_Syms));
148     return Void;
149 }
150 
P_Get_Pointer_Mapping(Object dpy)151 static Object P_Get_Pointer_Mapping (Object dpy) {
152     unsigned char map[256];
153     register int i, n;
154     Object ret;
155 
156     Check_Type (dpy, T_Display);
157     n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256);
158     ret = Make_Vector (n, Null);
159     for (i = 0; i < n; i++)
160         VECTOR(ret)->data[i] = Make_Integer (map[i]);
161     return ret;
162 }
163 
P_Set_Pointer_Mapping(Object dpy,Object map)164 static Object P_Set_Pointer_Mapping (Object dpy, Object map) {
165     register int i, n;
166     register unsigned char *p;
167     Object ret;
168     Alloca_Begin;
169 
170     Check_Type (dpy, T_Display);
171     Check_Type (map, T_Vector);
172     n = VECTOR(map)->size;
173     Alloca (p, unsigned char*, n);
174     for (i = 0; i < n; i++)
175         p[i] = Get_Integer (VECTOR(map)->data[i]);
176     ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ?
177         True : False;
178     Alloca_End;
179     return ret;
180 }
181 
elk_init_xlib_wm()182 void elk_init_xlib_wm () {
183     Define_Primitive (P_Reparent_Window,  "reparent-window",  4, 4, EVAL);
184     Define_Primitive (P_Install_Colormap, "install-colormap", 1, 1, EVAL);
185     Define_Primitive (P_Uninstall_Colormap,
186                         "uninstall-colormap",                 1, 1, EVAL);
187     Define_Primitive (P_List_Installed_Colormaps,
188                         "list-installed-colormaps",           1, 1, EVAL);
189     Define_Primitive (P_Set_Input_Focus,  "set-input-focus",  4, 4, EVAL);
190     Define_Primitive (P_Input_Focus,      "input-focus",      1, 1, EVAL);
191     Define_Primitive (P_General_Warp_Pointer,
192                         "general-warp-pointer",               9, 9, EVAL);
193     Define_Primitive (P_Bell,             "bell",             1, 2, VARARGS);
194     Define_Primitive (P_Set_Access_Control,
195                         "set-access-control",                 2, 2, EVAL);
196     Define_Primitive (P_Change_Save_Set,  "change-save-set",  2, 2, EVAL);
197     Define_Primitive (P_Set_Close_Down_Mode,
198                         "set-close-down-mode",                2, 2, EVAL);
199     Define_Primitive (P_Get_Pointer_Mapping,
200                         "get-pointer-mapping",                1, 1, EVAL);
201     Define_Primitive (P_Set_Pointer_Mapping,
202                         "set-pointer-mapping",                2, 2, EVAL);
203     Define_Symbol(&Sym_Pointer_Root, "pointer-root");
204 }
205