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;
}
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
}
}
+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;
}
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
void
vars_of_select_mswindows (void)
{
+ /* Initialise Vhandle_alist */
+ Vhandle_alist = Qnil;
+ staticpro (&Vhandle_alist);
}
projects / chise / xemacs-chise.git.1 / blobdiff