X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fselect-msw.c;h=4aa0aaf8a1b2271ef6a072ab57e06ab53267cc8b;hp=7d11bd9b2f7faf1117f08af7d35900aff6d9e90d;hb=762383636a99307282c2d93d26c35c046ec24da1;hpb=e31bfd1501359ce20fe1caf6b913a019318ec83c

diff --git a/src/select-msw.c b/src/select-msw.c
index 7d11bd9..4aa0aaf 100644
--- a/src/select-msw.c
+++ b/src/select-msw.c
@@ -24,104 +24,396 @@ Boston, MA 02111-1307, USA.  */
 
    Written by Kevin Gallo for FSF Emacs.
    Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
- */
-
+   Hacked by Alastair Houghton, July 2000 for enhanced clipboard support.
+*/
 
 #include <config.h>
 #include "lisp.h"
 #include "frame.h"
 #include "select.h"
+#include "opaque.h"
+#include "file-coding.h"
+#include "buffer.h"
 
 #include "console-msw.h"
 
+/* A list of handles that we must release. Not accessible from Lisp. */
+static Lisp_Object Vhandle_alist;
+
+/* Test if this is an X symbol that we understand */
+static int
+x_sym_p (Lisp_Object value)
+{
+  if (NILP (value) || INTP (value))
+    return 0;
+
+  /* Check for some of the X symbols */
+  if (EQ (value, QSTRING))		return 1;
+  if (EQ (value, QTEXT))		return 1;
+  if (EQ (value, QCOMPOUND_TEXT))	return 1;
+
+  return 0;
+}
+
+/* This converts a Lisp symbol to an MS-Windows clipboard format.
+   We have symbols for all predefined clipboard formats, but that
+   doesn't mean we support them all ;-)
+   The name of this function is actually a lie - it also knows about
+   integers and strings... */
+static UINT
+symbol_to_ms_cf (Lisp_Object value)
+{
+  /* If it's NIL, we're in trouble. */
+  if (NILP (value))			return 0;
+  
+  /* If it's an integer, assume it's a format ID */
+  if (INTP (value))			return (UINT) (XINT (value));
+
+  /* If it's a string, register the format(!) */
+  if (STRINGP (value))
+    return RegisterClipboardFormat (XSTRING_DATA (value));
+  
+  /* Check for Windows clipboard format symbols */
+  if (EQ (value, QCF_TEXT))		return CF_TEXT;
+  if (EQ (value, QCF_BITMAP))		return CF_BITMAP;
+  if (EQ (value, QCF_METAFILEPICT))	return CF_METAFILEPICT;
+  if (EQ (value, QCF_SYLK))		return CF_SYLK;
+  if (EQ (value, QCF_DIF))		return CF_DIF;
+  if (EQ (value, QCF_TIFF))		return CF_TIFF;
+  if (EQ (value, QCF_OEMTEXT))		return CF_OEMTEXT;
+  if (EQ (value, QCF_DIB))		return CF_DIB;
+  if (EQ (value, QCF_PALETTE))		return CF_PALETTE;
+  if (EQ (value, QCF_PENDATA))		return CF_PENDATA;
+  if (EQ (value, QCF_RIFF))		return CF_RIFF;
+  if (EQ (value, QCF_WAVE))		return CF_WAVE;
+  if (EQ (value, QCF_UNICODETEXT))	return CF_UNICODETEXT;
+  if (EQ (value, QCF_ENHMETAFILE))	return CF_ENHMETAFILE;
+  if (EQ (value, QCF_HDROP))		return CF_HDROP;
+  if (EQ (value, QCF_LOCALE))		return CF_LOCALE;
+  if (EQ (value, QCF_OWNERDISPLAY))	return CF_OWNERDISPLAY;
+  if (EQ (value, QCF_DSPTEXT))		return CF_DSPTEXT;
+  if (EQ (value, QCF_DSPBITMAP))	return CF_DSPBITMAP;
+  if (EQ (value, QCF_DSPMETAFILEPICT))	return CF_DSPMETAFILEPICT;
+  if (EQ (value, QCF_DSPENHMETAFILE))	return CF_DSPENHMETAFILE;
+
+  return 0;
+}
+
+/* This converts an MS-Windows clipboard format to its corresponding
+   Lisp symbol, or a Lisp integer otherwise. */
+static Lisp_Object
+ms_cf_to_symbol (UINT format)
+{
+  switch (format)
+    {
+    case CF_TEXT:		return QCF_TEXT;
+    case CF_BITMAP:		return QCF_BITMAP;
+    case CF_METAFILEPICT:	return QCF_METAFILEPICT;
+    case CF_SYLK:		return QCF_SYLK;
+    case CF_DIF:		return QCF_DIF;
+    case CF_TIFF:		return QCF_TIFF;
+    case CF_OEMTEXT:		return QCF_OEMTEXT;
+    case CF_DIB:		return QCF_DIB;
+    case CF_PALETTE:		return QCF_PALETTE;
+    case CF_PENDATA:		return QCF_PENDATA;
+    case CF_RIFF:		return QCF_RIFF;
+    case CF_WAVE:		return QCF_WAVE;
+    case CF_UNICODETEXT:	return QCF_UNICODETEXT;
+    case CF_ENHMETAFILE:	return QCF_ENHMETAFILE;
+    case CF_HDROP:		return QCF_HDROP;
+    case CF_LOCALE:		return QCF_LOCALE;
+    case CF_OWNERDISPLAY:	return QCF_OWNERDISPLAY;
+    case CF_DSPTEXT:		return QCF_DSPTEXT;
+    case CF_DSPBITMAP:		return QCF_DSPBITMAP;
+    case CF_DSPMETAFILEPICT:	return QCF_DSPMETAFILEPICT;
+    case CF_DSPENHMETAFILE:	return QCF_DSPENHMETAFILE;
+    default:			return make_int ((int) format);
+    }
+}
+
+/* Test if the specified clipboard format is auto-released by the OS. If
+   not, we must remember the handle on Vhandle_alist, and free it if
+   the clipboard is emptied or if we set data with the same format. */
+static int
+cf_is_autofreed (UINT format)
+{
+  switch (format)
+    {
+    /* This list comes from the SDK documentation */
+    case CF_DSPENHMETAFILE:
+    case CF_DSPMETAFILEPICT:
+    case CF_ENHMETAFILE:
+    case CF_BITMAP:
+    case CF_DSPBITMAP:
+    case CF_PALETTE:
+    case CF_DIB:
+    case CF_DSPTEXT:
+    case CF_OEMTEXT:
+    case CF_TEXT:
+    case CF_UNICODETEXT:
+      return TRUE;
+
+    default:
+      return FALSE;
+    }
+}
+
+/* Do protocol to assert ourself as a selection owner.
+   
+   Under mswindows, we:
 
-/* Do protocol to assert ourself as a selection owner. Under mswindows
-this is easy, we just set the clipboard.  */
+   * Only set the clipboard if (eq selection-name 'CLIPBOARD)
+
+   * Check if an X atom name has been passed. If so, convert to CF_TEXT
+     (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion.
+
+   * Otherwise assume the data is formatted appropriately for the data type
+     that was passed.
+
+   Then set the clipboard as necessary.
+*/
 static Lisp_Object
 mswindows_own_selection (Lisp_Object selection_name,
-			 Lisp_Object selection_value)
+			 Lisp_Object selection_value,
+			 Lisp_Object how_to_add,
+			 Lisp_Object selection_type)
 {
-  Lisp_Object converted_value = get_local_selection (selection_name, QSTRING);
-
-  if (!NILP (converted_value) &&
-      CONSP (converted_value) &&
-      EQ (XCAR (converted_value), QSTRING) &&
-      /* pure mswindows behaviour only says we can own the selection 
-	 if it is the clipboard */
-      EQ (selection_name, QCLIPBOARD))
-    {
-      int rawsize, size, i;
-      unsigned char *src, *dst, *next;
-      HGLOBAL h = NULL;
-      struct frame *f = NULL;
-      struct gcpro gcpro1, gcpro2;
-      Lisp_Object string = XCDR (converted_value);
-
-      GCPRO2 (converted_value, string);
-
-      CHECK_STRING (string);
-
-      /* Calculate size with LFs converted to CRLFs because
-       * CF_TEXT format uses CRLF delimited ASCIIZ */
-      src = XSTRING_DATA (string);
-      size = rawsize = XSTRING_LENGTH (string) + 1;
-      for (i=0; i<rawsize; i++)
-	if (src[i] == '\n')
-	  size++;
-
-      f = selected_frame ();
-      if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
-	{
-	  UNGCPRO;
-	  return Qnil;
-	}
+  HGLOBAL 	hValue = NULL;
+  UINT		cfType;
+  int		is_X_type = FALSE;
+  Lisp_Object	cfObject;
+  Lisp_Object	data = Qnil;
+  int		size;
+  void		*src, *dst;
+  struct frame  *f = NULL;
+
+  /* Only continue if we're trying to set the clipboard - mswindows doesn't
+     use the same selection model as X */
+  if (!EQ (selection_name, QCLIPBOARD))
+    return Qnil;
 
-      /* This call to EmptyClipboard may post an event back to us if
-	 we already own the clipboard (to tell us we lost it) and this
-	 event may execute random lisp code.  Hence we must protect
-	 the string and get its address again after the call. */
-      if (!EmptyClipboard () ||
-	  (h = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, size)) == NULL ||
-	  (dst = (unsigned char *) GlobalLock (h)) == NULL)
+  /* If this is one of the X-style atom name symbols, or NIL, convert it
+     as appropriate */
+  if (NILP (selection_type) || x_sym_p (selection_type))
+    {
+      /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
+      cfType = CF_TEXT;
+      cfObject = QCF_TEXT;
+      is_X_type = TRUE;
+    }
+  else
+    {
+      cfType = symbol_to_ms_cf (selection_type);
+
+      /* Only continue if we can figure out a clipboard type */
+      if (!cfType)
+	return Qnil;
+      
+      cfObject = selection_type;
+    }
+
+  /* Convert things appropriately */
+  data = select_convert_out (selection_name,
+			     cfObject,
+			     selection_value);
+
+  if (NILP (data))
+    return Qnil;
+
+  if (CONSP (data))
+    {
+      if (!EQ (XCAR (data), cfObject))
+	cfType = symbol_to_ms_cf (XCAR (data));
+
+      if (!cfType)
+	return Qnil;
+
+      data = XCDR (data);
+    }
+  
+  /* We support opaque or string values, but we only mention string
+     values for now... */
+  if (!OPAQUEP (data)
+      && !STRINGP (data))
+    return Qnil;
+      
+  /* Compute the data length */
+  if (OPAQUEP (data))
+    size = XOPAQUE_SIZE (data);
+  else
+    size = XSTRING_LENGTH (data) + 1;
+      
+  /* Find the frame */
+  f = selected_frame ();
+
+  /* Open the clipboard */
+  if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
+    return Qnil;
+  
+  /* Allocate memory */
+  hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
+      
+  if (!hValue)
+    {
+      CloseClipboard ();
+
+      return Qnil;
+    }
+      
+  /* Copy the data */
+  if (OPAQUEP (data))
+    src = XOPAQUE_DATA (data);
+  else
+    src = XSTRING_DATA (data);
+      
+  dst = GlobalLock (hValue);
+  
+  if (!dst)
+    {
+      GlobalFree (hValue);
+      CloseClipboard ();
+      
+      return Qnil;
+    }
+  
+  memcpy (dst, src, size);
+
+  GlobalUnlock (hValue);
+
+  /* Empty the clipboard if we're replacing everything */
+  if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
+    {
+      if (!EmptyClipboard ())
 	{
-	  if (h != NULL) GlobalFree (h);
 	  CloseClipboard ();
-	  UNGCPRO;
+	  GlobalFree (hValue);
+
 	  return Qnil;
 	}
-      src = XSTRING_DATA (string);
+    }
+
+  /* Append is currently handled in select.el; perhaps this should change,
+     but it only really makes sense for ordinary text in any case... */
 
-      /* Convert LFs to CRLFs */
-      do
+  SetClipboardData (cfType, hValue);
+
+  if (!cf_is_autofreed (cfType))
+    {
+      Lisp_Object alist_elt = Qnil, rest;
+      Lisp_Object cfType_int = make_int (cfType);
+      
+      /* First check if there's an element in the alist for this type
+	 already. */
+      alist_elt = assq_no_quit (cfType_int, Vhandle_alist);
+
+      /* Add an element to the alist */
+      Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
+			     Vhandle_alist);
+
+      if (!NILP (alist_elt))
 	{
-	  /* copy next line or remaining bytes including '\0' */
-	  next = (char*) memccpy (dst, src, '\n', rawsize);
-	  if (next)
-	    {
-	      /* copied one line ending with '\n' */
-	      int copied = next - dst;
-	      rawsize -= copied;
-	      src += copied;
-	      /* insert '\r' before '\n' */
-	      next[-1] = '\r';
-	      next[0] = '\n';
-	      dst = next+1;
-	    }	    
+	  /* Free the original handle */
+	  GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
+	
+	  /* Remove the original one (adding first makes life easier, because
+	     we don't have to special case this being the first element)      */
+	  for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
+	    if (EQ (cfType_int, Fcar (XCDR (rest))))
+	      {
+		XCDR (rest) = Fcdr (XCDR (rest));
+		break;
+	      }
 	}
-      while (next);
-    
-      GlobalUnlock (h);
+    }
   
-      i = (SetClipboardData (CF_TEXT, h) != NULL);
+  CloseClipboard ();
+
+  /* #### Should really return a time, though this is because of the
+     X model (by the looks of things) */
+  return Qnil;
+}
+
+static Lisp_Object
+mswindows_available_selection_types (Lisp_Object selection_name)
+{
+  Lisp_Object	types = Qnil;
+  UINT		format = 0;
+  struct frame  *f = NULL;
+
+  if (!EQ (selection_name, QCLIPBOARD))
+    return Qnil;
   
-      CloseClipboard ();
+  /* Find the frame */
+  f = selected_frame ();
 
-      UNGCPRO;
-      /* #### we are supposed to return a time! */
-      /* return i ? Qt : Qnil; */
-      return Qnil;
-    }
+  /* Open the clipboard */
+  if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
+    return Qnil;
+
+  /* #### ajh - Should there be an unwind-protect handler around this?
+                It could (well it probably won't, but it's always better to
+		be safe) run out of memory and leave the clipboard open... */
+  
+  while ((format = EnumClipboardFormats (format)))
+    types = Fcons (ms_cf_to_symbol (format), types);
+
+  /* Close it */
+  CloseClipboard ();
+
+  return types;
+}
+
+static Lisp_Object
+mswindows_register_selection_data_type (Lisp_Object type_name)
+{
+  /* Type already checked in select.c */
+  const char *name = XSTRING_DATA (type_name);
+  UINT	      format;
 
+  format = RegisterClipboardFormat (name);
+
+  if (format)
+    return make_int ((int) format);
+  else
+    return Qnil;
+}
+
+static Lisp_Object
+mswindows_selection_data_type_name (Lisp_Object type_id)
+{
+  UINT		format;
+  int		numchars;
+  char		name_buf[128];
+
+  /* If it's an integer, convert to a symbol if appropriate */
+  if (INTP (type_id))
+    type_id = ms_cf_to_symbol (XINT (type_id));
+  
+  /* If this is a symbol, return it */
+  if (SYMBOLP (type_id))
+    return type_id;
+
+  /* Find the format code */
+  format = symbol_to_ms_cf (type_id);
+
+  if (!format)
+    return Qnil;
+
+  /* Microsoft, stupid Microsoft */
+  numchars = GetClipboardFormatName (format, name_buf, 128);
+
+  if (numchars)
+    {
+      Lisp_Object name;
+
+      /* Do this properly - though we could support UNICODE (UCS-2) if
+         MULE could hack it. */
+      name = make_ext_string (name_buf, numchars,
+			      Fget_coding_system (Qraw_text));
+      
+      return name;
+    }
+  
   return Qnil;
 }
 
