Mercurial > hg > xemacs-beta

comparison src/select-msw.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 5fd7ba8b56e7
children a5954632b187
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* mswindows selection processing for XEmacs 1 /* mswindows selection processing for XEmacs
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. 2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 2000, 2001 Ben Wing.
3 4
4 This file is part of XEmacs. 5 This file is part of XEmacs.
5 6
6 XEmacs is free software; you can redistribute it and/or modify it 7 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 under the terms of the GNU General Public License as published by the
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */ 20 Boston, MA 02111-1307, USA. */
20 21
21 /* Synched up with: Not synched with FSF. */ 22 /* Synched up with: Not synched with FSF. */
22 23
24 /* This file Mule-ized 7-00?? Needs some Unicode review. --ben */
25
23 /* Authorship: 26 /* Authorship:
24 27
25 Written by Kevin Gallo for FSF Emacs. 28 Written by Kevin Gallo for FSF Emacs.
26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0. 29 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
30 Rewritten April 2000 by Ben Wing -- support device methods, Mule-ize.
27 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support. 31 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support.
28 */ 32 */
29 33
30 #include <config.h> 34 #include <config.h>
31 #include "lisp.h" 35 #include "lisp.h"
36 #include "buffer.h"
32 #include "frame.h" 37 #include "frame.h"
33 #include "select.h" 38 #include "select.h"
34 #include "opaque.h" 39 #include "opaque.h"
35 #include "file-coding.h" 40 #include "file-coding.h"
36 #include "buffer.h"
37 41
38 #include "console-msw.h" 42 #include "console-msw.h"
43
44 static int in_own_selection;
39 45
40 /* A list of handles that we must release. Not accessible from Lisp. */ 46 /* A list of handles that we must release. Not accessible from Lisp. */
41 static Lisp_Object Vhandle_alist; 47 static Lisp_Object Vhandle_alist;
48
49 void
50 mswindows_handle_destroyclipboard (void)
51 {
52 /* We also receive a destroy message when we call EmptyClipboard() and
53 we already own it. In this case we don't want to call
54 handle_selection_clear() because it will remove what we're trying
55 to add! */
56 if (!in_own_selection)
57 {
58 /* We own the clipboard and someone else wants it. Delete our
59 cached copy of the clipboard contents so we'll ask for it from
60 Windows again when someone does a paste, and destroy any memory
61 objects we hold on the clipboard that are not in the list of types
62 that Windows will delete itself. */
63 mswindows_destroy_selection (QCLIPBOARD);
64 handle_selection_clear (QCLIPBOARD);
65 }
66 }
67
68 static int
69 mswindows_empty_clipboard (void)
70 {
71 int retval;
72
73 in_own_selection = 1;
74 retval = EmptyClipboard ();
75 in_own_selection = 0;
76 return retval;
77 }
42 78
43 /* Test if this is an X symbol that we understand */ 79 /* Test if this is an X symbol that we understand */
44 static int 80 static int
45 x_sym_p (Lisp_Object value) 81 x_sym_p (Lisp_Object value)
46 { 82 {
69 /* If it's an integer, assume it's a format ID */ 105 /* If it's an integer, assume it's a format ID */
70 if (INTP (value)) return (UINT) (XINT (value)); 106 if (INTP (value)) return (UINT) (XINT (value));
71 107
72 /* If it's a string, register the format(!) */ 108 /* If it's a string, register the format(!) */
73 if (STRINGP (value)) 109 if (STRINGP (value))
74 /* !!#### more mule bogosity */ 110 {
75 return RegisterClipboardFormat ((Extbyte *) XSTRING_DATA (value)); 111 Extbyte *valext;
112 LISP_STRING_TO_TSTR (value, valext);
113 return qxeRegisterClipboardFormat (valext);
114 }
76 115
77 /* Check for Windows clipboard format symbols */ 116 /* Check for Windows clipboard format symbols */
78 if (EQ (value, QCF_TEXT)) return CF_TEXT; 117 if (EQ (value, QCF_TEXT)) return CF_TEXT;
79 if (EQ (value, QCF_BITMAP)) return CF_BITMAP; 118 if (EQ (value, QCF_BITMAP)) return CF_BITMAP;
80 if (EQ (value, QCF_METAFILEPICT)) return CF_METAFILEPICT; 119 if (EQ (value, QCF_METAFILEPICT)) return CF_METAFILEPICT;
207 /* If this is one of the X-style atom name symbols, or NIL, convert it 246 /* If this is one of the X-style atom name symbols, or NIL, convert it
208 as appropriate */ 247 as appropriate */
209 if (NILP (selection_type) || x_sym_p (selection_type)) 248 if (NILP (selection_type) || x_sym_p (selection_type))
210 { 249 {
211 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */ 250 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
212 cfType = CF_TEXT; 251 if (XEUNICODE_P)
213 cfObject = QCF_TEXT; 252 {
253 cfType = CF_UNICODETEXT;
254 cfObject = QCF_UNICODETEXT;
255 }
256 else
257 {
258 cfType = CF_TEXT;
259 cfObject = QCF_TEXT;
260 }
214 is_X_type = TRUE; 261 is_X_type = TRUE;
215 } 262 }
216 else 263 else
217 { 264 {
218 cfType = symbol_to_ms_cf (selection_type); 265 cfType = symbol_to_ms_cf (selection_type);
242 289
243 data = XCDR (data); 290 data = XCDR (data);
244 } 291 }
245 292
246 /* We support opaque or string values, but we only mention string 293 /* We support opaque or string values, but we only mention string
247 values for now... */ 294 values for now...
295 #### where do the opaque objects come from? currently they're not
296 allowed to be exported to the lisp level! */
248 if (!OPAQUEP (data) 297 if (!OPAQUEP (data)
249 && !STRINGP (data)) 298 && !STRINGP (data))
250 return Qnil; 299 return Qnil;
251 300
252 /* Compute the data length */
253 if (OPAQUEP (data))
254 size = XOPAQUE_SIZE (data);
255 else
256 size = XSTRING_LENGTH (data) + 1;
257
258 /* Find the frame */ 301 /* Find the frame */
259 f = selected_frame (); 302 f = selected_frame ();
260 303
261 /* Open the clipboard */ 304 /* Open the clipboard */
262 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) 305 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
263 return Qnil; 306 return Qnil;
264 307
308 /* Obtain the data */
309 if (OPAQUEP (data))
310 {
311 src = XOPAQUE_DATA (data);
312 size = XOPAQUE_SIZE (data);
313 }
314 else
315 /* we do NOT append a zero byte. we don't know whether we're dealing
316 with regular text, unicode text, binary data, etc. */
317 TO_EXTERNAL_FORMAT (LISP_STRING, data, ALLOCA, (src, size),
318 Qbinary);
319
265 /* Allocate memory */ 320 /* Allocate memory */
266 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size); 321 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
267 322
268 if (!hValue) 323 if (!hValue)
269 { 324 {
270 CloseClipboard (); 325 CloseClipboard ();
271 326
272 return Qnil; 327 return Qnil;
273 } 328 }
274 329
275 /* Copy the data */
276 if (OPAQUEP (data))
277 src = XOPAQUE_DATA (data);
278 else
279 src = XSTRING_DATA (data);
280
281 dst = GlobalLock (hValue); 330 dst = GlobalLock (hValue);
282 331
283 if (!dst) 332 if (!dst)
284 { 333 {
285 GlobalFree (hValue); 334 GlobalFree (hValue);
293 GlobalUnlock (hValue); 342 GlobalUnlock (hValue);
294 343
295 /* Empty the clipboard if we're replacing everything */ 344 /* Empty the clipboard if we're replacing everything */
296 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all)) 345 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
297 { 346 {
298 if (!EmptyClipboard ()) 347 if (!mswindows_empty_clipboard ())
299 { 348 {
300 CloseClipboard (); 349 CloseClipboard ();
301 GlobalFree (hValue); 350 GlobalFree (hValue);
302 351
303 return Qnil; 352 return Qnil;
325 if (!NILP (alist_elt)) 374 if (!NILP (alist_elt))
326 { 375 {
327 /* Free the original handle */ 376 /* Free the original handle */
328 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt))); 377 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
329 378
330 /* Remove the original one (adding first makes life easier, because 379 /* Remove the original one (adding first makes life easier,
331 we don't have to special case this being the first element) */ 380 because we don't have to special case this being the
381 first element) */
332 for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest)) 382 for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
333 if (EQ (cfType_int, Fcar (XCDR (rest)))) 383 if (EQ (cfType_int, Fcar (XCDR (rest))))
334 { 384 {
335 XCDR (rest) = Fcdr (XCDR (rest)); 385 XCDR (rest) = Fcdr (XCDR (rest));
336 break; 386 break;
360 410
361 /* Open the clipboard */ 411 /* Open the clipboard */
362 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) 412 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
363 return Qnil; 413 return Qnil;
364 414
365 /* #### ajh - Should there be an unwind-protect handler around this? 415 /* [[ ajh - Should there be an unwind-protect handler around this?
366 It could (well it probably won't, but it's always better to 416 It could (well it probably won't, but it's always better to
367 be safe) run out of memory and leave the clipboard open... */ 417 be safe) run out of memory and leave the clipboard open... ]]
418 -- xemacs in general makes no provisions for out-of-memory errors;
419 we will probably just crash. fixing this is a huge amount of work,
420 so don't bother protecting in this case. --ben */
368 421
369 while ((format = EnumClipboardFormats (format))) 422 while ((format = EnumClipboardFormats (format)))
370 types = Fcons (ms_cf_to_symbol (format), types); 423 types = Fcons (ms_cf_to_symbol (format), types);
371 424
372 /* Close it */ 425 /* Close it */
377 430
378 static Lisp_Object 431 static Lisp_Object
379 mswindows_register_selection_data_type (Lisp_Object type_name) 432 mswindows_register_selection_data_type (Lisp_Object type_name)
380 { 433 {
381 /* Type already checked in select.c */ 434 /* Type already checked in select.c */
382 /* !!#### more mule bogosity */ 435 Extbyte *nameext;
383 const char *name = (char *) XSTRING_DATA (type_name); 436 UINT format;
384 UINT format; 437
385 438 LISP_STRING_TO_TSTR (type_name, nameext);
386 format = RegisterClipboardFormat (name); 439 format = qxeRegisterClipboardFormat (nameext);
387 440
388 if (format) 441 if (format)
389 return make_int ((int) format); 442 return make_int ((int) format);
390 else 443 else
391 return Qnil; 444 return Qnil;
392 } 445 }
393 446
394 static Lisp_Object 447 static Lisp_Object
395 mswindows_selection_data_type_name (Lisp_Object type_id) 448 mswindows_selection_data_type_name (Lisp_Object type_id)
396 { 449 {
397 UINT format; 450 UINT format;
398 int numchars; 451 Extbyte *namebuf;
399 char name_buf[128]; 452 int numchars;
400 453
401 /* If it's an integer, convert to a symbol if appropriate */ 454 /* If it's an integer, convert to a symbol if appropriate */
402 if (INTP (type_id)) 455 if (INTP (type_id))
403 type_id = ms_cf_to_symbol (XINT (type_id)); 456 type_id = ms_cf_to_symbol (XINT (type_id));
404 457
411 464
412 if (!format) 465 if (!format)
413 return Qnil; 466 return Qnil;
414 467
415 /* Microsoft, stupid Microsoft */ 468 /* Microsoft, stupid Microsoft */
416 numchars = GetClipboardFormatName (format, name_buf, 128); 469 {
470 int size, new_size = 128;
471 do
472 {
473 size = new_size;
474 new_size *= 2;
475 namebuf = alloca_extbytes (size * XETCHAR_SIZE);
476 numchars = qxeGetClipboardFormatName (format, namebuf, size);
477 }
478 while (numchars >= size - 1);
479 }
417 480
418 if (numchars) 481 if (numchars)
419 { 482 return build_tstr_string (namebuf);
420 Lisp_Object name;
421
422 /* Do this properly - though we could support UNICODE (UCS-2) if
423 MULE could hack it. */
424 name = make_ext_string (name_buf, numchars,
425 Fget_coding_system (Qraw_text));
426
427 return name;
428 }
429 483
430 return Qnil; 484 return Qnil;
431 } 485 }
432 486
433 static Lisp_Object 487 static Lisp_Object
451 /* If this is one of the X-style atom name symbols, or NIL, convert it 505 /* If this is one of the X-style atom name symbols, or NIL, convert it
452 as appropriate */ 506 as appropriate */
453 if (NILP (target_type) || x_sym_p (target_type)) 507 if (NILP (target_type) || x_sym_p (target_type))
454 { 508 {
455 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */ 509 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
456 cfType = CF_TEXT; 510 if (XEUNICODE_P)
457 cfObject = QCF_TEXT; 511 {
512 cfType = CF_UNICODETEXT;
513 cfObject = QCF_UNICODETEXT;
514 }
515 else
516 {
517 cfType = CF_TEXT;
518 cfObject = QCF_TEXT;
519 }
458 is_X_type = TRUE; 520 is_X_type = TRUE;
459 } 521 }
460 else 522 else
461 { 523 {
462 cfType = symbol_to_ms_cf (target_type); 524 cfType = symbol_to_ms_cf (target_type);
495 557
496 return Qnil; 558 return Qnil;
497 } 559 }
498 560
499 /* Place it in a Lisp string */ 561 /* Place it in a Lisp string */
500 TO_INTERNAL_FORMAT (DATA, (data, size), 562 ret = make_ext_string ((Extbyte *) data, size, Qbinary);
501 LISP_STRING, ret,
502 Qbinary);
503 563
504 GlobalUnlock (data); 564 GlobalUnlock (data);
505 CloseClipboard (); 565 CloseClipboard ();
506 566
507 GCPRO1 (ret); 567 GCPRO1 (ret);
527 if (EQ (selection, QCLIPBOARD)) 587 if (EQ (selection, QCLIPBOARD))
528 { 588 {
529 BOOL success = OpenClipboard (NULL); 589 BOOL success = OpenClipboard (NULL);
530 if (success) 590 if (success)
531 { 591 {
532 success = EmptyClipboard (); 592 /* the caller calls handle_selection_clear(). */
593 success = mswindows_empty_clipboard ();
533 /* Close it regardless of whether empty worked. */ 594 /* Close it regardless of whether empty worked. */
534 if (!CloseClipboard ()) 595 if (!CloseClipboard ())
535 success = FALSE; 596 success = FALSE;
536 } 597 }
537 598
599 { 660 {
600 /* Initialise Vhandle_alist */ 661 /* Initialise Vhandle_alist */
601 Vhandle_alist = Qnil; 662 Vhandle_alist = Qnil;
602 staticpro (&Vhandle_alist); 663 staticpro (&Vhandle_alist);
603 } 664 }
665
666 void
667 init_select_mswindows (void)
668 {
669 /* Reinitialise Vhandle_alist */
670 /* #### Why do we need to do this? Somehow I added this. --ben */
671 Vhandle_alist = Qnil;
672 }