X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/638cb9c6b7a9c3cd4f5ad7dfe6fef60928cc89de..ba976213c358271b653ae2a8fec9d09c6692a7fd:/src/xselect.c.old

diff --git a/src/xselect.c.old b/src/xselect.c.old
index cb7697270c..8a3e044327 100644
--- a/src/xselect.c.old
+++ b/src/xselect.c.old
@@ -1,5 +1,5 @@
 /* X Selection processing for emacs
-   Copyright (C) 1990, 1992 Free Software Foundation.
+   Copyright (C) 1990, 1992, 1993 Free Software Foundation.
 
 This file is part of GNU Emacs.
 
@@ -53,10 +53,8 @@ Lisp_Object Vx_selection_value;
 /* The value of the current SECONDARY selection. */
 Lisp_Object Vx_secondary_selection_value;
 
-/* Types of selections we may make.  Note that Qcut_buffer0 isn't really
-   a selection, but it acts like one for the sake of Fx_own_selection and
-   Fx_selection_value.  */
-Lisp_Object Qprimary, Qsecondary, Qclipboard, Qcut_buffer0;
+/* Types of selections we may make.  */
+Lisp_Object Qprimary, Qsecondary, Qclipboard;
 
 /* Emacs' selection property identifiers. */
 Atom Xatom_emacs_selection;
@@ -110,7 +108,52 @@ int incr_nbytes;
 unsigned char *incr_value;
 unsigned char *incr_ptr;
 
-/* SELECTION OWNER CODE */
+/* Declarations for handling cut buffers.
+
+   Whenever we set a cut buffer or read a cut buffer's value, we cache
+   it in cut_buffer_value.  We look for PropertyNotify events about
+   the CUT_BUFFER properties, and invalidate our cache accordingly.
+   We ignore PropertyNotify events that we suspect were caused by our
+   own changes to the cut buffers, so we can keep the cache valid
+   longer.
+
+   IS ALL THIS HAIR WORTH IT?  Well, these functions get called every
+   time an element goes into or is retrieved from the kill ring, and
+   those ought to be quick.  It's not fun in time or space to wait for
+   50k cut buffers to fly back and forth across the net.  */
+
+/* The number of CUT_BUFFER properties defined under X.  */
+#define NUM_CUT_BUFFERS (8)
+
+/* cut_buffer_atom[n] is the atom naming the nth cut buffer.  */
+static Atom cut_buffer_atom[NUM_CUT_BUFFERS] = {
+  XA_CUT_BUFFER0, XA_CUT_BUFFER1, XA_CUT_BUFFER2, XA_CUT_BUFFER3,
+  XA_CUT_BUFFER4, XA_CUT_BUFFER5, XA_CUT_BUFFER6, XA_CUT_BUFFER7
+};
+
+/* cut_buffer_value is an eight-element vector;
+   (aref cut_buffer_value n) is the cached value of cut buffer n, or
+   Qnil if cut buffer n is unset.  */
+static Lisp_Object cut_buffer_value;
+
+/* Bit N of cut_buffer_cached is true if (aref cut_buffer_value n) is
+   known to be valid.  This is cleared by PropertyNotify events
+   handled by x_invalidate_cut_buffer_cache.  It would be wonderful if
+   that routine could just set the appropriate element of
+   cut_buffer_value to some special value meaning "uncached", but that
+   would lose if a GC happened to be in progress.
+
+   Bit N of cut_buffer_just_set is true if cut buffer N has been set since
+   the last PropertyNotify event; since we get an event even when we set
+   the property ourselves, we should ignore one event after setting
+   a cut buffer, so we don't have to throw away our cache.  */
+#ifdef __STDC__
+volatile
+#endif
+static cut_buffer_cached, cut_buffer_just_set;
+
+
+/* Acquiring ownership of a selection.  */
 
 
 /* Request selection ownership if we do not already have it. */
