This commit was generated by cvs2svn to compensate for changes in r5670,
[chise/xemacs-chise.git.1] / src / select-x.c
index d37ff2b..cc6031a 100644 (file)
@@ -138,10 +138,8 @@ symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists)
 #endif /* CUT_BUFFER_SUPPORT */
 
   {
-    const char *nameext;
-    TO_EXTERNAL_FORMAT (LISP_STRING, Fsymbol_name (sym),
-                       C_STRING_ALLOCA, nameext,
-                       Qctext);
+    CONST char *nameext;
+    GET_C_STRING_CTEXT_DATA_ALLOCA (Fsymbol_name (sym), nameext);
     return XInternAtom (display, nameext, only_if_exists ? True : False);
   }
 }
@@ -185,25 +183,26 @@ x_atom_to_symbol (struct device *d, Atom atom)
 #endif
 
   {
-    char *intstr;
+    Lisp_Object newsym;
+    CONST Bufbyte *intstr;
     char *str = XGetAtomName (display, atom);
 
     if (! str) return Qnil;
 
-    TO_INTERNAL_FORMAT (C_STRING, str,
-                       C_STRING_ALLOCA, intstr,
-                       Qctext);
+    GET_C_CHARPTR_INT_CTEXT_DATA_ALLOCA (str, intstr);
+    newsym = intern ((char *) intstr);
     XFree (str);
-    return intern (intstr);
+    return newsym;
   }
 }
 
 \f
 /* Do protocol to assert ourself as a selection owner.
+   Update the Vselection_alist so that we can reply to later requests for
+   our selection.
  */
 static Lisp_Object
