1 /* event.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 #include <string.h>
34
35 #define MAX_ARGS 14
36
37 static Object Argl, Argv;
38
39 static struct event_desc {
40 char *name;
41 int argc;
42 } Event_Table[] = {
43 { "event-0", 1 },
44 { "event-1", 1 },
45 { "key-press", 12 },
46 { "key-release", 12 },
47 { "button-press", 12 },
48 { "button-release", 12 },
49 { "motion-notify", 12 },
50 { "enter-notify", 14 },
51 { "leave-notify", 14 },
52 { "focus-in", 4 },
53 { "focus-out", 4 },
54 { "keymap-notify", 3 },
55 { "expose", 7 },
56 { "graphics-expose", 9 },
57 { "no-expose", 4 },
58 { "visibility-notify", 3 },
59 { "create-notify", 9 },
60 { "destroy-notify", 3 },
61 { "unmap-notify", 4 },
62 { "map-notify", 4 },
63 { "map-request", 3 },
64 { "reparent-notify", 7 },
65 { "configure-notify", 10 },
66 { "configure-request", 11 },
67 { "gravity-notify", 5 },
68 { "resize-request", 4 },
69 { "circulate-notify", 4 },
70 { "circulate-request", 4 },
71 { "property-notify", 5 },
72 { "selection-clear", 4 },
73 { "selection-request", 7 },
74 { "selection-notify", 6 },
75 { "colormap-notify", 5 },
76 { "client-message", 4 },
77 { "mapping-notify", 4 },
78 { 0, 0 }
79 };
80
81 struct predicate_arg {
82 Object *funcs;
83 Object *ret;
84 };
85
86 /*ARGSUSED*/
Event_Predicate(Display * dpy,XEvent * ep,XPointer ptr)87 static int Event_Predicate (Display *dpy, XEvent *ep,
88 #ifdef XLIB_RELEASE_5_OR_LATER
89 XPointer ptr) {
90 #else
91 char *ptr) {
92 #endif
93 struct predicate_arg *ap = (struct predicate_arg *)ptr;
94 register int i;
95 Object args;
96 GC_Node;
97
98 if ((i = ep->type) < LASTEvent && !Nullp (ap->funcs[i])) {
99 args = Get_Event_Args (ep);
100 GC_Link (args);
101 *ap->ret = Funcall (ap->funcs[i], args, 0);
102 Destroy_Event_Args (args);
103 GC_Unlink;
104 }
105 return Truep (*ap->ret);
106 }
107
108 /* (handle-events display discard? peek? clause...)
109 * clause = (event function) or ((event...) function) or (else function)
110 * loops/blocks until a function returns x != #f, then returns x.
111 * discard?: discard unprocessed events.
112 * peek?: don't discard processed events.
113 */
114
115 static Object P_Handle_Events (Object argl) {
116 Object next, clause, func, ret, funcs[LASTEvent], args;
117 register int i, discard, peek;
118 Display *dpy;
119 char *errmsg = "event occurs more than once";
120 GC_Node3; struct gcnode gcv;
121 TC_Prolog;
122
123 TC_Disable;
124 clause = args = Null;
125 GC_Link3 (argl, clause, args);
126 next = Eval (Car (argl));
127 Check_Type (next, T_Display);
128 dpy = DISPLAY(next)->dpy;
129 argl = Cdr (argl);
130 next = Eval (Car (argl));
131 Check_Type (next, T_Boolean);
132 discard = Truep (next);
133 argl = Cdr (argl);
134 next = Eval (Car (argl));
135 Check_Type (next, T_Boolean);
136 peek = Truep (next);
137 for (i = 0; i < LASTEvent; i++)
138 funcs[i] = Null;
139 gcv.gclen = 1+LASTEvent; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv;
140 for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) {
141 clause = Car (argl);
142 Check_List (clause);
143 if (Fast_Length (clause) != 2)
144 Primitive_Error ("badly formed event clause");
145 func = Eval (Car (Cdr (clause)));
146 Check_Procedure (func);
147 clause = Car (clause);
148 if (EQ(clause, Sym_Else)) {
149 for (i = 0; i < LASTEvent; i++)
150 if (Nullp (funcs[i])) funcs[i] = func;
151 } else {
152 if (TYPE(clause) == T_Pair) {
153 for (; !Nullp (clause); clause = Cdr (clause)) {
154 i = Encode_Event (Car (clause));
155 if (!Nullp (funcs[i]))
156 Primitive_Error (errmsg);
157 funcs[i] = func;
158 }
159 } else {
160 i = Encode_Event (clause);
161 if (!Nullp (funcs[i]))
162 Primitive_Error (errmsg);
163 funcs[i] = func;
164 }
165 }
166 }
167 ret = False;
168 while (!Truep (ret)) {
169 XEvent e;
170 if (discard) {
171 (peek ? XPeekEvent : XNextEvent) (dpy, &e);
172 if ((i = e.type) < LASTEvent && !Nullp (funcs[i])) {
173 args = Get_Event_Args (&e);
174 ret = Funcall (funcs[i], args, 0);
175 Destroy_Event_Args (args);
176 } else {
177 if (peek)
178 XNextEvent (dpy, &e); /* discard it */
179 }
180 } else {
181 struct predicate_arg a;
182 a.funcs = funcs;
183 a.ret = &ret;
184 (peek ? XPeekIfEvent : XIfEvent) (dpy, &e, Event_Predicate,
185 #ifdef XLIB_RELEASE_5_OR_LATER
186 (XPointer)&a);
187 #else
188 (char *)&a);
189 #endif
190 }
191 }
192 GC_Unlink;
193 TC_Enable;
194 return ret;
195 }
196
197 static Object Get_Time_Arg (Time t) {
198 return t == CurrentTime ? Sym_Now : Make_Unsigned_Long ((unsigned long)t);
199 }
200
201 Object Get_Event_Args (XEvent *ep) {
202 Object tmpargs[MAX_ARGS];
203 register int e, i;
204 register Object *a, *vp;
205 struct gcnode gcv;
206 Object dummy;
207 GC_Node;
208
209 e = ep->type;
210 dummy = Null;
211 a = tmpargs;
212 for (i = 0; i < MAX_ARGS; i++)
213 a[i] = Null;
214 GC_Link (dummy);
215 gcv.gclen = 1 + MAX_ARGS; gcv.gcobj = a; gcv.next = &gc1; GC_List = &gcv;
216 switch (e) {
217 case KeyPress: case KeyRelease:
218 case ButtonPress: case ButtonRelease:
219 case MotionNotify:
220 case EnterNotify: case LeaveNotify: {
221 register XKeyEvent *p = (XKeyEvent *)ep;
222 a[1] = Make_Window (0, p->display, p->window);
223 a[2] = Make_Window (0, p->display, p->root);
224 a[3] = Make_Window (0, p->display, p->subwindow);
225 a[4] = Get_Time_Arg (p->time);
226 a[5] = Make_Integer (p->x);
227 a[6] = Make_Integer (p->y);
228 a[7] = Make_Integer (p->x_root);
229 a[8] = Make_Integer (p->y_root);
230 if (e == KeyPress || e == KeyRelease) {
231 a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms);
232 a[10] = Make_Integer (p->keycode);
233 a[11] = p->same_screen ? True : False;
234 } else if (e == ButtonPress || e == ButtonRelease) {
235 register XButtonEvent *q = (XButtonEvent *)ep;
236 a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
237 a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms);
238 a[11] = q->same_screen ? True : False;
239 } else if (e == MotionNotify) {
240 register XMotionEvent *q = (XMotionEvent *)ep;
241 a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
242 a[10] = q->is_hint ? True : False;
243 a[11] = q->same_screen ? True : False;
244 } else {
245 register XCrossingEvent *q = (XCrossingEvent *)ep;
246 a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms);
247 a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0,
248 Cross_Detail_Syms);
249 a[11] = q->same_screen ? True : False;
250 a[12] = q->focus ? True : False;
251 a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms);
252 }
253 } break;
254 case FocusIn: case FocusOut: {
255 register XFocusChangeEvent *p = (XFocusChangeEvent *)ep;
256 a[1] = Make_Window (0, p->display, p->window);
257 a[2] = Bits_To_Symbols ((unsigned long)p->mode, 0, Cross_Mode_Syms);
258 a[3] = Bits_To_Symbols ((unsigned long)p->detail, 0, Focus_Detail_Syms);
259 } break;
260 case KeymapNotify: {
261 register XKeymapEvent *p = (XKeymapEvent *)ep;
262 a[1] = Make_Window (0, p->display, p->window);
263 a[2] = Make_String (p->key_vector, 32);
264 } break;
265 case Expose: {
266 register XExposeEvent *p = (XExposeEvent *)ep;
267 a[1] = Make_Window (0, p->display, p->window);
268 a[2] = Make_Integer (p->x);
269 a[3] = Make_Integer (p->y);
270 a[4] = Make_Integer (p->width);
271 a[5] = Make_Integer (p->height);
272 a[6] = Make_Integer (p->count);
273 } break;
274 case GraphicsExpose: {
275 register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep;
276 a[1] = Make_Window (0, p->display, p->drawable);
277 a[2] = Make_Integer (p->x);
278 a[3] = Make_Integer (p->y);
279 a[4] = Make_Integer (p->width);
280 a[5] = Make_Integer (p->height);
281 a[6] = Make_Integer (p->count);
282 a[7] = Make_Integer (p->major_code);
283 a[8] = Make_Integer (p->minor_code);
284 } break;
285 case NoExpose: {
286 register XNoExposeEvent *p = (XNoExposeEvent *)ep;
287 a[1] = Make_Window (0, p->display, p->drawable);
288 a[2] = Make_Integer (p->major_code);
289 a[3] = Make_Integer (p->minor_code);
290 } break;
291 case VisibilityNotify: {
292 register XVisibilityEvent *p = (XVisibilityEvent *)ep;
293 a[1] = Make_Window (0, p->display, p->window);
294 a[2] = Bits_To_Symbols ((unsigned long)p->state, 0, Visibility_Syms);
295 } break;
296 case CreateNotify: {
297 register XCreateWindowEvent *p = (XCreateWindowEvent *)ep;
298 a[1] = Make_Window (0, p->display, p->parent);
299 a[2] = Make_Window (0, p->display, p->window);
300 a[3] = Make_Integer (p->x);
301 a[4] = Make_Integer (p->y);
302 a[5] = Make_Integer (p->width);
303 a[6] = Make_Integer (p->height);
304 a[7] = Make_Integer (p->border_width);
305 a[8] = p->override_redirect ? True : False;
306 } break;
307 case DestroyNotify: {
308 register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep;
309 a[1] = Make_Window (0, p->display, p->event);
310 a[2] = Make_Window (0, p->display, p->window);
311 } break;
312 case UnmapNotify: {
313 register XUnmapEvent *p = (XUnmapEvent *)ep;
314 a[1] = Make_Window (0, p->display, p->event);
315 a[2] = Make_Window (0, p->display, p->window);
316 a[3] = p->from_configure ? True : False;
317 } break;
318 case MapNotify: {
319 register XMapEvent *p = (XMapEvent *)ep;
320 a[1] = Make_Window (0, p->display, p->event);
321 a[2] = Make_Window (0, p->display, p->window);
322 a[3] = p->override_redirect ? True : False;
323 } break;
324 case MapRequest: {
325 register XMapRequestEvent *p = (XMapRequestEvent *)ep;
326 a[1] = Make_Window (0, p->display, p->parent);
327 a[2] = Make_Window (0, p->display, p->window);
328 } break;
329 case ReparentNotify: {
330 register XReparentEvent *p = (XReparentEvent *)ep;
331 a[1] = Make_Window (0, p->display, p->event);
332 a[2] = Make_Window (0, p->display, p->window);
333 a[3] = Make_Window (0, p->display, p->parent);
334 a[4] = Make_Integer (p->x);
335 a[5] = Make_Integer (p->y);
336 a[6] = p->override_redirect ? True : False;
337 } break;
338 case ConfigureNotify: {
339 register XConfigureEvent *p = (XConfigureEvent *)ep;
340 a[1] = Make_Window (0, p->display, p->event);
341 a[2] = Make_Window (0, p->display, p->window);
342 a[3] = Make_Integer (p->x);
343 a[4] = Make_Integer (p->y);
344 a[5] = Make_Integer (p->width);
345 a[6] = Make_Integer (p->height);
346 a[7] = Make_Integer (p->border_width);
347 a[8] = Make_Window (0, p->display, p->above);
348 a[9] = p->override_redirect ? True : False;
349 } break;
350 case ConfigureRequest: {
351 register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep;
352 a[1] = Make_Window (0, p->display, p->parent);
353 a[2] = Make_Window (0, p->display, p->window);
354 a[3] = Make_Integer (p->x);
355 a[4] = Make_Integer (p->y);
356 a[5] = Make_Integer (p->width);
357 a[6] = Make_Integer (p->height);
358 a[7] = Make_Integer (p->border_width);
359 a[8] = Make_Window (0, p->display, p->above);
360 a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms);
361 a[10] = Make_Unsigned_Long (p->value_mask);
362 } break;
363 case GravityNotify: {
364 register XGravityEvent *p = (XGravityEvent *)ep;
365 a[1] = Make_Window (0, p->display, p->event);
366 a[2] = Make_Window (0, p->display, p->window);
367 a[3] = Make_Integer (p->x);
368 a[4] = Make_Integer (p->y);
369 } break;
370 case ResizeRequest: {
371 register XResizeRequestEvent *p = (XResizeRequestEvent *)ep;
372 a[1] = Make_Window (0, p->display, p->window);
373 a[2] = Make_Integer (p->width);
374 a[3] = Make_Integer (p->height);
375 } break;
376 case CirculateNotify: {
377 register XCirculateEvent *p = (XCirculateEvent *)ep;
378 a[1] = Make_Window (0, p->display, p->event);
379 a[2] = Make_Window (0, p->display, p->window);
380 a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms);
381 } break;
382 case CirculateRequest: {
383 register XCirculateRequestEvent *p = (XCirculateRequestEvent *)ep;
384 a[1] = Make_Window (0, p->display, p->parent);
385 a[2] = Make_Window (0, p->display, p->window);
386 a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms);
387 } break;
388 case PropertyNotify: {
389 register XPropertyEvent *p = (XPropertyEvent *)ep;
390 a[1] = Make_Window (0, p->display, p->window);
391 a[2] = Make_Atom (p->atom);
392 a[3] = Get_Time_Arg (p->time);
393 a[4] = Bits_To_Symbols ((unsigned long)p->state, 0, Prop_Syms);
394 } break;
395 case SelectionClear: {
396 register XSelectionClearEvent *p = (XSelectionClearEvent *)ep;
397 a[1] = Make_Window (0, p->display, p->window);
398 a[2] = Make_Atom (p->selection);
399 a[3] = Get_Time_Arg (p->time);
400 } break;
401 case SelectionRequest: {
402 register XSelectionRequestEvent *p = (XSelectionRequestEvent *)ep;
403 a[1] = Make_Window (0, p->display, p->owner);
404 a[2] = Make_Window (0, p->display, p->requestor);
405 a[3] = Make_Atom (p->selection);
406 a[4] = Make_Atom (p->target);
407 a[5] = Make_Atom (p->property);
408 a[6] = Get_Time_Arg (p->time);
409 } break;
410 case SelectionNotify: {
411 register XSelectionEvent *p = (XSelectionEvent *)ep;
412 a[1] = Make_Window (0, p->display, p->requestor);
413 a[2] = Make_Atom (p->selection);
414 a[3] = Make_Atom (p->target);
415 a[4] = Make_Atom (p->property);
416 a[5] = Get_Time_Arg (p->time);
417 } break;
418 case ColormapNotify: {
419 register XColormapEvent *p = (XColormapEvent *)ep;
420 a[1] = Make_Window (0, p->display, p->window);
421 a[2] = Make_Colormap (0, p->display, p->colormap);
422 a[3] = p->new ? True : False;
423 a[4] = p->state == ColormapInstalled ? True : False;
424 } break;
425 case ClientMessage: {
426 register XClientMessageEvent *p = (XClientMessageEvent *)ep;
427 register int i;
428
429 a[1] = Make_Window (0, p->display, p->window);
430 a[2] = Make_Atom (p->message_type);
431 switch (p->format) {
432 case 8:
433 a[3] = Make_String (p->data.b, 20);
434 break;
435 case 16:
436 a[3] = Make_Vector (10, Null);
437 for (i = 0; i < 10; i++)
438 VECTOR(a[3])->data[i] = Make_Integer (p->data.s[i]);
439 break;
440 case 32:
441 a[3] = Make_Vector (5, Null);
442 for (i = 0; i < 5; i++)
443 VECTOR(a[3])->data[i] = Make_Long (p->data.l[i]);
444 break;
445 default:
446 a[3] = Make_Integer (p->format); /* ??? */
447 }
448 } break;
449 case MappingNotify: {
450 register XMappingEvent *p = (XMappingEvent *)ep;
451 a[1] = Make_Window (0, p->display, p->window);
452 a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms);
453 a[3] = Make_Integer (p->first_keycode);
454 a[4] = Make_Integer (p->count);
455 } break;
456 }
457 a[0] = Intern (Event_Table[e].name);
458 for (vp = VECTOR(Argv)->data, i = 0; i < Event_Table[e].argc; i++) {
459 if (i) vp++;
460 Car (*vp) = a[i];
461 Cdr (*vp) = vp[1];
462 }
463 Cdr (*vp) = Null;
464 GC_Unlink;
465 return Argl;
466 }
467
468 void Destroy_Event_Args (Object args) {
469 Object t;
470
471 for (t = args; !Nullp (t); t = Cdr (t))
472 Car (t) = Null;
473 }
474
475 int Encode_Event (Object e) {
476 Object s;
477 register char *p;
478 register struct event_desc *ep;
479 register int n;
480
481 Check_Type (e, T_Symbol);
482 s = SYMBOL(e)->name;
483 p = STRING(s)->data;
484 n = STRING(s)->size;
485 for (ep = Event_Table; ep->name; ep++)
486 if (n && strncmp (ep->name, p, n) == 0) break;
487 if (ep->name == 0)
488 Primitive_Error ("no such event: ~s", e);
489 return ep-Event_Table;
490 }
491
492 static Object P_Get_Motion_Events (Object w, Object from, Object to) {
493 XTimeCoord *p;
494 int n;
495 register int i;
496 Object e, ret;
497 GC_Node2;
498
499 Check_Type (w, T_Window);
500 p = XGetMotionEvents (WINDOW(w)->dpy, WINDOW(w)->win, Get_Time (from),
501 Get_Time (to), &n);
502 e = ret = Make_Vector (n, Null);
503 GC_Link2 (ret, e);
504 for (i = 0; i < n; i++) {
505 e = P_Make_List (Make_Integer (3), Null);
506 VECTOR(ret)->data[i] = e;
507 Car (e) = Get_Time_Arg (p[i].time); e = Cdr (e);
508 Car (e) = Make_Integer (p[i].x); e = Cdr (e);
509 Car (e) = Make_Integer (p[i].y);
510 }
511 GC_Unlink;
512 XFree ((char *)p);
513 return ret;
514 }
515
516 static Object P_Event_Listen (Object d, Object wait_flag) {
517 Display *dpy;
518 register int n;
519 XEvent e;
520
521 Check_Type (d, T_Display);
522 Check_Type (wait_flag, T_Boolean);
523 dpy = DISPLAY(d)->dpy;
524 n = XPending (dpy);
525 if (n == 0 && EQ(wait_flag, True)) {
526 XPeekEvent (dpy, &e);
527 n = XPending (dpy);
528 }
529 return Make_Integer (n);
530 }
531
532 void elk_init_xlib_event () {
533 Object t;
534 register int i;
535
536 Argl = P_Make_List (Make_Integer (MAX_ARGS), Null);
537 Global_GC_Link (Argl);
538 Argv = Make_Vector (MAX_ARGS, Null);
539 Global_GC_Link (Argv);
540 for (i = 0, t = Argl; i < MAX_ARGS; i++, t = Cdr (t))
541 VECTOR(Argv)->data[i] = t;
542 Define_Primitive (P_Handle_Events, "handle-events", 3, MANY, NOEVAL);
543 Define_Primitive (P_Get_Motion_Events,
544 "get-motion-events", 3, 3, EVAL);
545 Define_Primitive (P_Event_Listen, "event-listen", 2, 2, EVAL);
546 }
547