@@ -122,12 +165,15 @@ own_selection (selection_type, time)
 {
   Window owner_window, selecting_window;
 
-  if ((EQ (selection_type, Qprimary) && !NILP (Vx_selection_value))
-      || ((EQ (selection_type, Qsecondary)) && !NILP (Vx_secondary_selection_value))
-      || ((EQ (selection_type, Qclipboard)) && !NILP (Vx_clipboard_value)))
+  if ((selection_type == XA_PRIMARY
+       && !NILP (Vx_selection_value))
+      || (selection_type == XA_SECONDARY
+          && !NILP (Vx_secondary_selection_value))
+      || (selection_type == Xatom_clipboard
+          && !NILP (Vx_clipboard_value)))
     return 1;
 
-  selecting_window = selected_frame->display.x->window_desc;
+  selecting_window = FRAME_X_WINDOW (selected_frame);
   XSetSelectionOwner (x_current_display, selection_type,
 		      selecting_window, time);
   owner_window = XGetSelectionOwner (x_current_display, selection_type);
@@ -142,17 +188,41 @@ own_selection (selection_type, time)
    If we are already the owner, merely change data and timestamp values.
    This avoids generating SelectionClear events for ourselves. */
 
-DEFUN ("x-own-selection", Fx_own_selection, Sx_own_selection,
-  1, 2, "",
-  "Make STRING the selection value.  Default is the primary selection,\n\
-but optional second argument TYPE may specify secondary or clipboard.\n\
+DEFUN ("x-set-selection", Fx_set_selection, Sx_set_selection,
+  2, 2, "",
+  "Set the value of SELECTION to STRING.\n\
+SELECTION may be `primary', `secondary', or `clipboard'.\n\
 \n\
-TYPE may also be cut-buffer0, indicating that Emacs should set the X\n\
-cut buffer 0 to STRING.  This is for compatibility with older X\n\
-applications which still use the cut buffers; new applications should\n\
-use X selections.")
-  (string, type)
-     register Lisp_Object string, type;
+Selections are a mechanism for cutting and pasting information between\n\
+X Windows clients.  Emacs's kill ring commands set the `primary'\n\
+selection to the top string of the kill ring, making it available to\n\
+other clients, like xterm.  Those commands also use the `primary'\n\
+selection to retrieve information from other clients.\n\
+\n\
+According to the Inter-Client Communications Conventions Manual:\n\
+\n\
+The `primary' selection \"... is used for all commands that take only a\n\
+   single argument and is the principal means of communication between\n\
+   clients that use the selection mechanism.\"  In Emacs, this means\n\
+   that the kill ring commands set the primary selection to the text\n\
+   put in the kill ring.\n\
+\n\
+The `secondary' selection \"... is used as the second argument to\n\
+   commands taking two arguments (for example, `exchange primary and\n\
+   secondary selections'), and as a means of obtaining data when there\n\
+   is a primary selection and the user does not want to disturb it.\"\n\
+   I am not sure how Emacs should use the secondary selection; if you\n\
+   come up with ideas, this function will at least let you get at it.\n\
+\n\
+The `clipboard' selection \"... is used to hold data that is being\n\
+   transferred between clients, that is, data that usually is being\n\
+   cut or copied, and then pasted.\"  It seems that the `clipboard'\n\
+   selection is for the most part equivalent to the `primary'\n\
+   selection, so Emacs sets them both.\n\
+\n\
+Also see `x-selection', and the `interprogram-cut-function' variable.")
+  (selection, string)
+     register Lisp_Object selection, string;
 {
   Atom selection_type;
   Lisp_Object val;
@@ -161,7 +231,7 @@ use X selections.")
 
   val = Qnil;
 
-  if (NILP (type) || EQ (type, Qprimary))
+  if (NILP (selection) || EQ (selection, Qprimary))
     {
       BLOCK_INPUT;
       if (own_selection (XA_PRIMARY, event_time))
@@ -171,7 +241,7 @@ use X selections.")
 	}
       UNBLOCK_INPUT;
     }
-  else if (EQ (type, Qsecondary))
+  else if (EQ (selection, Qsecondary))
     {
       BLOCK_INPUT;
       if (own_selection (XA_SECONDARY, event_time))
@@ -181,7 +251,7 @@ use X selections.")
 	}
       UNBLOCK_INPUT;
     }
-  else if (EQ (type, Qclipboard))
+  else if (EQ (selection, Qclipboard))
     {
       BLOCK_INPUT;
       if (own_selection (Xatom_clipboard, event_time))
@@ -191,15 +261,6 @@ use X selections.")
 	}
       UNBLOCK_INPUT;
     }
-  else if (EQ (type, Qcut_buffer0))
-    {
-      BLOCK_INPUT;
-      XStoreBytes (x_current_display,
-		   (char *) XSTRING (string)->data,
-		   XSTRING (string)->size);
-      val = string;
-      UNBLOCK_INPUT;
-    }
   else
     error ("Invalid X selection type");
 
@@ -241,11 +302,14 @@ x_disown_selection (old_owner, selection, changed_owner_time)
     abort ();			/* Inconsistent state. */
 }
 
