#include "xlib.h" #include "scheme48.h" SYMDESCR Event_Names[] = { { "key-press", KeyPress }, { "key-release", KeyRelease }, { "button-press", ButtonPress }, { "button-release", ButtonRelease }, { "motion-notify", MotionNotify }, { "enter-notify", EnterNotify }, { "leave-notify", LeaveNotify }, { "focus-in", FocusIn }, { "focus-out", FocusOut }, { "keymap-notify", KeymapNotify }, { "expose", Expose }, { "graphics-expose", GraphicsExpose }, { "no-expose", NoExpose }, { "visibility-notify", VisibilityNotify }, { "create-notify", CreateNotify }, { "destroy-notify", DestroyNotify }, { "unmap-notify", UnmapNotify }, { "map-notify", MapNotify }, { "map-request", MapRequest }, { "reparent-notify", ReparentNotify }, { "configure-notify", ConfigureNotify }, { "configure-request", ConfigureRequest }, { "gravity-notify", GravityNotify }, { "resize-request", ResizeRequest }, { "circulate-notify", CirculateNotify }, { "circulate-request", CirculateRequest }, { "property-notify", PropertyNotify }, { "selection-clear", SelectionClear }, { "selection-notify", SelectionNotify }, { "colormap-notify", ColormapNotify }, { "client-message", ClientMessage }, { "mapping-notify", MappingNotify } }; #define ECAST(name, type) type* name = (type*)e #define sidx 4 #define SET(i, v) S48_VECTOR_SET(r, i, v) #define SETSIZE(i) r = s48_make_vector(sidx+i, S48_FALSE) s48_value enter_event(XEvent* e) { s48_value r = S48_FALSE; s48_value temp = S48_FALSE; int i; S48_DECLARE_GC_PROTECT(2); S48_GC_PROTECT_2(r, temp); switch (e->type) { case KeyPress : case KeyRelease : case ButtonPress : case ButtonRelease : case MotionNotify : { ECAST(q, XKeyEvent); SETSIZE(10); // all equal in the beginning SET(sidx+0, ENTER_WINDOW(q->root)); SET(sidx+1, ENTER_WINDOW(q->subwindow)); SET(sidx+2, ENTER_TIME(q->time)); SET(sidx+3, s48_enter_integer(q->x)); SET(sidx+4, s48_enter_integer(q->y)); SET(sidx+5, s48_enter_integer(q->x_root)); SET(sidx+6, s48_enter_integer(q->y_root)); SET(sidx+7, Bits_To_Symbols(q->state, State_Syms)); // now they are different switch (e->type) { case KeyPress : case KeyRelease : { SET(sidx+8, s48_enter_integer(q->keycode)); SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen)); } break; case ButtonPress : case ButtonRelease : { ECAST(q, XButtonEvent); SET(sidx+8, Bit_To_Symbol(q->button, Button_Syms)); SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen)); } break; case MotionNotify : { ECAST(q, XMotionEvent); SET(sidx+8, S48_ENTER_BOOLEAN(q->is_hint)); SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen)); } break; } } break; case EnterNotify : case LeaveNotify : { ECAST(q, XCrossingEvent); SETSIZE(12); SET(sidx+0, ENTER_WINDOW(q->root)); SET(sidx+1, ENTER_WINDOW(q->subwindow)); SET(sidx+2, ENTER_TIME(q->time)); SET(sidx+3, s48_enter_integer(q->x)); SET(sidx+4, s48_enter_integer(q->y)); SET(sidx+5, s48_enter_integer(q->x_root)); SET(sidx+6, s48_enter_integer(q->y_root)); SET(sidx+7, Bit_To_Symbol(q->mode, Cross_Mode_Syms)); SET(sidx+8, Bit_To_Symbol(q->detail, Cross_Detail_Syms)); SET(sidx+9, S48_ENTER_BOOLEAN(q->same_screen)); SET(sidx+10, S48_ENTER_BOOLEAN(q->focus)); // Elk does this; but why not State_Syms?? SET(sidx+11, Bit_To_Symbol(q->state, Button_Syms)); } break; case FocusIn : case FocusOut : { ECAST(q, XFocusChangeEvent); SETSIZE(2); SET(sidx+0, Bit_To_Symbol(q->mode, Cross_Mode_Syms)); SET(sidx+1, Bit_To_Symbol(q->detail, Focus_Detail_Syms)); } break; case KeymapNotify : { ECAST(q, XKeymapEvent); SETSIZE(1); temp = s48_make_string(32, (char)0); for (i=0; i < 32; i++) S48_STRING_SET(temp, i, q->key_vector[i]); SET(sidx+0, temp); } break; case Expose : { ECAST(q, XExposeEvent); SETSIZE(5); SET(sidx+0, s48_enter_integer(q->x)); SET(sidx+1, s48_enter_integer(q->y)); SET(sidx+2, s48_enter_integer(q->width)); SET(sidx+3, s48_enter_integer(q->height)); SET(sidx+4, s48_enter_integer(q->count)); } break; case GraphicsExpose : { ECAST(q, XGraphicsExposeEvent); SETSIZE(7); // the ->window member is only a drawable here! ?? SET(sidx+0, s48_enter_integer(q->x)); SET(sidx+1, s48_enter_integer(q->y)); SET(sidx+2, s48_enter_integer(q->width)); SET(sidx+3, s48_enter_integer(q->height)); SET(sidx+4, s48_enter_integer(q->count)); SET(sidx+5, s48_enter_integer(q->major_code)); SET(sidx+6, s48_enter_integer(q->minor_code)); } break; case NoExpose : { ECAST(q, XNoExposeEvent); SETSIZE(2); SET(sidx+0, s48_enter_integer(q->major_code)); SET(sidx+1, s48_enter_integer(q->minor_code)); } break; case VisibilityNotify : { ECAST(q, XVisibilityEvent); SETSIZE(1); SET(sidx+0, Bit_To_Symbol(q->state, Visibility_Syms)); } break; case CreateNotify : { ECAST(q, XCreateWindowEvent); SETSIZE(7); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, s48_enter_integer(q->x)); SET(sidx+2, s48_enter_integer(q->y)); SET(sidx+3, s48_enter_integer(q->width)); SET(sidx+4, s48_enter_integer(q->height)); SET(sidx+5, s48_enter_integer(q->border_width)); SET(sidx+6, S48_ENTER_BOOLEAN(q->override_redirect)); } break; case DestroyNotify : { ECAST(q, XDestroyWindowEvent); SETSIZE(1); SET(sidx+0, ENTER_WINDOW(q->window)); } break; case UnmapNotify : { ECAST(q, XUnmapEvent); SETSIZE(2); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, S48_ENTER_BOOLEAN(q->from_configure)); } break; case MapNotify : { ECAST(q, XMapEvent); SETSIZE(2); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, S48_ENTER_BOOLEAN(q->override_redirect)); } break; case MapRequest : { ECAST(q, XMapRequestEvent); SETSIZE(1); SET(sidx+0, ENTER_WINDOW(q->window)); } break; case ReparentNotify : { ECAST(q, XReparentEvent); SETSIZE(5); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, ENTER_WINDOW(q->parent)); SET(sidx+2, s48_enter_integer(q->x)); SET(sidx+3, s48_enter_integer(q->y)); SET(sidx+4, S48_ENTER_BOOLEAN(q->override_redirect)); } break; case ConfigureNotify : { ECAST(q, XConfigureEvent); SETSIZE(8); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, s48_enter_integer(q->x)); SET(sidx+2, s48_enter_integer(q->y)); SET(sidx+3, s48_enter_integer(q->width)); SET(sidx+4, s48_enter_integer(q->height)); SET(sidx+5, s48_enter_integer(q->border_width)); SET(sidx+6, ENTER_WINDOW(q->above)); SET(sidx+7, S48_ENTER_BOOLEAN(q->override_redirect)); } break; case ConfigureRequest : { ECAST(q, XConfigureRequestEvent); SETSIZE(9); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, s48_enter_integer(q->x)); SET(sidx+2, s48_enter_integer(q->y)); SET(sidx+3, s48_enter_integer(q->width)); SET(sidx+4, s48_enter_integer(q->height)); SET(sidx+5, s48_enter_integer(q->border_width)); SET(sidx+6, ENTER_WINDOW(q->above)); SET(sidx+7, Bit_To_Symbol(q->detail, Stack_Mode_Syms)); SET(sidx+8, s48_enter_integer(q->value_mask)); } break; case GravityNotify : { ECAST(q, XGravityEvent); SETSIZE(3); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, s48_enter_integer(q->x)); SET(sidx+2, s48_enter_integer(q->y)); } break; case ResizeRequest : { ECAST(q, XResizeRequestEvent); SETSIZE(2); SET(sidx+0, s48_enter_integer(q->width)); SET(sidx+1, s48_enter_integer(q->height)); } break; case CirculateRequest : { ECAST(q, XCirculateEvent); SETSIZE(2); SET(sidx+0, ENTER_WINDOW(q->window)); SET(sidx+1, Bit_To_Symbol(q->place, Place_Syms)); } break; case PropertyNotify : { ECAST(q, XPropertyEvent); SETSIZE(3); SET(sidx+0, ENTER_ATOM(q->atom)); SET(sidx+1, ENTER_TIME(q->time)); SET(sidx+2, Bit_To_Symbol(q->state, Prop_Syms)); } break; case SelectionClear : { ECAST(q, XSelectionClearEvent); SETSIZE(2); SET(sidx+0, ENTER_ATOM(q->selection)); SET(sidx+1, ENTER_TIME(q->time)); } break; case SelectionRequest : { ECAST(q, XSelectionRequestEvent); SETSIZE(5); SET(sidx+0, ENTER_WINDOW(q->requestor)); SET(sidx+1, ENTER_ATOM(q->selection)); SET(sidx+2, ENTER_ATOM(q->target)); SET(sidx+3, ENTER_ATOM(q->property)); SET(sidx+4, ENTER_TIME(q->time)); } break; case SelectionNotify : { ECAST(q, XSelectionEvent); SETSIZE(4); SET(sidx+0, ENTER_ATOM(q->selection)); SET(sidx+1, ENTER_ATOM(q->target)); SET(sidx+2, ENTER_ATOM(q->property)); SET(sidx+3, ENTER_TIME(q->time)); } break; case ColormapNotify : { ECAST(q, XColormapEvent); SETSIZE(3); SET(sidx+0, ENTER_COLORMAP(q->colormap)); SET(sidx+1, S48_ENTER_BOOLEAN(q->new)); SET(sidx+2, q->state == ColormapInstalled ? S48_TRUE : S48_FALSE); } break; case ClientMessage : { ECAST(q, XClientMessageEvent); SETSIZE(2); SET(sidx+0, ENTER_ATOM(q->message_type)); switch (q->format) { case 8 : { temp = s48_make_string(20, (char)0); for (i=0; i < 20; i++) S48_STRING_SET(temp, i, q->data.b[i]); } break; case 16 : { temp = s48_make_vector(10, S48_FALSE); for (i=0; i < 10; i++) S48_VECTOR_SET(temp, i, s48_enter_integer(q->data.s[i])); } break; case 32 : { temp = s48_make_vector(5, S48_FALSE); for (i=0; i < 5; i++) S48_VECTOR_SET(temp, i, s48_enter_integer(q->data.l[i])); } break; default : temp = s48_enter_integer(q->format); //?? } SET(sidx+1, temp); } case MappingNotify : { ECAST(q, XMappingEvent); SETSIZE(3); SET(sidx+0, Bit_To_Symbol(q->request, Mapping_Syms)); SET(sidx+1, s48_enter_integer(q->first_keycode)); SET(sidx+2, s48_enter_integer(q->count)); } break; } // switch end // XAnyEvent entries { ECAST(q, XAnyEvent); SET(0, s48_enter_integer(q->serial)); SET(1, S48_ENTER_BOOLEAN(q->send_event)); SET(2, ENTER_DISPLAY(q->display)); SET(3, ENTER_WINDOW(q->window)); } // more?? // And the Event-Name r = s48_cons( Bit_To_Symbol(e->type, Event_Names), r ); S48_GC_UNPROTECT(); return r; } s48_value Next_Event(s48_value Xdisplay) { XEvent e; XNextEvent(EXTRACT_DISPLAY(Xdisplay), &e); return enter_event(&e); } s48_value Peek_Event(s48_value Xdisplay) { XEvent e; XPeekEvent(EXTRACT_DISPLAY(Xdisplay), &e); return enter_event(&e); } s48_value Events_Pending(s48_value Xdisplay) { return s48_enter_integer(XPending(EXTRACT_DISPLAY(Xdisplay))); } /* #include "xlib.h" #define MAX_ARGS 14 static s48_value Argl, Argv; static struct event_desc { char *name; int argc; } Event_Table[] = { { "event-0", 1 }, { "event-1", 1 }, { "key-press", 12 }, { "key-release", 12 }, { "button-press", 12 }, { "button-release", 12 }, { "motion-notify", 12 }, { "enter-notify", 14 }, { "leave-notify", 14 }, { "focus-in", 4 }, { "focus-out", 4 }, { "keymap-notify", 3 }, { "expose", 7 }, { "graphics-expose", 9 }, { "no-expose", 4 }, { "visibility-notify", 3 }, { "create-notify", 9 }, { "destroy-notify", 3 }, { "unmap-notify", 4 }, { "map-notify", 4 }, { "map-request", 3 }, { "reparent-notify", 7 }, { "configure-notify", 10 }, { "configure-request", 11 }, { "gravity-notify", 5 }, { "resize-request", 4 }, { "circulate-notify", 4 }, { "circulate-request", 4 }, { "property-notify", 5 }, { "selection-clear", 4 }, { "selection-request", 7 }, { "selection-notify", 6 }, { "colormap-notify", 5 }, { "client-message", 4 }, { "mapping-notify", 4 }, { 0, 0 } }; struct predicate_arg { s48_value *funcs; s48_value *ret; }; //ARGSUSED static Event_Predicate (dpy, ep, ptr) Display *dpy; XEvent *ep; #ifdef XLIB_RELEASE_5_OR_LATER XPointer ptr; { #else char *ptr; { #endif struct predicate_arg *ap = (struct predicate_arg *)ptr; register i; s48_value args; S48_DECLARE_GC_PROTECT(1); if ((i = ep->type) < LASTEvent && !S48_NULL_P (ap->funcs[i])) { args = Get_Event_Args (ep); S48_GC_PROTECT_1 (args); *ap->ret = Funcall (ap->funcs[i], args, 0); Destroy_Event_Args (args); S48_GC_UNPROTECT; } return S48_TRUE_P (*ap->ret); } // (handle-events display discard? peek? clause...) // clause = (event function) or ((event...) function) or (else function) // loops/blocks until a function returns x != #f, then returns x. // discard?: discard unprocessed events. // peek?: don't discard processed events. // static s48_value P_Handle_Events (argl) s48_value argl; { s48_value next, clause, func, ret, funcs[LASTEvent], args; register i, discard, peek; Display *dpy; char *errmsg = "event occurs more than once"; S48_DECLARE_GC_PROTECT(3); struct gcnode gcv; TC_Prolog; TC_Disable; clause = args = S48_NULL; S48_GC_PROTECT_3 (argl, clause, args); next = Eval (S48_CAR (argl)); Check_Type (next, T_Display); dpy = DISPLAY(next)->dpy; argl = S48_CDR (argl); next = Eval (S48_CAR (argl)); Check_Type (next, T_Boolean); discard = S48_TRUE_P (next); argl = S48_CDR (argl); next = Eval (S48_CAR (argl)); Check_Type (next, T_Boolean); peek = S48_TRUE_P (next); for (i = 0; i < LASTEvent; i++) funcs[i] = S48_NULL; gcv.gclen = 1+LASTEvent; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv; for (argl = S48_CDR (argl); !S48_NULL_P (argl); argl = S48_CDR (argl)) { clause = S48_CAR (argl); Check_List (clause); if (Fast_Length (clause) != 2) Primitive_Error ("badly formed event clause"); func = Eval (S48_CAR (S48_CDR (clause))); Check_Procedure (func); clause = S48_CAR (clause); if (S48_EQ_P(clause, Sym_Else)) { for (i = 0; i < LASTEvent; i++) if (S48_NULL_P (funcs[i])) funcs[i] = func; } else { if (S48_PAIR_P(clause)) { for (; !S48_NULL_P (clause); clause = S48_CDR (clause)) { i = Encode_Event (S48_CAR (clause)); if (!S48_NULL_P (funcs[i])) Primitive_Error (errmsg); funcs[i] = func; } } else { i = Encode_Event (clause); if (!S48_NULL_P (funcs[i])) Primitive_Error (errmsg); funcs[i] = func; } } } ret = S48_FALSE; while (!S48_TRUE_P (ret)) { XEvent e; if (discard) { (peek ? XPeekEvent : XNextEvent) (dpy, &e); if ((i = e.type) < LASTEvent && !S48_NULL_P (funcs[i])) { args = Get_Event_Args (&e); ret = Funcall (funcs[i], args, 0); Destroy_Event_Args (args); } else { if (peek) XNextEvent (dpy, &e); // discard it } } else { struct predicate_arg a; a.funcs = funcs; a.ret = &ret; (peek ? XPeekIfEvent : XIfEvent) (dpy, &e, Event_Predicate, #ifdef XLIB_RELEASE_5_OR_LATER (XPointer)&a); #else (char *)&a); #endif } } S48_GC_UNPROTECT; TC_Enable; return ret; } static s48_value Get_Time_Arg (t) Time t; { return t == CurrentTime ? Sym_Now : s48_enter_integer ((unsigned long)t); } s48_value Get_Event_Args (ep) XEvent *ep; { s48_value tmpargs[MAX_ARGS]; register e, i; register s48_value *a, *vp; struct gcnode gcv; s48_value dummy; S48_DECLARE_GC_PROTECT(1); e = ep->type; dummy = S48_NULL; a = tmpargs; for (i = 0; i < MAX_ARGS; i++) a[i] = S48_NULL; S48_GC_PROTECT_1 (dummy); gcv.gclen = 1 + MAX_ARGS; gcv.gcobj = a; gcv.next = &gc1; GC_List = &gcv; switch (e) { case KeyPress: case KeyRelease: case ButtonPress: case ButtonRelease: case MotionNotify: case EnterNotify: case LeaveNotify: { register XKeyEvent *p = (XKeyEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Make_Window (0, p->display, p->root); a[3] = Make_Window (0, p->display, p->subwindow); a[4] = Get_Time_Arg (p->time); a[5] = s48_enter_integer (p->x); a[6] = s48_enter_integer (p->y); a[7] = s48_enter_integer (p->x_root); a[8] = s48_enter_integer (p->y_root); if (e == KeyPress || e == KeyRelease) { a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms); a[10] = s48_enter_integer (p->keycode); a[11] = p->same_screen ? S48_TRUE : S48_FALSE; } else if (e == ButtonPress || e == ButtonRelease) { register XButtonEvent *q = (XButtonEvent *)ep; a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms); a[11] = q->same_screen ? S48_TRUE : S48_FALSE; } else if (e == MotionNotify) { register XMotionEvent *q = (XMotionEvent *)ep; a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); a[10] = q->is_hint ? S48_TRUE : S48_FALSE; a[11] = q->same_screen ? S48_TRUE : S48_FALSE; } else { register XCrossingEvent *q = (XCrossingEvent *)ep; a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms); a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0, Cross_Detail_Syms); a[11] = q->same_screen ? S48_TRUE : S48_FALSE; a[12] = q->focus ? S48_TRUE : S48_FALSE; a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms); } } break; case FocusIn: case FocusOut: { register XFocusChangeEvent *p = (XFocusChangeEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Bits_To_Symbols ((unsigned long)p->mode, 0, Cross_Mode_Syms); a[3] = Bits_To_Symbols ((unsigned long)p->detail, 0, Focus_Detail_Syms); } break; case KeymapNotify: { register XKeymapEvent *p = (XKeymapEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Make_String (p->key_vector, 32); } break; case Expose: { register XExposeEvent *p = (XExposeEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = s48_enter_integer (p->x); a[3] = s48_enter_integer (p->y); a[4] = s48_enter_integer (p->width); a[5] = s48_enter_integer (p->height); a[6] = s48_enter_integer (p->count); } break; case GraphicsExpose: { register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep; a[1] = Make_Window (0, p->display, p->drawable); a[2] = s48_enter_integer (p->x); a[3] = s48_enter_integer (p->y); a[4] = s48_enter_integer (p->width); a[5] = s48_enter_integer (p->height); a[6] = s48_enter_integer (p->count); a[7] = s48_enter_integer (p->major_code); a[8] = s48_enter_integer (p->minor_code); } break; case NoExpose: { register XNoExposeEvent *p = (XNoExposeEvent *)ep; a[1] = Make_Window (0, p->display, p->drawable); a[2] = s48_enter_integer (p->major_code); a[3] = s48_enter_integer (p->minor_code); } break; case VisibilityNotify: { register XVisibilityEvent *p = (XVisibilityEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Bits_To_Symbols ((unsigned long)p->state, 0, Visibility_Syms); } break; case CreateNotify: { register XCreateWindowEvent *p = (XCreateWindowEvent *)ep; a[1] = Make_Window (0, p->display, p->parent); a[2] = Make_Window (0, p->display, p->window); a[3] = s48_enter_integer (p->x); a[4] = s48_enter_integer (p->y); a[5] = s48_enter_integer (p->width); a[6] = s48_enter_integer (p->height); a[7] = s48_enter_integer (p->border_width); a[8] = p->override_redirect ? S48_TRUE : S48_FALSE; } break; case DestroyNotify: { register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep; a[1] = Make_Window (0, p->display, p->event); a[2] = Make_Window (0, p->display, p->window); } break; case UnmapNotify: { register XUnmapEvent *p = (XUnmapEvent *)ep; a[1] = Make_Window (0, p->display, p->event); a[2] = Make_Window (0, p->display, p->window); a[3] = p->from_configure ? S48_TRUE : S48_FALSE; } break; case MapNotify: { register XMapEvent *p = (XMapEvent *)ep; a[1] = Make_Window (0, p->display, p->event); a[2] = Make_Window (0, p->display, p->window); a[3] = p->override_redirect ? S48_TRUE : S48_FALSE; } break; case MapRequest: { register XMapRequestEvent *p = (XMapRequestEvent *)ep; a[1] = Make_Window (0, p->display, p->parent); a[2] = Make_Window (0, p->display, p->window); } break; case ReparentNotify: { register XReparentEvent *p = (XReparentEvent *)ep; a[1] = Make_Window (0, p->display, p->event); a[2] = Make_Window (0, p->display, p->window); a[3] = Make_Window (0, p->display, p->parent); a[4] = s48_enter_integer (p->x); a[5] = s48_enter_integer (p->y); a[6] = p->override_redirect ? S48_TRUE : S48_FALSE; } break; case ConfigureNotify: { register XConfigureEvent *p = (XConfigureEvent *)ep; a[1] = Make_Window (0, p->display, p->event); a[2] = Make_Window (0, p->display, p->window); a[3] = s48_enter_integer (p->x); a[4] = s48_enter_integer (p->y); a[5] = s48_enter_integer (p->width); a[6] = s48_enter_integer (p->height); a[7] = s48_enter_integer (p->border_width); a[8] = Make_Window (0, p->display, p->above); a[9] = p->override_redirect ? S48_TRUE : S48_FALSE; } break; case ConfigureRequest: { register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep; a[1] = Make_Window (0, p->display, p->parent); a[2] = Make_Window (0, p->display, p->window); a[3] = s48_enter_integer (p->x); a[4] = s48_enter_integer (p->y); a[5] = s48_enter_integer (p->width); a[6] = s48_enter_integer (p->height); a[7] = s48_enter_integer (p->border_width); a[8] = Make_Window (0, p->display, p->above); a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms); a[10] = s48_enter_integer (p->value_mask); } break; case GravityNotify: { register XGravityEvent *p = (XGravityEvent *)ep; a[1] = Make_Window (0, p->display, p->event); a[2] = Make_Window (0, p->display, p->window); a[3] = s48_enter_integer (p->x); a[4] = s48_enter_integer (p->y); } break; case ResizeRequest: { register XResizeRequestEvent *p = (XResizeRequestEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = s48_enter_integer (p->width); a[3] = s48_enter_integer (p->height); } break; case CirculateNotify: { register XCirculateEvent *p = (XCirculateEvent *)ep; a[1] = Make_Window (0, p->display, p->event); a[2] = Make_Window (0, p->display, p->window); a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); } break; case CirculateRequest: { register XCirculateRequestEvent *p = (XCirculateRequestEvent *)ep; a[1] = Make_Window (0, p->display, p->parent); a[2] = Make_Window (0, p->display, p->window); a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); } break; case PropertyNotify: { register XPropertyEvent *p = (XPropertyEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Make_Atom (p->atom); a[3] = Get_Time_Arg (p->time); a[4] = Bits_To_Symbols ((unsigned long)p->state, 0, Prop_Syms); } break; case SelectionClear: { register XSelectionClearEvent *p = (XSelectionClearEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Make_Atom (p->selection); a[3] = Get_Time_Arg (p->time); } break; case SelectionRequest: { register XSelectionRequestEvent *p = (XSelectionRequestEvent *)ep; a[1] = Make_Window (0, p->display, p->owner); a[2] = Make_Window (0, p->display, p->requestor); a[3] = Make_Atom (p->selection); a[4] = Make_Atom (p->target); a[5] = Make_Atom (p->property); a[6] = Get_Time_Arg (p->time); } break; case SelectionNotify: { register XSelectionEvent *p = (XSelectionEvent *)ep; a[1] = Make_Window (0, p->display, p->requestor); a[2] = Make_Atom (p->selection); a[3] = Make_Atom (p->target); a[4] = Make_Atom (p->property); a[5] = Get_Time_Arg (p->time); } break; case ColormapNotify: { register XColormapEvent *p = (XColormapEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Make_Colormap (0, p->display, p->colormap); a[3] = p->new ? S48_TRUE : S48_FALSE; a[4] = p->state == ColormapInstalled ? S48_TRUE : S48_FALSE; } break; case ClientMessage: { register XClientMessageEvent *p = (XClientMessageEvent *)ep; register i; a[1] = Make_Window (0, p->display, p->window); a[2] = Make_Atom (p->message_type); switch (p->format) { case 8: a[3] = Make_String (p->data.b, 20); break; case 16: a[3] = s48_make_vector (10, S48_NULL); for (i = 0; i < 10; i++) S48_VECTOR_SET(a[3], i, s48_enter_integer (p->data.s[i]);) break; case 32: a[3] = s48_make_vector (5, S48_NULL); for (i = 0; i < 5; i++) S48_VECTOR_SET(a[3], i, s48_enter_integer (p->data.l[i]);) break; default: a[3] = s48_enter_integer (p->format); // ??? } } break; case MappingNotify: { register XMappingEvent *p = (XMappingEvent *)ep; a[1] = Make_Window (0, p->display, p->window); a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms); a[3] = s48_enter_integer (p->first_keycode); a[4] = s48_enter_integer (p->count); } break; } a[0] = Intern (Event_Table[e].name); for (vp = VECTOR(Argv)->data, i = 0; i < Event_Table[e].argc; i++) { if (i) vp++; S48_CAR (*vp) = a[i]; S48_CDR (*vp) = vp[1]; } S48_CDR (*vp) = S48_NULL; S48_GC_UNPROTECT; return Argl; } void Destroy_Event_Args (args) s48_value args; { s48_value t; for (t = args; !S48_NULL_P (t); t = S48_CDR (t)) S48_CAR (t) = S48_NULL; } */ /* Encode_Event (e) s48_value e; { s48_value s; register char *p; register struct event_desc *ep; register n; Check_Type (e, T_Symbol); s = s48_extract_string(S48_SYMBOL_TO_STRING(e)); p = STRING(s)->data; n = STRING(s)->size; for (ep = Event_Table; ep->name; ep++) if (n && strncmp (ep->name, p, n) == 0) break; if (ep->name == 0) Primitive_Error ("no such event: ~s", e); return ep-Event_Table; } static s48_value P_Get_Motion_Events (w, from, to) s48_value w, from, to; { XTimeCoord *p; int n; register i; s48_value e, ret; S48_DECLARE_GC_PROTECT(2); Check_Type (w, T_Window); p = XGetMotionEvents (WINDOW(w)->dpy, WINDOW(w)->win, Get_Time (from), Get_Time (to), &n); e = ret = s48_make_vector (n, S48_NULL); S48_GC_PROTECT_2 (ret, e); for (i = 0; i < n; i++) { e = P_Make_List (s48_enter_integer (3), S48_NULL); S48_VECTOR_SET(ret, i, e;) S48_CAR (e) = Get_Time_Arg (p[i].time); e = S48_CDR (e); S48_CAR (e) = s48_enter_integer (p[i].x); e = S48_CDR (e); S48_CAR (e) = s48_enter_integer (p[i].y); } S48_GC_UNPROTECT; XFree ((char *)p); return ret; } static s48_value P_Event_Listen (d, wait_flag) s48_value d, wait_flag; { Display *dpy; register n; XEvent e; Check_Type (d, T_Display); Check_Type (wait_flag, T_Boolean); dpy = DISPLAY(d)->dpy; n = XPending (dpy); if (n == 0 && S48_EQ_P(wait_flag, S48_TRUE)) { XPeekEvent (dpy, &e); n = XPending (dpy); } return s48_enter_integer (n); } elk_init_xlib_event () { s48_value t; register i; Argl = P_Make_List (s48_enter_integer (MAX_ARGS), S48_NULL); Global_S48_GC_PROTECT_1 (Argl); Argv = s48_make_vector (MAX_ARGS, S48_NULL); Global_S48_GC_PROTECT_1 (Argv); for (i = 0, t = Argl; i < MAX_ARGS; i++, t = S48_CDR (t)) S48_VECTOR_SET(Argv, i, t;) Define_Primitive (P_Handle_Events, "handle-events", 3, MANY, NOEVAL); Define_Primitive (P_Get_Motion_Events, "get-motion-events", 3, 3, EVAL); Define_Primitive (P_Event_Listen, "event-listen", 2, 2, EVAL); } */ void s48_init_event(void) { S48_EXPORT_FUNCTION(Next_Event); S48_EXPORT_FUNCTION(Peek_Event); S48_EXPORT_FUNCTION(Events_Pending); // Encode_Event // Get_Motion_Events ?? }