]> code.delx.au - gnu-emacs/blobdiff - src/xselect.c
Declare calloc like malloc.
[gnu-emacs] / src / xselect.c
index b34686c20f88f36c9265f1cf3bd11597fc005497..ad0cc265861a49c69251f4f1b8c43cfd14ce086e 100644 (file)
@@ -1,5 +1,5 @@
 /* X Selection processing for Emacs.
-   Copyright (C) 1993, 1994 Free Software Foundation.
+   Copyright (C) 1993, 1994, 1995 Free Software Foundation.
 
 This file is part of GNU Emacs.
 
@@ -17,18 +17,11 @@ 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.  */
 
-/* x_handle_selection_notify
-x_reply_selection_request  */
-
 
 /* Rewritten by jwz */
 
 #include <config.h>
 #include "lisp.h"
-#if 0
-#include <stdio.h>     /* termhooks.h needs this */
-#include "termhooks.h"
-#endif
 #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 */
@@ -47,16 +40,15 @@ Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
   QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
 #endif
 
-Lisp_Object Vx_lost_selection_hooks;
-Lisp_Object Vx_sent_selection_hooks;
+static Lisp_Object Vx_lost_selection_hooks;
+static Lisp_Object Vx_sent_selection_hooks;
 
 /* 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 
    smaller than that, set this.  I added this mostly for debugging the
-   incremental transfer stuff, but it might improve server performance.
- */
+   incremental transfer stuff, but it might improve server performance.  */
 #define MAX_SELECTION_QUANTUM 0xFFFFFF
 
 #ifdef HAVE_X11R4
@@ -79,22 +71,19 @@ unsigned long last_event_timestamp;
    If there is an entry in this alist, then it can be assumed that Emacs owns
     that selection.
    The only (eq) parts of this list that are visible from Lisp are the
-    selection-values.
- */
-Lisp_Object Vselection_alist;
+    selection-values.  */
+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 
    the given selection type.  This is for Lisp-level extension of the emacs
-   selection handling.
- */
-Lisp_Object Vselection_converter_alist;
+   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.)
- */
-int x_selection_timeout;
+   we give up on it.  This is in milliseconds (0 = no timeout.)  */
+static int x_selection_timeout;
 \f
 /* Utility functions */
 
@@ -244,10 +233,10 @@ x_own_selection (selection_name, selection_value)
   selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
 
   BLOCK_INPUT;
-  x_catch_errors (selected_frame);
+  x_catch_errors (display);
   XSetSelectionOwner (display, selection_atom, selecting_window, time);
-  x_check_errors (selected_frame, "Can't set selection: %s");
-  x_uncatch_errors (selected_frame);
+  x_check_errors (display, "Can't set selection: %s");
+  x_uncatch_errors (display);
   UNBLOCK_INPUT;
 
   /* Now update the local cache */
@@ -465,6 +454,35 @@ static Lisp_Object property_change_reply;
 static struct prop_location *property_change_reply_object;
 
 static struct prop_location *property_change_wait_list;
+
+static Lisp_Object
+queue_selection_requests_unwind (frame)
+     Lisp_Object frame;
+{
+  FRAME_PTR f = XFRAME (frame);
+
+  if (! NILP (frame))
+    x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
+  return Qnil;
+}
+
+/* Return some frame whose display info is DPYINFO.
+   Return nil if there is none.  */
+
+static Lisp_Object
+some_frame_on_display (dpyinfo)
+     struct x_display_info *dpyinfo;
+{
+  Lisp_Object list, frame;
+
+  FOR_EACH_FRAME (list, frame)
+    {
+      if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
+       return frame;
+    }
+
+  return Qnil;
+}
 \f
 /* Send the reply to a selection request event EVENT.
    TYPE is the type of selection data requested.
@@ -500,6 +518,8 @@ x_reply_selection_request (event, format, data, size, type)
     reply.property = reply.target;
 
   /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
+  BLOCK_INPUT;
+  x_catch_errors (display);
 
   /* Store the data on the requested property.
      If the selection is large, only store the first N bytes of it.
@@ -511,22 +531,33 @@ x_reply_selection_request (event, format, data, size, type)
 #if 0
       fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
 #endif
-      BLOCK_INPUT;
       XChangeProperty (display, window, reply.property, type, format,
                       PropModeReplace, data, size);
       /* At this point, the selection was successfully stored; ack it.  */
       XSendEvent (display, window, False, 0L, (XEvent *) &reply);