@@ -129,56 +421,91 @@ static Lisp_Object
 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
 				 Lisp_Object target_type)
 {
-  if (EQ (selection_symbol, QCLIPBOARD))
+  HGLOBAL	hValue = NULL;
+  UINT		cfType;
+  Lisp_Object	cfObject = Qnil, ret = Qnil, value = Qnil;
+  int		is_X_type = FALSE;
+  int		size;
+  void		*data;
+  struct frame  *f = NULL;
+  struct gcpro	gcpro1;
+  
+  /* Only continue if we're trying to read the clipboard - mswindows doesn't
+     use the same selection model as X */
+  if (!EQ (selection_symbol, QCLIPBOARD))
+    return Qnil;
+
+  /* If this is one fo the X-style atom name symbols, or NIL, convert it
+     as appropriate */
+  if (NILP (target_type) || x_sym_p (target_type))
+    {
+      /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
+      cfType = CF_TEXT;
+      cfObject = QCF_TEXT;
+      is_X_type = TRUE;
+    }
+  else
     {
-      HANDLE h;
-      unsigned char *src, *dst, *next;
-      Lisp_Object ret = Qnil;
+      cfType = symbol_to_ms_cf (target_type);
 
-      if (!OpenClipboard (NULL))
+      /* Only continue if we can figure out a clipboard type */
+      if (!cfType)
 	return Qnil;
 
-      if ((h = GetClipboardData (CF_TEXT)) != NULL &&
-	  (src = (unsigned char *) GlobalLock (h)) != NULL)
-	{
-	  int i;
-	  int size, rawsize;
-	  size = rawsize = strlen (src);
-
-	  for (i=0; i<rawsize; i++)
-	    if (src[i] == '\r' && src[i+1] == '\n')
-	      size--;
-
-	  /* Convert CRLFs to LFs */
-	  ret = make_uninit_string (size);
-	  dst = XSTRING_DATA (ret);
-	  do
-	    {
-	      /* copy next line or remaining bytes excluding '\0' */
-	      next = (unsigned char *) memccpy (dst, src, '\r', rawsize);
-	      if (next)
-		{
-		  /* copied one line ending with '\r' */
-		  int copied = next - dst;
-		  rawsize -= copied;
-		  src += copied;
-		  if (*src == '\n')
-		    dst += copied - 1;		/* overwrite '\r' */
-		  else
-		    dst += copied;
-		}	    
-	    }
-	  while (next);
-
-	  GlobalUnlock (h);
-	}
+      cfObject = ms_cf_to_symbol (cfType);
+    }
 
+  /* Find the frame */
+  f = selected_frame ();
+
+  /* Open the clipboard */
+  if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
+    return Qnil;
+
+  /* Read the clipboard */
+  hValue = GetClipboardData (cfType);
+
+  if (!hValue)
+    {
       CloseClipboard ();
 
-      return ret;
+      return Qnil;
     }
+
+  /* Find the data */
+  size = GlobalSize (hValue);
+  data = GlobalLock (hValue);
+
+  if (!data)
+    {
+      CloseClipboard ();
+
+      return Qnil;
+    }
+
+  /* Place it in a Lisp string */
+  TO_INTERNAL_FORMAT (DATA, (data, size),
+		      LISP_STRING, ret,
+		      Qbinary);
+
+  GlobalUnlock (data);
+  CloseClipboard ();
+
+  GCPRO1 (ret);
+  
+  /* Convert this to the appropriate type. If we can't find anything,
+     then we return a cons of the form (DATA-TYPE . STRING), where the
+     string contains the raw binary data. */
+  value = select_convert_in (selection_symbol,
+			     cfObject,
+			     ret);
+
+  UNGCPRO;
+  
+  if (NILP (value))
+    return Fcons (cfObject, ret);
   else
-    return Qnil;
+    return value;
 }
 
 static void