-x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
-                Lisp_Object how_to_add, Lisp_Object selection_type)
+x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
 {
   struct device *d = decode_x_device (Qnil);
   Display *display = DEVICE_X_DISPLAY (d);
@@ -231,7 +230,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
      
      Opaque pointers are the clean way to go here.
   */
-  selection_time = make_opaque (&thyme, sizeof (thyme));
+  selection_time = make_opaque (sizeof (thyme), (void *) &thyme);
 
 #ifdef MOTIF_CLIPBOARDS
   hack_motif_clipboard_selection (selection_atom, selection_value,
@@ -251,7 +250,7 @@ hack_motif_clipboard_selection (Atom selection_atom,
                                Lisp_Object selection_value,
                                Time thyme,
                                Display *display,
-                               Window selecting_window)
+                                                Window selecting_window)
      /*                                Bool owned_p)*/
 {
   struct device *d = get_device_from_display (display);
@@ -286,13 +285,13 @@ hack_motif_clipboard_selection (Atom selection_atom,
 #endif
       XmString fmh;
       String encoding = "STRING";
-      const Extbyte *data  = XSTRING_DATA (selection_value);
+      CONST Extbyte *data  = XSTRING_DATA (selection_value);
       Extcount bytes = XSTRING_LENGTH (selection_value);
 
 #ifdef MULE
       {
        enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
-       const Bufbyte *ptr = data, *end = ptr + bytes;
+       CONST Bufbyte *ptr = data, *end = ptr + bytes;
        /* Optimize for the common ASCII case */
        while (ptr <= end)
          {
@@ -315,14 +314,10 @@ hack_motif_clipboard_selection (Atom selection_atom,
          }
 
        if (chartypes == LATIN_1)
-         TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
-                             ALLOCA, (data, bytes),
-                             Qbinary);
+         GET_STRING_BINARY_DATA_ALLOCA (selection_value, data, bytes);
        else if (chartypes == WORLD)
          {
-           TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
-                               ALLOCA, (data, bytes),
-                               Qctext);
+           GET_STRING_CTEXT_DATA_ALLOCA (selection_value, data, bytes);
            encoding = "COMPOUND_TEXT";
          }
       }
@@ -374,34 +369,10 @@ motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
       {
        Display *dpy = XtDisplay (widget);
        Window window = (Window) *private_id;
-       Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil);
-
-       /* Whichever lazy git wrote this originally just called abort()
-          when anything didn't go their way... */
-       
-       /* Try some other text types */
-       if (NILP (selection))
-         selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil);
-       if (NILP (selection))
-         selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil);
-       if (NILP (selection))
-         selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil);
-       
-       if (CONSP (selection) && SYMBOLP (XCAR (selection))
-           && (EQ (XCAR (selection), QSTRING)
-               || EQ (XCAR (selection), QTEXT)
-               || EQ (XCAR (selection), QCOMPOUND_TEXT)))
-         selection = XCDR (selection);
-
-       if (NILP (selection))
-         signal_error (Qselection_conversion_error,
-                       build_string ("no selection"));
-
-       if (!STRINGP (selection))
-         signal_error (Qselection_conversion_error,
-                       build_string ("couldn't convert selection to string"));
-                              
-       
+       Lisp_Object selection = assq_no_quit (QCLIPBOARD, Vselection_alist);
+       if (NILP (selection)) abort ();
+       selection = XCDR (selection);
+       if (!STRINGP (selection)) abort ();
        XmClipboardCopyByName (dpy, window, *data_id,
                               (char *) XSTRING_DATA (selection),
                               XSTRING_LENGTH (selection) + 1,
@@ -569,8 +540,8 @@ void
 x_handle_selection_request (XSelectionRequestEvent *event)
 {
   /* This function can GC */
-  struct gcpro gcpro1, gcpro2;
-  Lisp_Object temp_obj;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object local_selection_data = Qnil;
   Lisp_Object selection_symbol;
   Lisp_Object target_symbol = Qnil;
   Lisp_Object converted_selection = Qnil;
@@ -579,28 +550,33 @@ x_handle_selection_request (XSelectionRequestEvent *event)
   int count;
   struct device *d = get_device_from_display (event->display);
 
-  GCPRO2 (converted_selection, target_symbol);
+  GCPRO3 (local_selection_data, converted_selection, target_symbol);
 
   selection_symbol = x_atom_to_symbol (d, event->selection);
-  target_symbol = x_atom_to_symbol (d, event->target);
 
-#if 0 /* #### MULTIPLE doesn't work yet */
-  if (EQ (target_symbol, QMULTIPLE))
-    target_symbol = fetch_multiple_target (event);
-#endif
+  local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
 
-  temp_obj = Fget_selection_timestamp (selection_symbol);
+#if 0
+  /* This list isn't user-visible, so it can't "go bad." */
+  assert (CONSP (local_selection_data));
+  assert (CONSP (XCDR (local_selection_data)));
+  assert (CONSP (XCDR (XCDR (local_selection_data))));
+  assert (NILP  (XCDR (XCDR (XCDR (local_selection_data)))));
+  assert (CONSP (XCAR (XCDR (XCDR (local_selection_data)))));
+  assert (INTP  (XCAR (XCAR (XCDR (XCDR (local_selection_data))))));
+  assert (INTP  (XCDR (XCAR (XCDR (XCDR (local_selection_data))))));
+#endif
 
-  if (NILP (temp_obj))
+  if (NILP (local_selection_data))
     {
-      /* We don't appear to have the selection. */
+      /* Someone asked for the selection, but we don't have it any more. */
       x_decline_selection_request (event);
-
       goto DONE_LABEL;
     }
 
-  local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj);
-  
+  local_selection_time =
+    * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
+
   if (event->time != CurrentTime &&
       local_selection_time > event->time)
     {
@@ -610,36 +586,35 @@ x_handle_selection_request (XSelectionRequestEvent *event)
       goto DONE_LABEL;
     }
 
-  converted_selection = select_convert_out (selection_symbol,
-                                           target_symbol, Qnil);
-
-  /* #### Is this the right thing to do? I'm no X expert. -- ajh */
-  if (NILP (converted_selection))
-    {
-      /* We don't appear to have a selection in that data type. */
-      x_decline_selection_request (event);
-      goto DONE_LABEL;
-    }
-
   count = specpdl_depth ();
   record_unwind_protect (x_selection_request_lisp_error,
                         make_opaque_ptr (event));
+  target_symbol = x_atom_to_symbol (d, event->target);
 
-  {
-    unsigned char *data;
-    unsigned int size;
-    int format;
-    Atom type;
-    lisp_data_to_selection_data (d, converted_selection,
-                                &data, &type, &size, &format);
-    
-    x_reply_selection_request (event, format, data, size, type);
-    successful_p = Qt;
-    /* Tell x_selection_request_lisp_error() it's cool. */
-    event->type = 0;
-    xfree (data);
-  }
-  
+#if 0 /* #### MULTIPLE doesn't work yet */
+  if (EQ (target_symbol, QMULTIPLE))
+    target_symbol = fetch_multiple_target (event);
+#endif
+
+  /* Convert lisp objects back into binary data */
+
+  converted_selection =
+    get_local_selection (selection_symbol, target_symbol);
+
+  if (! NILP (converted_selection))
+    {
+      unsigned char *data;
+      unsigned int size;
+      int format;
+      Atom type;
+      lisp_data_to_selection_data (d, converted_selection,
+                                  &data, &type, &size, &format);
+
+      x_reply_selection_request (event, format, data, size, type);
+      successful_p = Qt;
+      /* Tell x_selection_request_lisp_error() it's cool. */      event->type = 0;
+      xfree (data);
+    }
   unbind_to (count, Qnil);
 
  DONE_LABEL:
@@ -648,15 +623,17 @@ x_handle_selection_request (XSelectionRequestEvent *event)
 
   /* Let random lisp code notice that the selection has been asked for. */
   {
+    Lisp_Object rest;
     Lisp_Object val = Vx_sent_selection_hooks;
     if (!UNBOUNDP (val) && !NILP (val))
       {
-       Lisp_Object rest;
        if (CONSP (val) && !EQ (XCAR (val), Qlambda))
          for (rest = val; !NILP (rest); rest = Fcdr (rest))
-           call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
+           call3 (Fcar(rest), selection_symbol, target_symbol,
+                  successful_p);
        else
-         call3 (val, selection_symbol, target_symbol, successful_p);
+         call3 (val, selection_symbol, target_symbol,
+                successful_p);
       }
   }
 }
