-/* 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 */
+#include "termhooks.h"
+#endif
#include "xterm.h" /* for all of the X includes */
-#include "dispextern.h" /* screen.h seems to want this */
-#include "screen.h" /* Need this to get the X window of selected_screen */
+#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 CUT_BUFFER_SUPPORT
*/
#define MAX_SELECTION_QUANTUM 0xFFFFFF
-#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
-
-
-/* The time of the last-read mouse or keyboard event.
- For selection purposes, we use this as a sleazy way of knowing what the
- current time is in server-time. This assumes that the most recently read
- mouse or keyboard event has something to do with the assertion of the
- selection, which is probably true.
- */
-extern Time mouse_timestamp;
+#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;
/* This is an association list whose elements are of the form
( selection-name selection-value selection-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;
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. */
char *str;
Lisp_Object val;
if (! atom) return Qnil;
- case XA_PRIMARY:
- return QPRIMARY;
- case XA_SECONDARY:
- return QSECONDARY;
- case XA_STRING:
- return QSTRING;
- case XA_INTEGER:
- return QINTEGER;
- case XA_ATOM:
- return QATOM;
- case Xatom_CLIPBOARD:
- return QCLIPBOARD;
- case Xatom_TIMESTAMP:
- return QTIMESTAMP;
- case Xatom_TEXT:
- return QTEXT;
- case Xatom_DELETE:
- return QDELETE;
- case Xatom_MULTIPLE:
- return QMULTIPLE;
- case Xatom_INCR:
- return QINCR;
- case Xatom_EMACS_TMP:
- return QEMACS_TMP;
- case Xatom_TARGETS:
- return QTARGETS;
- case Xatom_NULL:
- return QNULL;
+ switch (atom)
+ {
+ case XA_PRIMARY:
+ return QPRIMARY;
+ case XA_SECONDARY:
+ return QSECONDARY;
+ case XA_STRING:
+ return QSTRING;
+ case XA_INTEGER:
+ return QINTEGER;
+ case XA_ATOM:
+ return QATOM;
#ifdef CUT_BUFFER_SUPPORT
- case XA_CUT_BUFFER0:
- return QCUT_BUFFER0;
- case XA_CUT_BUFFER1:
- return QCUT_BUFFER1;
- case XA_CUT_BUFFER2:
- return QCUT_BUFFER2;
- case XA_CUT_BUFFER3:
- return QCUT_BUFFER3;
- case XA_CUT_BUFFER4:
- return QCUT_BUFFER4;
- case XA_CUT_BUFFER5:
- return QCUT_BUFFER5;
- case XA_CUT_BUFFER6:
- return QCUT_BUFFER6;
- case XA_CUT_BUFFER7:
- return QCUT_BUFFER7;
+ case XA_CUT_BUFFER0:
+ return QCUT_BUFFER0;
+ case XA_CUT_BUFFER1:
+ return QCUT_BUFFER1;
+ case XA_CUT_BUFFER2:
+ return QCUT_BUFFER2;
+ case XA_CUT_BUFFER3:
+ return QCUT_BUFFER3;
+ case XA_CUT_BUFFER4:
+ return QCUT_BUFFER4;
+ case XA_CUT_BUFFER5:
+ return QCUT_BUFFER5;
+ case XA_CUT_BUFFER6:
+ return QCUT_BUFFER6;
+ case XA_CUT_BUFFER7:
+ return QCUT_BUFFER7;
#endif
+ }
+
+ if (atom == Xatom_CLIPBOARD)
+ return QCLIPBOARD;
+ if (atom == Xatom_TIMESTAMP)
+ return QTIMESTAMP;
+ if (atom == Xatom_TEXT)
+ return QTEXT;
+ if (atom == Xatom_DELETE)
+ return QDELETE;
+ if (atom == Xatom_MULTIPLE)
+ return QMULTIPLE;
+ if (atom == Xatom_INCR)
+ return QINCR;
+ if (atom == Xatom_EMACS_TMP)
+ return QEMACS_TMP;
+ if (atom == Xatom_TARGETS)
+ return QTARGETS;
+ if (atom == Xatom_NULL)
+ return QNULL;
BLOCK_INPUT;
str = XGetAtomName (display, atom);
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 (FIXNUMP (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
#else
Window selecting_window = FRAME_X_WINDOW (selected_frame);
#endif
- Time time = mouse_timestamp;
+ Time time = last_event_timestamp;
Atom selection_atom;
CHECK_SYMBOL (selection_name, 0);
the selection value and convert it to the type.
The value is nil or a string.
This function is used both for remote requests
- and for local x-get-selection-internal. */
+ and for local x-get-selection-internal.
This calls random Lisp code, and may signal or gc. */
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);
+ 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);
}
/* 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))
if (STRINGP (check)
|| VECTORP (check)
|| SYMBOLP (check)
- || FIXNUMP (check)
+ || INTEGERP (check)
|| NILP (value))
return value;
+ /* Check for a value that cons_to_long could handle. */
else if (CONSP (check)
- && FIXNUMP (XCONS (check)->car)
- && (FIXNUMP (XCONS (check)->cdr)
+ && INTEGERP (XCONS (check)->car)
+ && (INTEGERP (XCONS (check)->cdr)
||
(CONSP (XCONS (check)->cdr)
- && FIXNUMP (XCONS (XCONS (check)->cdr)->car)
+ && INTEGERP (XCONS (XCONS (check)->cdr)->car)
&& NILP (XCONS (XCONS (check)->cdr)->cdr))))
return value;
else
return
Fsignal (Qerror,
- Fcons (build_string ("unrecognised selection-conversion type"),
+ Fcons (build_string ("invalid data returned by selection-conversion function"),
Fcons (handler_fn, Fcons (value, Qnil))));
}
\f
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;
- if (x_window_to_screen (window)) /* #### debug */
+ 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 (!FIXNUMP (CAR (CAR (CDR (CDR (local_selection_data)))))) abort ();
- if (!FIXNUMP (CDR (CAR (CDR (CDR (local_selection_data)))))) abort ();
-# undef CAR
-# undef CDR
-#endif
if (NILP (local_selection_data))
{
cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
if (SELECTION_EVENT_TIME (event) != CurrentTime
- && local_selection_time > event->time)
+ && local_selection_time > SELECTION_EVENT_TIME (event))
{
/* Someone asked for the selection, and we have one, but not the one
they're looking for.
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_event = 0;
+ 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)
{
Display *display = x_current_display;
#ifdef X_TOOLKIT
- Window selecting_window = XtWindow (selected_screen->display.x->edit_widget);
+ Window requestor_window = XtWindow (selected_screen->display.x->edit_widget);
#else
- Window selecting_window = FRAME_X_WINDOW (selected_frame);
+ Window requestor_window = FRAME_X_WINDOW (selected_frame);
#endif
- Time requestor_time = mouse_timestamp;
+ Time requestor_time = last_event_timestamp;
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);
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;
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))
(*(Atom **) data_ret) [0] = symbol_to_x_atom (display, obj);
if (NILP (type)) type = QATOM;
}
- else if (FIXNUMP (obj)
+ else if (INTEGERP (obj)
&& XINT (obj) < 0xFFFF
&& XINT (obj) > -0xFFFF)
{
(*(short **) data_ret) [0] = (short) XINT (obj);
if (NILP (type)) type = QINTEGER;
}
- else if (FIXNUMP (obj) || CONSP (obj))
+ 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;
for (i = 0; i < *size_ret; i++)
if (CONSP (XVECTOR (obj)->contents [i]))
*format_ret = 32;
- else if (!FIXNUMP (XVECTOR (obj)->contents [i]))
+ 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"),
Lisp_Object obj;
{
if (CONSP (obj)
- && FIXNUMP (XCONS (obj)->car)
+ && INTEGERP (XCONS (obj)->car)
&& CONSP (XCONS (obj)->cdr)
- && FIXNUMP (XCONS (XCONS (obj)->cdr)->car)
+ && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
&& NILP (XCONS (XCONS (obj)->cdr)->cdr))
obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
if (CONSP (obj)
- && FIXNUMP (XCONS (obj)->car)
- && FIXNUMP (XCONS (obj)->cdr))
+ && INTEGERP (XCONS (obj)->car)
+ && INTEGERP (XCONS (obj)->cdr))
{
if (XINT (XCONS (obj)->car) == 0)
return XCONS (obj)->cdr;
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.")
+anything that the functions on `selection-converter-alist' know about.")
(selection_name, selection_value)
Lisp_Object selection_name, selection_value;
{
"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.")
+TYPE is the type of data desired, typically `STRING'.")
(selection_symbol, target_type)
Lisp_Object selection_symbol, target_type;
{
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).")
+ "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;
CHECK_SYMBOL (selection, 0);
if (NILP (time))
- timestamp = mouse_timestamp;
+ timestamp = last_event_timestamp;
else
timestamp = cons_to_long (time);
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
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\
+ "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\
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);
}
}
-#define CHECK_CUTBUFFER(symbol,n) \
+#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 cutbuffer"), \
+ Fcons (build_string ("doesn't name a cut buffer"), \
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).")
+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); /* Cutbuffers are on screen 0 */
+ Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
Atom buffer_atom;
unsigned char *data;
int bytes;
unsigned long size;
Lisp_Object ret;
- CHECK_CUTBUFFER (buffer, 0);
+ CHECK_CUT_BUFFER (buffer, 0);
buffer_atom = symbol_to_x_atom (display, buffer);
x_get_window_property (display, window, buffer_atom, &data, &bytes,
}
-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).")
+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); /* Cutbuffers are on screen 0 */
+ Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
Atom buffer_atom;
unsigned char *data;
int bytes;
int max_bytes = SELECTION_QUANTUM (display);
if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
- CHECK_CUTBUFFER (buffer, 0);
+ CHECK_CUT_BUFFER (buffer, 0);
CHECK_STRING (string, 0);
buffer_atom = symbol_to_x_atom (display, buffer);
data = (unsigned char *) XSTRING (string)->data;
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
}
-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\
+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); /* Cutbuffers are on screen 0 */
+ Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
Atom props [8];
- CHECK_FIXNUM (n, 0);
+ CHECK_NUMBER (n, 0);
if (XINT (n) == 0) return n;
if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
props[0] = XA_CUT_BUFFER0;
#endif
\f
-static void
-atoms_of_xselect ()
+void
+Xatoms_of_xselect ()
{
#define ATOM(x) XInternAtom (x_current_display, (x), False)
void
syms_of_xselect ()
{
- atoms_of_select ();
-
defsubr (&Sx_get_selection_internal);
defsubr (&Sx_own_selection_internal);
defsubr (&Sx_disown_selection_internal);
defsubr (&Sx_selection_exists_p);
#ifdef CUT_BUFFER_SUPPORT
- defsubr (&Sx_get_cutbuffer_internal);
- defsubr (&Sx_store_cutbuffer_internal);
- defsubr (&Sx_rotate_cutbuffers_internal);
+ defsubr (&Sx_get_cut_buffer_internal);
+ defsubr (&Sx_store_cut_buffer_internal);
+ defsubr (&Sx_rotate_cut_buffers_internal);
cut_buffers_initialized = 0;
#endif
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