]> code.delx.au - gnu-emacs/blobdiff - src/xselect.c
(archive-l-e): New optional argument `float' means generate a float value.
[gnu-emacs] / src / xselect.c
index bf37cde4d0bfbd0be00c733b00bde2da315da94e..9c2c221c02190d0e80c8b2e1d50f3075fb10e081 100644 (file)
@@ -1,6 +1,6 @@
 /* X Selection processing for Emacs.
-   Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004
-   Free Software Foundation.
+   Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
+                 2004, 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -16,8 +16,8 @@ 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, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 
 /* Rewritten by jwz */
@@ -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));
@@ -402,16 +403,15 @@ x_own_selection (selection_name, selection_value)
   Time time = last_event_timestamp;
   Atom selection_atom;
   struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
-  int count;
 
   CHECK_SYMBOL (selection_name);
   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 */
@@ -572,7 +572,6 @@ x_decline_selection_request (event)
      struct input_event *event;
 {
   XSelectionEvent reply;
-  int count;
 
   reply.type = SelectionNotify;
   reply.display = SELECTION_EVENT_DISPLAY (event);
@@ -585,10 +584,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;
 }
 
@@ -613,6 +612,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
@@ -690,7 +699,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;
@@ -705,9 +714,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
   {
@@ -860,7 +872,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
@@ -1370,7 +1383,7 @@ x_get_foreign_selection (selection_symbol, target_type, time_stamp)
   Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
   Atom type_atom;
   int secs, usecs;
-  int count;
+  int count = SPECPDL_INDEX ();
   Lisp_Object frame;
 
   if (CONSP (target_type))
@@ -1392,7 +1405,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),
@@ -1430,8 +1447,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)))
@@ -1908,7 +1927,12 @@ lisp_data_to_selection_data (display, obj,
     }
   else if (STRINGP (obj))
     {
-      xassert (! STRING_MULTIBYTE (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)));
       if (NILP (type))
        type = QSTRING;
       *format_ret = 8;
@@ -2026,7 +2050,7 @@ lisp_data_to_selection_data (display, obj,
 
           /* Use sizeof(long) even if it is more than 32 bits.  See comment
              in x_get_window_property and x_fill_property_data.  */
-          
+
           if (*format_ret == 32) data_size = sizeof(long);
          *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
          for (i = 0; i < *size_ret; i++)
@@ -2040,7 +2064,7 @@ lisp_data_to_selection_data (display, obj,
     }
   else
     Fsignal (Qerror, /* Qselection_error */
-            Fcons (build_string ("unrecognised selection data"),
+            Fcons (build_string ("unrecognized selection data"),
                    Fcons (obj, Qnil)));
 
   *type_ret = symbol_to_x_atom (dpyinfo, display, type);
@@ -2114,7 +2138,7 @@ anything that the functions on `selection-converter-alist' know about.  */)
 {
   check_x ();
   CHECK_SYMBOL (selection_name);
-  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;
 }
@@ -2184,7 +2208,10 @@ Disowning it means there is no such selection.  */)
 {
   Time timestamp;
   Atom selection_atom;
-  struct selection_input_event event;
+  union {
+    struct selection_input_event sie;
+    struct input_event ie;
+  } event;
   Display *display;
   struct x_display_info *dpyinfo;
   struct frame *sf = SELECTED_FRAME ();
@@ -2212,10 +2239,10 @@ Disowning it means there is no such selection.  */)
      the selection owner to None.  The NCD server does, the MIT Sun4 server
      doesn't.  So we synthesize one; this means we might get two, but
      that's ok, because the second one won't have any effect.  */
-  SELECTION_EVENT_DISPLAY (&event) = display;
-  SELECTION_EVENT_SELECTION (&event) = selection_atom;
-  SELECTION_EVENT_TIME (&event) = timestamp;
-  x_handle_selection_clear ((struct input_event *) &event);
+  SELECTION_EVENT_DISPLAY (&event.sie) = display;
+  SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
+  SELECTION_EVENT_TIME (&event.sie) = timestamp;
+  x_handle_selection_clear (&event.ie);
 
   return Qt;
 }
@@ -2642,9 +2669,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);
@@ -2656,15 +2683,14 @@ 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);
 
@@ -2719,11 +2745,11 @@ x_handle_dnd_message (f, event, dpyinfo, bufp)
 
   mouse_position_for_drop (f, &x, &y);
   bufp->kind = DRAG_N_DROP_EVENT;
-  bufp->frame_or_window = Fcons (frame, vec);
+  bufp->frame_or_window = frame;
   bufp->timestamp = CurrentTime;
   bufp->x = make_number (x);
   bufp->y = make_number (y);
-  bufp->arg = Qnil;
+  bufp->arg = vec;
   bufp->modifiers = 0;
 
   return 1;
@@ -2763,7 +2789,6 @@ are ignored.  */)
   Lisp_Object cons;
   int size;
   struct frame *f = check_x_frame (from);
-  int count;
   int to_root;
 
   CHECK_STRING (message_type);
@@ -2824,7 +2849,7 @@ are ignored.  */)
      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);
@@ -2833,14 +2858,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;
@@ -2946,7 +2971,6 @@ A value of 0 means wait as long as necessary.  This is initialized from the
   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);
   QINCR      = intern ("INCR");                staticpro (&QINCR);