-      XFlush (display);
-      UNBLOCK_INPUT;
     }
   else
     {
       /* Send an INCR selection.  */
       struct prop_location *wait_object;
+      int had_errors;
+      int count = specpdl_ptr - specpdl;
+      Lisp_Object frame;
 
-      BLOCK_INPUT;
+      frame = some_frame_on_display (dpyinfo);
 
-      if (x_window_to_frame (window)) /* #### debug */
+      /* If the display no longer has frames, we can't expect
+        to get many more selection requests from it, so don't
+        bother trying to queue them.  */
+      if (!NILP (frame))
+       {
+         x_start_queuing_selection_requests (display);
+
+         record_unwind_protect (queue_selection_requests_unwind,
+                                frame);
+       }
+
+      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);
@@ -535,17 +566,20 @@ x_reply_selection_request (event, format, data, size, type)
                                            PropertyDelete);
 
       XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
-                      32, PropModeReplace, (unsigned char *)
-                      &bytes_remaining, 1);
+                      32, PropModeReplace,
+                      (unsigned char *) &bytes_remaining, 1);
       XSelectInput (display, window, PropertyChangeMask);
       /* Tell 'em the INCR data is there...  */
-      (void) XSendEvent (display, window, False, 0L, (XEvent *) &reply);
+      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.
         This can run random lisp code (process handlers) or signal.  */
-      wait_for_property_change (wait_object);
+      if (! had_errors)
+       wait_for_property_change (wait_object);
 
       while (bytes_remaining)
        {
@@ -567,8 +601,12 @@ x_reply_selection_request (event, format, data, size, type)
          bytes_remaining -= i;
          data += i;
          XFlush (display);
+         had_errors = x_had_errors_p (display);
          UNBLOCK_INPUT;
 
+         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.
           */
@@ -585,9 +623,13 @@ x_reply_selection_request (event, format, data, size, type)
 
       XChangeProperty (display, window, reply.property, type, format,
                       PropModeReplace, data, 0);
-      XFlush (display);
-      UNBLOCK_INPUT;
+
+      unbind_to (count, Qnil);
     }
+
+  XFlush (display);
+  x_uncatch_errors (display);
+  UNBLOCK_INPUT;
 }
 \f
 /* Handle a SelectionRequest event EVENT.
@@ -776,25 +818,6 @@ x_clear_frame_selections (f)
   /* Otherwise, we're really honest and truly being told to drop it.
      Don't use Fdelq as that may QUIT;.  */
 
