]> code.delx.au - gnu-emacs/blobdiff - src/xselect.c
Merge from emacs--devo--0
[gnu-emacs] / src / xselect.c
index 71232ee87bae9bf4c821d0d44defb27cdedf22e5..7e77df0d6c3aaeb6429a896965f56d583c35c454 100644 (file)
@@ -1,12 +1,12 @@
 /* X Selection processing for Emacs.
    Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
-                 2004, 2005, 2006 Free Software Foundation, Inc.
+                 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -55,6 +55,7 @@ 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 Lisp_Object x_catch_errors_unwind P_ ((Lisp_Object));
 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));
@@ -122,8 +123,8 @@ Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
 
 static Lisp_Object Vx_lost_selection_functions;
 static Lisp_Object Vx_sent_selection_functions;
-/* Coding system for communicating with other X clients via cutbuffer,
-   selection, and clipboard.  */
+/* Coding system for communicating with other X clients via selection
+   and clipboard.  */
 static Lisp_Object Vselection_coding_system;
 
 /* Coding system for the next communicating with other X clients.  */
@@ -402,7 +403,6 @@ x_own_selection (selection_name, selection_value)
   Time time = last_event_timestamp;
   Atom selection_atom;
   struct x_display_info *dpyinfo;
-  int count;
 
   if (! FRAME_X_P (sf))
     return;
@@ -415,10 +415,10 @@ x_own_selection (selection_name, selection_value)
   selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
 
   BLOCK_INPUT;
-  count = x_catch_errors (display);
+  x_catch_errors (display);
   XSetSelectionOwner (display, selection_atom, selecting_window, time);
   x_check_errors (display, "Can't set selection: %s");
-  x_uncatch_errors (display, count);
+  x_uncatch_errors ();
   UNBLOCK_INPUT;
 
   /* Now update the local cache */
@@ -562,11 +562,9 @@ x_get_local_selection (selection_symbol, target_type, local_request)
                && INTEGERP (XCAR (XCDR (check)))
                && NILP (XCDR (XCDR (check))))))
     return value;
-  else
-    return
-      Fsignal (Qerror,
-              Fcons (build_string ("invalid data returned by selection-conversion function"),
-                     Fcons (handler_fn, Fcons (value, Qnil))));
+
+  signal_error ("Invalid data returned by selection-conversion function",
+               list2 (handler_fn, value));
 }
 \f
 /* Subroutines of x_reply_selection_request.  */
@@ -579,7 +577,6 @@ x_decline_selection_request (event)
      struct input_event *event;
 {
   XSelectionEvent reply;
-  int count;
 
   reply.type = SelectionNotify;
   reply.display = SELECTION_EVENT_DISPLAY (event);
@@ -592,10 +589,10 @@ x_decline_selection_request (event)
   /* The reason for the error may be that the receiver has
      died in the meantime.  Handle that case.  */
   BLOCK_INPUT;
-  count = x_catch_errors (reply.display);
+  x_catch_errors (reply.display);
   XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
   XFlush (reply.display);
-  x_uncatch_errors (reply.display, count);
+  x_uncatch_errors ();
   UNBLOCK_INPUT;
 }
 
@@ -620,6 +617,16 @@ x_selection_request_lisp_error (ignore)
     x_decline_selection_request (x_selection_current_request);
   return Qnil;
 }
+
+static Lisp_Object
+x_catch_errors_unwind (dummy)
+     Lisp_Object dummy;
+{
+  BLOCK_INPUT;
+  x_uncatch_errors ();
+  UNBLOCK_INPUT;
+  return Qnil;
+}
 \f
 
 /* This stuff is so that INCR selections are reentrant (that is, so we can
@@ -698,7 +705,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;
+  int count = SPECPDL_INDEX ();
 
   if (max_bytes > MAX_SELECTION_QUANTUM)
     max_bytes = MAX_SELECTION_QUANTUM;
@@ -713,9 +720,12 @@ x_reply_selection_request (event, format, data, size, type)
   if (reply.property == None)
     reply.property = reply.target;
 
-  /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
   BLOCK_INPUT;
-  count = x_catch_errors (display);
+  /* The protected block contains wait_for_property_change, which can
+     run random lisp code (process handlers) or signal.  Therefore, we
+     put the x_uncatch_errors call in an unwind.  */
+  record_unwind_protect (x_catch_errors_unwind, Qnil);
+  x_catch_errors (display);
 
 #ifdef TRACE_SELECTION
   {
@@ -833,7 +843,7 @@ x_reply_selection_request (event, format, data, size, type)
            break;
 
          /* Now wait for the requester to ack this chunk by deleting the
-            property.   This can run random lisp code or signal.  */
+            property.  This can run random lisp code or signal.  */
          TRACE1 ("Waiting for increment ACK (deletion of %s)",
                  XGetAtomName (display, reply.property));
          wait_for_property_change (wait_object);
@@ -868,7 +878,8 @@ x_reply_selection_request (event, format, data, size, type)
      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);
