/* X Selection processing for Emacs.
- Copyright (C) 1993, 1994, 1995 Free Software Foundation.
+ Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation.
This file is part of GNU Emacs.
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 "dispextern.h" /* frame.h seems to want this */
#include "frame.h" /* Need this to get the X window of selected_frame */
#include "blockinput.h"
-
-#define xfree free
+#include "charset.h"
+#include "coding.h"
#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. */
+
#ifdef CUT_BUFFER_SUPPORT
Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
#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 (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;
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)
if (! str) return Qnil;
val = intern (str);
BLOCK_INPUT;
+ /* This was allocated by Xlib, so use XFree. */
XFree (str);
UNBLOCK_INPUT;
return val;
Time time = last_event_timestamp;
Atom selection_atom;
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
+ int count;
CHECK_SYMBOL (selection_name, 0);
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 */
static struct input_event *x_selection_current_request;
/* 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
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.
/* 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!");
+ error ("Attempt to transfer an INCR to ourself!");
#if 0
fprintf (stderr, "\nINCR %d\n", bytes_remaining);
#endif
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);
if (had_errors)
break;
- /* Now wait for the requestor to ack this chunk by deleting the
+ /* Now wait for the requester to ack this chunk by deleting the
property. This can run random lisp code or signal.
*/
wait_for_property_change (wait_object);
}
- /* Now write a zero-length chunk to the property to tell the requestor
+ /* Now write a zero-length chunk to the property to tell the requester
that we're done. */
#if 0
fprintf (stderr," INCR done\n");
XChangeProperty (display, window, reply.property, type, format,
PropModeReplace, data, 0);
-
- unbind_to (count, Qnil);
}
XFlush (display);
- x_uncatch_errors (display);
+ x_uncatch_errors (display, count);
UNBLOCK_INPUT;
}
\f
/* Indicate we have successfully processed this event. */
x_selection_current_request = 0;
+ /* Use free, not XFree, because lisp_data_to_selection_data
+ calls xmalloc itself. */
if (!nofree)
- xfree (data);
+ free (data);
}
unbind_to (count, Qnil);
/* Otherwise, we're really honest and truly being told to drop it.
Don't use Fdelq as that may QUIT;. */
+ /* Delete elements from the beginning of Vselection_alist. */
+ while (!NILP (Vselection_alist)
+ && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
+ {
+ /* 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 (Vselection_alist));
+
+ if (!EQ (hooks, Qunbound))
+ {
+ for (; CONSP (hooks); hooks = Fcdr (hooks))
+ call1 (Fcar (hooks), selection_symbol);
+#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 ();
+#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)))))))
{
Lisp_Object hooks, selection_symbol;
hooks = Vx_lost_selection_hooks;
- selection_symbol = Fcar (XCONS (rest)->cdr);
+ selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
if (!EQ (hooks, Qunbound))
{
for (; CONSP (hooks); hooks = Fcdr (hooks))
call1 (Fcar (hooks), selection_symbol);
+#if 0 /* See above */
redisplay_preserve_echo_area ();
+#endif
}
XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
break;
expect_property_change (display, window, property, state)
Display *display;
Window window;
- Lisp_Object property;
+ Atom property;
int state;
{
struct prop_location *pl
prev->next = rest->next;
else
property_change_wait_list = rest->next;
- xfree (rest);
+ free (rest);
return;
}
prev = rest;
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");
+ error ("Timed out waiting for property-notify event");
}
unbind_to (count, Qnil);
prev->next = rest->next;
else
property_change_wait_list = rest->next;
- xfree (rest);
+ free (rest);
return;
}
prev = rest;
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, target_type);
BLOCK_INPUT;
- x_catch_errors (display);
+ count = x_catch_errors (display);
XConvertSelection (display, selection_atom, type_atom, target_property,
requestor_window, requestor_time);
XFlush (display);
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");
+ error ("Timed out waiting for reply from selection owner");
+ if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
+ error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
/* Otherwise, the selection is waiting for us on the requested property. */
return
\f
/* Subroutines of x_get_window_property_as_lisp_data */
+/* Use free, 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,
*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)
{
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
*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 free, 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,
int tmp_size_bytes;
wait_for_property_change (wait_object);
/* expect it again immediately, because x_get_window_property may
- .. no it wont, I dont get it.
+ .. no it won't, I don't get it.
.. Ok, I get it now, the Xt code that implements INCR is broken.
*/
x_get_window_property (display, window, property,
if (! waiting_for_other_props_on_window (display, window))
XSelectInput (display, window, STANDARD_EVENT_SET);
unexpect_property_change (wait_object);
- if (tmp_data) xfree (tmp_data);
+ /* Use free, not XFree, because x_get_window_property
+ calls xmalloc itself. */
+ if (tmp_data) free (tmp_data);
break;
}
}
bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
offset += tmp_size_bytes;
- xfree (tmp_data);
+ /* Use free, not XFree, because x_get_window_property
+ calls xmalloc itself. */
+ free (tmp_data);
}
}
\f
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,
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 (dpyinfo, display,
+ selection_atom),
+ Qnil)));
}
if (actual_type == dpyinfo->Xatom_INCR)
unsigned int min_size_bytes = * ((unsigned int *) data);
BLOCK_INPUT;
- XFree ((char *) data);
+ /* Use free, not XFree, because x_get_window_property
+ calls xmalloc itself. */
+ free ((char *) data);
UNBLOCK_INPUT;
receive_incremental_selection (display, window, property, target_type,
min_size_bytes, &data, &bytes,
val = selection_data_to_lisp_data (display, data, bytes,
actual_type, actual_format);
- xfree ((char *) data);
+ /* Use free, not XFree, because x_get_window_property
+ calls xmalloc itself. */
+ free ((char *) data);
return val;
}
\f
/* 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 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_string ((char *) data, size);
+ else
+ {
+ int bufsize, dummy;
+ unsigned char *buf;
+ struct coding_system coding;
+ Lisp_Object sym = intern ("iso-8859-1");
+
+ setup_coding_system (Fcheck_coding_system (sym), &coding);
+ coding.last_block = 1;
+ bufsize = decoding_buffer_size (&coding, size);
+ buf = (unsigned char *) xmalloc (bufsize);
+ size = decode_coding (&coding, data, buf, size, bufsize, &dummy);
+ str = make_string ((char *) buf, size);
+ xfree (buf);
+ }
+ return str;
+ }
/* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
a vector of symbols.
*/
}
+/* Use free, 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,
}
else if (STRINGP (obj))
{
+ /* Since we are now handling multilingual text, we must consider
+ sending back compound text. */
+ int charsets[MAX_CHARSET + 1];
+ int num;
+
*format_ret = 8;
*size_ret = XSTRING (obj)->size;
*data_ret = XSTRING (obj)->data;
- *nofree_ret = 1;
- if (NILP (type)) type = QSTRING;
+ bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
+ num = ((*size_ret <= 1) /* Check the possibility of short cut. */
+ ? 0
+ : find_charset_in_str (*data_ret, *size_ret, charsets, Qnil));
+
+ if (!num || (num == 1 && charsets[CHARSET_ASCII]))
+ {
+ /* No multibyte character in OBJ. We need not encode it. */
+ *nofree_ret = 1;
+ if (NILP (type)) type = QSTRING;
+ }
+ else
+ {
+ /* We must encode contents of OBJ to compound text format.
+ The format is compatible with what the target `STRING'
+ expects if OBJ contains only ASCII and Latin-1
+ characters. */
+ int bufsize, dummy;
+ unsigned char *buf;
+ struct coding_system coding;
+ Lisp_Object sym = intern ("iso-8859-1");
+
+ setup_coding_system (Fcheck_coding_system (sym), &coding);
+ coding.last_block = 1;
+ bufsize = encoding_buffer_size (&coding, *size_ret);
+ buf = (unsigned char *) xmalloc (bufsize);
+ *size_ret = encode_coding (&coding, *data_ret, buf,
+ *size_ret, bufsize, &dummy);
+ *data_ret = buf;
+ if (charsets[charset_latin_iso8859_1]
+ && (num == 1 || (num == 2 && charsets[CHARSET_ASCII])))
+ {
+ /* Ok, we can return it as `STRING'. */
+ if (NILP (type)) type = QSTRING;
+ }
+ else
+ {
+ /* We must return it as `COMPOUND_TEXT'. */
+ if (NILP (type)) type = QCOMPOUND_TEXT;
+ }
+ }
}
else if (SYMBOLP (obj))
{
}
\f
/* 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)
if (event->selection != reading_which_selection)
return;
- XCONS (reading_selection_reply)->car = Qt;
+ XCONS (reading_selection_reply)->car
+ = (event->property != 0 ? Qt : Qlambda);
}
\f
-DEFUN ("x-own-selection-internal",
- Fx_own_selection_internal, Sx_own_selection_internal,
- 2, 2, 0,
+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\
{
check_x ();
CHECK_SYMBOL (selection_name, 0);
- if (NILP (selection_value)) error ("selection-value may not be nil.");
+ 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,
+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\
return val;
}
-DEFUN ("x-disown-selection-internal",
- Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
+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)
Fcons (make_number (format), Qnil))));
ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
- xfree (data);
+ /* Use free, not XFree, because x_get_window_property
+ calls xmalloc itself. */
+ free (data);
return ret;
}
\(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'.)");
+\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
Vx_lost_selection_hooks = Qnil;
DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
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\
+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.");
x_selection_timeout = 0;
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);