/* Source code copyright 1989 by Alan M. Carroll, all rights reserved.
 * This code may be freely distributed as long as the copyright is preserved.
 */
/* Code for Elisp event handling */

#include <stdio.h>
#undef NULL

#include <signal.h>
#include <sys/ioctl.h>
/* load sys/types.h, but make sure we haven't done it twice */
#ifndef makedev
#include <sys/types.h>
#endif

#include "config.h"
#include "lisp.h"
#include "x11term.h"

#include "screen.h"
#include "screenX.h"

#include "xresource.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;
#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
ReadPropertyEvent(pe,xs)
        XPropertyEvent *pe;
        struct X_Screen *xs;
    {
    Lisp_Object result,value;
    char * atom_name,lookup=0;
    BLOCK_INPUT_DECLARE();

    if (!NULL(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)
        XMotionEvent *me;
        struct X_Screen *xs;
    {
    int cx,cy;                          /* character locations */

    cx = (me->x - xs->in_border) / xs->font_width;
    cy = (me->y - xs->in_border) / xs->font_height;

    return Fcons(make_number(cx),
                 Fcons(make_number(cy),
                       Fcons(make_number(me->state),Qnil)));

    }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static Lisp_Object
ReadButtonEvent(be,xs)
        XButtonEvent *be;
        struct X_Screen *xs;
    {
    int cx,cy;                          /* character locations */

    cx = (be->x - xs->in_border) / xs->font_width;
    cy = (be->y - xs->in_border) / xs->font_height;

    return Fcons(be->type == ButtonPress ? Qt : Qnil,
                 Fcons(make_number(cx),
                       Fcons(make_number(cy),
                             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
 */
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 3-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") ()
{
  /*
    Lisp_Object evarray = Fmake_vector(make_number(3),Qnil);
    struct Lisp_Vector *evp = XVECTOR(evarray);
    */
  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(3,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);

  switch (xp->xany.type)
    {
    case PropertyNotify :
      evp->contents[0] = Qx_property_change;
      evp->contents[1] = ReadPropertyEvent((XPropertyEvent *)xp,xs);
      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);
      break;

    case ButtonPress :
    case ButtonRelease :
      evp->contents[0] = Qx_button;
      evp->contents[1] = ReadButtonEvent((XButtonEvent *)xp,xs);
      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 (NULL(Vepoch_event)) return 0; /* no valid events */
  if (NULL(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);

#ifdef DENYS_ALARM
    Qx_timer = intern("timer");                         staticpro(&Qx_timer);
#endif /* DENYS_ALARM */
    }
