/* X Selection processing for Emacs.
- Copyright (C) 1993, 1994, 1995 Free Software Foundation.
+ Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001
+ Free Software Foundation.
This file is part of GNU Emacs.
#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"
+#include "buffer.h"
+#include "charset.h"
+#include "coding.h"
+#include "process.h"
+#include "composite.h"
+
+struct prop_location;
+
+static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
+static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
+ Lisp_Object));
+static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object));
+static void x_decline_selection_request P_ ((struct input_event *));
+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 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 struct prop_location *expect_property_change P_ ((Display *, Window,
+ Atom, int));
+static void unexpect_property_change P_ ((struct prop_location *));
+static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
+static void wait_for_property_change P_ ((struct prop_location *));
+static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object, Lisp_Object));
+static void x_get_window_property P_ ((Display *, Window, Atom,
+ unsigned char **, int *,
+ Atom *, int *, unsigned long *, int));
+static void receive_incremental_selection P_ ((Display *, Window, Atom,
+ Lisp_Object, unsigned,
+ unsigned char **, int *,
+ Atom *, int *, unsigned long *));
+static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
+ Window, Atom,
+ Lisp_Object, Atom));
+static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
+ int, Atom, int));
+static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
+ unsigned char **, Atom *,
+ unsigned *, int *, int *));
+static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
+static void initialize_cut_buffers P_ ((Display *, Window));
+
+
+/* Printing traces to stderr. */
+
+#ifdef TRACE_SELECTION
+#define TRACE0(fmt) \
+ fprintf (stderr, "%d: " fmt "\n", getpid ())
+#define TRACE1(fmt, a0) \
+ fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
+#define TRACE2(fmt, a0, a1) \
+ fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
+#else
+#define TRACE0(fmt) (void) 0
+#define TRACE1(fmt, a0) (void) 0
+#define TRACE2(fmt, a0, a1) (void) 0
+#endif
-#define xfree free
#define CUT_BUFFER_SUPPORT
QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
QATOM_PAIR;
+Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
+
+Lisp_Object Qcompound_text_with_extensions;
+
#ifdef CUT_BUFFER_SUPPORT
Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
static Lisp_Object Vx_lost_selection_hooks;
static Lisp_Object Vx_sent_selection_hooks;
+/* 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;
/* If this is a smaller number than the max-request-size of the display,
emacs will use INCR selection transfer when the selection is larger
#endif
/* The timestamp of the last input event Emacs received from the X server. */
-unsigned long last_event_timestamp;
+/* Defined in keyboard.c. */
+extern unsigned long last_event_timestamp;
/* This is an association list whose elements are of the form
( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
/* If the selection owner takes too long to reply to a selection request,
we give up on it. This is in milliseconds (0 = no timeout.) */
-static int x_selection_timeout;
+static EMACS_INT x_selection_timeout;
\f
/* Utility functions */
if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
+ if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
#endif
if (!SYMBOLP (sym)) abort ();
-#if 0
- fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
-#endif
+ TRACE1 (" XInternAtom %s", (char *) XSYMBOL (sym)->name->data);
BLOCK_INPUT;
val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
UNBLOCK_INPUT;
and calls to intern whenever possible. */
static Lisp_Object
-x_atom_to_symbol (dpyinfo, display, atom)
- struct x_display_info *dpyinfo;
- Display *display;
+x_atom_to_symbol (dpy, atom)
+ Display *dpy;
Atom atom;
{
+ struct x_display_info *dpyinfo;
char *str;
Lisp_Object val;
- if (! atom) return Qnil;
+
+ if (! atom)
+ return Qnil;
+
switch (atom)
{
case XA_PRIMARY:
#endif
}
+ dpyinfo = x_display_info_for_display (dpy);
if (atom == dpyinfo->Xatom_CLIPBOARD)
return QCLIPBOARD;
if (atom == dpyinfo->Xatom_TIMESTAMP)
return QTIMESTAMP;
if (atom == dpyinfo->Xatom_TEXT)
return QTEXT;
+ if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
+ return QCOMPOUND_TEXT;
if (atom == dpyinfo->Xatom_DELETE)
return QDELETE;
if (atom == dpyinfo->Xatom_MULTIPLE)
return QNULL;
BLOCK_INPUT;
- str = XGetAtomName (display, atom);
+ str = XGetAtomName (dpy, atom);
UNBLOCK_INPUT;
-#if 0
- fprintf (stderr, " XGetAtomName --> %s\n", str);
-#endif
+ TRACE1 ("XGetAtomName --> %s", str);
if (! str) return Qnil;
val = intern (str);
BLOCK_INPUT;
+ /* This was allocated by Xlib, so use XFree. */
XFree (str);
UNBLOCK_INPUT;
return val;
x_own_selection (selection_name, selection_value)
Lisp_Object selection_name, selection_value;
{
- Window selecting_window = FRAME_X_WINDOW (selected_frame);
- Display *display = FRAME_X_DISPLAY (selected_frame);
+ struct frame *sf = SELECTED_FRAME ();
+ Window selecting_window = FRAME_X_WINDOW (sf);
+ Display *display = FRAME_X_DISPLAY (sf);
Time time = last_event_timestamp;
Atom selection_atom;
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
+ int count;
- CHECK_SYMBOL (selection_name, 0);
+ CHECK_SYMBOL (selection_name);
selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
BLOCK_INPUT;
- x_catch_errors (display);
+ count = x_catch_errors (display);
XSetSelectionOwner (display, selection_atom, selecting_window, time);
x_check_errors (display, "Can't set selection: %s");
- x_uncatch_errors (display);
+ x_uncatch_errors (display, count);
UNBLOCK_INPUT;
/* Now update the local cache */
selection_data = Fcons (selection_name,
Fcons (selection_value,
Fcons (selection_time,
- Fcons (Fselected_frame (), Qnil))));
+ Fcons (selected_frame, Qnil))));
prev_value = assq_no_quit (selection_name, Vselection_alist);
Vselection_alist = Fcons (selection_data, Vselection_alist);
{
Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
- if (EQ (prev_value, Fcar (XCONS (rest)->cdr)))
+ if (EQ (prev_value, Fcar (XCDR (rest))))
{
- XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
+ XSETCDR (rest, Fcdr (XCDR (rest)));
break;
}
}
if (EQ (target_type, QTIMESTAMP))
{
handler_fn = Qnil;
- value = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car;
+ value = XCAR (XCDR (XCDR (local_value)));
}
#if 0
else if (EQ (target_type, QDELETE))
handler_fn = Qnil;
Fx_disown_selection_internal
(selection_symbol,
- XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car);
+ XCAR (XCDR (XCDR (local_value))));
value = QNULL;
}
#endif
#if 0 /* #### MULTIPLE doesn't work yet */
else if (CONSP (target_type)
- && XCONS (target_type)->car == QMULTIPLE)
+ && XCAR (target_type) == QMULTIPLE)
{
Lisp_Object pairs;
int size;
int i;
- pairs = XCONS (target_type)->cdr;
+ pairs = XCDR (target_type);
size = XVECTOR (pairs)->size;
/* If the target is MULTIPLE, then target_type looks like
(MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
count = specpdl_ptr - specpdl;
specbind (Qinhibit_quit, Qt);
- CHECK_SYMBOL (target_type, 0);
+ CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
if (!NILP (handler_fn))
value = call3 (handler_fn,
selection_symbol, target_type,
- XCONS (XCONS (local_value)->cdr)->car);
+ XCAR (XCDR (local_value)));
else
value = Qnil;
unbind_to (count, Qnil);
check = value;
if (CONSP (value)
- && SYMBOLP (XCONS (value)->car))
- type = XCONS (value)->car,
- check = XCONS (value)->cdr;
+ && SYMBOLP (XCAR (value)))
+ type = XCAR (value),
+ check = XCDR (value);
if (STRINGP (check)
|| VECTORP (check)
return value;
/* Check for a value that cons_to_long could handle. */
else if (CONSP (check)
- && INTEGERP (XCONS (check)->car)
- && (INTEGERP (XCONS (check)->cdr)
+ && INTEGERP (XCAR (check))
+ && (INTEGERP (XCDR (check))
||
- (CONSP (XCONS (check)->cdr)
- && INTEGERP (XCONS (XCONS (check)->cdr)->car)
- && NILP (XCONS (XCONS (check)->cdr)->cdr))))
+ (CONSP (XCDR (check))
+ && INTEGERP (XCAR (XCDR (check)))
+ && NILP (XCDR (XCDR (check))))))
return value;
else
return
struct input_event *event;
{
XSelectionEvent reply;
+ int count;
+
reply.type = SelectionNotify;
reply.display = SELECTION_EVENT_DISPLAY (event);
reply.requestor = SELECTION_EVENT_REQUESTOR (event);
reply.target = SELECTION_EVENT_TARGET (event);
reply.property = None;
+ /* The reason for the error may be that the receiver has
+ died in the meantime. Handle that case. */
BLOCK_INPUT;
- XSendEvent (reply.display, reply.requestor, False, 0L,
- (XEvent *) &reply);
+ count = x_catch_errors (reply.display);
+ XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
XFlush (reply.display);
+ x_uncatch_errors (reply.display, count);
UNBLOCK_INPUT;
}
It is set to zero when the request is fully processed. */
static struct input_event *x_selection_current_request;
+/* Display info in x_selection_request. */
+
+static struct x_display_info *selection_request_dpyinfo;
+
/* Used as an unwind-protect clause so that, if a selection-converter signals
an error, we tell the requester that we were unable to do what they wanted
before we throw to top-level or go into the debugger or whatever. */
x_selection_request_lisp_error (ignore)
Lisp_Object ignore;
{
- if (x_selection_current_request != 0)
+ if (x_selection_current_request != 0
+ && selection_request_dpyinfo->display)
x_decline_selection_request (x_selection_current_request);
return Qnil;
}
int format_bytes = format/8;
int max_bytes = SELECTION_QUANTUM (display);
struct x_display_info *dpyinfo = x_display_info_for_display (display);
+ int count;
if (max_bytes > MAX_SELECTION_QUANTUM)
max_bytes = MAX_SELECTION_QUANTUM;
/* #### XChangeProperty can generate BadAlloc, and we must handle it! */
BLOCK_INPUT;
- x_catch_errors (display);
+ count = x_catch_errors (display);
/* Store the data on the requested property.
If the selection is large, only store the first N bytes of it.
if (bytes_remaining <= max_bytes)
{
/* Send all the data at once, with minimal handshaking. */
-#if 0
- fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
-#endif
+ TRACE1 ("Sending all %d bytes", bytes_remaining);
XChangeProperty (display, window, reply.property, type, format,
PropModeReplace, data, size);
/* At this point, the selection was successfully stored; ack it. */
/* Send an INCR selection. */
struct prop_location *wait_object;
int had_errors;
- int count = specpdl_ptr - specpdl;
Lisp_Object frame;
frame = some_frame_on_display (dpyinfo);
if (x_window_to_frame (dpyinfo, window)) /* #### debug */
error ("Attempt to transfer an INCR to ourself!");
-#if 0
- fprintf (stderr, "\nINCR %d\n", bytes_remaining);
-#endif
+
+ TRACE2 ("Start sending %d bytes incrementally (%s)",
+ bytes_remaining, XGetAtomName (display, reply.property));
wait_object = expect_property_change (display, window, reply.property,
PropertyDelete);
+ TRACE1 ("Set %s to number of bytes to send",
+ XGetAtomName (display, reply.property));
XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
32, PropModeReplace,
(unsigned char *) &bytes_remaining, 1);
XSelectInput (display, window, PropertyChangeMask);
+
/* Tell 'em the INCR data is there... */
+ TRACE0 ("Send SelectionNotify event");
XSendEvent (display, window, False, 0L, (XEvent *) &reply);
XFlush (display);
/* First, wait for the requester to ack by deleting the property.
This can run random lisp code (process handlers) or signal. */
if (! had_errors)
- wait_for_property_change (wait_object);
+ {
+ TRACE1 ("Waiting for ACK (deletion of %s)",
+ XGetAtomName (display, reply.property));
+ wait_for_property_change (wait_object);
+ }
+ TRACE0 ("Got ACK");
while (bytes_remaining)
{
int i = ((bytes_remaining < max_bytes)
wait_object
= expect_property_change (display, window, reply.property,
PropertyDelete);
-#if 0
- fprintf (stderr," INCR adding %d\n", i);
-#endif
+
+ TRACE1 ("Sending increment of %d bytes", i);
+ TRACE1 ("Set %s to increment data",
+ XGetAtomName (display, reply.property));
+
/* Append the next chunk of data to the property. */
XChangeProperty (display, window, reply.property, type, format,
PropModeAppend, data, i / format_bytes);
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);
}
- /* Now write a zero-length chunk to the property to tell the requester
- that we're done. */
-#if 0
- fprintf (stderr," INCR done\n");
-#endif
+
+ /* Now write a zero-length chunk to the property to tell the
+ requester that we're done. */
BLOCK_INPUT;
if (! waiting_for_other_props_on_window (display, window))
XSelectInput (display, window, 0L);
+ TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
+ XGetAtomName (display, reply.property));
XChangeProperty (display, window, reply.property, type, format,
PropModeReplace, data, 0);
-
- unbind_to (count, Qnil);
+ TRACE0 ("Done sending incrementally");
}
+ /* The window we're communicating with may have been deleted
+ in the meantime (that's a real situation from a bug report).
+ In this case, there may be events in the event queue still
+ refering to the deleted window, and we'll get a BadWindow error
+ in XTread_socket when processing the events. I don't have
+ an idea how to fix that. gerd, 2001-01-98. */
XFlush (display);
- x_uncatch_errors (display);
+ x_uncatch_errors (display, count);
UNBLOCK_INPUT;
}
\f
GCPRO3 (local_selection_data, converted_selection, target_symbol);
- selection_symbol = x_atom_to_symbol (dpyinfo,
- SELECTION_EVENT_DISPLAY (event),
+ selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
SELECTION_EVENT_SELECTION (event));
local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
}
local_selection_time = (Time)
- cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
+ cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
if (SELECTION_EVENT_TIME (event) != CurrentTime
&& local_selection_time > SELECTION_EVENT_TIME (event))
goto DONE;
}
- count = specpdl_ptr - specpdl;
x_selection_current_request = event;
+ count = BINDING_STACK_SIZE ();
+ selection_request_dpyinfo = dpyinfo;
record_unwind_protect (x_selection_request_lisp_error, Qnil);
- target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
+ target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
SELECTION_EVENT_TARGET (event));
#if 0 /* #### MULTIPLE doesn't work yet */
/* Indicate we have successfully processed this event. */
x_selection_current_request = 0;
+ /* Use xfree, not XFree, because lisp_data_to_selection_data
+ calls xmalloc itself. */
if (!nofree)
xfree (data);
}
}
}
\f
-/* Handle a SelectionClear event EVENT, which indicates that some other
+/* Handle a SelectionClear event EVENT, which indicates that some
client cleared out our previously asserted selection.
This is called from keyboard.c when such an event is found in the queue. */
Lisp_Object selection_symbol, local_selection_data;
Time local_selection_time;
struct x_display_info *dpyinfo = x_display_info_for_display (display);
+ struct x_display_info *t_dpyinfo;
+
+ /* If the new selection owner is also Emacs,
+ don't clear the new selection. */
+ BLOCK_INPUT;
+ /* Check each display on the same terminal,
+ to see if this Emacs job now owns the selection
+ through that display. */
+ for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
+ if (t_dpyinfo->kboard == dpyinfo->kboard)
+ {
+ Window owner_window
+ = XGetSelectionOwner (t_dpyinfo->display, selection);
+ if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
+ {
+ UNBLOCK_INPUT;
+ return;
+ }
+ }
+ UNBLOCK_INPUT;
- selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
+ selection_symbol = x_atom_to_symbol (display, selection);
local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
if (NILP (local_selection_data)) return;
local_selection_time = (Time)
- cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
+ cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
/* This SelectionClear is for a selection that we no longer own, so we can
disregard it. (That is, we have reasserted the selection since this
{
Lisp_Object rest;
for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
- if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr)))
+ if (EQ (local_selection_data, Fcar (XCDR (rest))))
{
- XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
+ XSETCDR (rest, Fcdr (XCDR (rest)));
break;
}
}
for (; CONSP (rest); rest = Fcdr (rest))
call1 (Fcar (rest), selection_symbol);
prepare_menu_bars ();
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (20);
}
}
}
{
for (; CONSP (hooks); hooks = Fcdr (hooks))
call1 (Fcar (hooks), selection_symbol);
- redisplay_preserve_echo_area ();
+#if 0 /* This can crash when deleting a frame
+ from x_connection_closed. Anyway, it seems unnecessary;
+ something else should cause a redisplay. */
+ redisplay_preserve_echo_area (21);
+#endif
}
Vselection_alist = Fcdr (Vselection_alist);
/* Delete elements after the beginning of Vselection_alist. */
for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
- if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
+ if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
{
/* Let random Lisp code notice that the selection has been stolen. */
Lisp_Object hooks, selection_symbol;
hooks = Vx_lost_selection_hooks;
- selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
+ selection_symbol = Fcar (Fcar (XCDR (rest)));
if (!EQ (hooks, Qunbound))
{
for (; CONSP (hooks); hooks = Fcdr (hooks))
call1 (Fcar (hooks), selection_symbol);
- redisplay_preserve_echo_area ();
+#if 0 /* See above */
+ redisplay_preserve_echo_area (22);
+#endif
}
- XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
+ XSETCDR (rest, Fcdr (XCDR (rest)));
break;
}
}
expect_property_change (display, window, property, state)
Display *display;
Window window;
- Lisp_Object property;
+ Atom property;
int state;
{
- struct prop_location *pl
- = (struct prop_location *) xmalloc (sizeof (struct prop_location));
+ struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
pl->identifier = ++prop_location_identifier;
pl->display = display;
pl->window = window;
Lisp_Object identifierval;
{
unexpect_property_change ((struct prop_location *)
- (XFASTINT (XCONS (identifierval)->car) << 16
- | XFASTINT (XCONS (identifierval)->cdr)));
+ (XFASTINT (XCAR (identifierval)) << 16
+ | XFASTINT (XCDR (identifierval))));
return Qnil;
}
Lisp_Object tem;
tem = Fcons (Qnil, Qnil);
- XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
- XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff);
+ XSETCARFASTINT (tem, (EMACS_UINT)location >> 16);
+ XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff);
/* 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;
+ XSETCAR (property_change_reply, Qnil);
property_change_reply_object = location;
/* If the event we are waiting for arrives beyond here, it will set
{
secs = x_selection_timeout / 1000;
usecs = (x_selection_timeout % 1000) * 1000;
+ TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
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");
+ if (NILP (XCAR (property_change_reply)))
+ {
+ TRACE0 (" Timed out");
+ error ("Timed out waiting for property-notify event");
+ }
}
unbind_to (count, Qnil);
XPropertyEvent *event;
{
struct prop_location *prev = 0, *rest = property_change_wait_list;
+
while (rest)
{
if (rest->property == event->atom
&& rest->display == event->display
&& rest->desired_state == event->state)
{
-#if 0
- fprintf (stderr, "Saw expected prop-%s on %s\n",
- (event->state == PropertyDelete ? "delete" : "change"),
- (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
- event->atom))
- ->name->data);
-#endif
+ TRACE2 ("Expected %s of property %s",
+ (event->state == PropertyDelete ? "deletion" : "change"),
+ XGetAtomName (event->display, event->atom));
rest->arrived = 1;
/* If this is the one wait_for_property_change is waiting for,
tell it to wake up. */
if (rest == property_change_reply_object)
- XCONS (property_change_reply)->car = Qt;
+ XSETCAR (property_change_reply, Qt);
if (prev)
prev->next = rest->next;
xfree (rest);
return;
}
+
prev = rest;
rest = rest->next;
}
-#if 0
- fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
- (event->state == PropertyDelete ? "delete" : "change"),
- (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
- event->display, event->atom))
- ->name->data);
-#endif
}
int i;
int size;
if (CONSP (obj))
- return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
+ return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
- CHECK_VECTOR (obj, 0);
+ CHECK_VECTOR (obj);
vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
for (i = 0; i < size; i++)
{
Lisp_Object vec2 = XVECTOR (obj)->contents [i];
- CHECK_VECTOR (vec2, 0);
+ CHECK_VECTOR (vec2);
if (XVECTOR (vec2)->size != 2)
/* ??? Confusing error message */
Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
x_get_foreign_selection (selection_symbol, target_type)
Lisp_Object selection_symbol, target_type;
{
- Window requestor_window = FRAME_X_WINDOW (selected_frame);
- Display *display = FRAME_X_DISPLAY (selected_frame);
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
+ struct frame *sf = SELECTED_FRAME ();
+ Window requestor_window = FRAME_X_WINDOW (sf);
+ Display *display = FRAME_X_DISPLAY (sf);
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
Time requestor_time = last_event_timestamp;
Atom target_property = dpyinfo->Xatom_EMACS_TMP;
Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
Atom type_atom;
int secs, usecs;
- int count = specpdl_ptr - specpdl;
+ int count;
Lisp_Object frame;
if (CONSP (target_type))
- type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
+ type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
else
type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
BLOCK_INPUT;
- x_catch_errors (display);
+
+ count = x_catch_errors (display);
+
+ TRACE2 ("Get selection %s, type %s",
+ XGetAtomName (display, type_atom),
+ XGetAtomName (display, target_property));
+
XConvertSelection (display, selection_atom, type_atom, target_property,
requestor_window, requestor_time);
XFlush (display);
/* 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;
+ XSETCAR (reading_selection_reply, Qnil);
frame = some_frame_on_display (dpyinfo);
/* This allows quits. Also, don't wait forever. */
secs = x_selection_timeout / 1000;
usecs = (x_selection_timeout % 1000) * 1000;
+ TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
+ TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
BLOCK_INPUT;
x_check_errors (display, "Cannot get selection: %s");
- x_uncatch_errors (display);
- unbind_to (count, Qnil);
+ x_uncatch_errors (display, count);
UNBLOCK_INPUT;
- if (NILP (XCONS (reading_selection_reply)->car))
+ if (NILP (XCAR (reading_selection_reply)))
error ("Timed out waiting for reply from selection owner");
- if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
+ if (EQ (XCAR (reading_selection_reply), Qlambda))
error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
/* Otherwise, the selection is waiting for us on the requested property. */
\f
/* Subroutines of x_get_window_property_as_lisp_data */
+/* Use xfree, not XFree, to free the data obtained with this function. */
+
static void
x_get_window_property (display, window, property, data_ret, bytes_ret,
actual_type_ret, actual_format_ret, actual_size_ret,
unsigned char *tmp_data = 0;
int result;
int buffer_size = SELECTION_QUANTUM (display);
- if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
+
+ if (buffer_size > MAX_SELECTION_QUANTUM)
+ buffer_size = MAX_SELECTION_QUANTUM;
BLOCK_INPUT;
+
/* First probe the thing to find out how big it is. */
result = XGetWindowProperty (display, window, property,
0L, 0L, False, AnyPropertyType,
*bytes_ret = 0;
return;
}
- xfree ((char *) tmp_data);
+
+ /* This was allocated by Xlib, so use XFree. */
+ XFree ((char *) tmp_data);
if (*actual_type_ret == None || *actual_format_ret == 0)
{
/* Now read, until we've gotten it all. */
while (bytes_remaining)
{
-#if 0
+#ifdef TRACE_SELECTION
int last = bytes_remaining;
#endif
result
AnyPropertyType,
actual_type_ret, actual_format_ret,
actual_size_ret, &bytes_remaining, &tmp_data);
-#if 0
- fprintf (stderr, "<< read %d\n", last-bytes_remaining);
-#endif
+
+ TRACE2 ("Read %ld bytes from property %s",
+ last - bytes_remaining,
+ XGetAtomName (display, property));
+
/* If this doesn't return Success at this point, it means that
some clod deleted the selection while we were in the midst of
- reading it. Deal with that, I guess....
- */
- if (result != Success) break;
+ reading it. Deal with that, I guess.... */
+ if (result != Success)
+ break;
*actual_size_ret *= *actual_format_ret / 8;
bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
offset += *actual_size_ret;
- xfree ((char *) tmp_data);
+
+ /* This was allocated by Xlib, so use XFree. */
+ XFree ((char *) tmp_data);
}
XFlush (display);
*bytes_ret = offset;
}
\f
+/* Use xfree, not XFree, to free the data obtained with this function. */
+
static void
receive_incremental_selection (display, window, property, target_type,
min_size_bytes, data_ret, size_bytes_ret,
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
+
+ TRACE1 ("Read %d bytes incrementally", min_size_bytes);
/* At this point, we have read an INCR property.
Delete the property to ack it.
*/
BLOCK_INPUT;
XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
+ TRACE1 (" Delete property %s",
+ XSYMBOL (x_atom_to_symbol (display, property))->name->data);
XDeleteProperty (display, window, property);
+ TRACE1 (" Expect new value of property %s",
+ XSYMBOL (x_atom_to_symbol (display, property))->name->data);
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
XFlush (display);
{
unsigned char *tmp_data;
int tmp_size_bytes;
+
+ TRACE0 (" Wait for property change");
wait_for_property_change (wait_object);
+
/* expect it again immediately, because x_get_window_property may
.. no it won't, I don't get it.
- .. Ok, I get it now, the Xt code that implements INCR is broken.
- */
+ .. Ok, I get it now, the Xt code that implements INCR is broken. */
+ TRACE0 (" Get property value");
x_get_window_property (display, window, property,
&tmp_data, &tmp_size_bytes,
type_ret, format_ret, size_ret, 1);
+ TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
+
if (tmp_size_bytes == 0) /* we're done */
{
-#if 0
- fprintf (stderr, " read INCR done\n");
-#endif
+ TRACE0 ("Done reading incrementally");
+
if (! waiting_for_other_props_on_window (display, window))
XSelectInput (display, window, STANDARD_EVENT_SET);
unexpect_property_change (wait_object);
+ /* Use xfree, not XFree, because x_get_window_property
+ calls xmalloc itself. */
if (tmp_data) xfree (tmp_data);
break;
}
BLOCK_INPUT;
+ TRACE1 (" ACK by deleting property %s",
+ XGetAtomName (display, property));
XDeleteProperty (display, window, property);
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
XFlush (display);
UNBLOCK_INPUT;
-#if 0
- fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
-#endif
if (*size_bytes_ret < offset + tmp_size_bytes)
{
-#if 0
- fprintf (stderr, " read INCR realloc %d -> %d\n",
- *size_bytes_ret, offset + tmp_size_bytes);
-#endif
*size_bytes_ret = offset + tmp_size_bytes;
*data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
}
+
bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
offset += tmp_size_bytes;
+
+ /* Use xfree, not XFree, because x_get_window_property
+ calls xmalloc itself. */
xfree (tmp_data);
}
}
+
\f
/* Once a requested selection is "ready" (we got a SelectionNotify event),
fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
Lisp_Object val;
struct x_display_info *dpyinfo = x_display_info_for_display (display);
+ TRACE0 ("Reading selection data");
+
x_get_window_property (display, window, property, &data, &bytes,
&actual_type, &actual_format, &actual_size, 1);
if (! data)
there_is_a_selection_owner
= XGetSelectionOwner (display, selection_atom);
UNBLOCK_INPUT;
- while (1) /* Note debugger can no longer return, so this is obsolete */
- Fsignal (Qerror,
- there_is_a_selection_owner ?
- Fcons (build_string ("selection owner couldn't convert"),
+ 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 (dpyinfo, display,
+ Fcons (x_atom_to_symbol (display,
actual_type),
Qnil))
: Fcons (target_type, Qnil))
- : Fcons (build_string ("no selection"),
- Fcons (x_atom_to_symbol (dpyinfo, display,
- selection_atom),
- Qnil)));
+ : Fcons (build_string ("no selection"),
+ Fcons (x_atom_to_symbol (display,
+ selection_atom),
+ Qnil)));
}
if (actual_type == dpyinfo->Xatom_INCR)
unsigned int min_size_bytes = * ((unsigned int *) data);
BLOCK_INPUT;
- XFree ((char *) data);
+ /* Use xfree, not XFree, because x_get_window_property
+ calls xmalloc itself. */
+ xfree ((char *) data);
UNBLOCK_INPUT;
receive_incremental_selection (display, window, property, target_type,
min_size_bytes, &data, &bytes,
}
BLOCK_INPUT;
+ TRACE1 (" Delete property %s", XGetAtomName (display, property));
XDeleteProperty (display, window, property);
XFlush (display);
UNBLOCK_INPUT;
val = selection_data_to_lisp_data (display, data, bytes,
actual_type, actual_format);
+ /* Use xfree, not XFree, because x_get_window_property
+ calls xmalloc itself. */
xfree ((char *) data);
return val;
}
/* Convert any 8-bit data to a string, for compactness. */
else if (format == 8)
- return make_string ((char *) data, size);
+ {
+ Lisp_Object str;
+ int require_encoding = 0;
+ if (
+#if 1
+ 1
+#else
+ ! NILP (buffer_defaults.enable_multibyte_characters)
+#endif
+ )
+ {
+ /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
+ DATA to Emacs internal format because DATA may be encoded
+ in compound text format. In addtion, if TYPE is `STRING'
+ and DATA contains any 8-bit Latin-1 code, we should also
+ decode it. */
+ if (type == dpyinfo->Xatom_TEXT
+ || type == dpyinfo->Xatom_COMPOUND_TEXT)
+ require_encoding = 1;
+ else if (type == XA_STRING)
+ {
+ int i;
+ for (i = 0; i < size; i++)
+ {
+ if (data[i] >= 0x80)
+ {
+ require_encoding = 1;
+ break;
+ }
+ }
+ }
+ }
+ if (!require_encoding)
+ {
+ str = make_unibyte_string ((char *) data, size);
+ Vlast_coding_system_used = Qraw_text;
+ }
+ else
+ {
+ int bufsize;
+ unsigned char *buf;
+ struct coding_system coding;
+
+ if (NILP (Vnext_selection_coding_system))
+ Vnext_selection_coding_system = Vselection_coding_system;
+ setup_coding_system
+ (Fcheck_coding_system(Vnext_selection_coding_system), &coding);
+ coding.src_multibyte = 0;
+ coding.dst_multibyte = 1;
+ Vnext_selection_coding_system = Qnil;
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ bufsize = decoding_buffer_size (&coding, size);
+ buf = (unsigned char *) xmalloc (bufsize);
+ decode_coding (&coding, data, buf, size, bufsize);
+ str = make_string_from_bytes ((char *) buf,
+ coding.produced_char, coding.produced);
+ xfree (buf);
+
+ if (SYMBOLP (coding.post_read_conversion)
+ && !NILP (Ffboundp (coding.post_read_conversion)))
+ str = run_pre_post_conversion_on_str (str, &coding, 0);
+ Vlast_coding_system_used = coding.symbol;
+ }
+ compose_chars_in_text (0, XSTRING (str)->size, str);
+ return str;
+ }
/* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
a vector of symbols.
*/
{
int i;
if (size == sizeof (Atom))
- return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
+ return x_atom_to_symbol (display, *((Atom *) data));
else
{
- Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
+ Lisp_Object v = Fmake_vector (make_number (size / sizeof (Atom)),
+ make_number (0));
for (i = 0; i < size / sizeof (Atom); i++)
- Faset (v, i, x_atom_to_symbol (dpyinfo, display,
- ((Atom *) data) [i]));
+ Faset (v, make_number (i),
+ x_atom_to_symbol (display, ((Atom *) data) [i]));
return v;
}
}
else if (format == 16)
{
int i;
- Lisp_Object v = Fmake_vector (size / 4, 0);
- for (i = 0; i < size / 4; i++)
+ Lisp_Object v;
+ v = Fmake_vector (make_number (size / 2), make_number (0));
+ for (i = 0; i < size / 2; i++)
{
int j = (int) ((unsigned short *) data) [i];
- Faset (v, i, make_number (j));
+ Faset (v, make_number (i), make_number (j));
}
return v;
}
else
{
int i;
- Lisp_Object v = Fmake_vector (size / 4, 0);
+ Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
for (i = 0; i < size / 4; i++)
{
unsigned long j = ((unsigned long *) data) [i];
- Faset (v, i, long_to_cons (j));
+ Faset (v, make_number (i), long_to_cons (j));
}
return v;
}
}
+/* Use xfree, not XFree, to free the data obtained with this function. */
+
static void
lisp_data_to_selection_data (display, obj,
data_ret, type_ret, size_ret,
*nofree_ret = 0;
- if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
+ if (CONSP (obj) && SYMBOLP (XCAR (obj)))
{
- type = XCONS (obj)->car;
- obj = XCONS (obj)->cdr;
- if (CONSP (obj) && NILP (XCONS (obj)->cdr))
- obj = XCONS (obj)->car;
+ type = XCAR (obj);
+ obj = XCDR (obj);
+ if (CONSP (obj) && NILP (XCDR (obj)))
+ obj = XCAR (obj);
}
if (EQ (obj, QNULL) || (EQ (type, QNULL)))
}
else if (STRINGP (obj))
{
+ /* Since we are now handling multilingual text, we must consider
+ sending back compound text. */
+ int stringp;
+
+ if (NILP (Vnext_selection_coding_system))
+ Vnext_selection_coding_system = Vselection_coding_system;
+
*format_ret = 8;
- *size_ret = XSTRING (obj)->size;
- *data_ret = XSTRING (obj)->data;
- *nofree_ret = 1;
- if (NILP (type)) type = QSTRING;
+ *data_ret = x_encode_text (obj, Vnext_selection_coding_system, 1,
+ (int *) size_ret, &stringp);
+ *nofree_ret = (*data_ret == XSTRING (obj)->data);
+ if (EQ (Vnext_selection_coding_system,
+ Qcompound_text_with_extensions))
+ type = QCOMPOUND_TEXT;
+ else if (NILP (type))
+ type = (stringp ? QSTRING : QCOMPOUND_TEXT);
+ Vlast_coding_system_used = (*nofree_ret
+ ? Qraw_text
+ : Vnext_selection_coding_system);
+ Vnext_selection_coding_system = Qnil;
}
else if (SYMBOLP (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)))))
+ || (CONSP (obj) && INTEGERP (XCAR (obj))
+ && (INTEGERP (XCDR (obj))
+ || (CONSP (XCDR (obj))
+ && INTEGERP (XCAR (XCDR (obj)))))))
{
*format_ret = 32;
*size_ret = 1;
Lisp_Object obj;
{
if (CONSP (obj)
- && INTEGERP (XCONS (obj)->car)
- && CONSP (XCONS (obj)->cdr)
- && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
- && NILP (XCONS (XCONS (obj)->cdr)->cdr))
- obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
+ && INTEGERP (XCAR (obj))
+ && CONSP (XCDR (obj))
+ && INTEGERP (XCAR (XCDR (obj)))
+ && NILP (XCDR (XCDR (obj))))
+ obj = Fcons (XCAR (obj), XCDR (obj));
if (CONSP (obj)
- && INTEGERP (XCONS (obj)->car)
- && INTEGERP (XCONS (obj)->cdr))
+ && INTEGERP (XCAR (obj))
+ && INTEGERP (XCDR (obj)))
{
- if (XINT (XCONS (obj)->car) == 0)
- return XCONS (obj)->cdr;
- if (XINT (XCONS (obj)->car) == -1)
- return make_number (- XINT (XCONS (obj)->cdr));
+ if (XINT (XCAR (obj)) == 0)
+ return XCDR (obj);
+ if (XINT (XCAR (obj)) == -1)
+ return make_number (- XINT (XCDR (obj)));
}
if (VECTORP (obj))
{
Lisp_Object copy;
if (size == 1)
return clean_local_selection_data (XVECTOR (obj)->contents [0]);
- copy = Fmake_vector (size, Qnil);
+ copy = Fmake_vector (make_number (size), Qnil);
for (i = 0; i < size; i++)
XVECTOR (copy)->contents [i]
= clean_local_selection_data (XVECTOR (obj)->contents [i]);
if (event->selection != reading_which_selection)
return;
- XCONS (reading_selection_reply)->car
- = (event->property != 0 ? Qt : Qlambda);
+ TRACE0 ("Received SelectionNotify");
+ XSETCAR (reading_selection_reply,
+ (event->property != 0 ? Qt : Qlambda));
}
\f
-DEFUN ("x-own-selection-internal",
- Fx_own_selection_internal, Sx_own_selection_internal,
- 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)
+DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
+ Sx_own_selection_internal, 2, 2, 0,
+ doc: /* Assert an X selection of the given TYPE with the given VALUE.
+TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+VALUE is typically a string, or a cons of two markers, but may be
+anything that the functions on `selection-converter-alist' know about. */)
+ (selection_name, selection_value)
Lisp_Object selection_name, selection_value;
{
check_x ();
- CHECK_SYMBOL (selection_name, 0);
+ CHECK_SYMBOL (selection_name);
if (NILP (selection_value)) error ("selection-value may not be nil");
x_own_selection (selection_name, selection_value);
return selection_value;
simply return our selection value. If we are not the owner, this
will block until all of the data has arrived. */
-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)
+DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
+ Sx_get_selection_internal, 2, 2, 0,
+ doc: /* Return text selected from some X window.
+SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+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;
GCPRO2 (target_type, val); /* we store newly consed data into these */
check_x ();
- CHECK_SYMBOL (selection_symbol, 0);
+ CHECK_SYMBOL (selection_symbol);
#if 0 /* #### MULTIPLE doesn't work yet */
if (CONSP (target_type)
- && XCONS (target_type)->car == QMULTIPLE)
+ && XCAR (target_type) == QMULTIPLE)
{
- CHECK_VECTOR (XCONS (target_type)->cdr, 0);
+ CHECK_VECTOR (XCDR (target_type));
/* So we don't destructively modify this... */
target_type = copy_multiple_data (target_type);
}
else
#endif
- CHECK_SYMBOL (target_type, 0);
+ CHECK_SYMBOL (target_type);
val = x_get_local_selection (selection_symbol, target_type);
}
if (CONSP (val)
- && SYMBOLP (XCONS (val)->car))
+ && SYMBOLP (XCAR (val)))
{
- val = XCONS (val)->cdr;
- if (CONSP (val) && NILP (XCONS (val)->cdr))
- val = XCONS (val)->car;
+ val = XCDR (val);
+ if (CONSP (val) && NILP (XCDR (val)))
+ val = XCAR (val);
}
val = clean_local_selection_data (val);
DONE:
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)
+DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
+ Sx_disown_selection_internal, 1, 2, 0,
+ doc: /* If we own the selection SELECTION, disown it.
+Disowning it means there is no such selection. */)
+ (selection, time)
Lisp_Object selection;
Lisp_Object time;
{
Time timestamp;
Atom selection_atom;
- XSelectionClearEvent event;
+ struct selection_input_event event;
Display *display;
struct x_display_info *dpyinfo;
+ struct frame *sf = SELECTED_FRAME ();
check_x ();
- display = FRAME_X_DISPLAY (selected_frame);
- dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
- CHECK_SYMBOL (selection, 0);
+ display = FRAME_X_DISPLAY (sf);
+ dpyinfo = FRAME_X_DISPLAY_INFO (sf);
+ CHECK_SYMBOL (selection);
if (NILP (time))
timestamp = last_event_timestamp;
else
SELECTION_EVENT_DISPLAY (&event) = display;
SELECTION_EVENT_SELECTION (&event) = selection_atom;
SELECTION_EVENT_TIME (&event) = timestamp;
- x_handle_selection_clear (&event);
+ x_handle_selection_clear ((struct input_event *) &event);
return Qt;
}
Lisp_Object tail;
struct buffer *buf = XBUFFER (buffer);
- for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
{
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);
+ elt = XCAR (tail);
+ value = XCDR (elt);
+ if (CONSP (value) && MARKERP (XCAR (value))
+ && XMARKER (XCAR (value))->buffer == buf)
+ Fx_disown_selection_internal (XCAR (elt), 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'.)")
- (selection)
+ 0, 1, 0,
+ doc: /* Whether the current Emacs process owns the given X Selection.
+The arg should be the name of the selection in question, typically one of
+the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+For convenience, the symbol nil is the same as `PRIMARY',
+and t is the same as `SECONDARY'. */)
+ (selection)
Lisp_Object selection;
{
check_x ();
- CHECK_SYMBOL (selection, 0);
+ CHECK_SYMBOL (selection);
if (EQ (selection, Qnil)) selection = QPRIMARY;
if (EQ (selection, Qt)) selection = QSECONDARY;
}
DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
- 0, 1, 0,
- "Whether there is an owner for 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'.)")
- (selection)
+ 0, 1, 0,
+ doc: /* Whether there is an owner for the given X Selection.
+The arg should be the name of the selection in question, typically one of
+the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+For convenience, the symbol nil is the same as `PRIMARY',
+and t is the same as `SECONDARY'. */)
+ (selection)
Lisp_Object selection;
{
Window owner;
Atom atom;
Display *dpy;
+ struct frame *sf = SELECTED_FRAME ();
/* It should be safe to call this before we have an X frame. */
- if (! FRAME_X_P (selected_frame))
+ if (! FRAME_X_P (sf))
return Qnil;
- dpy = FRAME_X_DISPLAY (selected_frame);
- CHECK_SYMBOL (selection, 0);
+ dpy = FRAME_X_DISPLAY (sf);
+ CHECK_SYMBOL (selection);
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 (FRAME_X_DISPLAY_INFO (selected_frame),
- dpy, selection);
+ atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
if (atom == 0)
return Qnil;
BLOCK_INPUT;
}
-#define CHECK_CUT_BUFFER(symbol,n) \
- { CHECK_SYMBOL ((symbol), (n)); \
+#define CHECK_CUT_BUFFER(symbol) \
+ { 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) \
}
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)
+ Sx_get_cut_buffer_internal, 1, 1, 0,
+ doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
+ (buffer)
Lisp_Object buffer;
{
Window window;
Lisp_Object ret;
Display *display;
struct x_display_info *dpyinfo;
+ struct frame *sf = SELECTED_FRAME ();
check_x ();
- display = FRAME_X_DISPLAY (selected_frame);
- dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
+ display = FRAME_X_DISPLAY (sf);
+ dpyinfo = FRAME_X_DISPLAY_INFO (sf);
window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
- CHECK_CUT_BUFFER (buffer, 0);
+ CHECK_CUT_BUFFER (buffer);
buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
x_get_window_property (display, window, buffer_atom, &data, &bytes,
&type, &format, &size, 0);
- if (!data) return Qnil;
+ if (!data || !format)
+ 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 (dpyinfo, display, type),
+ Fcons (x_atom_to_symbol (display, type),
Fcons (make_number (format), Qnil))));
ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
+ /* Use xfree, not XFree, because x_get_window_property
+ calls xmalloc itself. */
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)
+ Sx_store_cut_buffer_internal, 2, 2, 0,
+ doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
+ (buffer, string)
Lisp_Object buffer, string;
{
Window window;
int bytes_remaining;
int max_bytes;
Display *display;
+ struct frame *sf = SELECTED_FRAME ();
check_x ();
- display = FRAME_X_DISPLAY (selected_frame);
+ display = FRAME_X_DISPLAY (sf);
window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
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 (FRAME_X_DISPLAY_INFO (selected_frame),
+ CHECK_CUT_BUFFER (buffer);
+ CHECK_STRING (string);
+ buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
display, buffer);
data = (unsigned char *) XSTRING (string)->data;
- bytes = XSTRING (string)->size;
+ bytes = STRING_BYTES (XSTRING (string));
bytes_remaining = bytes;
- if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
+ if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
{
initialize_cut_buffers (display, window);
- FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
+ FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
}
BLOCK_INPUT;
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)
+ Sx_rotate_cut_buffers_internal, 1, 1, 0,
+ doc: /* Rotate the values of the cut buffers by the given number of step.
+Positive means shift the values forward, negative means backward. */)
+ (n)
Lisp_Object n;
{
Window window;
Atom props[8];
Display *display;
+ struct frame *sf = SELECTED_FRAME ();
check_x ();
- display = FRAME_X_DISPLAY (selected_frame);
+ display = FRAME_X_DISPLAY (sf);
window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
- CHECK_NUMBER (n, 0);
+ CHECK_NUMBER (n);
if (XINT (n) == 0)
return n;
- if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
+ if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
{
initialize_cut_buffers (display, window);
- FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
+ FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
}
props[0] = XA_CUT_BUFFER0;
staticpro (&Vselection_alist);
DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
- "An alist associating X Windows selection-types with functions.\n\
-These functions are called to convert the selection, with three args:\n\
-the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
-a desired type to which the selection should be converted;\n\
-and the local selection value (whatever was given to `x-own-selection').\n\
-\n\
-The function should return the value to send to the X server\n\
-\(typically a string). A return value of nil\n\
-means that the conversion could not be done.\n\
-A return value which is the symbol `NULL'\n\
-means that a side-effect was executed,\n\
-and there is no meaningful selection value.");
+ doc: /* An alist associating X Windows selection-types with functions.
+These functions are called to convert the selection, with three args:
+the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
+a desired type to which the selection should be converted;
+and the local selection value (whatever was given to `x-own-selection').
+
+The function should return the value to send to the X server
+\(typically a string). A return value of nil
+means that the conversion could not be done.
+A return value which is the symbol `NULL'
+means that a side-effect was executed,
+and there is no meaningful selection value. */);
Vselection_converter_alist = Qnil;
DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
- "A list of functions to be called when Emacs loses an X selection.\n\
-\(This happens when some other X client makes its own selection\n\
-or when a Lisp program explicitly clears the selection.)\n\
-The functions are called with one argument, the selection type\n\
-\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
+ doc: /* A list of functions to be called when Emacs loses an X selection.
+\(This happens when some other X client makes its own selection
+or when a Lisp program explicitly clears the selection.)
+The functions are called with one argument, the selection type
+\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
Vx_lost_selection_hooks = Qnil;
DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
- "A list of functions to be called when Emacs answers a selection request.\n\
-The functions are called with four arguments:\n\
- - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
- - the selection-type which Emacs was asked to convert the\n\
- selection into before sending (for example, `STRING' or `LENGTH');\n\
- - a flag indicating success or failure for responding to the request.\n\
-We might have failed (and declined the request) for any number of reasons,\n\
-including being asked for a selection that we no longer own, or being asked\n\
-to convert into a type that we don't know about or that is inappropriate.\n\
-This hook doesn't let you change the behavior of Emacs's selection replies,\n\
-it merely informs you that they have happened.");
+ doc: /* A list of functions to be called when Emacs answers a selection request.
+The functions are called with four arguments:
+ - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
+ - the selection-type which Emacs was asked to convert the
+ selection into before sending (for example, `STRING' or `LENGTH');
+ - a flag indicating success or failure for responding to the request.
+We might have failed (and declined the request) for any number of reasons,
+including being asked for a selection that we no longer own, or being asked
+to convert into a type that we don't know about or that is inappropriate.
+This hook doesn't let you change the behavior of Emacs's selection replies,
+it merely informs you that they have happened. */);
Vx_sent_selection_hooks = 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,
- "Number of milliseconds to wait for a selection reply.\n\
-If the selection owner doesn'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.");
+ doc: /* Number of milliseconds to wait for a selection reply.
+If the selection owner doesn't reply in this time, we give up.
+A value of 0 means wait as long as necessary. This is initialized from the
+\"*selectionTimeout\" resource. */);
x_selection_timeout = 0;
QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
QTEXT = intern ("TEXT"); staticpro (&QTEXT);
+ QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
QDELETE = intern ("DELETE"); staticpro (&QDELETE);
QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
QATOM = intern ("ATOM"); staticpro (&QATOM);
QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
QNULL = intern ("NULL"); staticpro (&QNULL);
+ Qcompound_text_with_extensions = intern ("compound-text-with-extensions");
+ staticpro (&Qcompound_text_with_extensions);
#ifdef CUT_BUFFER_SUPPORT
QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
HCoop / bpt / emacs.git / blobdiff