@@ -672,18 +649,18 @@ x_handle_selection_clear (XSelectionClearEvent *event)
   Atom selection = event->selection;
   Time changed_owner_time = event->time;
 
-  Lisp_Object selection_symbol, local_selection_time_lisp;
+  Lisp_Object selection_symbol, local_selection_data;
   Time local_selection_time;
 
   selection_symbol = x_atom_to_symbol (d, selection);
 
-  local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
+  local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
 
-  /* We don't own the selection, so that's fine. */
-  if (NILP (local_selection_time_lisp))
-    return;
-  
-  local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp);
+  /* Well, we already believe that we don't own it, so that's just fine. */
+  if (NILP (local_selection_data)) return;
+
+  local_selection_time =
+    * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
 
   /* This SelectionClear is for a selection that we no longer own, so we can
      disregard it.  (That is, we have reasserted the selection since this
@@ -937,14 +914,10 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
   unbind_to (speccount, Qnil);
 
   /* otherwise, the selection is waiting for us on the requested property. */
-
-  return select_convert_in (selection_symbol,
-                           target_type,
-                           x_get_window_property_as_lisp_data(display,
-                                                              requestor_window,
-                                                              target_property,
-                                                              target_type,
-                                                              selection_atom));
+  return
+    x_get_window_property_as_lisp_data (display, requestor_window,
+                                       target_property, target_type,
+                                       selection_atom);
 }
 
 
@@ -1144,9 +1117,6 @@ x_get_window_property_as_lisp_data (Display *display,
   return val;
 }
 \f
-/* #### These are going to move into Lisp code(!) with the aid of
-        some new functions I'm working on - ajh */
-
 /* These functions convert from the selection data read from the server into
    something that we can use from elisp, and vice versa.
 
@@ -1194,7 +1164,7 @@ selection_data_to_lisp_data (struct device *d,
     return make_ext_string (data, size,
                            type == DEVICE_XATOM_TEXT (d) ||
                            type == DEVICE_XATOM_COMPOUND_TEXT (d)
-                           ? Qctext : Qbinary);
+                           ? FORMAT_CTEXT : FORMAT_BINARY);
 
   /* Convert a single atom to a Lisp Symbol.
      Convert a set of atoms to a vector of symbols. */
@@ -1290,12 +1260,13 @@ lisp_data_to_selection_data (struct device *d,
     }
   else if (STRINGP (obj))
     {
-      const Extbyte *extval;
+      CONST Extbyte *extval;
       Extcount extvallen;
 
-      TO_EXTERNAL_FORMAT (LISP_STRING, obj,
-                         ALLOCA, (extval, extvallen),
-                         (NILP (type) ? Qctext : Qbinary));
+      if (NILP (type))
+       GET_STRING_CTEXT_DATA_ALLOCA (obj, extval, extvallen);
+      else
+       GET_STRING_BINARY_DATA_ALLOCA (obj, extval, extvallen);
       *format_ret = 8;
       *size_ret = extvallen;
       *data_ret = (unsigned char *) xmalloc (*size_ret);
@@ -1310,14 +1281,12 @@ lisp_data_to_selection_data (struct device *d,
     {
       Bufbyte buf[MAX_EMCHAR_LEN];
       Bytecount len;
-      const Extbyte *extval;
+      CONST Extbyte *extval;
       Extcount extvallen;
 
       *format_ret = 8;
       len = set_charptr_emchar (buf, XCHAR (obj));
-      TO_EXTERNAL_FORMAT (DATA, (buf, len),
-                         ALLOCA, (extval, extvallen),
-                         Qctext);
+      GET_CHARPTR_EXT_CTEXT_DATA_ALLOCA (buf, len, extval, extvallen);
       *size_ret = extvallen;
       *data_ret = (unsigned char *) xmalloc (*size_ret);
       memcpy (*data_ret, extval, *size_ret);
@@ -1491,8 +1460,7 @@ x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
 }
 
 static Lisp_Object
-x_selection_exists_p (Lisp_Object selection,
-                     Lisp_Object selection_type)
+x_selection_exists_p (Lisp_Object selection)
 {
   struct device *d = decode_x_device (Qnil);
   Display *dpy = DEVICE_X_DISPLAY (d);
@@ -1509,7 +1477,7 @@ static int cut_buffers_initialized; /* Whether we're sure they all exist */
 static void
 initialize_cut_buffers (Display *display, Window window)
 {
-  static unsigned const char * const data = (unsigned const char *) "";
+  static unsigned CONST char * CONST data = (unsigned CONST char *) "";
 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
                                    PropModeAppend, data, 0)
   FROB (XA_CUT_BUFFER0);
@@ -1524,18 +1492,15 @@ initialize_cut_buffers (Display *display, Window window)
   cut_buffers_initialized = 1;
 }
 
-#define CHECK_CUTBUFFER(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)))                            \
-    signal_simple_error ("Doesn't name a cutbuffer", symbol);  \
-} while (0)
+#define CHECK_CUTBUFFER(symbol)                                                \
+  { 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))       \
+      signal_error (Qerror, list2 (build_string ("Doesn't name a cutbuffer"), \
+                                   (symbol))); \
+  }
 
 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