+  /* This calls x_uncatch_errors.  */
+  unbind_to (count, Qnil);
   UNBLOCK_INPUT;
 }
 \f
@@ -953,6 +964,12 @@ x_handle_selection_request (event)
       Atom type;
       int nofree;
 
+      if (CONSP (converted_selection) && NILP (XCDR (converted_selection)))
+        {
+          x_decline_selection_request (event);
+          goto DONE2;
+        }
+
       lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
                                   converted_selection,
                                   &data, &type, &size, &format, &nofree);
@@ -968,6 +985,8 @@ x_handle_selection_request (event)
       if (!nofree)
        xfree (data);
     }
+
+ DONE2:
   unbind_to (count, Qnil);
 
  DONE:
@@ -1003,6 +1022,7 @@ x_handle_selection_clear (event)
 
   TRACE0 ("x_handle_selection_clear");
 
+#ifdef MULTI_KBOARD  
   /* If the new selection owner is also Emacs,
      don't clear the new selection.  */
   BLOCK_INPUT;
@@ -1021,7 +1041,8 @@ x_handle_selection_clear (event)
          }
       }
   UNBLOCK_INPUT;
-
+#endif
+  
   selection_symbol = x_atom_to_symbol (display, selection);
 
   local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
@@ -1343,8 +1364,7 @@ copy_multiple_data (obj)
       CHECK_VECTOR (vec2);
       if (XVECTOR (vec2)->size != 2)
        /* ??? Confusing error message */
-       Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
-                               Fcons (vec2, Qnil)));
+       signal_error ("Vectors must be of length 2", vec2);
       XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
       XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
        = XVECTOR (vec2)->contents [0];
@@ -1378,7 +1398,7 @@ x_get_foreign_selection (selection_symbol, target_type, time_stamp)
   Atom selection_atom;
   Atom type_atom;
   int secs, usecs;
-  int count;
+  int count = SPECPDL_INDEX ();
   Lisp_Object frame;
 
   if (! FRAME_X_P (sf))
@@ -1409,7 +1429,11 @@ x_get_foreign_selection (selection_symbol, target_type, time_stamp)
 
   BLOCK_INPUT;
 
-  count = x_catch_errors (display);
+  /* The protected block contains wait_reading_process_output, which
+     can run random lisp code (process handlers) or signal.
+     Therefore, we put the x_uncatch_errors call in an unwind.  */
+  record_unwind_protect (x_catch_errors_unwind, Qnil);
+  x_catch_errors (display);
 
   TRACE2 ("Get selection %s, type %s",
          XGetAtomName (display, type_atom),
@@ -1447,8 +1471,10 @@ x_get_foreign_selection (selection_symbol, target_type, time_stamp)
   TRACE1 ("  Got event = %d", !NILP (XCAR (reading_selection_reply)));
 
   BLOCK_INPUT;
-  x_check_errors (display, "Cannot get selection: %s");
-  x_uncatch_errors (display, count);
+  if (x_had_errors_p (display))
+    error ("Cannot get selection");
+  /* This calls x_uncatch_errors.  */
+  unbind_to (count, Qnil);
   UNBLOCK_INPUT;
 
   if (NILP (XCAR (reading_selection_reply)))
@@ -1715,19 +1741,15 @@ x_get_window_property_as_lisp_data (display, window, property, target_type,
       there_is_a_selection_owner
        = XGetSelectionOwner (display, selection_atom);
       UNBLOCK_INPUT;
-      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 (display,
-                                                         actual_type),
-                                       Qnil))
-                       : Fcons (target_type, Qnil))
-              : Fcons (build_string ("no selection"),
-                       Fcons (x_atom_to_symbol (display,
-                                                selection_atom),
-                              Qnil)));
+      if (there_is_a_selection_owner)
+       signal_error ("Selection owner couldn't convert",
+                     actual_type
+                     ? list2 (target_type,
+                              x_atom_to_symbol (display, actual_type))
+                     : target_type);
+      else
+       signal_error ("No selection",
+                     x_atom_to_symbol (display, selection_atom));
     }
 
   if (actual_type == dpyinfo->Xatom_INCR)
