/* Source code copyright 1989 by Alan M. Carroll, all rights reserved. * This code may be freely distributed as long as the copyright is preserved. * * Epoch 4.0 : Code for Elisp event handling * * $Revision: 1.6 $ * $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/xevent.c,v $ * $Author: love $ * $Date: 91/10/16 16:22:07 $ */ #ifndef LINT static char rcsid[] = "$Author: love $ $Date: 91/10/16 16:22:07 $ $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/xevent.c,v $ $Revision: 1.6 $"; #endif #include #undef NULL #include #include /* load sys/types.h, but make sure we haven't done it twice */ #ifndef makedev #include #endif #include "config.h" #include "lisp.h" #include "x11term.h" #include "screen.h" #include "screenX.h" #include "screenW.h" #include "dispepoch.h" #include "button.h" #include "xresource.h" /* X11 includes used; use NIL rather than NULL from lisp.h */ extern int interrupt_input; extern Display *XD_display; extern Atom XA_current; /* current property atom */ extern Atom XA_screen_id; /* root block sequence # */ extern Lisp_Object ConvertXtoE(); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Q definitions */ #define EQSIZE 128 static XEvent eq[EQSIZE]; static int eqhead,eqtail; Lisp_Object Vx_event_handler; Lisp_Object Vepoch_event; int x_in_handler_hook; Lisp_Object Vx_event_handler_abort; Lisp_Object Vx_lazy_events; Lisp_Object Vx_mouse_events; Lisp_Object Qx_property_change,Qx_focus,Qx_map,Qx_move,Qx_resize; Lisp_Object Qx_client_message,Qx_motion,Qx_button; Lisp_Object Qx_selection_clear; Lisp_Object Qx_selection_request; Lisp_Object Qx_selection_notify; #ifdef DENYS_ALARM Lisp_Object Qx_timer; #endif /* DENYS_ALARM */ /* only need to GCPRO if we could hit eval or it's ilk. */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ int eqlength; #ifdef DENYS_MOTION_COMPRESSION void x_queue_event(p) XEvent *p; { /* if the queue is non empty and the last event is a motion event * and the event to be put in the queue is also a motion event, * then simply overwrite the previous motion event */ if (!eqlength || p->type != MotionNotify || eq[eqhead].type != MotionNotify) { eqhead = (eqhead+1)%EQSIZE; bcopy(p,eq+eqhead,sizeof(XEvent)); if (eqhead == eqtail) eqtail = (eqtail+1)%EQSIZE; else eqlength++; } else bcopy(p,eq+eqhead,sizeof(XEvent)); } #else /* not DENYS_MOTION_COMPRESSION */ void x_queue_event(p) XEvent *p; { eqhead = (eqhead+1)%EQSIZE; bcopy(p,eq+eqhead,sizeof(XEvent)); /* if we've wrapped, drop the oldest event */ if (eqhead == eqtail) eqtail = (eqtail+1)%EQSIZE; else eqlength += 1; } #endif /* not DENYS_MOTION_COMPRESSION */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object ReadConfigureEvent(ce,xs) XConfigureEvent *ce; struct X_Screen *xs; { Lisp_Object result; struct Lisp_Vector *v; if (ce->send_event == True) result = Fcons(make_number(ce->x),Fcons(make_number(ce->y),Qnil)); else result = Fcons(make_number(ce->width), Fcons(make_number(ce->height), Fcons(make_number(ce->border_width),Qnil))); return result; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object ReadClientMessage(cm,xs) XClientMessageEvent *cm; struct X_Screen *xs; { Lisp_Object result; result = Fcons(make_Xresource(xs->display,xs->plane, cm->message_type,XA_ATOM), Fcons(make_Xresource(xs->display,xs->plane, cm->window,XA_WINDOW), ConvertXtoE((VOID *)cm->data.b, /* data address */ (20*8)/cm->format, /* count */ cm->message_type, /* type */ cm->format) /* data format */ ) ); return result; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object ReadSelectionClear(sc,xs) XSelectionClearEvent *sc; struct X_Screen *xs; { Lisp_Object result; char *atom_name; BLOCK_INPUT_DECLARE (); if (!NIL(Vx_lazy_events)) result = make_Xresource(xs->display,xs->plane,sc->selection,XA_ATOM); else { BLOCK_INPUT(); atom_name = XGetAtomName(xs->display,sc->selection); UNBLOCK_INPUT(); /* didn't get a name, blow this one off */ if (atom_name == (char *)0) return Qnil; result = build_string(atom_name); XFree(atom_name); } return result; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object ReadPropertyEvent(pe,xs) XPropertyEvent *pe; struct X_Screen *xs; { Lisp_Object result,value; char * atom_name,lookup=0; BLOCK_INPUT_DECLARE(); if (!NIL(Vx_lazy_events)) return make_Xresource(xs->display,xs->plane,pe->atom,XA_ATOM); /* convert the atom to a string: check for known atoms */ if (pe->atom == XA_current) atom_name = XA_EPOCH_CURRENT; else if (pe->atom == XA_screen_id) atom_name = XA_EPOCH_SCREEN_ID; else { BLOCK_INPUT(); atom_name = XGetAtomName(xs->display,pe->atom); UNBLOCK_INPUT(); lookup = 1; } /* didn't get a name, blow this one off */ if (atom_name == (char *)0) return Qnil; value = raw_get_property(xs->display,xs->xid,pe->atom); result = Fcons(build_string(atom_name),value); if (lookup) XFree(atom_name); return result; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object ReadMotionEvent(me,xs,rb) XMotionEvent *me; struct X_Screen *xs; struct Root_Block *rb; { return Fcons(make_number(me->x), Fcons(make_number(me->y), Fcons(make_number(me->state),Qnil))); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object ReadButtonEvent(be,xs,rb) XButtonEvent *be; struct X_Screen *xs; struct Root_Block *rb; { return Fcons(be->type == ButtonPress ? Qt : Qnil, Fcons(make_number(be->x), Fcons(make_number(be->y), Fcons(make_number(be->button), Fcons(make_number(be->state),Qnil))))); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Returned value is a vector of size 3. The elements are * 0 : A symbol indicating the type of event * 1 : The value of the event (type dependent) * 2 : The screen the event relates to */ #define TIME_MODULO 8388607L /* 2^23 - 1 */ DEFUN ("epoch::get-event",Fget_event,Sget_event, 0,0,0, "Get the next X-window event off the queue.\ The returned value is nil or a 4-vector consisting of\n\ 0 : A symbol indicating the type of event\n\ 1 : The value of the event (type dependent)\n\ 2 : The screen the event occured on\n\ 3 : The X time stamp of the event modulo 2^23 - 1, (or nil)") () { Lisp_Object evarray; struct Lisp_Vector *evp; char * atom_name; struct X_Screen *xs; struct Root_Block *rb,*x_find_screen(); XEvent *xp; char found=0; BLOCK_INPUT_DECLARE (); /* make sure the epoch::event has a vector that's big enough */ if (XTYPE(Vepoch_event) != Lisp_Vector || XVECTOR(Vepoch_event)->size < 3) Vepoch_event = Fmake_vector(4,Qnil); evp = XVECTOR(Vepoch_event); BLOCK_INPUT (); /* let's not have race conditions */ while (!found && (eqhead != eqtail)) /* anything in the Q? */ { xp = eq + (eqtail = (eqtail+1)%EQSIZE); /* next entry */ eqlength -= 1; /* find the screen - if not there, blow off event */ rb = x_find_screen(xp->xany.window); if (rb) found = 1; } UNBLOCK_INPUT(); if (!found) return Qnil; xs = XXSCREEN(rb->x11); XSET(evp->contents[2],Lisp_Root_Block,rb); evp->contents[3] = Qnil; /* default - no valid timestamp */ switch (xp->xany.type) { case PropertyNotify : evp->contents[0] = Qx_property_change; evp->contents[1] = ReadPropertyEvent((XPropertyEvent *)xp,xs); evp->contents[3] = make_number(xp->xproperty.time); break; /* Focus and Leave/Enter events aren't queued unles they're * real focus changes */ case EnterNotify : case FocusIn : case LeaveNotify : case FocusOut : evp->contents[0] = Qx_focus; evp->contents[1] = (xp->xany.type == EnterNotify || xp->xany.type == FocusIn) ? Qt : Qnil; break; /* report screen mapping */ case MapNotify : case UnmapNotify : evp->contents[0] = Qx_map; evp->contents[1] = xp->xany.type == MapNotify ? Qt : Qnil; break; case ConfigureNotify : evp->contents[0] = xp->xany.send_event == True ? Qx_move : Qx_resize; evp->contents[1] = ReadConfigureEvent((XConfigureEvent *)xp,xs); break; case ClientMessage : evp->contents[0] = Qx_client_message; evp->contents[1] = ReadClientMessage((XClientMessageEvent *)xp,xs); break; case MotionNotify : evp->contents[0] = Qx_motion; evp->contents[1] = ReadMotionEvent((XMotionEvent *)xp,xs,rb); evp->contents[3] = make_number(xp->xmotion.time % TIME_MODULO); break; case SelectionClear : evp->contents[0] = Qx_selection_clear; evp->contents[1] = ReadSelectionClear((XSelectionClearEvent *)xp,xs); evp->contents[3] = make_number(xp->xselectionclear.time % TIME_MODULO); break; case ButtonPress : case ButtonRelease : evp->contents[0] = Qx_button; evp->contents[1] = ReadButtonEvent((XButtonEvent *)xp,xs,rb); evp->contents[3] = make_number(xp->xbutton.time % TIME_MODULO); break; } return evarray; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* this is a coed hook installed to process things while waiting for input * the other part of this is in process.c, in wait_reading_process_input * that function loops looking for input - this function is called every * loop. It must check to see if there is anything to do here */ static Lisp_Object x_reset_epoch_hook(ignored) Lisp_Object ignored; { if (x_in_handler_hook > 0) x_in_handler_hook -= 1; return Qnil; } int epoch_event_dispatch() { register int count = specpdl_ptr - specpdl; if (!eqlength) return 0; /* no events to process */ Fget_event(); /* look up the event */ if (NIL(Vepoch_event)) return 0; /* no valid events */ if (NIL(Vx_event_handler)) return 0; /* no function to call */ x_in_handler_hook += 1; record_unwind_protect (x_reset_epoch_hook,0); Ffuncall(1,&Vx_event_handler); unbind_to (count); XFlush(XD_display); return 1; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ void syms_of_xevent() { defsubr(&Sget_event); DEFVAR_LISP("epoch::event-handler",&Vx_event_handler, "If this variable is not nil, then it is assumed to have \ a function in it. When a property change on a screen is received, \ it is stored in an internal queue. Whenever the editor is waiting for \ input, and there are events in the queue, the function is called. \ Use *x-get-property-event* to retrieve the events." ); DEFVAR_LISP("epoch::event",&Vepoch_event, "Bound to the value of the current event when epoch::event-handler is called"); DEFVAR_LISP("epoch::event-handler-abort",&Vx_event_handler_abort, "If this variable is not nil, then any error in the X event handler\ will cause the variable epoch::event-handler to become nil, to prevent runaway\ error lockup. If epoch::event-handler-abort is nil, only the current\ call to the epoch::event-handler function will be aborted on error"); Vx_event_handler = Qnil; x_in_handler_hook = 0; Vx_event_handler_abort = Qt; DEFVAR_LISP("epoch::lazy-events",&Vx_lazy_events, "If this variable is non-nil, then the internal event code will do as little\ work as possible. For example, property events will only report the atom\ of the property changed, and leave it up to other code to acquire the value\ if desired. NOT INSTALLED YET"); Vx_lazy_events = Qnil; DEFVAR_LISP("epoch::mouse-events",&Vx_mouse_events, "If this variable is non-nil, then mouse events are placed into the Epoch\ event Q instead of generating fake key strokes"); Vx_mouse_events = Qnil; Qx_property_change = intern("property-change"); staticpro(&Qx_property_change); Qx_focus = intern("focus"); staticpro(&Qx_focus); Qx_map = intern("map"); staticpro(&Qx_map); Qx_move = intern("move"); staticpro(&Qx_move); Qx_resize = intern("resize"); staticpro(&Qx_resize); Qx_client_message = intern("client-message"); staticpro(&Qx_client_message); Qx_motion = intern("motion"); staticpro(&Qx_motion); Qx_button = intern("button"); staticpro(&Qx_button); Qx_selection_clear = intern("selection-clear"); staticpro(&Qx_selection_clear); Qx_selection_request = intern("selection-request"); staticpro(&Qx_selection_request); Qx_selection_notify = intern("selection-notify"); staticpro(&Qx_selection_notify); #ifdef DENYS_ALARM Qx_timer = intern("timer"); staticpro(&Qx_timer); #endif /* DENYS_ALARM */ }