comparison src/xselect.c @ 2169:2484b562777f

entered into RCS

2168:af8f27940f79

      count = specpdl_ptr - specpdl;
      specbind (Qinhibit_quit, Qt);

      CHECK_SYMBOL (target_type, 0);
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
      if (NILP (handler_fn)) return Qnil;
      value = call3 (handler_fn,
		     selection_symbol, target_type,
		     XCONS (XCONS (local_value)->cdr)->car);
      unbind_to (count, Qnil);
    }

  /* Make sure this value is of a type that we could transmit
     to another X client.  */
  check = value;
  if (CONSP (value)
      && SYMBOLP (XCONS (value)->car))
    type = XCONS (value)->car,
    check = XCONS (value)->cdr;

      || VECTORP (check)
      || SYMBOLP (check)
      || INTEGERP (check)
      || NILP (value))
    return value;
  else if (CONSP (check)
	   && INTEGERP (XCONS (check)->car)
	   && (INTEGERP (XCONS (check)->cdr)
	       ||
	       (CONSP (XCONS (check)->cdr)

		&& NILP (XCONS (XCONS (check)->cdr)->cdr))))
    return value;
  else
    return
      Fsignal (Qerror,
	       Fcons (build_string ("unrecognised selection-conversion type"),
		      Fcons (handler_fn, Fcons (value, Qnil))));
}

/* Subroutines of x_reply_selection_request.  */

    type_atom = symbol_to_x_atom (display, target_type);

  BLOCK_INPUT;
  XConvertSelection (display, selection_atom, type_atom, target_property,
		     requestor_window, requestor_time);

  /* Prepare to block until the reply has been read.  */
  reading_selection_window = requestor_window;
  reading_which_selection = selection_atom;
  XCONS (reading_selection_reply)->car = Qnil;

      *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
      (*data_ret) [sizeof (short)] = 0;
      (*(short **) data_ret) [0] = (short) XINT (obj);
      if (NILP (type)) type = QINTEGER;
    }
  else if (INTEGERP (obj) || CONSP (obj))
    {
      *format_ret = 32;
      *size_ret = 1;
      *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
      (*data_ret) [sizeof (long)] = 0;

  2, 2, 0,
  "Assert an X selection of the given TYPE with the given VALUE.\n\
TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
VALUE is typically a string, or a cons of two markers, but may be\n\
anything that the functions on selection-converter-alist know about.")
  (selection_name, selection_value)
     Lisp_Object selection_name, selection_value;
{
  CHECK_SYMBOL (selection_name, 0);
  if (NILP (selection_value)) error ("selection-value may not be nil.");

DEFUN ("x-get-selection-internal",
  Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
  "Return text selected from some X window.\n\
SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
TYPE is the type of data desired, typically STRING.")
  (selection_symbol, target_type)
     Lisp_Object selection_symbol, target_type;
{
  Lisp_Object val = Qnil;
  struct gcpro gcpro1, gcpro2;

  return val;
}

DEFUN ("x-disown-selection-internal",
  Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
  "If we own the named selection, then disown it (make there be no selection).")
  (selection, time)
     Lisp_Object selection;
     Lisp_Object time;
{
  Display *display = x_current_display;

  x_handle_selection_clear (&event);

  return Qt;
}


DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
  0, 1, 0,
  "Whether the current emacs process owns the given X Selection.\n\
The arg should be the name of the selection in question, typically one of\n\
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
For convenience, the symbol nil is the same as `PRIMARY',\n\
and t is the same as `SECONDARY'.)")

  UNBLOCK_INPUT;
  cut_buffers_initialized = 1;
}


#define CHECK_CUTBUFFER(symbol,n)					\
  { CHECK_SYMBOL ((symbol), (n));					\
    if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1)	\
	&& !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3)	\
	&& !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5)	\
	&& !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7))	\
      Fsignal (Qerror,							\
	       Fcons (build_string ("doesn't name a cutbuffer"),	\
			     Fcons ((symbol), Qnil)));			\
  }

DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal,
  Sx_get_cutbuffer_internal, 1, 1, 0,
  "Returns the value of the named cutbuffer (typically CUT_BUFFER0).")
  (buffer)
     Lisp_Object buffer;
{
  Display *display = x_current_display;
  Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
  Atom buffer_atom;
  unsigned char *data;
  int bytes;
  Atom type;
  int format;
  unsigned long size;
  Lisp_Object ret;

  CHECK_CUTBUFFER (buffer, 0);
  buffer_atom = symbol_to_x_atom (display, buffer);

  x_get_window_property (display, window, buffer_atom, &data, &bytes,
			 &type, &format, &size, 0);
  if (!data) return Qnil;

  xfree (data);
  return ret;
}


DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal,
  Sx_store_cutbuffer_internal, 2, 2, 0,
  "Sets the value of the named cutbuffer (typically CUT_BUFFER0).")
  (buffer, string)
     Lisp_Object buffer, string;
{
  Display *display = x_current_display;
  Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
  Atom buffer_atom;
  unsigned char *data;
  int bytes;
  int bytes_remaining;
  int max_bytes = SELECTION_QUANTUM (display);
  if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;

  CHECK_CUTBUFFER (buffer, 0);
  CHECK_STRING (string, 0);
  buffer_atom = symbol_to_x_atom (display, buffer);
  data = (unsigned char *) XSTRING (string)->data;
  bytes = XSTRING (string)->size;
  bytes_remaining = bytes;

  UNBLOCK_INPUT;
  return string;
}


DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal,
  Sx_rotate_cutbuffers_internal, 1, 1, 0,
  "Rotate the values of the cutbuffers by the given number of steps;\n\
positive means move values forward, negative means backward.")
  (n)
     Lisp_Object n;
{
  Display *display = x_current_display;
  Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
  Atom props [8];

  CHECK_NUMBER (n, 0);
  if (XINT (n) == 0) return n;
  if (! cut_buffers_initialized) initialize_cut_buffers (display, window);

}

void
syms_of_xselect ()
{
  atoms_of_xselect ();

  defsubr (&Sx_get_selection_internal);
  defsubr (&Sx_own_selection_internal);
  defsubr (&Sx_disown_selection_internal);
  defsubr (&Sx_selection_owner_p);
  defsubr (&Sx_selection_exists_p);

#ifdef CUT_BUFFER_SUPPORT
  defsubr (&Sx_get_cutbuffer_internal);
  defsubr (&Sx_store_cutbuffer_internal);
  defsubr (&Sx_rotate_cutbuffers_internal);
  cut_buffers_initialized = 0;
#endif

  reading_selection_reply = Fcons (Qnil, Qnil);
  staticpro (&reading_selection_reply);

2169:2484b562777f

      count = specpdl_ptr - specpdl;
      specbind (Qinhibit_quit, Qt);

      CHECK_SYMBOL (target_type, 0);
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
      if (NILP (handler_fn))
	Fsignal (Qerror,
		 Fcons (build_string ("missing selection-conversion function"),
			Fcons (target_type, Fcons (value, Qnil))));
      value = call3 (handler_fn,
		     selection_symbol, target_type,
		     XCONS (XCONS (local_value)->cdr)->car);
      unbind_to (count, Qnil);
    }

  /* Make sure this value is of a type that we could transmit
     to another X client.  */

  check = value;
  if (CONSP (value)
      && SYMBOLP (XCONS (value)->car))
    type = XCONS (value)->car,
    check = XCONS (value)->cdr;

      || VECTORP (check)
      || SYMBOLP (check)
      || INTEGERP (check)
      || NILP (value))
    return value;
  /* Check for a value that cons_to_long could handle.  */
  else if (CONSP (check)
	   && INTEGERP (XCONS (check)->car)
	   && (INTEGERP (XCONS (check)->cdr)
	       ||
	       (CONSP (XCONS (check)->cdr)

		&& NILP (XCONS (XCONS (check)->cdr)->cdr))))
    return value;
  else
    return
      Fsignal (Qerror,
	       Fcons (build_string ("invalid data returned by selection-conversion function"),
		      Fcons (handler_fn, Fcons (value, Qnil))));
}

