1 /* window.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_Set_Attr, Sym_Get_Attr, Sym_Geo;
34 Object Sym_Conf;
35
36 Generic_Predicate (Window)
37
Generic_Equal_Dpy(Window,WINDOW,win)38 Generic_Equal_Dpy (Window, WINDOW, win)
39
40 Generic_Print (Window, "#[window %lu]", WINDOW(x)->win)
41
42 Generic_Get_Display (Window, WINDOW)
43
44 Object Make_Window (int finalize, Display *dpy, Window win) {
45 Object w;
46
47 if (win == None)
48 return Sym_None;
49 if (win == PointerRoot)
50 return Intern ("pointer-root");
51 w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win);
52 if (Nullp (w)) {
53 w = Alloc_Object (sizeof (struct S_Window), T_Window, 0);
54 WINDOW(w)->tag = Null;
55 WINDOW(w)->win = win;
56 WINDOW(w)->dpy = dpy;
57 WINDOW(w)->free = 0;
58 WINDOW(w)->finalize = finalize;
59 Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window :
60 (PFO)0, 0);
61 }
62 return w;
63 }
64
Get_Window(Object w)65 Window Get_Window (Object w) {
66 if (EQ(w, Sym_None))
67 return None;
68 Check_Type (w, T_Window);
69 return WINDOW(w)->win;
70 }
71
Get_Drawable(Object d,Display ** dpyp)72 Drawable Get_Drawable (Object d, Display **dpyp) {
73 if (TYPE(d) == T_Window) {
74 *dpyp = WINDOW(d)->dpy;
75 return (Drawable)WINDOW(d)->win;
76 } else if (TYPE(d) == T_Pixmap) {
77 *dpyp = PIXMAP(d)->dpy;
78 return (Drawable)PIXMAP(d)->pm;
79 }
80 Wrong_Type_Combination (d, "drawable");
81 /*NOTREACHED*/
82 }
83
P_Create_Window(Object parent,Object x,Object y,Object width,Object height,Object border_width,Object attr)84 static Object P_Create_Window (Object parent, Object x, Object y, Object width,
85 Object height, Object border_width,
86 Object attr) {
87 unsigned long mask;
88 Window win;
89
90 Check_Type (parent, T_Window);
91 mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
92 if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win,
93 Get_Integer (x), Get_Integer (y), Get_Integer (width),
94 Get_Integer (height), Get_Integer (border_width),
95 CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0)
96 Primitive_Error ("cannot create window");
97 return Make_Window (1, WINDOW(parent)->dpy, win);
98 }
99
P_Configure_Window(Object w,Object conf)100 static Object P_Configure_Window (Object w, Object conf) {
101 unsigned long mask;
102
103 Check_Type (w, T_Window);
104 mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec);
105 XConfigureWindow (WINDOW(w)->dpy, WINDOW(w)->win, mask, &WC);
106 return Void;
107 }
108
P_Change_Window_Attributes(Object w,Object attr)109 static Object P_Change_Window_Attributes (Object w, Object attr) {
110 unsigned long mask;
111
112 Check_Type (w, T_Window);
113 mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
114 XChangeWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, mask, &SWA);
115 return Void;
116 }
117
P_Get_Window_Attributes(Object w)118 static Object P_Get_Window_Attributes (Object w) {
119 Check_Type (w, T_Window);
120 XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA);
121 return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr,
122 WINDOW(w)->dpy, ~0L);
123 }
124
P_Get_Geometry(Object d)125 static Object P_Get_Geometry (Object d) {
126 Display *dpy;
127 Drawable dr = Get_Drawable (d, &dpy);
128
129 /* GEO.width, GEO.height, etc. should really be unsigned, not int.
130 */
131 XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, (unsigned *)&GEO.width,
132 (unsigned *)&GEO.height, (unsigned *)&GEO.border_width,
133 (unsigned *)&GEO.depth);
134 return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L);
135 }
136
P_Map_Window(Object w)137 static Object P_Map_Window (Object w) {
138 Check_Type (w, T_Window);
139 XMapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
140 return Void;
141 }
142
P_Unmap_Window(Object w)143 static Object P_Unmap_Window (Object w) {
144 Check_Type (w, T_Window);
145 XUnmapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
146 return Void;
147 }
148
P_Destroy_Window(Object w)149 Object P_Destroy_Window (Object w) {
150 Check_Type (w, T_Window);
151 if (!WINDOW(w)->free)
152 XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win);
153 Deregister_Object (w);
154 WINDOW(w)->free = 1;
155 return Void;
156 }
157
P_Destroy_Subwindows(Object w)158 static Object P_Destroy_Subwindows (Object w) {
159 Check_Type (w, T_Window);
160 XDestroySubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
161 return Void;
162 }
163
P_Map_Subwindows(Object w)164 static Object P_Map_Subwindows (Object w) {
165 Check_Type (w, T_Window);
166 XMapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
167 return Void;
168 }
169
P_Unmap_Subwindows(Object w)170 static Object P_Unmap_Subwindows (Object w) {
171 Check_Type (w, T_Window);
172 XUnmapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
173 return Void;
174 }
175
P_Circulate_Subwindows(Object w,Object dir)176 static Object P_Circulate_Subwindows (Object w, Object dir) {
177 Check_Type (w, T_Window);
178 XCirculateSubwindows (WINDOW(w)->dpy, WINDOW(w)->win,
179 Symbols_To_Bits (dir, 0, Circulate_Syms));
180 return Void;
181 }
182
P_Query_Tree(Object w)183 static Object P_Query_Tree (Object w) {
184 Window root, parent, *children;
185 Display *dpy;
186 unsigned int i, n;
187 Object v, ret;
188 GC_Node2;
189
190 Check_Type (w, T_Window);
191 dpy = WINDOW(w)->dpy;
192 Disable_Interrupts;
193 XQueryTree (dpy, WINDOW(w)->win, &root, &parent, &children, &n);
194 Enable_Interrupts;
195 v = ret = Null;
196 GC_Link2 (v, ret);
197 v = Make_Window (0, dpy, root);
198 ret = Cons (v, Null);
199 v = Make_Window (0, dpy, parent);
200 ret = Cons (v, ret);
201 v = Make_Vector (n, Null);
202 for (i = 0; i < n; i++) {
203 Object x;
204
205 x = Make_Window (0, dpy, children[i]);
206 VECTOR(v)->data[i] = x;
207 }
208 ret = Cons (v, ret);
209 GC_Unlink;
210 return ret;
211 }
212
P_Translate_Coordinates(Object src,Object x,Object y,Object dst)213 static Object P_Translate_Coordinates (Object src, Object x, Object y,
214 Object dst) {
215 int rx, ry;
216 Window child;
217 Object l, t, z;
218 GC_Node3;
219
220 Check_Type (src, T_Window);
221 Check_Type (dst, T_Window);
222 if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win,
223 WINDOW(dst)->win, Get_Integer (x), Get_Integer (y), &rx, &ry,
224 &child))
225 return False;
226 l = t = P_Make_List (Make_Integer (3), Null);
227 GC_Link3 (l, t, dst);
228 Car (t) = Make_Integer (rx); t = Cdr (t);
229 Car (t) = Make_Integer (ry), t = Cdr (t);
230 z = Make_Window (0, WINDOW(dst)->dpy, child);
231 Car (t) = z;
232 GC_Unlink;
233 return l;
234 }
235
P_Query_Pointer(Object win)236 static Object P_Query_Pointer (Object win) {
237 Object l, t, z;
238 Bool ret;
239 Window root, child;
240 int r_x, r_y, x, y;
241 unsigned int mask;
242 GC_Node3;
243
244 Check_Type (win, T_Window);
245 ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child,
246 &r_x, &r_y, &x, &y, &mask);
247 t = l = P_Make_List (Make_Integer (8), Null);
248 GC_Link3 (l, t, win);
249 Car (t) = Make_Integer (x); t = Cdr (t);
250 Car (t) = Make_Integer (y); t = Cdr (t);
251 Car (t) = ret ? True : False; t = Cdr (t);
252 z = Make_Window (0, WINDOW(win)->dpy, root);
253 Car (t) = z; t = Cdr (t);
254 Car (t) = Make_Integer (r_x); t = Cdr (t);
255 Car (t) = Make_Integer (r_y); t = Cdr (t);
256 z = Make_Window (0, WINDOW(win)->dpy, child);
257 Car (t) = z; t = Cdr (t);
258 z = Bits_To_Symbols ((unsigned long)mask, 1, State_Syms);
259 Car (t) = z;
260 GC_Unlink;
261 return l;
262 }
263
elk_init_xlib_window()264 void elk_init_xlib_window () {
265 Define_Symbol (&Sym_Set_Attr, "set-window-attributes");
266 Define_Symbol (&Sym_Get_Attr, "get-window-attributes");
267 Define_Symbol (&Sym_Conf, "window-configuration");
268 Define_Symbol (&Sym_Geo, "geometry");
269 Generic_Define (Window, "window", "window?");
270 Define_Primitive (P_Window_Display, "window-display", 1, 1, EVAL);
271 Define_Primitive (P_Create_Window,
272 "xlib-create-window", 7, 7, EVAL);
273 Define_Primitive (P_Configure_Window,
274 "xlib-configure-window", 2, 2, EVAL);
275 Define_Primitive (P_Change_Window_Attributes,
276 "xlib-change-window-attributes", 2, 2, EVAL);
277 Define_Primitive (P_Get_Window_Attributes,
278 "xlib-get-window-attributes", 1, 1, EVAL);
279 Define_Primitive (P_Get_Geometry, "xlib-get-geometry",1, 1, EVAL);
280 Define_Primitive (P_Map_Window, "map-window", 1, 1, EVAL);
281 Define_Primitive (P_Unmap_Window, "unmap-window", 1, 1, EVAL);
282 Define_Primitive (P_Circulate_Subwindows,
283 "circulate-subwindows", 2, 2, EVAL);
284 Define_Primitive (P_Destroy_Window, "destroy-window", 1, 1, EVAL);
285 Define_Primitive (P_Destroy_Subwindows,
286 "destroy-subwindows", 1, 1, EVAL);
287 Define_Primitive (P_Map_Subwindows, "map-subwindows", 1, 1, EVAL);
288 Define_Primitive (P_Unmap_Subwindows, "unmap-subwindows", 1, 1, EVAL);
289 Define_Primitive (P_Query_Tree, "query-tree", 1, 1, EVAL);
290 Define_Primitive (P_Translate_Coordinates,
291 "translate-coordinates", 4, 4, EVAL);
292 Define_Primitive (P_Query_Pointer, "query-pointer", 1, 1, EVAL);
293 }
294