/* X Selection processing for Emacs.
Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
+static Lisp_Object x_catch_errors_unwind P_ ((Lisp_Object));
static void x_reply_selection_request P_ ((struct input_event *, int,
unsigned char *, int, Atom));
static int waiting_for_other_props_on_window P_ ((Display *, Window));
static Lisp_Object Vx_lost_selection_functions;
static Lisp_Object Vx_sent_selection_functions;
-/* Coding system for communicating with other X clients via cutbuffer,
- selection, and clipboard. */
-static Lisp_Object Vselection_coding_system;
-
-/* Coding system for the next communicating with other X clients. */
-static Lisp_Object Vnext_selection_coding_system;
-
static Lisp_Object Qforeign_selection;
/* If this is a smaller number than the max-request-size of the display,
incremental transfer stuff, but it might improve server performance. */
#define MAX_SELECTION_QUANTUM 0xFFFFFF
-#ifdef HAVE_X11R4
#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
-#else
-#define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
-#endif
/* The timestamp of the last input event Emacs received from the X server. */
/* Defined in keyboard.c. */
Time time = last_event_timestamp;
Atom selection_atom;
struct x_display_info *dpyinfo;
- int count;
if (! FRAME_X_P (sf))
return;
selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
BLOCK_INPUT;
- count = x_catch_errors (display);
+ x_catch_errors (display);
XSetSelectionOwner (display, selection_atom, selecting_window, time);
x_check_errors (display, "Can't set selection: %s");
- x_uncatch_errors (display, count);
+ x_uncatch_errors ();
UNBLOCK_INPUT;
/* Now update the local cache */
if (!NILP (prev_value))
{
Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
if (EQ (prev_value, Fcar (XCDR (rest))))
{
XSETCDR (rest, Fcdr (XCDR (rest)));
&& INTEGERP (XCAR (XCDR (check)))
&& NILP (XCDR (XCDR (check))))))
return value;
- else
- return
- Fsignal (Qerror,
- Fcons (build_string ("invalid data returned by selection-conversion function"),
- Fcons (handler_fn, Fcons (value, Qnil))));
+
+ signal_error ("Invalid data returned by selection-conversion function",
+ list2 (handler_fn, value));
}
\f
/* Subroutines of x_reply_selection_request. */
struct input_event *event;
{
XSelectionEvent reply;
- int count;
reply.type = SelectionNotify;
reply.display = SELECTION_EVENT_DISPLAY (event);
/* The reason for the error may be that the receiver has
died in the meantime. Handle that case. */
BLOCK_INPUT;
- count = x_catch_errors (reply.display);
+ x_catch_errors (reply.display);
XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
XFlush (reply.display);
- x_uncatch_errors (reply.display, count);
+ x_uncatch_errors ();
UNBLOCK_INPUT;
}
x_decline_selection_request (x_selection_current_request);
return Qnil;
}
+
+static Lisp_Object
+x_catch_errors_unwind (dummy)
+ Lisp_Object dummy;
+{
+ BLOCK_INPUT;
+ x_uncatch_errors ();
+ UNBLOCK_INPUT;
+ return Qnil;
+}
\f
/* This stuff is so that INCR selections are reentrant (that is, so we can
DATA and SIZE describe the data to send, already converted.
FORMAT is the unit-size (in bits) of the data to be transmitted. */
+#ifdef TRACE_SELECTION
+static int x_reply_selection_request_cnt;
+#endif /* TRACE_SELECTION */
+
static void
x_reply_selection_request (event, format, data, size, type)
struct input_event *event;
int format_bytes = format/8;
int max_bytes = SELECTION_QUANTUM (display);
struct x_display_info *dpyinfo = x_display_info_for_display (display);
- int count;
+ int count = SPECPDL_INDEX ();
if (max_bytes > MAX_SELECTION_QUANTUM)
max_bytes = MAX_SELECTION_QUANTUM;
if (reply.property == None)
reply.property = reply.target;
- /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
BLOCK_INPUT;
- count = x_catch_errors (display);
+ /* The protected block contains wait_for_property_change, which can
+ run random lisp code (process handlers) or signal. Therefore, we
+ put the x_uncatch_errors call in an unwind. */
+ record_unwind_protect (x_catch_errors_unwind, Qnil);
+ x_catch_errors (display);
#ifdef TRACE_SELECTION
{
- static int cnt;
char *sel = XGetAtomName (display, reply.selection);
char *tgt = XGetAtomName (display, reply.target);
- TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
+ TRACE3 ("%s, target %s (%d)", sel, tgt, ++x_reply_selection_request_cnt);
if (sel) XFree (sel);
if (tgt) XFree (tgt);
}
break;
/* Now wait for the requester to ack this chunk by deleting the
- property. This can run random lisp code or signal. */
+ property. This can run random lisp code or signal. */
TRACE1 ("Waiting for increment ACK (deletion of %s)",
XGetAtomName (display, reply.property));
wait_for_property_change (wait_object);
UNBLOCK to enter the event loop and get possible errors delivered,
and then BLOCK again because x_uncatch_errors requires it. */
BLOCK_INPUT;
- x_uncatch_errors (display, count);
+ /* This calls x_uncatch_errors. */
+ unbind_to (count, Qnil);
UNBLOCK_INPUT;
}
\f
Atom type;
int nofree;
+ if (CONSP (converted_selection) && NILP (XCDR (converted_selection)))
+ {
+ x_decline_selection_request (event);
+ goto DONE2;
+ }
+
lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
converted_selection,
&data, &type, &size, &format, &nofree);
if (!nofree)
xfree (data);
}
+
+ DONE2:
unbind_to (count, Qnil);
DONE:
TRACE0 ("x_handle_selection_clear");
+#ifdef MULTI_KBOARD
/* If the new selection owner is also Emacs,
don't clear the new selection. */
BLOCK_INPUT;
}
}
UNBLOCK_INPUT;
-
+#endif
+
selection_symbol = x_atom_to_symbol (display, selection);
local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
else
{
Lisp_Object rest;
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
if (EQ (local_selection_data, Fcar (XCDR (rest))))
{
XSETCDR (rest, Fcdr (XCDR (rest)));
}
/* Delete elements after the beginning of Vselection_alist. */
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
{
/* Let random Lisp code notice that the selection has been stolen. */
CHECK_VECTOR (vec2);
if (XVECTOR (vec2)->size != 2)
/* ??? Confusing error message */
- Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
- Fcons (vec2, Qnil)));
+ signal_error ("Vectors must be of length 2", vec2);
XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
= XVECTOR (vec2)->contents [0];
Atom selection_atom;
Atom type_atom;
int secs, usecs;
- int count;
+ int count = SPECPDL_INDEX ();
Lisp_Object frame;
if (! FRAME_X_P (sf))
BLOCK_INPUT;
- count = x_catch_errors (display);
+ /* The protected block contains wait_reading_process_output, which
+ can run random lisp code (process handlers) or signal.
+ Therefore, we put the x_uncatch_errors call in an unwind. */
+ record_unwind_protect (x_catch_errors_unwind, Qnil);
+ x_catch_errors (display);
TRACE2 ("Get selection %s, type %s",
XGetAtomName (display, type_atom),
TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
BLOCK_INPUT;
- x_check_errors (display, "Cannot get selection: %s");
- x_uncatch_errors (display, count);
+ if (x_had_errors_p (display))
+ error ("Cannot get selection");
+ /* This calls x_uncatch_errors. */
+ unbind_to (count, Qnil);
UNBLOCK_INPUT;
if (NILP (XCAR (reading_selection_reply)))
there_is_a_selection_owner
= XGetSelectionOwner (display, selection_atom);
UNBLOCK_INPUT;
- Fsignal (Qerror,
- there_is_a_selection_owner
- ? Fcons (build_string ("selection owner couldn't convert"),
- actual_type
- ? Fcons (target_type,
- Fcons (x_atom_to_symbol (display,
- actual_type),
- Qnil))
- : Fcons (target_type, Qnil))
- : Fcons (build_string ("no selection"),
- Fcons (x_atom_to_symbol (display,
- selection_atom),
- Qnil)));
+ if (there_is_a_selection_owner)
+ signal_error ("Selection owner couldn't convert",
+ actual_type
+ ? list2 (target_type,
+ x_atom_to_symbol (display, actual_type))
+ : target_type);
+ else
+ signal_error ("No selection",
+ x_atom_to_symbol (display, selection_atom));
}
if (actual_type == dpyinfo->Xatom_INCR)
}
}
- /* Convert a single 16 or small 32 bit number to a Lisp_Int.
- If the number is > 16 bits, convert it to a cons of integers,
- 16 bits in each half.
+ /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
+ If the number is 32 bits and won't fit in a Lisp_Int,
+ convert it to a cons of integers, 16 bits in each half.
*/
else if (format == 32 && size == sizeof (int))
return long_to_cons (((unsigned int *) data) [0]);
{
if (SCHARS (obj) < SBYTES (obj))
/* OBJ is a multibyte string containing a non-ASCII char. */
- Fsignal (Qerror, /* Qselection_error */
- Fcons (build_string
- ("Non-ASCII string must be encoded in advance"),
- Fcons (obj, Qnil)));
+ signal_error ("Non-ASCII string must be encoded in advance", obj);
if (NILP (type))
type = QSTRING;
*format_ret = 8;
(*(Atom **) data_ret) [i]
= symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
else
- Fsignal (Qerror, /* Qselection_error */
- Fcons (build_string
- ("all elements of selection vector must have same type"),
- Fcons (obj, Qnil)));
+ signal_error ("All elements of selection vector must have same type", obj);
}
#if 0 /* #### MULTIPLE doesn't work yet */
else if (VECTORP (XVECTOR (obj)->contents [0]))
{
Lisp_Object pair = XVECTOR (obj)->contents [i];
if (XVECTOR (pair)->size != 2)
- Fsignal (Qerror,
- Fcons (build_string
- ("elements of the vector must be vectors of exactly two elements"),
- Fcons (pair, Qnil)));
+ signal_error (
+ "Elements of the vector must be vectors of exactly two elements",
+ pair);
(*(Atom **) data_ret) [i * 2]
= symbol_to_x_atom (dpyinfo, display,
XVECTOR (pair)->contents [1]);
}
else
- Fsignal (Qerror,
- Fcons (build_string
- ("all elements of the vector must be of the same type"),
- Fcons (obj, Qnil)));
+ signal_error ("All elements of the vector must be of the same type",
+ obj);
}
#endif
if (CONSP (XVECTOR (obj)->contents [i]))
*format_ret = 32;
else if (!INTEGERP (XVECTOR (obj)->contents [i]))
- Fsignal (Qerror, /* Qselection_error */
- Fcons (build_string
- ("elements of selection vector must be integers or conses of integers"),
- Fcons (obj, Qnil)));
+ signal_error (/* Qselection_error */
+ "Elements of selection vector must be integers or conses of integers",
+ obj);
/* Use sizeof(long) even if it is more than 32 bits. See comment
in x_get_window_property and x_fill_property_data. */
}
}
else
- Fsignal (Qerror, /* Qselection_error */
- Fcons (build_string ("unrecognized selection data"),
- Fcons (obj, Qnil)));
+ signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
*type_ret = symbol_to_x_atom (dpyinfo, display, type);
}
#define CHECK_CUT_BUFFER(symbol) \
- { CHECK_SYMBOL ((symbol)); \
+ do { CHECK_SYMBOL ((symbol)); \
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))); \
- }
+ signal_error ("Doesn't name a cut buffer", (symbol)); \
+ } while (0)
DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
Sx_get_cut_buffer_internal, 1, 1, 0,
return Qnil;
if (format != 8 || type != XA_STRING)
- Fsignal (Qerror,
- Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
- Fcons (x_atom_to_symbol (display, type),
- Fcons (make_number (format), Qnil))));
+ signal_error ("Cut buffer doesn't contain 8-bit data",
+ list2 (x_atom_to_symbol (display, type),
+ make_number (format)));
ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
/* Use xfree, not XFree, because x_get_window_property
struct frame *f = check_x_frame (frame);
char *name = 0;
Lisp_Object ret = Qnil;
- int count;
Display *dpy = FRAME_X_DISPLAY (f);
Atom atom;
+ int had_errors;
if (INTEGERP (value))
atom = (Atom) XUINT (value);
error ("Wrong type, value must be number or cons");
BLOCK_INPUT;
- count = x_catch_errors (dpy);
-
+ x_catch_errors (dpy);
name = atom ? XGetAtomName (dpy, atom) : "";
+ had_errors = x_had_errors_p (dpy);
+ x_uncatch_errors ();
- if (! x_had_errors_p (dpy))
+ if (!had_errors)
ret = make_string (name, strlen (name));
- x_uncatch_errors (dpy, count);
-
if (atom && name) XFree (name);
- if (NILP (ret)) ret = make_string ("", 0);
+ if (NILP (ret)) ret = empty_unibyte_string;
UNBLOCK_INPUT;
return ret;
}
-/* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
- TODO: Check if this client event really is a DND event? */
+DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom,
+ Sx_register_dnd_atom, 1, 2, 0,
+ doc: /* Request that dnd events are made for ClientMessages with ATOM.
+ATOM can be a symbol or a string. The ATOM is interned on the display that
+FRAME is on. If FRAME is nil, the selected frame is used. */)
+ (atom, frame)
+ Lisp_Object atom, frame;
+{
+ Atom x_atom;
+ struct frame *f = check_x_frame (frame);
+ size_t i;
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+
+
+ if (SYMBOLP (atom))
+ x_atom = symbol_to_x_atom (dpyinfo, FRAME_X_DISPLAY (f), atom);
+ else if (STRINGP (atom))
+ {
+ BLOCK_INPUT;
+ x_atom = XInternAtom (FRAME_X_DISPLAY (f), (char *) SDATA (atom), False);
+ UNBLOCK_INPUT;
+ }
+ else
+ error ("ATOM must be a symbol or a string");
+
+ for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
+ if (dpyinfo->x_dnd_atoms[i] == x_atom)
+ return Qnil;
+
+ if (dpyinfo->x_dnd_atoms_length == dpyinfo->x_dnd_atoms_size)
+ {
+ dpyinfo->x_dnd_atoms_size *= 2;
+ dpyinfo->x_dnd_atoms = xrealloc (dpyinfo->x_dnd_atoms,
+ sizeof (*dpyinfo->x_dnd_atoms)
+ * dpyinfo->x_dnd_atoms_size);
+ }
+
+ dpyinfo->x_dnd_atoms[dpyinfo->x_dnd_atoms_length++] = x_atom;
+ return Qnil;
+}
+
+/* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
int
x_handle_dnd_message (f, event, dpyinfo, bufp)
int x, y;
unsigned char *data = (unsigned char *) event->data.b;
int idata[5];
+ size_t i;
+
+ for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
+ if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
+
+ if (i == dpyinfo->x_dnd_atoms_length) return 0;
XSETFRAME (frame, f);
}
vec = Fmake_vector (make_number (4), Qnil);
- AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
- event->message_type));
- AREF (vec, 1) = frame;
- AREF (vec, 2) = make_number (event->format);
- AREF (vec, 3) = x_property_data_to_lisp (f,
- data,
- event->message_type,
- event->format,
- size);
+ ASET (vec, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
+ event->message_type)));
+ ASET (vec, 1, frame);
+ ASET (vec, 2, make_number (event->format));
+ ASET (vec, 3, x_property_data_to_lisp (f,
+ data,
+ event->message_type,
+ event->format,
+ size));
mouse_position_for_drop (f, &x, &y);
bufp->kind = DRAG_N_DROP_EVENT;
Lisp_Object cons;
int size;
struct frame *f = check_x_frame (from);
- int count;
int to_root;
CHECK_STRING (message_type);
the destination window. But if we are sending to the root window,
there is no such client. Then we set the event mask to 0xffff. The
event then goes to clients selecting for events on the root window. */
- count = x_catch_errors (dpyinfo->display);
+ x_catch_errors (dpyinfo->display);
{
int propagate = to_root ? False : True;
unsigned mask = to_root ? 0xffff : 0;
XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
XFlush (dpyinfo->display);
}
- x_uncatch_errors (dpyinfo->display, count);
+ x_uncatch_errors ();
UNBLOCK_INPUT;
return Qnil;
defsubr (&Sx_get_atom_name);
defsubr (&Sx_send_client_message);
+ defsubr (&Sx_register_dnd_atom);
reading_selection_reply = Fcons (Qnil, Qnil);
staticpro (&reading_selection_reply);
it merely informs you that they have happened. */);
Vx_sent_selection_functions = Qnil;
- DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
- doc: /* Coding system for communicating with other X clients.
-When sending or receiving text via cut_buffer, selection, and clipboard,
-the text is encoded or decoded by this coding system.
-The default value is `compound-text-with-extensions'. */);
- Vselection_coding_system = intern ("compound-text-with-extensions");
-
- DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
- doc: /* Coding system for the next communication with other X clients.
-Usually, `selection-coding-system' is used for communicating with
-other X clients. But, if this variable is set, it is used for the
-next communication only. After the communication, this variable is
-set to nil. */);
- Vnext_selection_coding_system = Qnil;
-
DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
doc: /* Number of milliseconds to wait for a selection reply.
If the selection owner doesn't reply in this time, we give up.
HCoop / bpt / emacs.git / blobdiff