@@ -1572,7 +1537,7 @@ Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
   ret = (bytes ?
         make_ext_string (data, bytes,
                          memchr (data, 0x1b, bytes) ?
-                         Qctext : Qbinary)
+                         FORMAT_CTEXT : FORMAT_BINARY)
         : Qnil);
   xfree (data);
   return ret;
@@ -1588,12 +1553,12 @@ Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
   Display *display = DEVICE_X_DISPLAY (d);
   Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
   Atom cut_buffer_atom;
-  const Extbyte *data  = XSTRING_DATA (string);
+  CONST Extbyte *data  = XSTRING_DATA (string);
   Extcount bytes = XSTRING_LENGTH (string);
   Extcount bytes_remaining;
   int max_bytes = SELECTION_QUANTUM (display);
 #ifdef MULE
-  const Bufbyte *ptr, *end;
+  CONST Bufbyte *ptr, *end;
   enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
 #endif
 
@@ -1635,13 +1600,9 @@ Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
     }
 
   if (chartypes == LATIN_1)
-    TO_EXTERNAL_FORMAT (LISP_STRING, string,
-                       ALLOCA, (data, bytes),
-                       Qbinary);
+    GET_STRING_BINARY_DATA_ALLOCA (string, data, bytes);
   else if (chartypes == WORLD)
-    TO_EXTERNAL_FORMAT (LISP_STRING, string,
-                       ALLOCA, (data, bytes),
-                       Qctext);
+    GET_STRING_CTEXT_DATA_ALLOCA  (string, data, bytes);
 #endif /* MULE */
 
   bytes_remaining = bytes;
@@ -1697,7 +1658,7 @@ positive means move values forward, negative means backward.
 /************************************************************************/
 
 void
-syms_of_select_x (void)
+syms_of_xselect (void)
 {
 
 #ifdef CUT_BUFFER_SUPPORT
@@ -1733,24 +1694,18 @@ console_type_create_select_x (void)
 }
 
 void
-reinit_vars_of_select_x (void)
+vars_of_xselect (void)
 {
+#ifdef CUT_BUFFER_SUPPORT
+  cut_buffers_initialized = 0;
+  Fprovide (intern ("cut-buffer"));
+#endif
+
   reading_selection_reply = 0;
   reading_which_selection = 0;
   selection_reply_timed_out = 0;
   for_whom_the_bell_tolls = 0;
   prop_location_tick = 0;
-}
-
-void
-vars_of_select_x (void)
-{
-  reinit_vars_of_select_x ();
-
-#ifdef CUT_BUFFER_SUPPORT
-  cut_buffers_initialized = 0;
-  Fprovide (intern ("cut-buffer"));
-#endif
 
   DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
 A function or functions to be called after we have responded to some
@@ -1777,7 +1732,7 @@ A value of 0 means wait as long as necessary.  This is initialized from the
 }
 
 void
-Xatoms_of_select_x (struct device *d)
+Xatoms_of_xselect (struct device *d)
 {
   Display *D = DEVICE_X_DISPLAY (d);
 
@@ -1792,7 +1747,5 @@ Xatoms_of_select_x (struct device *d)
   DEVICE_XATOM_NULL          (d) = XInternAtom (D, "NULL",          False);
   DEVICE_XATOM_ATOM_PAIR     (d) = XInternAtom (D, "ATOM_PAIR",     False);
   DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
-
-  /* #### I don't like the looks of this... what is it for? - ajh */
   DEVICE_XATOM_EMACS_TMP     (d) = XInternAtom (D, "_EMACS_TMP_",   False);
 }