-/* 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 <config.h>
#include "lisp.h"
#if 0
#include <stdio.h> /* termhooks.h needs this */
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;
static Lisp_Object selection_data_to_lisp_data ();
static Lisp_Object x_get_window_property_as_lisp_data ();
-static int expect_property_change ();
-static void wait_for_property_change ();
-static void unexpect_property_change ();
-static int waiting_for_other_props_on_window ();
-
/* This converts a Lisp symbol to a server Atom, avoiding a server
roundtrip whenever possible. */
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);
}
return Qnil;
}
\f
+
+/* This stuff is so that INCR selections are reentrant (that is, so we can
+ be servicing multiple INCR selection requests simultaneously.) I haven't
+ actually tested that yet. */
+
+/* Keep a list of the property changes that are awaited. */
+
+struct prop_location
+{
+ int identifier;
+ Display *display;
+ Window window;
+ Atom property;
+ int desired_state;
+ int arrived;
+ struct prop_location *next;
+};
+
+static struct prop_location *expect_property_change ();
+static void wait_for_property_change ();
+static void unexpect_property_change ();
+static int waiting_for_other_props_on_window ();
+
+static int prop_location_identifier;
+
+static Lisp_Object property_change_reply;
+
+static struct prop_location *property_change_reply_object;
+
+static struct prop_location *property_change_wait_list;
+\f
/* Send the reply to a selection request event EVENT.
TYPE is the type of selection data requested.
DATA and SIZE describe the data to send, already converted.
/* #### 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;
+ struct prop_location *wait_object;
+
+ BLOCK_INPUT;
if (x_window_to_frame (window)) /* #### debug */
error ("attempt to transfer an INCR to ourself!");
#if 0
fprintf (stderr, "\nINCR %d\n", bytes_remaining);
#endif
- prop_id = expect_property_change (display, window, reply.property,
- PropertyDelete);
+ wait_object = expect_property_change (display, window, reply.property,
+ PropertyDelete);
XChangeProperty (display, window, reply.property, Xatom_INCR,
32, PropModeReplace, (unsigned char *)
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. */
- wait_for_property_change (prop_id);
+ wait_for_property_change (wait_object);
while (bytes_remaining)
{
int i = ((bytes_remaining < max_bytes)
? bytes_remaining
: max_bytes);
- prop_id = expect_property_change (display, window, reply.property,
- PropertyDelete);
+
+ BLOCK_INPUT;
+
+ wait_object
+ = expect_property_change (display, window, reply.property,
+ PropertyDelete);
#if 0
fprintf (stderr," INCR adding %d\n", i);
#endif
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.
*/
- wait_for_property_change (prop_id);
+ wait_for_property_change (wait_object);
}
/* Now write a zero-length chunk to the property to tell the requestor
that we're done. */
#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);
/* Let random lisp code notice that the selection has been stolen. */
{
- Lisp_Object rest = Vx_lost_selection_hooks;
+ Lisp_Object rest;
+ rest = Vx_lost_selection_hooks;
if (!EQ (rest, Qunbound))
- for (; CONSP (rest); rest = Fcdr (rest))
- call1 (Fcar (rest), selection_symbol);
+ {
+ for (; CONSP (rest); rest = Fcdr (rest))
+ call1 (Fcar (rest), selection_symbol);
+ redisplay_preserve_echo_area ();
+ }
}
}
\f
-/* This stuff is so that INCR selections are reentrant (that is, so we can
- be servicing multiple INCR selection requests simultaneously.) I haven't
- actually tested that yet. */
-
-static int prop_location_tick;
-
-static Lisp_Object property_change_reply;
-static int property_change_reply_tick;
-
-/* Keep a list of the property changes that are awaited. */
-
-struct prop_location
-{
- int tick;
- Display *display;
- Window window;
- Atom property;
- int desired_state;
- struct prop_location *next;
-};
-
-static struct prop_location *property_change_wait_list;
-
-static int
-property_deleted_p (tick)
- void *tick;
-{
- struct prop_location *rest = property_change_wait_list;
- while (rest)
- if (rest->tick == (int) tick)
- return 0;
- else
- rest = rest->next;
- return 1;
-}
-
/* Nonzero if any properties for DISPLAY and WINDOW
are on the list of what we are waiting for. */
The return value is a number that uniquely identifies
this awaited property change. */
-static int
+static struct prop_location *
expect_property_change (display, window, property, state)
Display *display;
Window window;
{
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;
+ pl->arrived = 0;
property_change_wait_list = pl;
- return pl->tick;
+ return pl;
}
/* 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 (location)
+ struct prop_location *location;
{
struct prop_location *prev = 0, *rest = property_change_wait_list;
while (rest)
{
- if (rest->tick == tick)
+ if (rest == location)
{
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 (XPNTR (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 (location)
+ struct prop_location *location;
{
+ int secs, usecs;
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object tem;
+
+ XSET (tem, Lisp_Cons, location);
+
+ /* Make sure to do unexpect_property_change if we quit or err. */
+ record_unwind_protect (wait_for_property_change_unwind, tem);
+
XCONS (property_change_reply)->car = Qnil;
- property_change_reply_tick = tick;
- wait_reading_process_input (0, 0, property_change_reply, 0);
+
+ if (! location->arrived)
+ {
+ property_change_reply_object = location;
+ 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. */
->name->data);
#endif
+ rest->arrived = 1;
+
/* 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 == property_change_reply_object)
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;
}
int *format_ret;
{
int offset = 0;
- int prop_id;
+ struct prop_location *wait_object;
*size_bytes_ret = min_size_bytes;
*data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
#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.
*/
- prop_id = expect_property_change (display, window, property,
- PropertyNewValue);
+ BLOCK_INPUT;
+ XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
+ XDeleteProperty (display, window, property);
+ wait_object = expect_property_change (display, window, property,
+ PropertyNewValue);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
+
while (1)
{
unsigned char *tmp_data;
int tmp_size_bytes;
- wait_for_property_change (prop_id);
+ wait_for_property_change (wait_object);
/* expect it again immediately, because x_get_window_property may
.. 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
- unexpect_property_change (prop_id);
+ if (! waiting_for_other_props_on_window (display, window))
+ XSelectInput (display, window, STANDARD_EVENT_SET);
+ unexpect_property_change (wait_object);
if (tmp_data) xfree (tmp_data);
break;
}
+
+ BLOCK_INPUT;
+ XDeleteProperty (display, window, property);
+ wait_object = expect_property_change (display, window, property,
+ PropertyNewValue);
+ XFlushQueue ();
+ UNBLOCK_INPUT;
+
#if 0
fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
#endif
*size_bytes_ret = offset + tmp_size_bytes;
*data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
}
- memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
+ bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
offset += tmp_size_bytes;
xfree (tmp_data);
}
&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
that's ok, because the second one won't have any effect. */
- event.display = display;
- event.selection = selection_atom;
- event.time = timestamp;
+ SELECTION_EVENT_DISPLAY (&event) = display;
+ SELECTION_EVENT_SELECTION (&event) = selection_atom;
+ SELECTION_EVENT_TIME (&event) = timestamp;
x_handle_selection_clear (&event);
return Qt;
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);