+
+/* Answering selection requests.  */
+
 int x_selection_alloc_error;
 int x_converting_selection;
 
-/* Reply to some client's request for our selection data.  Data is
-   placed in a property supplied by the requesting window.
+/* Reply to some client's request for our selection data.
+   Data is placed in a property supplied by the requesting window.
 
    If the data exceeds the maximum amount the server can send,
    then prepare to send it incrementally, and reply to the client with
@@ -503,7 +567,10 @@ x_send_incremental (event)
     }
 }
 
-/* SELECTION REQUESTOR CODE */
+
+/* Requesting the value of a selection.  */
+
+static Lisp_Object x_selection_arrival ();
 
 /* Predicate function used to match a requested event. */
 
@@ -534,7 +601,7 @@ get_selection_value (type)
 
   BLOCK_INPUT;
   requestor_time = last_event_timestamp;
-  requestor_window = selected_frame->display.x->window_desc;
+  requestor_window = FRAME_X_WINDOW (selected_frame);
   XConvertSelection (x_current_display, type, XA_STRING,
 		     Xatom_emacs_selection, requestor_window, requestor_time);
   XIfEvent (x_current_display,
@@ -551,57 +618,50 @@ get_selection_value (type)
    simply return our selection value.  If we are not the owner, this
    will block until all of the data has arrived. */
 
-DEFUN ("x-selection-value", Fx_selection_value, Sx_selection_value,
-  0, 1, "",
-  "Return the value of one of the selections.  Default is the primary\n\
-selection, but optional argument TYPE may specify secondary or clipboard.")
-  (type)
-     register Lisp_Object type;
+DEFUN ("x-selection", Fx_selection, Sx_selection,
+  1, 1, "",
+  "Return the value of SELECTION.\n\
+SELECTION is one of `primary', `secondary', or `clipboard'.\n\
+\n\
+Selections are a mechanism for cutting and pasting information between\n\
+X Windows clients.  When the user selects text in an X application,\n\
+the application should set the primary selection to that text; Emacs's\n\
+kill ring commands will then check the value of the `primary'\n\
+selection, and return it as the most recent kill.\n\
+The documentation for `x-set-selection' gives more information on how\n\
+the different selection types are intended to be used.\n\
+Also see the `interprogram-paste-function' variable.")
+  (selection)
+     register Lisp_Object selection;
 {
   Atom selection_type;
 
-  if (NILP (type) || EQ (type, Qprimary))
+  if (NILP (selection) || EQ (selection, Qprimary))
     {
       if (!NILP (Vx_selection_value))
-    return Vx_selection_value;
+	return Vx_selection_value;
 
       return get_selection_value (XA_PRIMARY);
     }
-  else if (EQ (type, Qsecondary))
+  else if (EQ (selection, Qsecondary))
     {
       if (!NILP (Vx_secondary_selection_value))
 	return Vx_secondary_selection_value;
 
       return get_selection_value (XA_SECONDARY);
     }
-  else if (EQ (type, Qclipboard))
+  else if (EQ (selection, Qclipboard))
     {
       if (!NILP (Vx_clipboard_value))
 	return Vx_clipboard_value;
 
       return get_selection_value (Xatom_clipboard);
     }
-  else if (EQ (type, Qcut_buffer0))
-    {
-      char *data;
-      int size;
-      Lisp_Object string;
-
-      BLOCK_INPUT;
-      data = XFetchBytes (x_current_display, &size);
-      if (data == 0)
-	string = Qnil;
-      else
-	string = make_string (data, size);
-      UNBLOCK_INPUT;
-      
-      return string;
-    }
   else
     error ("Invalid X selection type");
 }
 
-Lisp_Object
+static Lisp_Object
 x_selection_arrival (event, requestor_window, requestor_time)
      register XSelectionEvent *event;
      Window requestor_window;
@@ -714,6 +774,148 @@ x_selection_arrival (event, requestor_window, requestor_time)
   return Qnil;
 }
 
