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;
86 if (EQ (value, QCF_DIBV5)) return CF_DIBV5;
88 if (EQ (value, QCF_PALETTE)) return CF_PALETTE;
89 if (EQ (value, QCF_PENDATA)) return CF_PENDATA;
90 if (EQ (value, QCF_RIFF)) return CF_RIFF;
91 if (EQ (value, QCF_WAVE)) return CF_WAVE;
92 if (EQ (value, QCF_UNICODETEXT)) return CF_UNICODETEXT;
93 if (EQ (value, QCF_ENHMETAFILE)) return CF_ENHMETAFILE;
94 if (EQ (value, QCF_HDROP)) return CF_HDROP;
95 if (EQ (value, QCF_LOCALE)) return CF_LOCALE;
96 if (EQ (value, QCF_OWNERDISPLAY)) return CF_OWNERDISPLAY;
97 if (EQ (value, QCF_DSPTEXT)) return CF_DSPTEXT;
98 if (EQ (value, QCF_DSPBITMAP)) return CF_DSPBITMAP;
99 if (EQ (value, QCF_DSPMETAFILEPICT)) return CF_DSPMETAFILEPICT;
100 if (EQ (value, QCF_DSPENHMETAFILE)) return CF_DSPENHMETAFILE;
105 /* This converts an MS-Windows clipboard format to its corresponding
106 Lisp symbol, or a Lisp integer otherwise. */
108 ms_cf_to_symbol (UINT format)
112 case CF_TEXT: return QCF_TEXT;
113 case CF_BITMAP: return QCF_BITMAP;
114 case CF_METAFILEPICT: return QCF_METAFILEPICT;
115 case CF_SYLK: return QCF_SYLK;
116 case CF_DIF: return QCF_DIF;
117 case CF_TIFF: return QCF_TIFF;
118 case CF_OEMTEXT: return QCF_OEMTEXT;
119 case CF_DIB: return QCF_DIB;
121 case CF_DIBV5: return QCF_DIBV5;
123 case CF_PALETTE: return QCF_PALETTE;
124 case CF_PENDATA: return QCF_PENDATA;
125 case CF_RIFF: return QCF_RIFF;
126 case CF_WAVE: return QCF_WAVE;
127 case CF_UNICODETEXT: return QCF_UNICODETEXT;
128 case CF_ENHMETAFILE: return QCF_ENHMETAFILE;
129 case CF_HDROP: return QCF_HDROP;
130 case CF_LOCALE: return QCF_LOCALE;
131 case CF_OWNERDISPLAY: return QCF_OWNERDISPLAY;
132 case CF_DSPTEXT: return QCF_DSPTEXT;
133 case CF_DSPBITMAP: return QCF_DSPBITMAP;
134 case CF_DSPMETAFILEPICT: return QCF_DSPMETAFILEPICT;
135 case CF_DSPENHMETAFILE: return QCF_DSPENHMETAFILE;
136 default: return make_int ((int) format);
140 /* Test if the specified clipboard format is auto-released by the OS. If
141 not, we must remember the handle on Vhandle_alist, and free it if
142 the clipboard is emptied or if we set data with the same format. */
144 cf_is_autofreed (UINT format)
148 /* This list comes from the SDK documentation */
149 case CF_DSPENHMETAFILE:
150 case CF_DSPMETAFILEPICT:
152 case CF_METAFILEPICT:
171 /* Do protocol to assert ourself as a selection owner.
175 * Only set the clipboard if (eq selection-name 'CLIPBOARD)
177 * Check if an X atom name has been passed. If so, convert to CF_TEXT
178 (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion.
180 * Otherwise assume the data is formatted appropriately for the data type
183 Then set the clipboard as necessary.
186 mswindows_own_selection (Lisp_Object selection_name,
187 Lisp_Object selection_value,
188 Lisp_Object how_to_add,
189 Lisp_Object selection_type)
191 HGLOBAL hValue = NULL;
193 int is_X_type = FALSE;
194 Lisp_Object cfObject;
195 Lisp_Object data = Qnil;
198 struct frame *f = NULL;
200 /* Only continue if we're trying to set the clipboard - mswindows doesn't
201 use the same selection model as X */
202 if (!EQ (selection_name, QCLIPBOARD))
205 /* If this is one of the X-style atom name symbols, or NIL, convert it
207 if (NILP (selection_type) || x_sym_p (selection_type))
209 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
216 cfType = symbol_to_ms_cf (selection_type);
218 /* Only continue if we can figure out a clipboard type */
222 cfObject = selection_type;
225 /* Convert things appropriately */
226 data = select_convert_out (selection_name,
235 if (!EQ (XCAR (data), cfObject))
236 cfType = symbol_to_ms_cf (XCAR (data));
244 /* We support opaque or string values, but we only mention string
250 /* Compute the data length */
252 size = XOPAQUE_SIZE (data);
254 size = XSTRING_LENGTH (data) + 1;
257 f = selected_frame ();
259 /* Open the clipboard */
260 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
263 /* Allocate memory */
264 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
275 src = XOPAQUE_DATA (data);
277 src = XSTRING_DATA (data);
279 dst = GlobalLock (hValue);
289 memcpy (dst, src, size);
291 GlobalUnlock (hValue);
293 /* Empty the clipboard if we're replacing everything */
294 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
296 if (!EmptyClipboard ())
305 /* Append is currently handled in select.el; perhaps this should change,
306 but it only really makes sense for ordinary text in any case... */
308 SetClipboardData (cfType, hValue);
310 if (!cf_is_autofreed (cfType))
312 Lisp_Object alist_elt = Qnil, rest;
313 Lisp_Object cfType_int = make_int (cfType);
315 /* First check if there's an element in the alist for this type
317 alist_elt = assq_no_quit (cfType_int, Vhandle_alist);
319 /* Add an element to the alist */
320 Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
323 if (!NILP (alist_elt))
325 /* Free the original handle */
326 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
328 /* Remove the original one (adding first makes life easier, because
329 we don't have to special case this being the first element) */
330 for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
331 if (EQ (cfType_int, Fcar (XCDR (rest))))
333 XCDR (rest) = Fcdr (XCDR (rest));
341 /* #### Should really return a time, though this is because of the
342 X model (by the looks of things) */
347 mswindows_available_selection_types (Lisp_Object selection_name)
349 Lisp_Object types = Qnil;
351 struct frame *f = NULL;
353 if (!EQ (selection_name, QCLIPBOARD))
357 f = selected_frame ();
359 /* Open the clipboard */
360 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
363 /* #### ajh - Should there be an unwind-protect handler around this?
364 It could (well it probably won't, but it's always better to
365 be safe) run out of memory and leave the clipboard open... */
367 while ((format = EnumClipboardFormats (format)))
368 types = Fcons (ms_cf_to_symbol (format), types);
377 mswindows_register_selection_data_type (Lisp_Object type_name)
379 /* Type already checked in select.c */
380 const char *name = XSTRING_DATA (type_name);
383 format = RegisterClipboardFormat (name);
386 return make_int ((int) format);
392 mswindows_selection_data_type_name (Lisp_Object type_id)
398 /* If it's an integer, convert to a symbol if appropriate */
400 type_id = ms_cf_to_symbol (XINT (type_id));
402 /* If this is a symbol, return it */
403 if (SYMBOLP (type_id))
406 /* Find the format code */
407 format = symbol_to_ms_cf (type_id);
412 /* Microsoft, stupid Microsoft */
413 numchars = GetClipboardFormatName (format, name_buf, 128);
419 /* Do this properly - though we could support UNICODE (UCS-2) if
420 MULE could hack it. */
421 name = make_ext_string (name_buf, numchars,
422 Fget_coding_system (Qraw_text));
431 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
432 Lisp_Object target_type)
434 HGLOBAL hValue = NULL;
436 Lisp_Object cfObject = Qnil, ret = Qnil, value = Qnil;
437 int is_X_type = FALSE;
440 struct frame *f = NULL;
443 /* Only continue if we're trying to read the clipboard - mswindows doesn't
444 use the same selection model as X */
445 if (!EQ (selection_symbol, QCLIPBOARD))
448 /* If this is one of the X-style atom name symbols, or NIL, convert it
450 if (NILP (target_type) || x_sym_p (target_type))
452 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
459 cfType = symbol_to_ms_cf (target_type);
461 /* Only continue if we can figure out a clipboard type */
465 cfObject = ms_cf_to_symbol (cfType);
469 f = selected_frame ();
471 /* Open the clipboard */
472 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
475 /* Read the clipboard */
476 hValue = GetClipboardData (cfType);
486 size = GlobalSize (hValue);
487 data = GlobalLock (hValue);
496 /* Place it in a Lisp string */
497 TO_INTERNAL_FORMAT (DATA, (data, size),
506 /* Convert this to the appropriate type. If we can't find anything,
507 then we return a cons of the form (DATA-TYPE . STRING), where the
508 string contains the raw binary data. */
509 value = select_convert_in (selection_symbol,
516 return Fcons (cfObject, ret);
522 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
524 if (EQ (selection, QCLIPBOARD))
526 BOOL success = OpenClipboard (NULL);
529 success = EmptyClipboard ();
530 /* Close it regardless of whether empty worked. */
531 if (!CloseClipboard ())
535 /* #### return success ? Qt : Qnil; */
540 mswindows_destroy_selection (Lisp_Object selection)
542 /* Do nothing if this isn't for the clipboard. */
543 if (!EQ (selection, QCLIPBOARD))
546 /* Right. We need to delete everything in Vhandle_alist. */
548 LIST_LOOP_2 (elt, Vhandle_alist)
549 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (elt)));
552 Vhandle_alist = Qnil;
556 mswindows_selection_exists_p (Lisp_Object selection,
557 Lisp_Object selection_type)
559 /* We used to be picky about the format, but now we support anything. */
560 if (EQ (selection, QCLIPBOARD))
562 if (NILP (selection_type))
563 return CountClipboardFormats () ? Qt : Qnil;
565 return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
573 /************************************************************************/
575 /************************************************************************/
578 console_type_create_select_mswindows (void)
580 CONSOLE_HAS_METHOD (mswindows, own_selection);
581 CONSOLE_HAS_METHOD (mswindows, disown_selection);
582 CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
583 CONSOLE_HAS_METHOD (mswindows, get_foreign_selection);
584 CONSOLE_HAS_METHOD (mswindows, available_selection_types);
585 CONSOLE_HAS_METHOD (mswindows, register_selection_data_type);
586 CONSOLE_HAS_METHOD (mswindows, selection_data_type_name);
590 syms_of_select_mswindows (void)
595 vars_of_select_mswindows (void)
597 /* Initialise Vhandle_alist */
598 Vhandle_alist = Qnil;
599 staticpro (&Vhandle_alist);