Mercurial > hg > xemacs-beta

comparison src/select-msw.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children da8ed4261e83
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
22 22
23 /* Authorship: 23 /* Authorship:
24 24
25 Written by Kevin Gallo for FSF Emacs. 25 Written by Kevin Gallo for FSF Emacs.
26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0. 26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
27 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support. 27 */
28 */ 28
29 29
30 #include <config.h> 30 #include <config.h>
31 #include "lisp.h" 31 #include "lisp.h"
32 #include "frame.h"
33 #include "select.h"
34 #include "opaque.h"
35 #include "file-coding.h"
36 #include "buffer.h"
37 32
38 #include "console-msw.h" 33 #include "console-msw.h"
39 34
40 /* A list of handles that we must release. Not accessible from Lisp. */ 35 DEFUN ("mswindows-set-clipboard", Fmswindows_set_clipboard, 1, 1, 0, /*
41 static Lisp_Object Vhandle_alist; 36 Copy STRING to the mswindows clipboard.
37 */
38 (string))
39 {
40 int rawsize, size, i;
41 unsigned char *src, *dst, *next;
42 HGLOBAL h = NULL;
42 43
43 /* Test if this is an X symbol that we understand */ 44 CHECK_STRING (string);
44 static int
45 x_sym_p (Lisp_Object value)
46 {
47 if (NILP (value) || INTP (value))
48 return 0;
49 45
50 /* Check for some of the X symbols */ 46 /* Calculate size with LFs converted to CRLFs because
51 if (EQ (value, QSTRING)) return 1; 47 * CF_TEXT format uses CRLF delimited ASCIIZ */
52 if (EQ (value, QTEXT)) return 1; 48 src = XSTRING_DATA (string);
53 if (EQ (value, QCOMPOUND_TEXT)) return 1; 49 size = rawsize = XSTRING_LENGTH (string) + 1;
50 for (i=0; i<rawsize; i++)
51 if (src[i] == '\n')
52 size++;
54 53
55 return 0; 54 if (!OpenClipboard (NULL))
55 return Qnil;
56
57 if (!EmptyClipboard () ||
58 (h = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, size)) == NULL ||
59 (dst = (unsigned char *) GlobalLock (h)) == NULL)
60 {
61 if (h != NULL) GlobalFree (h);
62 CloseClipboard ();
63 return Qnil;
64 }
65
66 /* Convert LFs to CRLFs */
67 do
68 {
69 /* copy next line or remaining bytes including '\0' */
70 next = memccpy (dst, src, '\n', rawsize);
71 if (next)
72 {
73 /* copied one line ending with '\n' */
74 int copied = next - dst;
75 rawsize -= copied;
76 src += copied;
77 /* insert '\r' before '\n' */
78 next[-1] = '\r';
79 next[0] = '\n';
80 dst = next+1;
81 }
82 }
83 while (next);
84
85 GlobalUnlock (h);
86
87 i = (SetClipboardData (CF_TEXT, h) != NULL);
88
89 CloseClipboard ();
90 GlobalFree (h);
91
92 return i ? Qt : Qnil;
56 } 93 }
57 94
58 /* This converts a Lisp symbol to an MS-Windows clipboard format. 95 DEFUN ("mswindows-get-clipboard", Fmswindows_get_clipboard, 0, 0, 0, /*
59 We have symbols for all predefined clipboard formats, but that 96 Return the contents of the mswindows clipboard.
60 doesn't mean we support them all ;-) 97 */
61 The name of this function is actually a lie - it also knows about 98 ())
62 integers and strings... */
63 static UINT
64 symbol_to_ms_cf (Lisp_Object value)
65 { 99 {
66 /* If it's NIL, we're in trouble. */ 100 HANDLE h;
67 if (NILP (value)) return 0; 101 unsigned char *src, *dst, *next;
68 102 Lisp_Object ret = Qnil;
69 /* If it's an integer, assume it's a format ID */
70 if (INTP (value)) return (UINT) (XINT (value));
71 103
72 /* If it's a string, register the format(!) */ 104 if (!OpenClipboard (NULL))
73 if (STRINGP (value)) 105 return Qnil;
74 return RegisterClipboardFormat (XSTRING_DATA (value));
75
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;
98 106
99 return 0; 107 if ((h = GetClipboardData (CF_TEXT)) != NULL &&
108 (src = (unsigned char *) GlobalLock (h)) != NULL)
109 {
110 int i;
111 int size, rawsize;
112 size = rawsize = strlen (src);
113
114 for (i=0; i<rawsize; i++)
115 if (src[i] == '\r' && src[i+1] == '\n')
116 size--;
117
118 /* Convert CRLFs to LFs */
119 ret = make_uninit_string (size);
120 dst = XSTRING_DATA (ret);
121 do
122 {
123 /* copy next line or remaining bytes excluding '\0' */
124 next = memccpy (dst, src, '\r', rawsize);
125 if (next)
126 {
127 /* copied one line ending with '\r' */
128 int copied = next - dst;
129 rawsize -= copied;
130 src += copied;
131 if (*src == '\n')
132 dst += copied - 1; /* overwrite '\r' */
133 else
134 dst += copied;
135 }
136 }
137 while (next);
138
139 GlobalUnlock (h);
140 }
141
142 CloseClipboard ();
143
144 return ret;
100 } 145 }
101 146
102 /* This converts an MS-Windows clipboard format to its corresponding 147 DEFUN ("mswindows-selection-exists-p", Fmswindows_selection_exists_p, 0, 0, 0, /*
103 Lisp symbol, or a Lisp integer otherwise. */ 148 Whether there is an MS-Windows selection.
104 static Lisp_Object 149 */
105 ms_cf_to_symbol (UINT format) 150 ())
106 { 151 {
107 switch (format) 152 return IsClipboardFormatAvailable (CF_TEXT) ? Qt : Qnil;
108 {
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);
131 }
132 } 153 }
133 154
134 /* Test if the specified clipboard format is auto-released by the OS. If 155 DEFUN ("mswindows-delete-selection", Fmswindows_delete_selection, 0, 0, 0, /*
135 not, we must remember the handle on Vhandle_alist, and free it if 156 Remove the current MS-Windows selection from the clipboard.
136 the clipboard is emptied or if we set data with the same format. */ 157 */
137 static int 158 ())
138 cf_is_autofreed (UINT format)
139 { 159 {
140 switch (format) 160 return EmptyClipboard () ? Qt : Qnil;
141 {
142 /* This list comes from the SDK documentation */
143 case CF_DSPENHMETAFILE:
144 case CF_DSPMETAFILEPICT:
145 case CF_ENHMETAFILE:
146 case CF_BITMAP:
147 case CF_DSPBITMAP:
148 case CF_PALETTE:
149 case CF_DIB:
150 case CF_DSPTEXT:
151 case CF_OEMTEXT:
152 case CF_TEXT:
153 case CF_UNICODETEXT:
154 return TRUE;
155
156 default:
157 return FALSE;
158 }
159 }
160
161 /* Do protocol to assert ourself as a selection owner.
162
163 Under mswindows, we:
164
165 * Only set the clipboard if (eq selection-name 'CLIPBOARD)
166
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.
169
170 * Otherwise assume the data is formatted appropriately for the data type
171 that was passed.
172
173 Then set the clipboard as necessary.
174 */
175 static Lisp_Object
176 mswindows_own_selection (Lisp_Object selection_name,
177 Lisp_Object selection_value,
178 Lisp_Object how_to_add,
179 Lisp_Object selection_type)
180 {
181 HGLOBAL hValue = NULL;
182 UINT cfType;
183 int is_X_type = FALSE;
184 Lisp_Object cfObject;
185 Lisp_Object data = Qnil;
186 int size;
187 void *src, *dst;
188 struct frame *f = NULL;
189
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))
193 return Qnil;
194
195 /* If this is one of the X-style atom name symbols, or NIL, convert it
196 as appropriate */
197 if (NILP (selection_type) || x_sym_p (selection_type))
198 {
199 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
200 cfType = CF_TEXT;
201 cfObject = QCF_TEXT;
202 is_X_type = TRUE;
203 }
204 else
205 {
206 cfType = symbol_to_ms_cf (selection_type);
207
208 /* Only continue if we can figure out a clipboard type */
209 if (!cfType)
210 return Qnil;
211
212 cfObject = selection_type;
213 }
214
215 /* Convert things appropriately */
216 data = select_convert_out (selection_name,
217 cfObject,
218 selection_value);
219
220 if (NILP (data))
221 return Qnil;
222
223 if (CONSP (data))
224 {
225 if (!EQ (XCAR (data), cfObject))
226 cfType = symbol_to_ms_cf (XCAR (data));
227
228 if (!cfType)
229 return Qnil;
230
231 data = XCDR (data);
232 }
233
234 /* We support opaque or string values, but we only mention string
235 values for now... */
236 if (!OPAQUEP (data)
237 && !STRINGP (data))
238 return Qnil;
239
240 /* Compute the data length */
241 if (OPAQUEP (data))
242 size = XOPAQUE_SIZE (data);
243 else
244 size = XSTRING_LENGTH (data) + 1;
245
246 /* Find the frame */
247 f = selected_frame ();
248
249 /* Open the clipboard */
250 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
251 return Qnil;
252
253 /* Allocate memory */
254 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
255
256 if (!hValue)
257 {
258 CloseClipboard ();
259
260 return Qnil;
261 }
262
263 /* Copy the data */
264 if (OPAQUEP (data))
265 src = XOPAQUE_DATA (data);
266 else
267 src = XSTRING_DATA (data);
268
269 dst = GlobalLock (hValue);
270
271 if (!dst)
272 {
273 GlobalFree (hValue);
274 CloseClipboard ();
275
276 return Qnil;
277 }
278
279 memcpy (dst, src, size);
280
281 GlobalUnlock (hValue);
282
283 /* Empty the clipboard if we're replacing everything */
284 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
285 {
286 if (!EmptyClipboard ())
287 {
288 CloseClipboard ();
289 GlobalFree (hValue);
290
291 return Qnil;
292 }
293 }
294
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... */
297
298 SetClipboardData (cfType, hValue);
299
300 if (!cf_is_autofreed (cfType))
301 {
302 Lisp_Object alist_elt = Qnil, rest;
303 Lisp_Object cfType_int = make_int (cfType);
304
305 /* First check if there's an element in the alist for this type
306 already. */
307 alist_elt = assq_no_quit (cfType_int, Vhandle_alist);
308
309 /* Add an element to the alist */
310 Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
311 Vhandle_alist);
312
313 if (!NILP (alist_elt))
314 {
315 /* Free the original handle */
316 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
317
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))))
322 {
323 XCDR (rest) = Fcdr (XCDR (rest));
324 break;
325 }
326 }
327 }
328
329 CloseClipboard ();
330
331 /* #### Should really return a time, though this is because of the
332 X model (by the looks of things) */
333 return Qnil;
334 }
335
336 static Lisp_Object
337 mswindows_available_selection_types (Lisp_Object selection_name)
338 {
339 Lisp_Object types = Qnil;
340 UINT format = 0;
341 struct frame *f = NULL;
342
343 if (!EQ (selection_name, QCLIPBOARD))
344 return Qnil;
345
346 /* Find the frame */
347 f = selected_frame ();
348
349 /* Open the clipboard */
350 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
351 return Qnil;
352
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... */
356
357 while ((format = EnumClipboardFormats (format)))
358 types = Fcons (ms_cf_to_symbol (format), types);
359
360 /* Close it */
361 CloseClipboard ();
362
363 return types;
364 }
365
366 static Lisp_Object
367 mswindows_register_selection_data_type (Lisp_Object type_name)
368 {
369 /* Type already checked in select.c */
370 const char *name = XSTRING_DATA (type_name);
371 UINT format;
372
373 format = RegisterClipboardFormat (name);
374
375 if (format)
376 return make_int ((int) format);
377 else
378 return Qnil;
379 }
380
381 static Lisp_Object
382 mswindows_selection_data_type_name (Lisp_Object type_id)
383 {
384 UINT format;
385 int numchars;
386 char name_buf[128];
387
388 /* If it's an integer, convert to a symbol if appropriate */
389 if (INTP (type_id))
390 type_id = ms_cf_to_symbol (XINT (type_id));
391
392 /* If this is a symbol, return it */
393 if (SYMBOLP (type_id))
394 return type_id;
395
396 /* Find the format code */
397 format = symbol_to_ms_cf (type_id);
398
399 if (!format)
400 return Qnil;
401
402 /* Microsoft, stupid Microsoft */
403 numchars = GetClipboardFormatName (format, name_buf, 128);
404
405 if (numchars)
406 {
407 Lisp_Object name;
408
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));
413
414 return name;
415 }
416
417 return Qnil;
418 }
419
420 static Lisp_Object
421 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
422 Lisp_Object target_type)
423 {
424 HGLOBAL hValue = NULL;
425 UINT cfType;
426 Lisp_Object cfObject = Qnil, ret = Qnil, value = Qnil;
427 int is_X_type = FALSE;
428 int size;
429 void *data;
430 struct frame *f = NULL;
431 struct gcpro gcpro1;
432
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))
436 return Qnil;
437
438 /* If this is one fo the X-style atom name symbols, or NIL, convert it
439 as appropriate */
440 if (NILP (target_type) || x_sym_p (target_type))
441 {
442 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
443 cfType = CF_TEXT;
444 cfObject = QCF_TEXT;
445 is_X_type = TRUE;
446 }
447 else
448 {
449 cfType = symbol_to_ms_cf (target_type);
450
451 /* Only continue if we can figure out a clipboard type */
452 if (!cfType)
453 return Qnil;
454
455 cfObject = ms_cf_to_symbol (cfType);
456 }
457
458 /* Find the frame */
459 f = selected_frame ();
460
461 /* Open the clipboard */
462 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
463 return Qnil;
464
465 /* Read the clipboard */
466 hValue = GetClipboardData (cfType);
467
468 if (!hValue)
469 {
470 CloseClipboard ();
471
472 return Qnil;
473 }
474
475 /* Find the data */
476 size = GlobalSize (hValue);
477 data = GlobalLock (hValue);
478
479 if (!data)
480 {
481 CloseClipboard ();
482
483 return Qnil;
484 }
485
486 /* Place it in a Lisp string */
487 TO_INTERNAL_FORMAT (DATA, (data, size),
488 LISP_STRING, ret,
489 Qbinary);
490
491 GlobalUnlock (data);
492 CloseClipboard ();
493
494 GCPRO1 (ret);
495
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,
500 cfObject,
501 ret);
502
503 UNGCPRO;
504
505 if (NILP (value))
506 return Fcons (cfObject, ret);
507 else
508 return value;
509 }
510
511 static void
512 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
513 {
514 if (EQ (selection, QCLIPBOARD))
515 {
516 BOOL success = OpenClipboard (NULL);
517 if (success)
518 {
519 success = EmptyClipboard ();
520 /* Close it regardless of whether empty worked. */
521 if (!CloseClipboard ())
522 success = FALSE;
523 }
524
525 /* #### return success ? Qt : Qnil; */
526 }
527 }
528
529 void
530 mswindows_destroy_selection (Lisp_Object selection)
531 {
532 Lisp_Object alist_elt;
533
534 /* Do nothing if this isn't for the clipboard. */
535 if (!EQ (selection, QCLIPBOARD))
536 return;
537
538 /* Right. We need to delete everything in Vhandle_alist. */
539 alist_elt = Vhandle_alist;
540
541 for (alist_elt; !NILP (alist_elt); alist_elt = Fcdr (alist_elt))
542 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
543
544 Vhandle_alist = Qnil;
545 }
546
547 static Lisp_Object
548 mswindows_selection_exists_p (Lisp_Object selection,
549 Lisp_Object selection_type)
550 {
551 /* We used to be picky about the format, but now we support anything. */
552 if (EQ (selection, QCLIPBOARD))
553 {
554 if (NILP (selection_type))
555 return CountClipboardFormats () ? Qt : Qnil;
556 else
557 return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
558 ? Qt : Qnil;
559 }
560 else
561 return Qnil;
562 } 161 }
563 162
564 163
565 /************************************************************************/ 164 /************************************************************************/
566 /* initialization */ 165 /* initialization */
567 /************************************************************************/ 166 /************************************************************************/
568 167
569 void 168 void
570 console_type_create_select_mswindows (void)
571 {
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);
579 }
580
581 void
582 syms_of_select_mswindows (void) 169 syms_of_select_mswindows (void)
583 { 170 {
171 DEFSUBR (Fmswindows_set_clipboard);
172 DEFSUBR (Fmswindows_get_clipboard);
173 DEFSUBR (Fmswindows_selection_exists_p);
174 DEFSUBR (Fmswindows_delete_selection);
584 } 175 }
585 176
586 void 177 void
587 vars_of_select_mswindows (void) 178 vars_of_select_mswindows (void)
588 { 179 {
589 /* Initialise Vhandle_alist */
590 Vhandle_alist = Qnil;
591 staticpro (&Vhandle_alist);
592 } 180 }