+
+/* Cut buffer management.  */
+
+DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 1, "",
+  "Return the value of cut buffer N, or nil if it is unset.\n\
+If N is omitted, it defaults to zero.\n\
+Note that cut buffers have some problems that selections don't; try to\n\
+write your code to use cut buffers only for backward compatibility,\n\
+and use selections for the serious work.")
+  (n)
+     Lisp_Object n;
+{
+  int buf_num;
+
+  if (NILP (n))
+    buf_num = 0;
+  else
+    {
+      CHECK_NUMBER (n, 0);
+      buf_num = XINT (n);
+    }
+
+  if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
+    error ("cut buffer numbers must be from zero to seven");
+
+  {
+    Lisp_Object value;
+
+    /* Note that no PropertyNotify events will be processed while
+       input is blocked.  */
+    BLOCK_INPUT;
+
+    if (cut_buffer_cached & (1 << buf_num))
+      value = XVECTOR (cut_buffer_value)->contents[buf_num];
+    else
+      {
+	/* Our cache is invalid; retrieve the property's value from
+	   the server.  */
+	int buf_len;
+	char *buf = XFetchBuffer (x_current_display, &buf_len, buf_num);
+
+	if (buf_len == 0)
+	  value = Qnil;
+	else
+	  value = make_string (buf, buf_len);
+
+	XVECTOR (cut_buffer_value)->contents[buf_num] = value;
+	cut_buffer_cached |= (1 << buf_num);
+
+	XFree (buf);
+      }
+
+    UNBLOCK_INPUT;
+
+    return value;
+  }
+}
+
+DEFUN ("x-set-cut-buffer", Fx_set_cut_buffer, Sx_set_cut_buffer, 2, 2, "",
+  "Set the value of cut buffer N to STRING.\n\
+Note that cut buffers have some problems that selections don't; try to\n\
+write your code to use cut buffers only for backward compatibility,\n\
+and use selections for the serious work.")
+  (n, string)
+     Lisp_Object n, string;
+{
+  int buf_num;
+
+  CHECK_NUMBER (n, 0);
+  CHECK_STRING (string, 1);
+
+  buf_num = XINT (n);
+
+  if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
+    error ("cut buffer numbers must be from zero to seven");
+
+  BLOCK_INPUT;
+
+  /* DECwindows and some other servers don't seem to like setting
+     properties to values larger than about 20k.  For very large
+     values, they signal an error, but for intermediate values they
+     just seem to hang.
+
+     We could just truncate the request, but it's better to let the
+     user know that the strategy he/she's using isn't going to work
+     than to have it work partially, but incorrectly.  */
+
+  if (XSTRING (string)->size == 0
+      || XSTRING (string)->size > MAX_SELECTION (x_current_display))
+    {
+      XStoreBuffer (x_current_display, (char *) 0, 0, buf_num);
+      string = Qnil;
+    }
+  else
+    {
+      XStoreBuffer (x_current_display,
+		    (char *) XSTRING (string)->data, XSTRING (string)->size,
+		    buf_num);
+    }
+
+  XVECTOR (cut_buffer_value)->contents[buf_num] = string;
+  cut_buffer_cached |= (1 << buf_num);
+  cut_buffer_just_set |= (1 << buf_num);
+
+  UNBLOCK_INPUT;
+
+  return string;
+}
+
+/* Ask the server to send us an event if any cut buffer is modified.  */
+
+void
+x_watch_cut_buffer_cache ()
+{
+  XSelectInput (x_current_display, ROOT_WINDOW, PropertyChangeMask);
+}
+
+/* The server has told us that a cut buffer has been modified; deal with that.
+   Note that this function is called at interrupt level.  */
+void
+x_invalidate_cut_buffer_cache (XPropertyEvent *event)
+{
+  int i;
+
+  /* See which cut buffer this is about, if any.  */
+  for (i = 0; i < NUM_CUT_BUFFERS; i++)
+    if (event->atom == cut_buffer_atom[i])
+      {
+	int mask = (1 << i);
+
+	if (cut_buffer_just_set & mask)
+	  cut_buffer_just_set &= ~mask;
+	else
+	  cut_buffer_cached &= ~mask;
+
+	break;
+      }
+}
+
+
+/* Bureaucracy.  */
+
 void
 syms_of_xselect ()
 {
@@ -735,10 +937,14 @@ syms_of_xselect ()
   staticpro (&Qsecondary);
   Qclipboard = intern ("clipboard");
   staticpro (&Qclipboard);
-  Qcut_buffer0 = intern ("cut-buffer0");
-  staticpro (&Qcut_buffer0);
 
-  defsubr (&Sx_own_selection);
-  defsubr (&Sx_selection_value);
+  defsubr (&Sx_set_selection);
+  defsubr (&Sx_selection);
+
+  cut_buffer_value = Fmake_vector (make_number (NUM_CUT_BUFFERS), Qnil);
+  staticpro (&cut_buffer_value);
+
+  defsubr (&Sx_get_cut_buffer);
+  defsubr (&Sx_set_cut_buffer);
 }
 #endif	/* X11 */