@@ -199,11 +526,37 @@ mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
     }
 }
 
+void
+mswindows_destroy_selection (Lisp_Object selection)
+{
+  Lisp_Object alist_elt;
+  
+  /* Do nothing if this isn't for the clipboard. */
+  if (!EQ (selection, QCLIPBOARD))
+    return;
+
+  /* Right. We need to delete everything in Vhandle_alist. */
+  alist_elt = Vhandle_alist;
+
+  for (alist_elt; !NILP (alist_elt); alist_elt = Fcdr (alist_elt))
+    GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
+
+  Vhandle_alist = Qnil;
+}
+
 static Lisp_Object
-mswindows_selection_exists_p (Lisp_Object selection)
+mswindows_selection_exists_p (Lisp_Object selection,
+			      Lisp_Object selection_type)
 {
+  /* We used to be picky about the format, but now we support anything. */
   if (EQ (selection, QCLIPBOARD))
-    return IsClipboardFormatAvailable (CF_TEXT) ? Qt : Qnil;
+    {
+      if (NILP (selection_type))
+	return CountClipboardFormats () ? Qt : Qnil;
+      else
+	return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
+	  ? Qt : Qnil;
+    }
   else
     return Qnil;
 }
@@ -220,6 +573,9 @@ console_type_create_select_mswindows (void)
   CONSOLE_HAS_METHOD (mswindows, disown_selection);
   CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
   CONSOLE_HAS_METHOD (mswindows, get_foreign_selection);
+  CONSOLE_HAS_METHOD (mswindows, available_selection_types);
+  CONSOLE_HAS_METHOD (mswindows, register_selection_data_type);
+  CONSOLE_HAS_METHOD (mswindows, selection_data_type_name);
 }
 
 void
@@ -230,4 +586,7 @@ syms_of_select_mswindows (void)
 void
 vars_of_select_mswindows (void)
 {
+  /* Initialise Vhandle_alist */
+  Vhandle_alist = Qnil;
+  staticpro (&Vhandle_alist);
 }