/*
 * Epoch 4.0: X-window selection handling
 */

/*
 * $Revision: 1.13 $
 * $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/selection.c,v $
 * $Date: 92/07/11 21:32:05 $
 * $Author: marca $
 */
#ifndef LINT
static char rcsid[] = "$Author: marca $ $Date: 92/07/11 21:32:05 $ $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/selection.c,v $ $Revision: 1.13 $";
#endif

#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
#ifndef __convex__
#include <memory.h>
#endif /* Convex */

#include "config.h"
#include "lisp.h"
#include "x11term.h"
#include "screen.h"
#include "screenX.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 int XD_plane;
extern Atom XA_targets;
extern Atom XA_text;
extern Atom XA_length;
extern Atom XA_list_length;
extern Atom XA_clipboard;

Lisp_Object Vepoch_selection_alist;
Lisp_Object Vconvert_selection_hook;
int Vselection_timeout;

/* Global variables used in converting selection values
 */
Window selection_screen;
Atom selection_selection;
Lisp_Object selection_value;
char selection_available;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::get-selection-owner",Fepoch_get_selection_owner,Sepoch_get_selection_owner,1,1,0,
       "Return owner of SELECTION as an X Resource of type Window.  Return\
nil if owner couldn't be found or selection is unowned.")

	(selection) Lisp_Object selection;
{
  struct Lisp_Xresource *xr;
  Window owner;
  Atom select;
  BLOCK_INPUT_DECLARE();

  if (XTYPE(selection) == Lisp_String)
    {
      BLOCK_INPUT ();
      select = XInternAtom(XD_display,XSTRING(selection)->data,False);
      UNBLOCK_INPUT ();
    }
  else if (XRESOURCEP(selection))
    {
      if (XXRESOURCE(selection)->type != XA_ATOM)
	error("Selection must be an ATOM X-resource");
      select = XXRESOURCE(selection)->id;
    }
  else
    error("Selection must be a string or X-resource ATOM");

  if (select == None) return Qnil;

  /* We've got selection as an atom; now find owner */
 
  BLOCK_INPUT();
  owner = XGetSelectionOwner(XD_display, select);
  UNBLOCK_INPUT();

  if (owner == None) return Qnil;
  
  return make_Xresource(XD_display,XD_plane,owner,XA_WINDOW);
}

DEFUN ("epoch::acquire-selection",Fepoch_acquire_selection,Sepoch_acquire_selection,1,2,0,
       "Assert ownership of SELECTION.  Returns X id of SCREEN (or current\
screen) if successful, nil if error.  Sets ownership to None if SCREEN is t.")
     (selection,seq) Lisp_Object selection;
{
  Lisp_Object block;
  struct Lisp_Xresource *xr;
  Atom select;
  Window win, own, owner;
  Display *dpy;
  int plane;
  XEvent ev;
  BLOCK_INPUT_DECLARE();

 if (XRESOURCEP(seq))
    {
      if (XXRESOURCE(seq)->type != XA_WINDOW)
	error("Screen resource must be of type WINDOW");
      dpy = XXRESOURCE(seq)->dpy;
      win = XXRESOURCE(seq)->id;
      plane = XXRESOURCE(seq)->plane;
    }
  else
    {
      if (EQ(seq,Qt))
	block = find_block(Qnil);
      else
	block = find_block(seq);
      if (NIL(block)) return Qnil;
      dpy = XXSCREEN(XROOT(block)->x11)->display;
      win = XXSCREEN(XROOT(block)->x11)->xid;
      plane = XXSCREEN(XROOT(block)->x11)->plane;
    }
  own = win;			/* default - set ownership to window */
  if (EQ(seq,Qt))
    own = None;			/* set ownership to None */
  
  if (XTYPE(selection) == Lisp_String)
    {
      BLOCK_INPUT ();
      select = XInternAtom(dpy,XSTRING(selection)->data,False);
      UNBLOCK_INPUT ();
    }
  else if (XRESOURCEP(selection))
    {
      if (XXRESOURCE(selection)->type != XA_ATOM)
	error("Selection must be an ATOM X-resource");
      select = XXRESOURCE(selection)->id;
    }
  else
    error("Selection must be a string or X-resource ATOM");

  if (select == None) return Qnil;

  /*
   * ICCCM:  set ownership request should verify success.
   */
  BLOCK_INPUT();
  XSetSelectionOwner(dpy, select, own, CurrentTime);
  owner = XGetSelectionOwner(dpy, select);
  UNBLOCK_INPUT();
  if (owner != own) return Qnil;

  if (own == None)
    {
      /* NOTE:  It is not clear that this is proper, but on every platform
       * tested, the current owner does *not* get a SelectionClear event
       * if the selection's owner is set to None.  This is bogus.
       * Fake a selection-clear event to Epoch; this will generate the
       * selection-clear event in the event handler.  Elisp handler will
       * have to check for the selection name atom.
       */
      
      ev.type = SelectionClear;
      ev.xselectionclear.window = win;
      ev.xselectionclear.selection = select;
      ev.xselectionclear.time = CurrentTime;

      x_queue_event(&ev);
      
      return Qnil;
    }
  
  return make_Xresource(dpy,plane,win,XA_WINDOW);  
}

