-/* x_handle_selection_notify
-x_reply_selection_request
-XFree
-x_selection_timeout initial value */
-
/* X Selection processing for emacs
- Copyright (C) 1990-1993 Free Software Foundation.
+ Copyright (C) 1993 Free Software Foundation.
This file is part of GNU Emacs.
along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+/* x_handle_selection_notify
+x_reply_selection_request */
+
+
/* Rewritten by jwz */
#include "config.h"
#include "xterm.h" /* for all of the X includes */
#include "dispextern.h" /* frame.h seems to want this */
#include "frame.h" /* Need this to get the X window of selected_frame */
+#include "blockinput.h"
#define xfree free
*/
#define MAX_SELECTION_QUANTUM 0xFFFFFF
-#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
-
+#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. */
unsigned long last_event_timestamp;
Lisp_Object Vselection_converter_alist;
/* If the selection owner takes too long to reply to a selection request,
- we give up on it. This is in seconds (0 = no timeout.)
+ we give up on it. This is in milliseconds (0 = no timeout.)
*/
int x_selection_timeout;
UNBLOCK_INPUT;
return val;
}
-
-
-static Lisp_Object
-long_to_cons (i)
- unsigned long i;
-{
- unsigned int top = i >> 16;
- unsigned int bot = i & 0xFFFF;
- if (top == 0) return make_number (bot);
- if (top == 0xFFFF) return Fcons (make_number (-1), make_number (bot));
- return Fcons (make_number (top), make_number (bot));
-}
-
-static unsigned long
-cons_to_long (c)
- Lisp_Object c;
-{
- int top, bot;
- if (INTEGERP (c)) return XINT (c);
- top = XCONS (c)->car;
- bot = XCONS (c)->cdr;
- if (CONSP (bot)) bot = XCONS (bot)->car;
- return ((XINT (top) << 16) | XINT (bot));
-}
-
-
\f
/* Do protocol to assert ourself as a selection owner.
Update the Vselection_alist so that we can reply to later requests for
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);
+ if (!NILP (handler_fn))
+ value = call3 (handler_fn,
+ selection_symbol, target_type,
+ XCONS (XCONS (local_value)->cdr)->car);
+ else
+ value = Qnil;
unbind_to (count, Qnil);
}
/* #### XChangeProperty can generate BadAlloc, and we must handle it! */
- BLOCK_INPUT;
/* Store the data on the requested property.
If the selection is large, only store the first N bytes of it.
*/
#if 0
fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
#endif
+ BLOCK_INPUT;
XChangeProperty (display, window, reply.property, type, format,
PropModeReplace, data, size);
/* At this point, the selection was successfully stored; ack it. */
- (void) XSendEvent (display, window, False, 0L, (XEvent *) &reply);
+ XSendEvent (display, window, False, 0L, (XEvent *) &reply);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
}
else
{
/* Send an INCR selection. */
int prop_id;
+ BLOCK_INPUT;
+
if (x_window_to_frame (window)) /* #### debug */
error ("attempt to transfer an INCR to ourself!");
#if 0
XSelectInput (display, window, PropertyChangeMask);
/* Tell 'em the INCR data is there... */
(void) XSendEvent (display, window, False, 0L, (XEvent *) &reply);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
/* First, wait for the requestor to ack by deleting the property.
This can run random lisp code (process handlers) or signal. */
int i = ((bytes_remaining < max_bytes)
? bytes_remaining
: max_bytes);
+
+ BLOCK_INPUT;
+
prop_id = expect_property_change (display, window, reply.property,
PropertyDelete);
#if 0
PropModeAppend, data, i / format_bytes);
bytes_remaining -= i;
data += i;
+ XFlushQueue ();
+ UNBLOCK_INPUT;
/* Now wait for the requestor to ack this chunk by deleting the
property. This can run random lisp code or signal.
#if 0
fprintf (stderr," INCR done\n");
#endif
+ BLOCK_INPUT;
if (! waiting_for_other_props_on_window (display, window))
XSelectInput (display, window, 0L);
XChangeProperty (display, window, reply.property, type, format,
PropModeReplace, data, 0);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
}
- UNBLOCK_INPUT;
}
\f
/* Handle a SelectionRequest event EVENT.
struct input_event *event;
{
struct gcpro gcpro1, gcpro2, gcpro3;
- XSelectionEvent reply;
Lisp_Object local_selection_data = Qnil;
Lisp_Object selection_symbol;
Lisp_Object target_symbol = Qnil;
GCPRO3 (local_selection_data, converted_selection, target_symbol);
- reply.type = SelectionNotify; /* Construct the reply event */
- reply.display = SELECTION_EVENT_DISPLAY (event);
- reply.requestor = SELECTION_EVENT_REQUESTOR (event);
- reply.selection = SELECTION_EVENT_SELECTION (event);
- reply.time = SELECTION_EVENT_TIME (event);
- reply.target = SELECTION_EVENT_TARGET (event);
- reply.property = SELECTION_EVENT_PROPERTY (event);
- if (reply.property == None)
- reply.property = reply.target;
-
- selection_symbol = x_atom_to_symbol (reply.display,
+ selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
SELECTION_EVENT_SELECTION (event));
local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
-
-#if 0
-# define CDR(x) (XCONS (x)->cdr)
-# define CAR(x) (XCONS (x)->car)
- /* This list isn't user-visible, so it can't "go bad." */
- if (!CONSP (local_selection_data)) abort ();
- if (!CONSP (CDR (local_selection_data))) abort ();
- if (!CONSP (CDR (CDR (local_selection_data)))) abort ();
- if (!NILP (CDR (CDR (CDR (local_selection_data))))) abort ();
- if (!CONSP (CAR (CDR (CDR (local_selection_data))))) abort ();
- if (!INTEGERP (CAR (CAR (CDR (CDR (local_selection_data)))))) abort ();
- if (!INTEGERP (CDR (CAR (CDR (CDR (local_selection_data)))))) abort ();
-# undef CAR
-# undef CDR
-#endif
if (NILP (local_selection_data))
{
x_selection_current_request = event;
record_unwind_protect (x_selection_request_lisp_error, Qnil);
- target_symbol = x_atom_to_symbol (reply.display,
+ target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
SELECTION_EVENT_TARGET (event));
#if 0 /* #### MULTIPLE doesn't work yet */
unsigned int size;
int format;
Atom type;
- lisp_data_to_selection_data (reply.display, converted_selection,
- &data, &type, &size, &format);
+ int nofree;
+
+ lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
+ converted_selection,
+ &data, &type, &size, &format, &nofree);
x_reply_selection_request (event, format, data, size, type);
successful_p = Qt;
/* Indicate we have successfully processed this event. */
x_selection_current_request = 0;
- xfree (data);
+ if (!nofree)
+ xfree (data);
}
unbind_to (count, Qnil);
be servicing multiple INCR selection requests simultaneously.) I haven't
actually tested that yet. */
-static int prop_location_tick;
+static int prop_location_identifier;
static Lisp_Object property_change_reply;
-static int property_change_reply_tick;
+static int property_change_reply_identifier;
/* Keep a list of the property changes that are awaited. */
struct prop_location
{
- int tick;
+ int identifier;
Display *display;
Window window;
Atom property;
static struct prop_location *property_change_wait_list;
static int
-property_deleted_p (tick)
- void *tick;
+property_deleted_p (identifier)
+ void *identifier;
{
struct prop_location *rest = property_change_wait_list;
while (rest)
- if (rest->tick == (int) tick)
+ if (rest->identifier == (int) identifier)
return 0;
else
rest = rest->next;
{
struct prop_location *pl
= (struct prop_location *) xmalloc (sizeof (struct prop_location));
- pl->tick = ++prop_location_tick;
+ pl->identifier = ++prop_location_identifier;
pl->display = display;
pl->window = window;
pl->property = property;
pl->desired_state = state;
pl->next = property_change_wait_list;
property_change_wait_list = pl;
- return pl->tick;
+ return pl->identifier;
}
/* Delete an entry from the list of property changes we are waiting for.
- TICK is the number that uniquely identifies the entry. */
+ IDENTIFIER is the number that uniquely identifies the entry. */
static void
-unexpect_property_change (tick)
- int tick;
+unexpect_property_change (identifier)
+ int identifier;
{
struct prop_location *prev = 0, *rest = property_change_wait_list;
while (rest)
{
- if (rest->tick == tick)
+ if (rest->identifier == identifier)
{
if (prev)
prev->next = rest->next;
}
}
+/* Remove the property change expectation element for IDENTIFIER. */
+
+static Lisp_Object
+wait_for_property_change_unwind (identifierval)
+ Lisp_Object identifierval;
+{
+ unexpect_property_change (XFASTINT (identifierval));
+}
+
/* Actually wait for a property change.
- TICK should be the value that expect_property_change returned. */
+ IDENTIFIER should be the value that expect_property_change returned. */
static void
-wait_for_property_change (tick)
+wait_for_property_change (identifier)
{
+ int secs, usecs;
+ int count = specpdl_ptr - specpdl;
+
+ /* Make sure to do unexpect_property_change if we quit or err. */
+ record_unwind_protect (wait_for_property_change_unwind,
+ make_number (identifier));
+
XCONS (property_change_reply)->car = Qnil;
- property_change_reply_tick = tick;
- wait_reading_process_input (0, 0, property_change_reply, 0);
+ property_change_reply_identifier = identifier;
+ secs = x_selection_timeout / 1000;
+ usecs = (x_selection_timeout % 1000) * 1000;
+ wait_reading_process_input (secs, usecs, property_change_reply, 0);
+
+ if (NILP (XCONS (property_change_reply)->car))
+ error ("timed out waiting for property-notify event");
+
+ unbind_to (count, Qnil);
}
/* Called from XTread_socket in response to a PropertyNotify event. */
/* If this is the one wait_for_property_change is waiting for,
tell it to wake up. */
- if (rest->tick == property_change_reply_tick)
+ if (rest->identifier == property_change_reply_identifier)
XCONS (property_change_reply)->car = Qt;
if (prev)
Atom target_property = Xatom_EMACS_TMP;
Atom selection_atom = symbol_to_x_atom (display, selection_symbol);
Atom type_atom;
+ int secs, usecs;
if (CONSP (target_type))
type_atom = symbol_to_x_atom (display, XCONS (target_type)->car);
XCONS (reading_selection_reply)->car = Qnil;
UNBLOCK_INPUT;
- /* This allows quits. */
- wait_reading_process_input (x_selection_timeout, 0,
- reading_selection_reply, 0);
+ /* This allows quits. Also, don't wait forever. */
+ secs = x_selection_timeout / 1000;
+ usecs = (x_selection_timeout % 1000) * 1000;
+ wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
if (NILP (XCONS (reading_selection_reply)->car))
error ("timed out waiting for reply from selection owner");
actual_type_ret, actual_format_ret,
actual_size_ret,
&bytes_remaining, &tmp_data);
- UNBLOCK_INPUT;
if (result != Success)
{
+ UNBLOCK_INPUT;
*data_ret = 0;
*bytes_ret = 0;
return;
}
- BLOCK_INPUT;
- XFree ((char *) tmp_data);
- UNBLOCK_INPUT;
+ xfree ((char *) tmp_data);
if (*actual_type_ret == None || *actual_format_ret == 0)
{
- if (delete_p) XDeleteProperty (display, window, property);
+ UNBLOCK_INPUT;
return;
}
*data_ret = (unsigned char *) xmalloc (total_size);
/* Now read, until weve gotten it all. */
- BLOCK_INPUT;
while (bytes_remaining)
{
#if 0
result
= XGetWindowProperty (display, window, property,
offset/4, buffer_size/4,
- (delete_p ? True : False),
+ False,
AnyPropertyType,
actual_type_ret, actual_format_ret,
actual_size_ret, &bytes_remaining, &tmp_data);
*actual_size_ret *= *actual_format_ret / 8;
bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
offset += *actual_size_ret;
- XFree ((char *) tmp_data);
+ xfree ((char *) tmp_data);
}
+
+ XFlushQueue ();
UNBLOCK_INPUT;
*bytes_ret = offset;
}
#if 0
fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
#endif
- /* At this point, we have read an INCR property, and deleted it (which
- is how we ack its receipt: the sending window will be selecting
- PropertyNotify events on our window to notice this.)
+
+ /* At this point, we have read an INCR property.
+ Delete the property to ack it.
+ (But first, prepare to receive the next event in this handshake.)
Now, we must loop, waiting for the sending window to put a value on
that property, then reading the property, then deleting it to ack.
We are done when the sender places a property of length 0.
*/
+ BLOCK_INPUT;
+ XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
+ XDeleteProperty (display, window, property);
prop_id = expect_property_change (display, window, property,
PropertyNewValue);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
+
while (1)
{
unsigned char *tmp_data;
.. no it wont, I dont get it.
.. Ok, I get it now, the Xt code that implements INCR is broken.
*/
- prop_id = expect_property_change (display, window, property,
- PropertyNewValue);
x_get_window_property (display, window, property,
&tmp_data, &tmp_size_bytes,
type_ret, format_ret, size_ret, 1);
#if 0
fprintf (stderr, " read INCR done\n");
#endif
+ if (! waiting_for_other_props_on_window (display, window))
+ XSelectInput (display, window, STANDARD_EVENT_SET);
unexpect_property_change (prop_id);
if (tmp_data) xfree (tmp_data);
break;
}
+
+ BLOCK_INPUT;
+ XDeleteProperty (display, window, property);
+ prop_id = expect_property_change (display, window, property,
+ PropertyNewValue);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
+
#if 0
fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
#endif
&actual_size);
}
+ BLOCK_INPUT;
+ XDeleteProperty (display, window, property);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
+
/* It's been read. Now convert it to a lisp object in some semi-rational
manner. */
val = selection_data_to_lisp_data (display, data, bytes,
static void
lisp_data_to_selection_data (display, obj,
- data_ret, type_ret, size_ret, format_ret)
+ data_ret, type_ret, size_ret,
+ format_ret, nofree_ret)
Display *display;
Lisp_Object obj;
unsigned char **data_ret;
Atom *type_ret;
unsigned int *size_ret;
int *format_ret;
+ int *nofree_ret;
{
Lisp_Object type = Qnil;
+
+ *nofree_ret = 0;
+
if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
{
type = XCONS (obj)->car;
{
*format_ret = 8;
*size_ret = XSTRING (obj)->size;
- *data_ret = (unsigned char *) xmalloc (*size_ret);
- memcpy (*data_ret, (char *) XSTRING (obj)->data, *size_ret);
+ *data_ret = XSTRING (obj)->data;
+ *nofree_ret = 1;
if (NILP (type)) type = QSTRING;
}
else if (SYMBOLP (obj))
XSetSelectionOwner (display, selection_atom, None, timestamp);
UNBLOCK_INPUT;
- /* It doesn't seem to be guarenteed that a SelectionClear event will be
+ /* It doesn't seem to be guaranteed that a SelectionClear event will be
generated for a window which owns the selection when that window sets
the selection owner to None. The NCD server does, the MIT Sun4 server
doesn't. So we synthesize one; this means we might get two, but
Lisp_Object selection;
{
Window owner;
+ Atom atom;
Display *dpy = x_current_display;
CHECK_SYMBOL (selection, 0);
if (!NILP (Fx_selection_owner_p (selection)))
return Qt;
+ if (EQ (selection, Qnil)) selection = QPRIMARY;
+ if (EQ (selection, Qt)) selection = QSECONDARY;
+ atom = symbol_to_x_atom (dpy, selection);
+ if (atom == 0)
+ return Qnil;
BLOCK_INPUT;
- owner = XGetSelectionOwner (dpy, symbol_to_x_atom (dpy, selection));
+ owner = XGetSelectionOwner (dpy, atom);
UNBLOCK_INPUT;
return (owner ? Qt : Qnil);
}
if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
BLOCK_INPUT;
+
+ /* Don't mess up with an empty value. */
+ if (!bytes_remaining)
+ XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
+ PropModeReplace, data, 0);
+
while (bytes_remaining)
{
int chunk = (bytes_remaining < max_bytes
reading_which_selection = 0;
property_change_wait_list = 0;
- prop_location_tick = 0;
+ prop_location_identifier = 0;
property_change_reply = Fcons (Qnil, Qnil);
staticpro (&property_change_reply);
Vx_sent_selection_hooks = Qnil;
DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
- "Number of seconds to wait for a selection reply from another X client.\n\
-If the selection owner doens't reply in this many seconds, we give up.\n\
+ "Number of milliseconds to wait for a selection reply.\n\
+If the selection owner doens't reply in this time, we give up.\n\
A value of 0 means wait as long as necessary. This is initialized from the\n\
-\"*selectionTimeout\" resource (which is expressed in milliseconds).");
+\"*selectionTimeout\" resource.");
x_selection_timeout = 0;
QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
HCoop / bpt / emacs.git / blobdiff