X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d31b6237e91336d5aca7bb0b4f4129ac1d83121a..5109b06a473d53342cb577c6886f5e789a3ef0fa:/src/xselect.c diff --git a/src/xselect.c b/src/xselect.c index b7360a1038..b4d61f7c9a 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1,5 +1,6 @@ /* X Selection processing for Emacs. - Copyright (C) 1993, 1994, 1995 Free Software Foundation. + Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003 + Free Software Foundation. This file is part of GNU Emacs. @@ -15,19 +16,81 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ /* Rewritten by jwz */ #include +#include /* termhooks.h needs this */ #include "lisp.h" #include "xterm.h" /* for all of the X includes */ #include "dispextern.h" /* frame.h seems to want this */ #include "frame.h" /* Need this to get the X window of selected_frame */ #include "blockinput.h" +#include "buffer.h" +#include "process.h" +#include "termhooks.h" + +#include + +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, int)); +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, + 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 @@ -35,6 +98,11 @@ Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, QATOM_PAIR; +Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */ +Lisp_Object QUTF8_STRING; /* 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; @@ -42,11 +110,19 @@ Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, 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; + +static Lisp_Object Qforeign_selection; /* 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 than this. The max-request-size is usually around 64k, so if you want - emacs to use incremental selection transfers when the selection is + emacs to use incremental selection transfers when the selection is smaller than that, set this. I added this mostly for debugging the incremental transfer stuff, but it might improve server performance. */ #define MAX_SELECTION_QUANTUM 0xFFFFFF @@ -58,7 +134,8 @@ static Lisp_Object Vx_sent_selection_hooks; #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) @@ -76,14 +153,14 @@ static Lisp_Object Vselection_alist; /* This is an alist whose CARs are selection-types (whose names are the same as the names of X Atoms) and whose CDRs are the names of Lisp functions to - call to convert the given Emacs selection value to a string representing + call to convert the given Emacs selection value to a string representing the given selection type. This is for Lisp-level extension of the emacs selection handling. */ static 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 milliseconds (0 = no timeout.) */ -static int x_selection_timeout; +static EMACS_INT x_selection_timeout; /* Utility functions */ @@ -91,7 +168,7 @@ static void lisp_data_to_selection_data (); static Lisp_Object selection_data_to_lisp_data (); static Lisp_Object x_get_window_property_as_lisp_data (); -/* This converts a Lisp symbol to a server Atom, avoiding a server +/* This converts a Lisp symbol to a server Atom, avoiding a server roundtrip whenever possible. */ static Atom @@ -110,6 +187,8 @@ symbol_to_x_atom (dpyinfo, display, sym) 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, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING; if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE; if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE; if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR; @@ -128,11 +207,9 @@ symbol_to_x_atom (dpyinfo, display, sym) #endif if (!SYMBOLP (sym)) abort (); -#if 0 - fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data); -#endif + TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym))); BLOCK_INPUT; - val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False); + val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False); UNBLOCK_INPUT; return val; } @@ -142,14 +219,17 @@ symbol_to_x_atom (dpyinfo, display, sym) 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: @@ -182,12 +262,17 @@ x_atom_to_symbol (dpyinfo, display, atom) #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_UTF8_STRING) + return QUTF8_STRING; if (atom == dpyinfo->Xatom_DELETE) return QDELETE; if (atom == dpyinfo->Xatom_MULTIPLE) @@ -202,41 +287,42 @@ x_atom_to_symbol (dpyinfo, display, atom) 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; } /* Do protocol to assert ourself as a selection owner. - Update the Vselection_alist so that we can reply to later requests for + Update the Vselection_alist so that we can reply to later requests for our selection. */ static void 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 */ @@ -249,7 +335,7 @@ x_own_selection (selection_name, selection_value) 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); @@ -261,9 +347,9 @@ x_own_selection (selection_name, selection_value) { 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; } } @@ -273,14 +359,15 @@ x_own_selection (selection_name, selection_value) /* Given a selection-name and desired type, look up our local copy of 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. + This function is used both for remote requests (LOCAL_REQUEST is zero) + and for local x-get-selection-internal (LOCAL_REQUEST is nonzero). This calls random Lisp code, and may signal or gc. */ static Lisp_Object -x_get_local_selection (selection_symbol, target_type) +x_get_local_selection (selection_symbol, target_type, local_request) Lisp_Object selection_symbol, target_type; + int local_request; { Lisp_Object local_value; Lisp_Object handler_fn, value, type, check; @@ -294,7 +381,7 @@ x_get_local_selection (selection_symbol, target_type) 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)) @@ -302,19 +389,19 @@ x_get_local_selection (selection_symbol, target_type) 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] ... ]) @@ -327,7 +414,8 @@ x_get_local_selection (selection_symbol, target_type) pair = XVECTOR (pairs)->contents [i]; XVECTOR (pair)->contents [1] = x_get_local_selection (XVECTOR (pair)->contents [0], - XVECTOR (pair)->contents [1]); + XVECTOR (pair)->contents [1], + local_request); } return pairs; } @@ -337,15 +425,18 @@ x_get_local_selection (selection_symbol, target_type) /* Don't allow a quit within the converter. When the user types C-g, he would be surprised if by luck it came during a converter. */ - count = specpdl_ptr - specpdl; + count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); - CHECK_SYMBOL (target_type, 0); + CHECK_SYMBOL (target_type); handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); + /* gcpro is not needed here since nothing but HANDLER_FN + is live, and that ought to be a symbol. */ + if (!NILP (handler_fn)) value = call3 (handler_fn, - selection_symbol, target_type, - XCONS (XCONS (local_value)->cdr)->car); + selection_symbol, (local_request ? Qnil : target_type), + XCAR (XCDR (local_value))); else value = Qnil; unbind_to (count, Qnil); @@ -356,10 +447,10 @@ x_get_local_selection (selection_symbol, target_type) 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) || SYMBOLP (check) @@ -368,12 +459,12 @@ x_get_local_selection (selection_symbol, target_type) 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 @@ -392,6 +483,8 @@ x_decline_selection_request (event) struct input_event *event; { XSelectionEvent reply; + int count; + reply.type = SelectionNotify; reply.display = SELECTION_EVENT_DISPLAY (event); reply.requestor = SELECTION_EVENT_REQUESTOR (event); @@ -400,10 +493,13 @@ x_decline_selection_request (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; } @@ -411,15 +507,20 @@ x_decline_selection_request (event) 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 requestor that we were unable to do what they wanted + 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. */ static Lisp_Object 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; } @@ -503,6 +604,7 @@ x_reply_selection_request (event, format, data, size, type) 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; @@ -519,7 +621,7 @@ x_reply_selection_request (event, format, data, size, type) /* #### 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. @@ -528,9 +630,7 @@ x_reply_selection_request (event, format, data, size, type) 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. */ @@ -541,7 +641,6 @@ x_reply_selection_request (event, format, data, size, type) /* 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); @@ -558,29 +657,38 @@ x_reply_selection_request (event, format, data, size, type) } 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 + error ("Attempt to transfer an INCR to ourself!"); + + 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); had_errors = x_had_errors_p (display); UNBLOCK_INPUT; - /* First, wait for the requestor to ack by deleting the property. + /* 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) @@ -592,9 +700,11 @@ x_reply_selection_request (event, format, data, size, type) 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); @@ -607,28 +717,35 @@ x_reply_selection_request (event, format, data, size, type) if (had_errors) break; - /* Now wait for the requestor to ack this chunk by deleting the - property. This can run random lisp code or signal. - */ + /* Now wait for the requester to ack this chunk by deleting the + 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 requestor - 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"); } + /* rms, 2003-01-03: I think I have fixed this bug. */ + /* 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; } @@ -657,8 +774,7 @@ x_handle_selection_request (event) 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); @@ -672,7 +788,7 @@ x_handle_selection_request (event) } 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)) @@ -684,23 +800,24 @@ x_handle_selection_request (event) goto DONE; } - count = specpdl_ptr - specpdl; x_selection_current_request = event; + count = SPECPDL_INDEX (); + 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 */ if (EQ (target_symbol, QMULTIPLE)) target_symbol = fetch_multiple_target (event); #endif - + /* Convert lisp objects back into binary data */ - + converted_selection - = x_get_local_selection (selection_symbol, target_symbol); - + = x_get_local_selection (selection_symbol, target_symbol, 0); + if (! NILP (converted_selection)) { unsigned char *data; @@ -712,13 +829,15 @@ x_handle_selection_request (event) 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; + /* Use xfree, not XFree, because lisp_data_to_selection_data + calls xmalloc itself. */ if (!nofree) xfree (data); } @@ -726,8 +845,6 @@ x_handle_selection_request (event) DONE: - UNGCPRO; - /* Let random lisp code notice that the selection has been asked for. */ { Lisp_Object rest; @@ -736,9 +853,11 @@ x_handle_selection_request (event) for (; CONSP (rest); rest = Fcdr (rest)) call3 (Fcar (rest), selection_symbol, target_symbol, successful_p); } + + UNGCPRO; } -/* 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. */ @@ -749,12 +868,32 @@ x_handle_selection_clear (event) Display *display = SELECTION_EVENT_DISPLAY (event); Atom selection = SELECTION_EVENT_SELECTION (event); Time changed_owner_time = SELECTION_EVENT_TIME (event); - + 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); @@ -762,7 +901,7 @@ x_handle_selection_clear (event) 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 @@ -781,9 +920,9 @@ x_handle_selection_clear (event) { 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; } } @@ -798,7 +937,7 @@ x_handle_selection_clear (event) for (; CONSP (rest); rest = Fcdr (rest)) call1 (Fcar (rest), selection_symbol); prepare_menu_bars (); - redisplay_preserve_echo_area (); + redisplay_preserve_echo_area (20); } } } @@ -832,7 +971,11 @@ x_clear_frame_selections (f) { 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); @@ -840,21 +983,23 @@ x_clear_frame_selections (f) /* 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; } } @@ -885,11 +1030,10 @@ static struct prop_location * 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; @@ -932,8 +1076,8 @@ wait_for_property_change_unwind (identifierval) 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; } @@ -945,17 +1089,17 @@ wait_for_property_change (location) struct prop_location *location; { int secs, usecs; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); 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 @@ -964,10 +1108,14 @@ wait_for_property_change (location) { 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); @@ -980,6 +1128,7 @@ x_handle_property_notify (event) XPropertyEvent *event; { struct prop_location *prev = 0, *rest = property_change_wait_list; + while (rest) { if (rest->property == event->atom @@ -987,20 +1136,16 @@ x_handle_property_notify (event) && 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; @@ -1009,16 +1154,10 @@ x_handle_property_notify (event) 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 } @@ -1049,14 +1188,14 @@ copy_multiple_data (obj) int i; int size; if (CONSP (obj)) - return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr)); - - CHECK_VECTOR (obj, 0); + return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj))); + + 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"), @@ -1082,27 +1221,46 @@ static Window reading_selection_window; Converts this to Lisp data and returns it. */ static Lisp_Object -x_get_foreign_selection (selection_symbol, target_type) - Lisp_Object selection_symbol, target_type; +x_get_foreign_selection (selection_symbol, target_type, time_stamp) + Lisp_Object selection_symbol, target_type, time_stamp; { - 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); + if (! NILP (time_stamp)) + { + if (CONSP (time_stamp)) + requestor_time = (Time) cons_to_long (time_stamp); + else if (INTEGERP (time_stamp)) + requestor_time = (Time) XUINT (time_stamp); + else if (FLOATP (time_stamp)) + requestor_time = (Time) XFLOAT (time_stamp); + else + error ("TIME_STAMP must be cons or number"); + } + 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); @@ -1110,7 +1268,7 @@ x_get_foreign_selection (selection_symbol, target_type) /* 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); @@ -1129,16 +1287,19 @@ x_get_foreign_selection (selection_symbol, target_type) /* 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)) - error ("timed out waiting for reply from selection owner"); + if (NILP (XCAR (reading_selection_reply))) + error ("Timed out waiting for reply from selection owner"); + if (EQ (XCAR (reading_selection_reply), Qlambda)) + error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol))); /* Otherwise, the selection is waiting for us on the requested property. */ return @@ -1149,6 +1310,8 @@ x_get_foreign_selection (selection_symbol, target_type) /* 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, @@ -1169,9 +1332,12 @@ x_get_window_property (display, window, property, data_ret, bytes_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, @@ -1185,8 +1351,10 @@ x_get_window_property (display, window, property, data_ret, bytes_ret, *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) { UNBLOCK_INPUT; @@ -1195,11 +1363,11 @@ x_get_window_property (display, window, property, data_ret, bytes_ret, total_size = bytes_remaining + 1; *data_ret = (unsigned char *) xmalloc (total_size); - - /* Now read, until weve gotten it all. */ + + /* Now read, until we've gotten it all. */ while (bytes_remaining) { -#if 0 +#ifdef TRACE_SELECTION int last = bytes_remaining; #endif result @@ -1209,18 +1377,22 @@ x_get_window_property (display, window, property, data_ret, bytes_ret, 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); @@ -1228,6 +1400,8 @@ x_get_window_property (display, window, property, data_ret, bytes_ret, *bytes_ret = offset; } +/* 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, @@ -1247,9 +1421,8 @@ receive_incremental_selection (display, window, property, target_type, 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. @@ -1261,7 +1434,11 @@ receive_incremental_selection (display, window, property, target_type, */ 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); @@ -1271,51 +1448,57 @@ receive_incremental_selection (display, window, property, target_type, { 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 wont, I dont get it. - .. Ok, I get it now, the Xt code that implements INCR is broken. - */ + .. no it won't, I don't get it. + .. 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); } } + /* Once a requested selection is "ready" (we got a SelectionNotify event), fetch value from property PROPERTY of X window WINDOW on display DISPLAY. @@ -1338,6 +1521,8 @@ x_get_window_property_as_lisp_data (display, window, property, target_type, 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) @@ -1347,29 +1532,30 @@ x_get_window_property_as_lisp_data (display, window, property, target_type, 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) { /* That wasn't really the data, just the beginning. */ 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, @@ -1378,6 +1564,7 @@ x_get_window_property_as_lisp_data (display, window, property, target_type, } BLOCK_INPUT; + TRACE1 (" Delete property %s", XGetAtomName (display, property)); XDeleteProperty (display, window, property); XFlush (display); UNBLOCK_INPUT; @@ -1386,7 +1573,9 @@ x_get_window_property_as_lisp_data (display, window, property, target_type, manner. */ 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; } @@ -1432,8 +1621,24 @@ selection_data_to_lisp_data (display, data, size, type, format) /* Convert any 8-bit data to a string, for compactness. */ else if (format == 8) - return make_string ((char *) data, size); - + { + Lisp_Object str, lispy_type; + + str = make_unibyte_string ((char *) data, size); + /* Indicate that this string is from foreign selection by a text + property `foreign-selection' so that the caller of + x-get-selection-internal (usually x-get-selection) can know + that the string must be decode. */ + if (type == dpyinfo->Xatom_COMPOUND_TEXT) + lispy_type = QCOMPOUND_TEXT; + else if (type == dpyinfo->Xatom_UTF8_STRING) + lispy_type = QUTF8_STRING; + else + lispy_type = QSTRING; + Fput_text_property (make_number (0), make_number (size), + Qforeign_selection, lispy_type, str); + return str; + } /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to a vector of symbols. */ @@ -1441,13 +1646,14 @@ selection_data_to_lisp_data (display, data, size, type, format) { 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; } } @@ -1456,8 +1662,8 @@ selection_data_to_lisp_data (display, data, size, type, format) If the number is > 16 bits, convert it to a cons of integers, 16 bits in each half. */ - else if (format == 32 && size == sizeof (long)) - return long_to_cons (((unsigned long *) data) [0]); + else if (format == 32 && size == sizeof (int)) + return long_to_cons (((unsigned int *) data) [0]); else if (format == 16 && size == sizeof (short)) return make_number ((int) (((unsigned short *) data) [0])); @@ -1467,28 +1673,31 @@ selection_data_to_lisp_data (display, data, size, type, format) 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)); + unsigned int j = ((unsigned int *) data) [i]; + 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, @@ -1506,12 +1715,12 @@ lisp_data_to_selection_data (display, obj, *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))) @@ -1523,11 +1732,13 @@ lisp_data_to_selection_data (display, obj, } else if (STRINGP (obj)) { + xassert (! STRING_MULTIBYTE (obj)); + if (NILP (type)) + type = QSTRING; *format_ret = 8; - *size_ret = XSTRING (obj)->size; - *data_ret = XSTRING (obj)->data; + *size_ret = SBYTES (obj); + *data_ret = SDATA (obj); *nofree_ret = 1; - if (NILP (type)) type = QSTRING; } else if (SYMBOLP (obj)) { @@ -1550,10 +1761,10 @@ lisp_data_to_selection_data (display, 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; @@ -1602,10 +1813,10 @@ lisp_data_to_selection_data (display, obj, Lisp_Object pair = XVECTOR (obj)->contents [i]; if (XVECTOR (pair)->size != 2) Fsignal (Qerror, - Fcons (build_string + Fcons (build_string ("elements of the vector must be vectors of exactly two elements"), Fcons (pair, Qnil))); - + (*(Atom **) data_ret) [i * 2] = symbol_to_x_atom (dpyinfo, display, XVECTOR (pair)->contents [0]); @@ -1618,7 +1829,7 @@ lisp_data_to_selection_data (display, obj, Fcons (build_string ("all elements of the vector must be of the same type"), Fcons (obj, Qnil))); - + } #endif else @@ -1659,20 +1870,20 @@ clean_local_selection_data (obj) 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)) { @@ -1681,7 +1892,7 @@ clean_local_selection_data (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]); @@ -1691,7 +1902,9 @@ clean_local_selection_data (obj) } /* Called from XTread_socket to handle SelectionNotify events. - If it's the selection we are waiting for, stop waiting. */ + If it's the selection we are waiting for, stop waiting + by setting the car of reading_selection_reply to non-nil. + We store t there if the reply is successful, lambda if not. */ void x_handle_selection_notify (event) @@ -1702,24 +1915,25 @@ x_handle_selection_notify (event) if (event->selection != reading_which_selection) return; - XCONS (reading_selection_reply)->car = Qt; + TRACE0 ("Received SelectionNotify"); + XSETCAR (reading_selection_reply, + (event->property != 0 ? Qt : Qlambda)); } -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); - if (NILP (selection_value)) error ("selection-value may not be nil."); + 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; } @@ -1729,47 +1943,49 @@ anything that the functions on `selection-converter-alist' know about.") 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) - Lisp_Object selection_symbol, target_type; +DEFUN ("x-get-selection-internal", Fx_get_selection_internal, + Sx_get_selection_internal, 2, 3, 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'. +TIME_STAMP is the time to use in the XConvertSelection call for foreign +selections. If omitted, defaults to the time for the last event. */) + (selection_symbol, target_type, time_stamp) + Lisp_Object selection_symbol, target_type, time_stamp; { 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); + val = x_get_local_selection (selection_symbol, target_type, 1); if (NILP (val)) { - val = x_get_foreign_selection (selection_symbol, target_type); + val = x_get_foreign_selection (selection_symbol, target_type, time_stamp); goto DONE; } 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: @@ -1777,24 +1993,25 @@ TYPE is the type of data desired, typically `STRING'.") 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 @@ -1817,7 +2034,7 @@ Disowning it means there is no such selection.") 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; } @@ -1832,65 +2049,65 @@ x_disown_buffer_selections (buffer) 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; - + if (NILP (Fassq (selection, Vselection_alist))) return Qnil; return Qt; } 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; @@ -1925,8 +2142,8 @@ initialize_cut_buffers (display, window) } -#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) \ @@ -1937,9 +2154,9 @@ initialize_cut_buffers (display, window) } 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; @@ -1952,34 +2169,38 @@ DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, 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; @@ -1989,27 +2210,28 @@ DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal, 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; + data = (unsigned char *) SDATA (string); + bytes = SBYTES (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; @@ -2037,26 +2259,27 @@ DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal, 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; @@ -2075,6 +2298,351 @@ positive means move values forward, negative means backward.") #endif +/*********************************************************************** + Drag and drop support +***********************************************************************/ +/* Check that lisp values are of correct type for x_fill_property_data. + That is, number, string or a cons with two numbers (low and high 16 + bit parts of a 32 bit number). */ + +int +x_check_property_data (data) + Lisp_Object data; +{ + Lisp_Object iter; + int size = 0; + + for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size) + { + Lisp_Object o = XCAR (iter); + + if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o)) + size = -1; + else if (CONSP (o) && + (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o)))) + size = -1; + } + + return size; +} + +/* Convert lisp values to a C array. Values may be a number, a string + which is taken as an X atom name and converted to the atom value, or + a cons containing the two 16 bit parts of a 32 bit number. + + DPY is the display use to look up X atoms. + DATA is a Lisp list of values to be converted. + RET is the C array that contains the converted values. It is assumed + it is big enough to hol all values. + FORMAT is 8, 16 or 32 and gives the size in bits for each C value to + be stored in RET. */ + +void +x_fill_property_data (dpy, data, ret, format) + Display *dpy; + Lisp_Object data; + void *ret; + int format; +{ + CARD32 val; + CARD32 *d32 = (CARD32 *) ret; + CARD16 *d16 = (CARD16 *) ret; + CARD8 *d08 = (CARD8 *) ret; + Lisp_Object iter; + + for (iter = data; CONSP (iter); iter = XCDR (iter)) + { + Lisp_Object o = XCAR (iter); + + if (INTEGERP (o)) + val = (CARD32) XFASTINT (o); + else if (FLOATP (o)) + val = (CARD32) XFLOAT (o); + else if (CONSP (o)) + val = (CARD32) cons_to_long (o); + else if (STRINGP (o)) + { + BLOCK_INPUT; + val = XInternAtom (dpy, (char *) SDATA (o), False); + UNBLOCK_INPUT; + } + else + error ("Wrong type, must be string, number or cons"); + + if (format == 8) + *d08++ = (CARD8) val; + else if (format == 16) + *d16++ = (CARD16) val; + else + *d32++ = val; + } +} + +/* Convert an array of C values to a Lisp list. + F is the frame to be used to look up X atoms if the TYPE is XA_ATOM. + DATA is a C array of values to be converted. + TYPE is the type of the data. Only XA_ATOM is special, it converts + each number in DATA to its corresponfing X atom as a symbol. + FORMAT is 8, 16 or 32 and gives the size in bits for each C value to + be stored in RET. + SIZE is the number of elements in DATA. + + Also see comment for selection_data_to_lisp_data above. */ + +Lisp_Object +x_property_data_to_lisp (f, data, type, format, size) + struct frame *f; + unsigned char *data; + Atom type; + int format; + unsigned long size; +{ + return selection_data_to_lisp_data (FRAME_X_DISPLAY (f), + data, size*format/8, type, format); +} + +/* Get the mouse position frame relative coordinates. */ + +static void +mouse_position_for_drop (f, x, y) + FRAME_PTR f; + int *x; + int *y; +{ + Window root, dummy_window; + int dummy; + + BLOCK_INPUT; + + XQueryPointer (FRAME_X_DISPLAY (f), + DefaultRootWindow (FRAME_X_DISPLAY (f)), + + /* The root window which contains the pointer. */ + &root, + + /* Window pointer is on, not used */ + &dummy_window, + + /* The position on that root window. */ + x, y, + + /* x/y in dummy_window coordinates, not used. */ + &dummy, &dummy, + + /* Modifier keys and pointer buttons, about which + we don't care. */ + (unsigned int *) &dummy); + + + /* Absolute to relative. */ + *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f); + *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f); + + UNBLOCK_INPUT; +} + +DEFUN ("x-get-atom-name", Fx_get_atom_name, + Sx_get_atom_name, 1, 2, 0, + doc: /* Return the X atom name for VALUE as a string. +VALUE may be a number or a cons where the car is the upper 16 bits and +the cdr is the lower 16 bits of a 32 bit value. +Use the display for FRAME or the current frame if FRAME is not given or nil. + +If the value is 0 or the atom is not known, return the empty string. */) + (value, frame) + Lisp_Object value, frame; +{ + struct frame *f = check_x_frame (frame); + char *name = 0; + Lisp_Object ret = Qnil; + int count; + Display *dpy = FRAME_X_DISPLAY (f); + Atom atom; + + if (INTEGERP (value)) + atom = (Atom) XUINT (value); + else if (FLOATP (value)) + atom = (Atom) XFLOAT (value); + else if (CONSP (value)) + atom = (Atom) cons_to_long (value); + else + error ("Wrong type, value must be number or cons"); + + BLOCK_INPUT; + count = x_catch_errors (dpy); + + name = atom ? XGetAtomName (dpy, atom) : ""; + + if (! x_had_errors_p (dpy)) + ret = make_string (name, strlen (name)); + + x_uncatch_errors (dpy, count); + + if (atom && name) XFree (name); + if (NILP (ret)) ret = make_string ("", 0); + + UNBLOCK_INPUT; + + return ret; +} + +/* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. + TODO: Check if this client event really is a DND event? */ + +int +x_handle_dnd_message (f, event, dpyinfo, bufp) + struct frame *f; + XClientMessageEvent *event; + struct x_display_info *dpyinfo; + struct input_event *bufp; +{ + Lisp_Object vec; + Lisp_Object frame; + unsigned long size = (8*sizeof (event->data))/event->format; + int x, y; + + XSETFRAME (frame, f); + + vec = Fmake_vector (make_number (4), Qnil); + AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f), + event->message_type)); + AREF (vec, 1) = frame; + AREF (vec, 2) = make_number (event->format); + AREF (vec, 3) = x_property_data_to_lisp (f, + event->data.b, + event->message_type, + event->format, + size); + + mouse_position_for_drop (f, &x, &y); + bufp->kind = DRAG_N_DROP_EVENT; + bufp->frame_or_window = Fcons (frame, vec); + bufp->timestamp = CurrentTime; + bufp->x = make_number (x); + bufp->y = make_number (y); + bufp->arg = Qnil; + bufp->modifiers = 0; + + return 1; +} + +DEFUN ("x-send-client-message", Fx_send_client_event, + Sx_send_client_message, 6, 6, 0, + doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY. + +For DISPLAY, specify either a frame or a display name (a string). +If DISPLAY is nil, that stands for the selected frame's display. +DEST may be a number, in which case it is a Window id. The value 0 may +be used to send to the root window of the DISPLAY. +If DEST is a cons, it is converted to a 32 bit number +with the high 16 bits from the car and the lower 16 bit from the cdr. That +number is then used as a window id. +If DEST is a frame the event is sent to the outer window of that frame. +Nil means the currently selected frame. +If DEST is the string "PointerWindow" the event is sent to the window that +contains the pointer. If DEST is the string "InputFocus" the event is +sent to the window that has the input focus. +FROM is the frame sending the event. Use nil for currently selected frame. +MESSAGE-TYPE is the name of an Atom as a string. +FORMAT must be one of 8, 16 or 32 and determines the size of the values in +bits. VALUES is a list of numbers, cons and/or strings containing the values +to send. If a value is a string, it is converted to an Atom and the value of +the Atom is sent. If a value is a cons, it is converted to a 32 bit number +with the high 16 bits from the car and the lower 16 bit from the cdr. +If more values than fits into the event is given, the excessive values +are ignored. */) + (display, dest, from, message_type, format, values) + Lisp_Object display, dest, from, message_type, format, values; +{ + struct x_display_info *dpyinfo = check_x_display_info (display); + Window wdest; + XEvent event; + Lisp_Object cons; + int size; + struct frame *f = check_x_frame (from); + int count; + int to_root; + + CHECK_STRING (message_type); + CHECK_NUMBER (format); + CHECK_CONS (values); + + if (x_check_property_data (values) == -1) + error ("Bad data in VALUES, must be number, cons or string"); + + event.xclient.type = ClientMessage; + event.xclient.format = XFASTINT (format); + + if (event.xclient.format != 8 && event.xclient.format != 16 + && event.xclient.format != 32) + error ("FORMAT must be one of 8, 16 or 32"); + + if (FRAMEP (dest) || NILP (dest)) + { + struct frame *fdest = check_x_frame (dest); + wdest = FRAME_OUTER_WINDOW (fdest); + } + else if (STRINGP (dest)) + { + if (strcmp (SDATA (dest), "PointerWindow") == 0) + wdest = PointerWindow; + else if (strcmp (SDATA (dest), "InputFocus") == 0) + wdest = InputFocus; + else + error ("DEST as a string must be one of PointerWindow or InputFocus"); + } + else if (INTEGERP (dest)) + wdest = (Window) XFASTINT (dest); + else if (FLOATP (dest)) + wdest = (Window) XFLOAT (dest); + else if (CONSP (dest)) + { + if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest))) + error ("Both car and cdr for DEST must be numbers"); + else + wdest = (Window) cons_to_long (dest); + } + else + error ("DEST must be a frame, nil, string, number or cons"); + + if (wdest == 0) wdest = dpyinfo->root_window; + to_root = wdest == dpyinfo->root_window; + + for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size) + ; + + BLOCK_INPUT; + + event.xclient.message_type + = XInternAtom (dpyinfo->display, SDATA (message_type), False); + event.xclient.display = dpyinfo->display; + + /* Some clients (metacity for example) expects sending window to be here + when sending to the root window. */ + event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest; + + memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b)); + x_fill_property_data (dpyinfo->display, values, event.xclient.data.b, + event.xclient.format); + + /* If event mask is 0 the event is sent to the client that created + the destination window. But if we are sending to the root window, + there is no such client. Then we set the event mask to 0xffff. The + event then goes to clients selecting for events on the root window. */ + count = x_catch_errors (dpyinfo->display); + { + int propagate = to_root ? False : True; + unsigned mask = to_root ? 0xffff : 0; + XSendEvent (dpyinfo->display, wdest, propagate, mask, &event); + XFlush (dpyinfo->display); + } + x_uncatch_errors (dpyinfo->display, count); + UNBLOCK_INPUT; + + return Qnil; +} + + void syms_of_xselect () { @@ -2090,6 +2658,9 @@ syms_of_xselect () defsubr (&Sx_rotate_cut_buffers_internal); #endif + defsubr (&Sx_get_atom_name); + defsubr (&Sx_send_client_message); + reading_selection_reply = Fcons (Qnil, Qnil); staticpro (&reading_selection_reply); reading_selection_window = 0; @@ -2104,47 +2675,62 @@ syms_of_xselect () 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 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."); + 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); @@ -2154,6 +2740,8 @@ A value of 0 means wait as long as necessary. This is initialized from the\n\ QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD); QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP); QTEXT = intern ("TEXT"); staticpro (&QTEXT); + QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT); + QUTF8_STRING = intern ("UTF8_STRING"); staticpro (&QUTF8_STRING); QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP); QDELETE = intern ("DELETE"); staticpro (&QDELETE); QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE); @@ -2163,6 +2751,8 @@ A value of 0 means wait as long as necessary. This is initialized from the\n\ 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); @@ -2175,4 +2765,9 @@ A value of 0 means wait as long as necessary. This is initialized from the\n\ QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7); #endif + Qforeign_selection = intern ("foreign-selection"); + staticpro (&Qforeign_selection); } + +/* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236 + (do not change this comment) */