DEFUN ("epoch::convert-selection",Fepoch_convert_selection,Sepoch_convert_selection,3,4,0,
       "Request that value of SELECTION be converted to X Resource of TYPE,\
and stored in PROPERTY.  Hang property on SCREEN, or current window if nil.")

	(selection,type,property,seq) Lisp_Object selection,type,property,seq;

{
  Lisp_Object block;
  Atom select;
  Atom typ;
  Atom prop;
  Window win, owner;
  Display *dpy;
  BLOCK_INPUT_DECLARE();

  if (XRESOURCEP(seq))
    {
      if (XXRESOURCE(seq)->type != XA_WINDOW)
	error("Screen resource must be of type window");
      dpy = XXRESOURCE(seq)->dpy;
      win = XXRESOURCE(seq)->id;
    }
  else
    {
      block = find_block(seq);
      if (NIL(block)) return Qnil;
      dpy = XXSCREEN(XROOT(block)->x11)->display;
      win = XXSCREEN(XROOT(block)->x11)->xid;
    }

  if (XTYPE(selection) == Lisp_String)
    {
      BLOCK_INPUT ();
      select = XInternAtom(dpy,XSTRING(selection)->data,False);
      UNBLOCK_INPUT ();
    }
  else if (XRESOURCEP(selection))
    {
      if (XXRESOURCE(selection)->type != XA_ATOM)
	error("Selection must be an ATOM X-resource");
      select = XXRESOURCE(selection)->id;
    }
  else
    error("Selection must be a string or X-resource ATOM");

  if (XTYPE(type) == Lisp_String)
    {
      BLOCK_INPUT ();
      typ = XInternAtom(dpy,XSTRING(type)->data,True);
      UNBLOCK_INPUT ();
    }
  else if (XRESOURCEP(type))
    {
      if (XXRESOURCE(type)->type != XA_ATOM)
	error("Type must be an ATOM X-resource");
      typ = XXRESOURCE(type)->id;
    }
  else
    error("Type must be a string or X-resource ATOM");

  if (XTYPE(property) == Lisp_String)
    {
      BLOCK_INPUT ();
      prop = XInternAtom(dpy,XSTRING(property)->data,False);
      UNBLOCK_INPUT ();
    }
  else if (XRESOURCEP(property))
    {
      if (XXRESOURCE(property)->type != XA_ATOM)
	error("Property must be an ATOM X-resource");
      prop = XXRESOURCE(property)->id;
    }
  else
    error("Property must be a string or X-resource");

  if (select == None) return Qnil;

  /* If no one owns the selection, avoid the timeout altogether */
  BLOCK_INPUT();
  owner = XGetSelectionOwner(XD_display, select);
  UNBLOCK_INPUT();
  if (owner == None) return Qnil;

  if (x_find_screen(owner))
    {
      Lisp_Object key =
	make_Xresource(XD_display,XD_plane,select,XA_ATOM);
      /* Epoch owns the selection */
      selection_value = Fcdr(Fassoc(key,Vepoch_selection_alist));
      return selection_value;
    }
  selection_selection = select;
  selection_screen = win;
  selection_value = Qnil;
  selection_available = 0;

  XConvertSelection(dpy,select,typ,prop,win,CurrentTime);
  if (Vselection_timeout < 1) Vselection_timeout = 1;

  wait_reading_process_input(Vselection_timeout,-1,0,1);
  consume_available_input();
#if 0  
  wait_for_selection(Vselection_timeout);
#endif 
  return selection_value;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Handle conversion request of a selection owned by Epoch.  This is done
 * internally for standard types, in interest of quick turnaround.  Other
 * types can be handled by users.
 */
x_selection_request(ev)
     XSelectionRequestEvent *ev;
{
  Lisp_Object item,key,tar;
  XEvent mev;
  BLOCK_INPUT_DECLARE();
  struct gcpro gcpro1,gcpro2;

  GCPRO2(item,tar);

  key = make_Xresource(XD_display,XD_plane,ev->selection,XA_ATOM);
  item = Fcdr(Fassoc(key,Vepoch_selection_alist));
  if (NIL(item) && !NIL(Vconvert_selection_hook) &&
      ev->selection != XA_PRIMARY && ev->selection != XA_clipboard)
    {
      /* Call hook to get selection value. */
      tar = make_Xresource(XD_display,XD_plane,ev->target,XA_ATOM);
      item = call1(Vconvert_selection_hook,tar);
    }

  mev.type = SelectionNotify;
  mev.xselection.display = ev->display;	/* Set this */
  mev.xselection.requestor = ev->requestor;
  mev.xselection.selection = ev->selection;
  mev.xselection.target = ev->target;
  mev.xselection.time = ev->time;
  mev.xselection.property = ev->property;

  /* Handle possible conversion of button to string, etc. and ship out the
   * destination property.
   */  
  BLOCK_INPUT();
  if (ev->target == XA_targets)
    {
      /* ICCCM TARGETS request - return a list of supported types: XA_STRING
       */
      Atom t[4];
      t[0] = XA_STRING;
      t[1] = XA_text;
      t[2] = XA_length;
      t[3] = XA_list_length;
      XChangeProperty(XD_display,mev.xselection.requestor,
		      mev.xselection.property, XA_ATOM,
		      32, PropModeReplace, (char *) t, 4);
#ifndef SUNOS_5
      /* This may or may not be a good idea under SunOS 5 (Solaris). */
      XFlush(XD_display);
#endif
    }
  else if (ev->target == XA_length)
    {
      /* ICCCM LENGTH request - return a 32 bit integer - length of
       * selection value
       */      
      long x = (STRINGP(item)) ? XSTRING(item)->size : 1;

      XChangeProperty(XD_display,mev.xselection.requestor,
		      mev.xselection.property, XA_INTEGER,
		      32, PropModeReplace, (unsigned char *) &x, 1);
      XFlush(XD_display);
    }
  else if (ev->target == XA_list_length)
    {
      /* ICCCM LISTLENGTH request - return 32 bit integer - 1 */
      long x = 1;

      XChangeProperty(XD_display,mev.xselection.requestor,
		      mev.xselection.property, XA_INTEGER,
		      32, PropModeReplace, (unsigned char *) &x, 1);
      XFlush(XD_display);
    }
  else if (ev->target == XA_STRING || ev->target == XA_text)
    {
      /* STRING or TEXT conversion */

      if (mev.xselection.property == None) abort();
      if (STRINGP(item))
	{
	  XChangeProperty(mev.xselection.display,
			  mev.xselection.requestor,
			  mev.xselection.property,
			  XA_STRING,
			  8,
			  PropModeReplace,
			  XSTRING(item)->data,
			  strlen(XSTRING(item)->data) );
	  XFlush(XD_display);
	}
    }
  else
    {
      /* Conversion request of other/nonstandard type
       * Respond with property == None
       */
      mev.xselection.property = None;
    }

  UNGCPRO;

  XSendEvent(XD_display,mev.xselection.requestor,False,0,&mev);
  UNBLOCK_INPUT(); /* corresponding BLOCK_INPUT is way up there */
  
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 
void syms_of_selection()
{
  defsubr(&Sepoch_convert_selection);
  defsubr(&Sepoch_acquire_selection);
  defsubr(&Sepoch_get_selection_owner);

  DEFVAR_LISP("epoch::selection-alist", &Vepoch_selection_alist,
	      "Alist of selection atoms and data owned by epoch.");
  Vepoch_selection_alist = Qnil;

  DEFVAR_LISP("epoch::convert-selection-hook", &Vconvert_selection_hook,
	      "Hook to be called for selection conversion requests of\n\
Non-standard types");
  Vconvert_selection_hook = Qnil;

  DEFVAR_LISP("epoch::selection-timeout", &Vselection_timeout,
	      "Timeout in seconds to wait for selection request");
  Vselection_timeout = 2;
}