@@ -1927,10 +1949,7 @@ lisp_data_to_selection_data (display, obj,
     {
       if (SCHARS (obj) < SBYTES (obj))
        /* OBJ is a multibyte string containing a non-ASCII char.  */
-       Fsignal (Qerror, /* Qselection_error */
-                Fcons (build_string
-                       ("Non-ASCII string must be encoded in advance"),
-                       Fcons (obj, Qnil)));
+       signal_error ("Non-ASCII string must be encoded in advance", obj);
       if (NILP (type))
        type = QSTRING;
       *format_ret = 8;
@@ -1991,10 +2010,7 @@ lisp_data_to_selection_data (display, obj,
              (*(Atom **) data_ret) [i]
                = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
            else
-             Fsignal (Qerror, /* Qselection_error */
-                      Fcons (build_string
-                  ("all elements of selection vector must have same type"),
-                             Fcons (obj, Qnil)));
+             signal_error ("All elements of selection vector must have same type", obj);
        }
 #if 0 /* #### MULTIPLE doesn't work yet */
       else if (VECTORP (XVECTOR (obj)->contents [0]))
@@ -2010,10 +2026,9 @@ lisp_data_to_selection_data (display, obj,
              {
                Lisp_Object pair = XVECTOR (obj)->contents [i];
                if (XVECTOR (pair)->size != 2)
-                 Fsignal (Qerror,
-                          Fcons (build_string
-       ("elements of the vector must be vectors of exactly two elements"),
-                                 Fcons (pair, Qnil)));
+                 signal_error (
+       "Elements of the vector must be vectors of exactly two elements",
+                               pair);
 
                (*(Atom **) data_ret) [i * 2]
                  = symbol_to_x_atom (dpyinfo, display,
@@ -2023,10 +2038,8 @@ lisp_data_to_selection_data (display, obj,
                                      XVECTOR (pair)->contents [1]);
              }
            else
-             Fsignal (Qerror,
-                      Fcons (build_string
-                  ("all elements of the vector must be of the same type"),
-                             Fcons (obj, Qnil)));
+             signal_error ("All elements of the vector must be of the same type",
+                           obj);
 
        }
 #endif
@@ -2041,10 +2054,9 @@ lisp_data_to_selection_data (display, obj,
            if (CONSP (XVECTOR (obj)->contents [i]))
              *format_ret = 32;
            else if (!INTEGERP (XVECTOR (obj)->contents [i]))
-             Fsignal (Qerror, /* Qselection_error */
-                      Fcons (build_string
-       ("elements of selection vector must be integers or conses of integers"),
-                             Fcons (obj, Qnil)));
+             signal_error (/* Qselection_error */
+    "Elements of selection vector must be integers or conses of integers",
+                           obj);
 
           /* Use sizeof(long) even if it is more than 32 bits.  See comment
              in x_get_window_property and x_fill_property_data.  */
@@ -2061,9 +2073,7 @@ lisp_data_to_selection_data (display, obj,
        }
     }
   else
-    Fsignal (Qerror, /* Qselection_error */
-            Fcons (build_string ("unrecognized selection data"),
-                   Fcons (obj, Qnil)));
+    signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
 
   *type_ret = symbol_to_x_atom (dpyinfo, display, type);
 }
@@ -2352,15 +2362,13 @@ initialize_cut_buffers (display, window)
 
 
 #define CHECK_CUT_BUFFER(symbol)                                       \
-  { CHECK_SYMBOL ((symbol));                                   \
+  do { 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)   \
        && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7))  \
-      Fsignal (Qerror,                                                 \
-              Fcons (build_string ("doesn't name a cut buffer"),       \
-                            Fcons ((symbol), Qnil)));                  \
-  }
+      signal_error ("Doesn't name a cut buffer", (symbol));            \
+  } while (0)
 
 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
        Sx_get_cut_buffer_internal, 1, 1, 0,
@@ -2397,10 +2405,9 @@ DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
     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 (display, type),
-                          Fcons (make_number (format), Qnil))));
+    signal_error ("Cut buffer doesn't contain 8-bit data",
+                 list2 (x_atom_to_symbol (display, type),
+                        make_number (format)));
 
   ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
   /* Use xfree, not XFree, because x_get_window_property
@@ -2682,9 +2689,9 @@ If the value is 0 or the atom is not known, return the empty string.  */)
   struct frame *f = check_x_frame (frame);
   char *name = 0;
   Lisp_Object ret = Qnil;
