* configure.in (HAVE_RANDOM_HEAPSTART): Change AC_MSG_ERROR to
[bpt/emacs.git] / src / xselect.c
index bf1690e..1e3efd2 100644 (file)
@@ -1,5 +1,5 @@
 /* X Selection processing for Emacs.
-   Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003
+   Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004
    Free Software Foundation.
 
 This file is part of GNU Emacs.
@@ -23,16 +23,17 @@ Boston, MA 02111-1307, USA.  */
 /* Rewritten by jwz */
 
 #include <config.h>
+#include <stdio.h>      /* 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 "charset.h"
-#include "coding.h"
 #include "process.h"
-#include "composite.h"
+#include "termhooks.h"
+
+#include <X11/Xproto.h>
 
 struct prop_location;
 
@@ -53,7 +54,9 @@ static struct prop_location *expect_property_change P_ ((Display *, Window,
 static void unexpect_property_change P_ ((struct prop_location *));
 static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
 static void wait_for_property_change P_ ((struct prop_location *));
-static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object, Lisp_Object));
+static 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));
@@ -114,6 +117,8 @@ 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
@@ -425,6 +430,9 @@ x_get_local_selection (selection_symbol, target_type, local_request)
 
       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, (local_request ? Qnil : target_type),
@@ -736,7 +744,15 @@ x_reply_selection_request (event, format, data, size, type)
      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);
+  /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
+     delivered before uncatch errors.  */
+  XSync (display, False);
+  UNBLOCK_INPUT;
+
+  /* GTK queues events in addition to the queue in Xlib.  So we
+     UNBLOCK to enter the event loop and get possible errors delivered,
+     and then BLOCK again because x_uncatch_errors requires it.  */
+  BLOCK_INPUT;
   x_uncatch_errors (display, count);
   UNBLOCK_INPUT;
 }
@@ -837,8 +853,6 @@ x_handle_selection_request (event)
 
  DONE:
 
-  UNGCPRO;
-
   /* Let random lisp code notice that the selection has been asked for.  */
   {
     Lisp_Object rest;
@@ -847,6 +861,8 @@ x_handle_selection_request (event)
       for (; CONSP (rest); rest = Fcdr (rest))
        call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
   }
+
+  UNGCPRO;
 }
 \f
 /* Handle a SelectionClear event EVENT, which indicates that some
@@ -1101,7 +1117,8 @@ 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);
+      wait_reading_process_output (secs, usecs, 0, 0,
+                                  property_change_reply, NULL, 0);
 
       if (NILP (XCAR (property_change_reply)))
        {
@@ -1213,8 +1230,8 @@ 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;
 {
   struct frame *sf = SELECTED_FRAME ();
   Window requestor_window = FRAME_X_WINDOW (sf);
@@ -1233,6 +1250,18 @@ x_get_foreign_selection (selection_symbol, 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;
 
   count = x_catch_errors (display);
@@ -1268,7 +1297,8 @@ x_get_foreign_selection (selection_symbol, target_type)
   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);
+  wait_reading_process_output (secs, usecs, 0, 0,
+                              reading_selection_reply, NULL, 0);
   TRACE1 ("  Got event = %d", !NILP (XCAR (reading_selection_reply)));
 
   BLOCK_INPUT;
@@ -1602,74 +1632,21 @@ selection_data_to_lisp_data (display, data, size, type, format)
   /* Convert any 8-bit data to a string, for compactness.  */
   else if (format == 8)
     {
-      Lisp_Object str;
-      int require_encoding = 0;
-
-      if (
-#if 1
-         1
-#else
-         ! NILP (buffer_defaults.enable_multibyte_characters)
-#endif
-         )
-       {
-         /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
-            DATA to Emacs internal format because DATA may be encoded
-            in compound text format.  In addtion, if TYPE is `STRING'
-            and DATA contains any 8-bit Latin-1 code, we should also
-            decode it.  */
-         if (type == dpyinfo->Xatom_TEXT
-             || type == dpyinfo->Xatom_COMPOUND_TEXT)
-           require_encoding = 1;
-         else if (type == XA_STRING)
-           {
-             int i;
-             for (i = 0; i < size; i++)
-               {
-                 if (data[i] >= 0x80)
-                   {
-                     require_encoding = 1;
-                     break;
-                   }
-               }
-           }
-       }
-      if (!require_encoding)
-       {
-         str = make_unibyte_string ((char *) data, size);
-         Vlast_coding_system_used = Qraw_text;
-       }
+      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
-       {
-         int bufsize;
-         unsigned char *buf;
-         struct coding_system coding;
-
-         if (NILP (Vnext_selection_coding_system))
-           Vnext_selection_coding_system = Vselection_coding_system;
-         setup_coding_system
-           (Fcheck_coding_system(Vnext_selection_coding_system), &coding);
-         coding.src_multibyte = 0;
-         coding.dst_multibyte = 1;
-         Vnext_selection_coding_system = Qnil;
-          coding.mode |= CODING_MODE_LAST_BLOCK;
-         /* We explicitely disable composition handling because
-            selection data should not contain any composition
-            sequence.  */
-         coding.composing = COMPOSITION_DISABLED;
-         bufsize = decoding_buffer_size (&coding, size);
-         buf = (unsigned char *) xmalloc (bufsize);
-         decode_coding (&coding, data, buf, size, bufsize);
-         str = make_string_from_bytes ((char *) buf,
-                                       coding.produced_char, coding.produced);
-         xfree (buf);
-
-         if (SYMBOLP (coding.post_read_conversion)
-             && !NILP (Ffboundp (coding.post_read_conversion)))
-           str = run_pre_post_conversion_on_str (str, &coding, 0);
-         Vlast_coding_system_used = coding.symbol;
-       }
-      compose_chars_in_text (0, SCHARS (str), str);
+       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
@@ -1977,13 +1954,15 @@ anything that the functions on `selection-converter-alist' know about.  */)
    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,
+       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'.  */)
-     (selection_symbol, target_type)
-     Lisp_Object selection_symbol, target_type;
+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;
@@ -2007,7 +1986,7 @@ TYPE is the type of data desired, typically `STRING'.  */)
 
   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;
     }
 
@@ -2329,6 +2308,351 @@ Positive means shift the values forward, negative means backward.  */)
 
 #endif
 \f
+/***********************************************************************
+                      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;
+}
+
+\f
 void
 syms_of_xselect ()
 {
@@ -2344,6 +2668,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;
@@ -2448,4 +2775,9 @@ A value of 0 means wait as long as necessary.  This is initialized from the
   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) */