1 /* mswindows selection processing for XEmacs
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not synched with FSF. */
25 Written by Kevin Gallo for FSF Emacs.
26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
27 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support.
35 #include "file-coding.h"
38 #include "console-msw.h"
40 /* A list of handles that we must release. Not accessible from Lisp. */
41 static Lisp_Object Vhandle_alist;
43 /* Test if this is an X symbol that we understand */
45 x_sym_p (Lisp_Object value)
47 if (NILP (value) || INTP (value))
50 /* Check for some of the X symbols */
51 if (EQ (value, QSTRING)) return 1;
52 if (EQ (value, QTEXT)) return 1;
53 if (EQ (value, QCOMPOUND_TEXT)) return 1;
58 /* This converts a Lisp symbol to an MS-Windows clipboard format.
59 We have symbols for all predefined clipboard formats, but that
60 doesn't mean we support them all ;-)
61 The name of this function is actually a lie - it also knows about
62 integers and strings... */
64 symbol_to_ms_cf (Lisp_Object value)
66 /* If it's NIL, we're in trouble. */
67 if (NILP (value)) return 0;
69 /* If it's an integer, assume it's a format ID */
70 if (INTP (value)) return (UINT) (XINT (value));
72 /* If it's a string, register the format(!) */
74 return RegisterClipboardFormat (XSTRING_DATA (value));
76 /* Check for Windows clipboard format symbols */
77 if (EQ (value, QCF_TEXT)) return CF_TEXT;
78 if (EQ (value, QCF_BITMAP)) return CF_BITMAP;
79 if (EQ (value, QCF_METAFILEPICT)) return CF_METAFILEPICT;
80 if (EQ (value, QCF_SYLK)) return CF_SYLK;
81 if (EQ (value, QCF_DIF)) return CF_DIF;
82 if (EQ (value, QCF_TIFF)) return CF_TIFF;
83 if (EQ (value, QCF_OEMTEXT)) return CF_OEMTEXT;
84 if (EQ (value, QCF_DIB)) return CF_DIB;
85 if (EQ (value, QCF_PALETTE)) return CF_PALETTE;
86 if (EQ (value, QCF_PENDATA)) return CF_PENDATA;
87 if (EQ (value, QCF_RIFF)) return CF_RIFF;
88 if (EQ (value, QCF_WAVE)) return CF_WAVE;
89 if (EQ (value, QCF_UNICODETEXT)) return CF_UNICODETEXT;
90 if (EQ (value, QCF_ENHMETAFILE)) return CF_ENHMETAFILE;
91 if (EQ (value, QCF_HDROP)) return CF_HDROP;
92 if (EQ (value, QCF_LOCALE)) return CF_LOCALE;
93 if (EQ (value, QCF_OWNERDISPLAY)) return CF_OWNERDISPLAY;
94 if (EQ (value, QCF_DSPTEXT)) return CF_DSPTEXT;
95 if (EQ (value, QCF_DSPBITMAP)) return CF_DSPBITMAP;
96 if (EQ (value, QCF_DSPMETAFILEPICT)) return CF_DSPMETAFILEPICT;
97 if (EQ (value, QCF_DSPENHMETAFILE)) return CF_DSPENHMETAFILE;
102 /* This converts an MS-Windows clipboard format to its corresponding
103 Lisp symbol, or a Lisp integer otherwise. */
105 ms_cf_to_symbol (UINT format)
109 case CF_TEXT: return QCF_TEXT;
110 case CF_BITMAP: return QCF_BITMAP;
111 case CF_METAFILEPICT: return QCF_METAFILEPICT;
112 case CF_SYLK: return QCF_SYLK;
113 case CF_DIF: return QCF_DIF;
114 case CF_TIFF: return QCF_TIFF;
115 case CF_OEMTEXT: return QCF_OEMTEXT;
116 case CF_DIB: return QCF_DIB;
117 case CF_PALETTE: return QCF_PALETTE;
118 case CF_PENDATA: return QCF_PENDATA;
119 case CF_RIFF: return QCF_RIFF;
120 case CF_WAVE: return QCF_WAVE;
121 case CF_UNICODETEXT: return QCF_UNICODETEXT;
122 case CF_ENHMETAFILE: return QCF_ENHMETAFILE;
123 case CF_HDROP: return QCF_HDROP;
124 case CF_LOCALE: return QCF_LOCALE;
125 case CF_OWNERDISPLAY: return QCF_OWNERDISPLAY;
126 case CF_DSPTEXT: return QCF_DSPTEXT;
127 case CF_DSPBITMAP: return QCF_DSPBITMAP;
128 case CF_DSPMETAFILEPICT: return QCF_DSPMETAFILEPICT;
129 case CF_DSPENHMETAFILE: return QCF_DSPENHMETAFILE;
130 default: return make_int ((int) format);
134 /* Test if the specified clipboard format is auto-released by the OS. If
135 not, we must remember the handle on Vhandle_alist, and free it if
136 the clipboard is emptied or if we set data with the same format. */
138 cf_is_autofreed (UINT format)
142 /* This list comes from the SDK documentation */
143 case CF_DSPENHMETAFILE:
144 case CF_DSPMETAFILEPICT:
161 /* Do protocol to assert ourself as a selection owner.
165 * Only set the clipboard if (eq selection-name 'CLIPBOARD)
167 * Check if an X atom name has been passed. If so, convert to CF_TEXT
168 (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion.
170 * Otherwise assume the data is formatted appropriately for the data type
173 Then set the clipboard as necessary.
176 mswindows_own_selection (Lisp_Object selection_name,
177 Lisp_Object selection_value,
178 Lisp_Object how_to_add,
179 Lisp_Object selection_type)
181 HGLOBAL hValue = NULL;
183 int is_X_type = FALSE;
184 Lisp_Object cfObject;
185 Lisp_Object data = Qnil;
188 struct frame *f = NULL;
190 /* Only continue if we're trying to set the clipboard - mswindows doesn't
191 use the same selection model as X */
192 if (!EQ (selection_name, QCLIPBOARD))
195 /* If this is one of the X-style atom name symbols, or NIL, convert it
197 if (NILP (selection_type) || x_sym_p (selection_type))
199 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
206 cfType = symbol_to_ms_cf (selection_type);
208 /* Only continue if we can figure out a clipboard type */
212 cfObject = selection_type;
215 /* Convert things appropriately */
216 data = select_convert_out (selection_name,
225 if (!EQ (XCAR (data), cfObject))
226 cfType = symbol_to_ms_cf (XCAR (data));
234 /* We support opaque or string values, but we only mention string
240 /* Compute the data length */
242 size = XOPAQUE_SIZE (data);
244 size = XSTRING_LENGTH (data) + 1;
247 f = selected_frame ();
249 /* Open the clipboard */
250 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
253 /* Allocate memory */
254 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
265 src = XOPAQUE_DATA (data);
267 src = XSTRING_DATA (data);
269 dst = GlobalLock (hValue);
279 memcpy (dst, src, size);
281 GlobalUnlock (hValue);
283 /* Empty the clipboard if we're replacing everything */
284 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
286 if (!EmptyClipboard ())
295 /* Append is currently handled in select.el; perhaps this should change,
296 but it only really makes sense for ordinary text in any case... */
298 SetClipboardData (cfType, hValue);
300 if (!cf_is_autofreed (cfType))
302 Lisp_Object alist_elt = Qnil, rest;
303 Lisp_Object cfType_int = make_int (cfType);
305 /* First check if there's an element in the alist for this type
307 alist_elt = assq_no_quit (cfType_int, Vhandle_alist);
309 /* Add an element to the alist */
310 Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
313 if (!NILP (alist_elt))
315 /* Free the original handle */
316 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
318 /* Remove the original one (adding first makes life easier, because
319 we don't have to special case this being the first element) */
320 for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
321 if (EQ (cfType_int, Fcar (XCDR (rest))))
323 XCDR (rest) = Fcdr (XCDR (rest));
331 /* #### Should really return a time, though this is because of the
332 X model (by the looks of things) */
337 mswindows_available_selection_types (Lisp_Object selection_name)
339 Lisp_Object types = Qnil;
341 struct frame *f = NULL;
343 if (!EQ (selection_name, QCLIPBOARD))
347 f = selected_frame ();
349 /* Open the clipboard */
350 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
353 /* #### ajh - Should there be an unwind-protect handler around this?
354 It could (well it probably won't, but it's always better to
355 be safe) run out of memory and leave the clipboard open... */
357 while ((format = EnumClipboardFormats (format)))
358 types = Fcons (ms_cf_to_symbol (format), types);
367 mswindows_register_selection_data_type (Lisp_Object type_name)
369 /* Type already checked in select.c */
370 const char *name = XSTRING_DATA (type_name);
373 format = RegisterClipboardFormat (name);
376 return make_int ((int) format);
382 mswindows_selection_data_type_name (Lisp_Object type_id)
388 /* If it's an integer, convert to a symbol if appropriate */
390 type_id = ms_cf_to_symbol (XINT (type_id));
392 /* If this is a symbol, return it */
393 if (SYMBOLP (type_id))
396 /* Find the format code */
397 format = symbol_to_ms_cf (type_id);
402 /* Microsoft, stupid Microsoft */
403 numchars = GetClipboardFormatName (format, name_buf, 128);
409 /* Do this properly - though we could support UNICODE (UCS-2) if
410 MULE could hack it. */
411 name = make_ext_string (name_buf, numchars,
412 Fget_coding_system (Qraw_text));
421 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
422 Lisp_Object target_type)
424 HGLOBAL hValue = NULL;
426 Lisp_Object cfObject = Qnil, ret = Qnil, value = Qnil;
427 int is_X_type = FALSE;
430 struct frame *f = NULL;
433 /* Only continue if we're trying to read the clipboard - mswindows doesn't
434 use the same selection model as X */
435 if (!EQ (selection_symbol, QCLIPBOARD))
438 /* If this is one fo the X-style atom name symbols, or NIL, convert it
440 if (NILP (target_type) || x_sym_p (target_type))
442 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
449 cfType = symbol_to_ms_cf (target_type);
451 /* Only continue if we can figure out a clipboard type */
455 cfObject = ms_cf_to_symbol (cfType);
459 f = selected_frame ();
461 /* Open the clipboard */
462 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
465 /* Read the clipboard */
466 hValue = GetClipboardData (cfType);
476 size = GlobalSize (hValue);
477 data = GlobalLock (hValue);
486 /* Place it in a Lisp string */
487 TO_INTERNAL_FORMAT (DATA, (data, size),
496 /* Convert this to the appropriate type. If we can't find anything,
497 then we return a cons of the form (DATA-TYPE . STRING), where the
498 string contains the raw binary data. */
499 value = select_convert_in (selection_symbol,
506 return Fcons (cfObject, ret);
512 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
514 if (EQ (selection, QCLIPBOARD))
516 BOOL success = OpenClipboard (NULL);
519 success = EmptyClipboard ();
520 /* Close it regardless of whether empty worked. */
521 if (!CloseClipboard ())
525 /* #### return success ? Qt : Qnil; */
530 mswindows_destroy_selection (Lisp_Object selection)
532 Lisp_Object alist_elt;
534 /* Do nothing if this isn't for the clipboard. */
535 if (!EQ (selection, QCLIPBOARD))
538 /* Right. We need to delete everything in Vhandle_alist. */
539 alist_elt = Vhandle_alist;
541 for (alist_elt; !NILP (alist_elt); alist_elt = Fcdr (alist_elt))
542 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
544 Vhandle_alist = Qnil;
548 mswindows_selection_exists_p (Lisp_Object selection,
549 Lisp_Object selection_type)
551 /* We used to be picky about the format, but now we support anything. */
552 if (EQ (selection, QCLIPBOARD))
554 if (NILP (selection_type))
555 return CountClipboardFormats () ? Qt : Qnil;
557 return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
565 /************************************************************************/
567 /************************************************************************/
570 console_type_create_select_mswindows (void)
572 CONSOLE_HAS_METHOD (mswindows, own_selection);
573 CONSOLE_HAS_METHOD (mswindows, disown_selection);
574 CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
575 CONSOLE_HAS_METHOD (mswindows, get_foreign_selection);
576 CONSOLE_HAS_METHOD (mswindows, available_selection_types);
577 CONSOLE_HAS_METHOD (mswindows, register_selection_data_type);
578 CONSOLE_HAS_METHOD (mswindows, selection_data_type_name);
582 syms_of_select_mswindows (void)
587 vars_of_select_mswindows (void)
589 /* Initialise Vhandle_alist */
590 Vhandle_alist = Qnil;
591 staticpro (&Vhandle_alist);