-  int count;
   Display *dpy = FRAME_X_DISPLAY (f);
   Atom atom;
+  int had_errors;
 
   if (INTEGERP (value))
     atom = (Atom) XUINT (value);
@@ -2696,25 +2703,64 @@ If the value is 0 or the atom is not known, return the empty string.  */)
     error ("Wrong type, value must be number or cons");
 
   BLOCK_INPUT;
-  count = x_catch_errors (dpy);
-
+  x_catch_errors (dpy);
   name = atom ? XGetAtomName (dpy, atom) : "";
+  had_errors = x_had_errors_p (dpy);
+  x_uncatch_errors ();
 
-  if (! x_had_errors_p (dpy))
+  if (!had_errors)
     ret = make_string (name, strlen (name));
 
-  x_uncatch_errors (dpy, count);
-
   if (atom && name) XFree (name);
-  if (NILP (ret)) ret = make_string ("", 0);
+  if (NILP (ret)) ret = empty_unibyte_string;
 
   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?  */
+DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom,
+       Sx_register_dnd_atom, 1, 2, 0,
+       doc: /* Request that dnd events are made for ClientMessages with ATOM.
+ATOM can be a symbol or a string.  The ATOM is interned on the display that
+FRAME is on.  If FRAME is nil, the selected frame is used.  */)
+    (atom, frame)
+    Lisp_Object atom, frame;
+{
+  Atom x_atom;
+  struct frame *f = check_x_frame (frame);
+  size_t i;
+  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+
+
+  if (SYMBOLP (atom))
+    x_atom = symbol_to_x_atom (dpyinfo, FRAME_X_DISPLAY (f), atom);
+  else if (STRINGP (atom))
+    {
+      BLOCK_INPUT;
+      x_atom = XInternAtom (FRAME_X_DISPLAY (f), (char *) SDATA (atom), False);
+      UNBLOCK_INPUT;
+    }
+  else
+    error ("ATOM must be a symbol or a string");
+
+  for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
+    if (dpyinfo->x_dnd_atoms[i] == x_atom)
+      return Qnil;
+
+  if (dpyinfo->x_dnd_atoms_length == dpyinfo->x_dnd_atoms_size)
+    {
+      dpyinfo->x_dnd_atoms_size *= 2;
+      dpyinfo->x_dnd_atoms = xrealloc (dpyinfo->x_dnd_atoms,
+                                       sizeof (*dpyinfo->x_dnd_atoms)
+                                       * dpyinfo->x_dnd_atoms_size);
+    }
+
+  dpyinfo->x_dnd_atoms[dpyinfo->x_dnd_atoms_length++] = x_atom;
+  return Qnil;
+}
+
+/* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.  */
 
 int
 x_handle_dnd_message (f, event, dpyinfo, bufp)
@@ -2730,6 +2776,12 @@ x_handle_dnd_message (f, event, dpyinfo, bufp)
   int x, y;
   unsigned char *data = (unsigned char *) event->data.b;
   int idata[5];
+  size_t i;
+
+  for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
+    if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
+
+  if (i == dpyinfo->x_dnd_atoms_length) return 0;
 
   XSETFRAME (frame, f);
 
@@ -2803,7 +2855,6 @@ are ignored.  */)
   Lisp_Object cons;
   int size;
   struct frame *f = check_x_frame (from);
-  int count;
   int to_root;
 
   CHECK_STRING (message_type);
@@ -2873,14 +2924,14 @@ are ignored.  */)
      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);
+  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);
+  x_uncatch_errors ();
   UNBLOCK_INPUT;
 
   return Qnil;
@@ -2904,6 +2955,7 @@ syms_of_xselect ()
 
   defsubr (&Sx_get_atom_name);
   defsubr (&Sx_send_client_message);
+  defsubr (&Sx_register_dnd_atom);
 
   reading_selection_reply = Fcons (Qnil, Qnil);
   staticpro (&reading_selection_reply);
@@ -2957,8 +3009,17 @@ it merely informs you that they have happened.  */);
 
   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.
+
+When sending text via selection and clipboard, if the requested
+data-type is not "UTF8_STRING", the text is encoded by this coding
+system.
+
+When receiving text, if the data-type of the received text is not
+"UTF8_STRING", it is decoded by this coding system.
+
+See also the documentation of the variable `x-select-request-type' how
+to control which data-type to request for receiving text.
+
 The default value is `compound-text-with-extensions'.  */);
   Vselection_coding_system = intern ("compound-text-with-extensions");