/* Subroutines of x_reply_selection_request.  */

    type_atom = symbol_to_x_atom (display, target_type);

  BLOCK_INPUT;
  XConvertSelection (display, selection_atom, type_atom, target_property,
		     requestor_window, requestor_time);
  XFlushQueue ();

  /* Prepare to block until the reply has been read.  */
  reading_selection_window = requestor_window;
  reading_which_selection = selection_atom;
  XCONS (reading_selection_reply)->car = Qnil;

      *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
      (*data_ret) [sizeof (short)] = 0;
      (*(short **) data_ret) [0] = (short) XINT (obj);
      if (NILP (type)) type = QINTEGER;
    }
  else if (INTEGERP (obj)
	   || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
	       && (INTEGERP (XCONS (obj)->cdr)
		   || (CONSP (XCONS (obj)->cdr)
		       && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
    {
      *format_ret = 32;
      *size_ret = 1;
      *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
      (*data_ret) [sizeof (long)] = 0;

  2, 2, 0,
  "Assert an X selection of the given TYPE with the given VALUE.\n\
TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
VALUE is typically a string, or a cons of two markers, but may be\n\
anything that the functions on `selection-converter-alist' know about.")
  (selection_name, selection_value)
     Lisp_Object selection_name, selection_value;
{
  CHECK_SYMBOL (selection_name, 0);
  if (NILP (selection_value)) error ("selection-value may not be nil.");

DEFUN ("x-get-selection-internal",
  Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
  "Return text selected from some X window.\n\
SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
TYPE is the type of data desired, typically `STRING'.")
  (selection_symbol, target_type)
     Lisp_Object selection_symbol, target_type;
{
  Lisp_Object val = Qnil;
  struct gcpro gcpro1, gcpro2;

  return val;
}

DEFUN ("x-disown-selection-internal",
  Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
  "If we own the selection SELECTION, disown it.\n\
Disowning it means there is no such selection.")
  (selection, time)
     Lisp_Object selection;
     Lisp_Object time;
{
  Display *display = x_current_display;

  x_handle_selection_clear (&event);

  return Qt;
}

/* Get rid of all the selections in buffer BUFFER.
   This is used when we kill a buffer.  */

void
x_disown_buffer_selections (buffer)
     Lisp_Object buffer;
{
  Lisp_Object tail;
  struct buffer *buf = XBUFFER (buffer);

  for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
    {
      Lisp_Object elt, value;
      elt = XCONS (tail)->car;
      value = XCONS (elt)->cdr;
      if (CONSP (value) && MARKERP (XCONS (value)->car)
	  && XMARKER (XCONS (value)->car)->buffer == buf)
	Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
    }
}

DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
  0, 1, 0,
  "Whether the current Emacs process owns the given X Selection.\n\
The arg should be the name of the selection in question, typically one of\n\
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
For convenience, the symbol nil is the same as `PRIMARY',\n\
and t is the same as `SECONDARY'.)")

  UNBLOCK_INPUT;
  cut_buffers_initialized = 1;
}


#define CHECK_CUT_BUFFER(symbol,n)					\
  { CHECK_SYMBOL ((symbol), (n));					\
    if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1)	\
	&& !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3)	\
	&& !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5)	\
	&& !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7))	\
      Fsignal (Qerror,							\
	       Fcons (build_string ("doesn't name a cut buffer"),	\
			     Fcons ((symbol), Qnil)));			\
  }

DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
  Sx_get_cut_buffer_internal, 1, 1, 0,
  "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
  (buffer)
     Lisp_Object buffer;
{
  Display *display = x_current_display;
  Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
  Atom buffer_atom;
  unsigned char *data;
  int bytes;
  Atom type;
  int format;
  unsigned long size;
  Lisp_Object ret;

  CHECK_CUT_BUFFER (buffer, 0);
  buffer_atom = symbol_to_x_atom (display, buffer);

  x_get_window_property (display, window, buffer_atom, &data, &bytes,
			 &type, &format, &size, 0);
  if (!data) return Qnil;

  xfree (data);
  return ret;
}


DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
  Sx_store_cut_buffer_internal, 2, 2, 0,
  "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
  (buffer, string)
     Lisp_Object buffer, string;
{
  Display *display = x_current_display;
  Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
  Atom buffer_atom;
  unsigned char *data;
  int bytes;
  int bytes_remaining;
  int max_bytes = SELECTION_QUANTUM (display);
  if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;

  CHECK_CUT_BUFFER (buffer, 0);
  CHECK_STRING (string, 0);
  buffer_atom = symbol_to_x_atom (display, buffer);
  data = (unsigned char *) XSTRING (string)->data;
  bytes = XSTRING (string)->size;
  bytes_remaining = bytes;

  UNBLOCK_INPUT;
  return string;
}


DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
  Sx_rotate_cut_buffers_internal, 1, 1, 0,
  "Rotate the values of the cut buffers by the given number of steps;\n\
positive means move values forward, negative means backward.")
  (n)
     Lisp_Object n;
{
  Display *display = x_current_display;
  Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
  Atom props [8];

  CHECK_NUMBER (n, 0);
  if (XINT (n) == 0) return n;
  if (! cut_buffers_initialized) initialize_cut_buffers (display, window);

}

void
syms_of_xselect ()
{
  defsubr (&Sx_get_selection_internal);
  defsubr (&Sx_own_selection_internal);
  defsubr (&Sx_disown_selection_internal);
  defsubr (&Sx_selection_owner_p);
  defsubr (&Sx_selection_exists_p);

#ifdef CUT_BUFFER_SUPPORT
  defsubr (&Sx_get_cut_buffer_internal);
  defsubr (&Sx_store_cut_buffer_internal);
  defsubr (&Sx_rotate_cut_buffers_internal);
  cut_buffers_initialized = 0;
#endif

  reading_selection_reply = Fcons (Qnil, Qnil);
  staticpro (&reading_selection_reply);