-  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 (Vselection_alist);
-
-      if (!EQ (hooks, Qunbound))
-       {
-         for (; CONSP (hooks); hooks = Fcdr (hooks))
-           call1 (Fcar (hooks), selection_symbol);
-         redisplay_preserve_echo_area ();
-       }
-
-      Vselection_alist = Fcdr (Vselection_alist);
-    }
-
   for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
     if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
       {
@@ -887,7 +910,10 @@ static Lisp_Object
 wait_for_property_change_unwind (identifierval)
      Lisp_Object identifierval;
 {
-  unexpect_property_change (XPNTR (identifierval));
+  unexpect_property_change ((struct prop_location *)
+                           (XFASTINT (XCONS (identifierval)->car) << 16
+                            | XFASTINT (XCONS (identifierval)->cdr)));
+  return Qnil;
 }
 
 /* Actually wait for a property change.
@@ -901,16 +927,20 @@ wait_for_property_change (location)
   int count = specpdl_ptr - specpdl;
   Lisp_Object tem;
 
-  XSETCONS (tem, location);
+  tem = Fcons (Qnil, Qnil);
+  XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
+  XSETFASTINT (XCONS (tem)->cdr, (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;
 
+  property_change_reply_object = location;
+  /* If the event we are waiting for arrives beyond here, it will set
+     property_change_reply, because property_change_reply_object says so.  */
   if (! location->arrived)
     {
-      property_change_reply_object = location;
       secs = x_selection_timeout / 1000;
       usecs = (x_selection_timeout % 1000) * 1000;
       wait_reading_process_input (secs, usecs, property_change_reply, 0);
@@ -1042,6 +1072,8 @@ x_get_foreign_selection (selection_symbol, target_type)
   Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
   Atom type_atom;
   int secs, usecs;
+  int count = specpdl_ptr - specpdl;
+  Lisp_Object frame;
 
   if (CONSP (target_type))
     type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
@@ -1049,7 +1081,7 @@ x_get_foreign_selection (selection_symbol, target_type)
     type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
 
   BLOCK_INPUT;
-  x_catch_errors (selected_frame);
+  x_catch_errors (display);
   XConvertSelection (display, selection_atom, type_atom, target_property,
                     requestor_window, requestor_time);
   XFlush (display);
@@ -1058,7 +1090,19 @@ x_get_foreign_selection (selection_symbol, target_type)
   reading_selection_window = requestor_window;
   reading_which_selection = selection_atom;
   XCONS (reading_selection_reply)->car = Qnil;
-  x_start_queuing_selection_requests (selected_frame);
+
+  frame = some_frame_on_display (dpyinfo);
+
+  /* If the display no longer has frames, we can't expect
+     to get many more selection requests from it, so don't
+     bother trying to queue them.  */
+  if (!NILP (frame))
+    {
+      x_start_queuing_selection_requests (display);
+
+      record_unwind_protect (queue_selection_requests_unwind,
+                            frame);
+    }
   UNBLOCK_INPUT;
 
   /* This allows quits.  Also, don't wait forever.  */
@@ -1067,9 +1111,9 @@ x_get_foreign_selection (selection_symbol, target_type)
   wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
 
   BLOCK_INPUT;
-  x_check_errors (selected_frame, "Cannot get selection: %s");
-  x_uncatch_errors (selected_frame);
-  x_stop_queuing_selection_requests (selected_frame);
+  x_check_errors (display, "Cannot get selection: %s");
+  x_uncatch_errors (display);
+  unbind_to (count, Qnil);
   UNBLOCK_INPUT;
 
   if (NILP (XCONS (reading_selection_reply)->car))
@@ -1109,7 +1153,7 @@ x_get_window_property (display, window, property, data_ret, bytes_ret,
   BLOCK_INPUT;
   /* First probe the thing to find out how big it is.  */
   result = XGetWindowProperty (display, window, property,
-                              0, 0, False, AnyPropertyType,
+                              0L, 0L, False, AnyPropertyType,
                               actual_type_ret, actual_format_ret,
                               actual_size_ret,
                               &bytes_remaining, &tmp_data);
@@ -1139,7 +1183,7 @@ x_get_window_property (display, window, property, data_ret, bytes_ret,
 #endif
       result
        = XGetWindowProperty (display, window, property,
-                             offset/4, buffer_size/4,
+                             (long)offset/4, (long)buffer_size/4,
                              False,
                              AnyPropertyType,
                              actual_type_ret, actual_format_ret,
@@ -1814,7 +1858,10 @@ and t is the same as `SECONDARY'.)")
   Atom atom;
   Display *dpy;
 
-  check_x ();
+  /* It should be safe to call this before we have an X frame.  */
+  if (! FRAME_X_P (selected_frame))
+    return Qnil;
+
   dpy = FRAME_X_DISPLAY (selected_frame);
   CHECK_SYMBOL (selection, 0);
   if (!NILP (Fx_selection_owner_p (selection)))
@@ -1834,8 +1881,6 @@ and t is the same as `SECONDARY'.)")
 \f
 #ifdef CUT_BUFFER_SUPPORT
 
-static int cut_buffers_initialized; /* Whether we're sure they all exist */
-
 /* Ensure that all 8 cut buffers exist.  ICCCM says we gotta...  */
 static void
 initialize_cut_buffers (display, window)
@@ -1856,7 +1901,6 @@ initialize_cut_buffers (display, window)
   FROB (XA_CUT_BUFFER7);
 #undef FROB
   UNBLOCK_INPUT;
-  cut_buffers_initialized = 1;
 }
 
 
@@ -1941,7 +1985,11 @@ DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
   bytes = XSTRING (string)->size;
   bytes_remaining = bytes;
 
-  if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
+  if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
+    {
+      initialize_cut_buffers (display, window);
+      FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
+    }
 
   BLOCK_INPUT;
 
@@ -1984,8 +2032,11 @@ positive means move values forward, negative means backward.")
   CHECK_NUMBER (n, 0);
   if (XINT (n) == 0)
     return n;
-  if (! cut_buffers_initialized)
-    initialize_cut_buffers (display, window);
+  if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
+    {
+      initialize_cut_buffers (display, window);
+      FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
+    }
 
   props[0] = XA_CUT_BUFFER0;
   props[1] = XA_CUT_BUFFER1;
@@ -2016,7 +2067,6 @@ syms_of_xselect ()
   defsubr (&Sx_get_cut_buffer_internal);
   defsubr (&Sx_store_cut_buffer_internal);
   defsubr (&Sx_rotate_cut_buffers_internal);
-  cut_buffers_initialized = 0;
 #endif
 
   reading_selection_reply = Fcons (Qnil, Qnil);