1/* Selection processing for Emacs on the Microsoft W32 API. 2 Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 3 2005, 2006, 2007 Free Software Foundation, Inc. 4 5This file is part of GNU Emacs. 6 7GNU Emacs is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Emacs is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Emacs; see the file COPYING. If not, write to 19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 20Boston, MA 02110-1301, USA. */ 21 22/* Written by Kevin Gallo, Benjamin Riefenstahl */ 23 24 25/* 26 * Notes on usage of selection-coding-system and 27 * next-selection-coding-system on MS Windows: 28 * 29 * The selection coding system variables apply only to the version of 30 * the clipboard data that is closest in type, i.e. when a 16-bit 31 * Unicode coding system is given, they apply to he Unicode clipboard 32 * (CF_UNICODETEXT), when a well-known console codepage is given, they 33 * apply to the console version of the clipboard data (CF_OEMTEXT), 34 * else they apply to the normal 8-bit text clipboard (CF_TEXT). 35 * 36 * When pasting (getting data from the OS), the clipboard format that 37 * matches the {next-}selection-coding-system is retrieved. If 38 * Unicode is requested, but not available, 8-bit text (CF_TEXT) is 39 * used. In all other cases the OS will transparently convert 40 * formats, so no other fallback is needed. 41 * 42 * When copying or cutting (sending data to the OS), the data is 43 * announced and stored internally, but only actually rendered on 44 * request. The requester determines the format provided. The 45 * {next-}selection-coding-system is only used, when its corresponding 46 * clipboard type matches the type requested. 47 * 48 * Scenarios to use the facilities for customizing the selection 49 * coding system are: 50 * 51 * ;; Generally use KOI8-R instead of the russian MS codepage for 52 * ;; the 8-bit clipboard. 53 * (set-selection-coding-system 'koi8-r-dos) 54 * 55 * Or 56 * 57 * ;; Create a special clipboard copy function that uses codepage 58 * ;; 1253 (Greek) to copy Greek text to a specific non-Unicode 59 * ;; application. 60 * (defun greek-copy (beg end) 61 * (interactive "r") 62 * (set-next-selection-coding-system 'cp1253-dos) 63 * (copy-region-as-kill beg end)) 64 * (global-set-key "\C-c\C-c" 'greek-copy) 65 */ 66 67/* 68 * Ideas for further directions: 69 * 70 * The encoding and decoding routines could be moved to Lisp code 71 * similar to how xselect.c does it (using well-known routine names 72 * for the delayed rendering). If the definition of which clipboard 73 * types should be supported is also moved to Lisp, functionality 74 * could be expanded to CF_HTML, CF_RTF and maybe other types. 75 */ 76 77#include <config.h> 78#include "lisp.h" 79#include "w32term.h" /* for all of the w32 includes */ 80#include "w32heap.h" /* os_subtype */ 81#include "blockinput.h" 82#include "keyboard.h" /* cmd_error_internal() */ 83#include "charset.h" 84#include "coding.h" 85#include "composite.h" 86 87 88static HGLOBAL convert_to_handle_as_ascii (void); 89static HGLOBAL convert_to_handle_as_coded (Lisp_Object coding_system); 90static Lisp_Object render (Lisp_Object oformat); 91static Lisp_Object render_locale (void); 92static Lisp_Object render_all (void); 93static void run_protected (Lisp_Object (*code) (), Lisp_Object arg); 94static Lisp_Object lisp_error_handler (Lisp_Object error); 95static LRESULT CALLBACK owner_callback (HWND win, UINT msg, 96 WPARAM wp, LPARAM lp); 97static HWND create_owner (void); 98 99static void setup_config (void); 100static BOOL WINAPI enum_locale_callback (/*const*/ char* loc_string); 101static UINT cp_from_locale (LCID lcid, UINT format); 102static Lisp_Object coding_from_cp (UINT codepage); 103 104 105/* A remnant from X11: Symbol for the CLIPBORD selection type. Other 106 selections are not used on Windows, so we don't need symbols for 107 PRIMARY and SECONDARY. */ 108Lisp_Object QCLIPBOARD; 109 110/* Coding system for communicating with other programs via the 111 clipboard. */ 112static Lisp_Object Vselection_coding_system; 113 114/* Coding system for the next communication with other programs. */ 115static Lisp_Object Vnext_selection_coding_system; 116 117/* Internal pseudo-constants, initialized in globals_of_w32select() 118 based on current system parameters. */ 119static LCID DEFAULT_LCID; 120static UINT ANSICP, OEMCP; 121static Lisp_Object QUNICODE, QANSICP, QOEMCP; 122 123/* A hidden window just for the clipboard management. */ 124static HWND clipboard_owner; 125/* A flag to tell WM_DESTROYCLIPBOARD who is to blame this time (just 126 checking GetClipboardOwner() doesn't work, sadly). */ 127static int modifying_clipboard = 0; 128 129/* Configured transfer parameters, based on the last inspection of 130 selection-coding-system. */ 131static Lisp_Object cfg_coding_system; 132static UINT cfg_codepage; 133static LCID cfg_lcid; 134static UINT cfg_clipboard_type; 135 136/* The current state for delayed rendering. */ 137static Lisp_Object current_text; 138static Lisp_Object current_coding_system; 139static int current_requires_encoding, current_num_nls; 140static UINT current_clipboard_type; 141static LCID current_lcid; 142 143#if TRACE 144#define ONTRACE(stmt) stmt 145#else 146#define ONTRACE(stmt) /*stmt*/ 147#endif 148 149 150/* This function assumes that there is no multibyte character in 151 current_text, so we can short-cut encoding. */ 152 153static HGLOBAL 154convert_to_handle_as_ascii (void) 155{ 156 HGLOBAL htext = NULL; 157 int nbytes; 158 int truelen; 159 unsigned char *src; 160 unsigned char *dst; 161 162 ONTRACE (fprintf (stderr, "convert_to_handle_as_ascii\n")); 163 164 nbytes = SBYTES (current_text) + 1; 165 src = SDATA (current_text); 166 167 /* We need to add to the size the number of LF chars where we have 168 to insert CR chars (the standard CF_TEXT clipboard format uses 169 CRLF line endings, while Emacs uses just LF internally). */ 170 171 truelen = nbytes + current_num_nls; 172 173 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL) 174 return NULL; 175 176 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL) 177 { 178 GlobalFree (htext); 179 return NULL; 180 } 181 182 /* convert to CRLF line endings expected by clipboard */ 183 while (1) 184 { 185 unsigned char *next; 186 /* copy next line or remaining bytes including '\0' */ 187 next = _memccpy (dst, src, '\n', nbytes); 188 if (next) 189 { 190 /* copied one line ending with '\n' */ 191 int copied = next - dst; 192 nbytes -= copied; 193 src += copied; 194 /* insert '\r' before '\n' */ 195 next[-1] = '\r'; 196 next[0] = '\n'; 197 dst = next + 1; 198 } 199 else 200 /* copied remaining partial line -> now finished */ 201 break; 202 } 203 204 GlobalUnlock (htext); 205 206 return htext; 207} 208 209/* This function assumes that there are multibyte or NUL characters in 210 current_text, or that we need to construct Unicode. It runs the 211 text through the encoding machinery. */ 212 213static HGLOBAL 214convert_to_handle_as_coded (Lisp_Object coding_system) 215{ 216 HGLOBAL htext = NULL, htext2; 217 int nbytes; 218 unsigned char *src; 219 unsigned char *dst = NULL; 220 int bufsize; 221 struct coding_system coding; 222 Lisp_Object string = Qnil; 223 224 ONTRACE (fprintf (stderr, "convert_to_handle_as_coded: %s\n", 225 SDATA (SYMBOL_NAME (coding_system)))); 226 227 setup_coding_system (Fcheck_coding_system (coding_system), &coding); 228 coding.src_multibyte = 1; 229 coding.dst_multibyte = 0; 230 /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in 231 encode_coding_iso2022 trying to dereference a null pointer. */ 232 coding.composing = COMPOSITION_DISABLED; 233 if (coding.type == coding_type_iso2022) 234 coding.flags |= CODING_FLAG_ISO_SAFE; 235 coding.mode |= CODING_MODE_LAST_BLOCK; 236 /* Force DOS line-ends. */ 237 coding.eol_type = CODING_EOL_CRLF; 238 239 if (SYMBOLP (coding.pre_write_conversion) 240 && !NILP (Ffboundp (coding.pre_write_conversion))) 241 string = run_pre_post_conversion_on_str (current_text, &coding, 1); 242 else 243 string = current_text; 244 245 nbytes = SBYTES (string); 246 src = SDATA (string); 247 248 bufsize = encoding_buffer_size (&coding, nbytes) +2; 249 htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize); 250 251 if (htext != NULL) 252 dst = (unsigned char *) GlobalLock (htext); 253 254 if (dst != NULL) 255 { 256 encode_coding (&coding, src, dst, nbytes, bufsize-2); 257 /* Add the string terminator. Add two NULs in case we are 258 producing Unicode here. */ 259 dst[coding.produced] = dst[coding.produced+1] = '\0'; 260 } 261 262 if (dst != NULL) 263 GlobalUnlock (htext); 264 265 if (htext != NULL) 266 { 267 /* Shrink data block to actual size. */ 268 htext2 = GlobalReAlloc (htext, coding.produced+2, 269 GMEM_MOVEABLE | GMEM_DDESHARE); 270 if (htext2 != NULL) htext = htext2; 271 } 272 273 return htext; 274} 275 276static Lisp_Object 277render (Lisp_Object oformat) 278{ 279 HGLOBAL htext = NULL; 280 UINT format = XFASTINT (oformat); 281 282 ONTRACE (fprintf (stderr, "render\n")); 283 284 if (NILP (current_text)) 285 return Qnil; 286 287 if (current_requires_encoding || format == CF_UNICODETEXT) 288 { 289 if (format == current_clipboard_type) 290 htext = convert_to_handle_as_coded (current_coding_system); 291 else 292 switch (format) 293 { 294 case CF_UNICODETEXT: 295 htext = convert_to_handle_as_coded (QUNICODE); 296 break; 297 case CF_TEXT: 298 case CF_OEMTEXT: 299 { 300 Lisp_Object cs; 301 cs = coding_from_cp (cp_from_locale (current_lcid, format)); 302 htext = convert_to_handle_as_coded (cs); 303 break; 304 } 305 } 306 } 307 else 308 htext = convert_to_handle_as_ascii (); 309 310 ONTRACE (fprintf (stderr, "render: htext = 0x%08X\n", (unsigned) htext)); 311 312 if (htext == NULL) 313 return Qnil; 314 315 if (SetClipboardData (format, htext) == NULL) 316 { 317 GlobalFree(htext); 318 return Qnil; 319 } 320 321 return Qt; 322} 323 324static Lisp_Object 325render_locale (void) 326{ 327 HANDLE hlocale = NULL; 328 LCID * lcid_ptr; 329 330 ONTRACE (fprintf (stderr, "render_locale\n")); 331 332 if (current_lcid == LOCALE_NEUTRAL || current_lcid == DEFAULT_LCID) 333 return Qt; 334 335 hlocale = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, sizeof (current_lcid)); 336 if (hlocale == NULL) 337 return Qnil; 338 339 if ((lcid_ptr = (LCID *) GlobalLock (hlocale)) == NULL) 340 { 341 GlobalFree(hlocale); 342 return Qnil; 343 } 344 345 *lcid_ptr = current_lcid; 346 GlobalUnlock (hlocale); 347 348 if (SetClipboardData (CF_LOCALE, hlocale) == NULL) 349 { 350 GlobalFree(hlocale); 351 return Qnil; 352 } 353 354 return Qt; 355} 356 357/* At the end of the program, we want to ensure that our clipboard 358 data survives us. This code will do that. */ 359 360static Lisp_Object 361render_all (void) 362{ 363 ONTRACE (fprintf (stderr, "render_all\n")); 364 365 /* According to the docs we should not call OpenClipboard() here, 366 but testing on W2K and working code in other projects shows that 367 it is actually necessary. */ 368 369 OpenClipboard (NULL); 370 371 /* There is no usefull means to report errors here, there are none 372 expected anyway, and even if there were errors, they wouldn't do 373 any harm. So we just go ahead and do what has to be done without 374 bothering with error handling. */ 375 376 ++modifying_clipboard; 377 EmptyClipboard (); 378 --modifying_clipboard; 379 380 /* For text formats that we don't render here, the OS can use its 381 own translation rules instead, so we don't really need to offer 382 everything. To minimize memory consumption we cover three 383 possible situations based on our primary format as detected from 384 selection-coding-system (see setup_config()): 385 386 - Post CF_TEXT only. Let the OS convert to CF_OEMTEXT and the OS 387 (on NT) or the application (on 9x/Me) convert to 388 CF_UNICODETEXT. 389 390 - Post CF_OEMTEXT only. Similar automatic conversions happen as 391 for CF_TEXT. 392 393 - Post CF_UNICODETEXT + CF_TEXT. 9x itself ignores 394 CF_UNICODETEXT, even though some applications can still handle 395 it. 396 397 Note 1: We render the less capable CF_TEXT *before* the more 398 capable CF_UNICODETEXT, to prevent clobbering through automatic 399 conversions, just in case. 400 401 Note 2: We could check os_subtype here and only render the 402 additional CF_TEXT on 9x/Me. But OTOH with 403 current_clipboard_type == CF_UNICODETEXT we don't involve the 404 automatic conversions anywhere else, so to get consistent 405 results, we probably don't want to rely on it here either. */ 406 407 render_locale(); 408 409 if (current_clipboard_type == CF_UNICODETEXT) 410 render (make_number (CF_TEXT)); 411 render (make_number (current_clipboard_type)); 412 413 CloseClipboard (); 414 415 return Qnil; 416} 417 418static void 419run_protected (Lisp_Object (*code) (), Lisp_Object arg) 420{ 421 /* FIXME: This works but it doesn't feel right. Too much fiddling 422 with global variables and calling strange looking functions. Is 423 this really the right way to run Lisp callbacks? */ 424 425 extern int waiting_for_input; 426 int owfi; 427 428 BLOCK_INPUT; 429 430 /* Fsignal calls abort() if it sees that waiting_for_input is 431 set. */ 432 owfi = waiting_for_input; 433 waiting_for_input = 0; 434 435 internal_condition_case_1 (code, arg, Qt, lisp_error_handler); 436 437 waiting_for_input = owfi; 438 439 UNBLOCK_INPUT; 440} 441 442static Lisp_Object 443lisp_error_handler (Lisp_Object error) 444{ 445 Vsignaling_function = Qnil; 446 cmd_error_internal (error, "Error in delayed clipboard rendering: "); 447 Vinhibit_quit = Qt; 448 return Qt; 449} 450 451 452static LRESULT CALLBACK 453owner_callback (HWND win, UINT msg, WPARAM wp, LPARAM lp) 454{ 455 switch (msg) 456 { 457 case WM_RENDERFORMAT: 458 ONTRACE (fprintf (stderr, "WM_RENDERFORMAT\n")); 459 run_protected (render, make_number (wp)); 460 return 0; 461 462 case WM_RENDERALLFORMATS: 463 ONTRACE (fprintf (stderr, "WM_RENDERALLFORMATS\n")); 464 run_protected (render_all, Qnil); 465 return 0; 466 467 case WM_DESTROYCLIPBOARD: 468 if (!modifying_clipboard) 469 { 470 ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (other)\n")); 471 current_text = Qnil; 472 current_coding_system = Qnil; 473 } 474 else 475 { 476 ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (self)\n")); 477 } 478 return 0; 479 480 case WM_DESTROY: 481 if (win == clipboard_owner) 482 clipboard_owner = NULL; 483 break; 484 } 485 486 return DefWindowProc (win, msg, wp, lp); 487} 488 489static HWND 490create_owner (void) 491{ 492 static const char CLASSNAME[] = "Emacs Clipboard"; 493 WNDCLASS wc; 494 495 memset (&wc, 0, sizeof (wc)); 496 wc.lpszClassName = CLASSNAME; 497 wc.lpfnWndProc = owner_callback; 498 RegisterClass (&wc); 499 500 return CreateWindow (CLASSNAME, CLASSNAME, 0, 0, 0, 0, 0, NULL, NULL, 501 NULL, NULL); 502} 503 504/* Called on exit by term_ntproc() in w32.c */ 505 506void 507term_w32select (void) 508{ 509 /* This is needed to trigger WM_RENDERALLFORMATS. */ 510 if (clipboard_owner != NULL) 511 DestroyWindow (clipboard_owner); 512} 513 514static void 515setup_config (void) 516{ 517 const char *coding_name; 518 const char *cp; 519 char *end; 520 int slen; 521 Lisp_Object new_coding_system; 522 523 CHECK_SYMBOL (Vselection_coding_system); 524 525 /* Check if we have it cached */ 526 new_coding_system = NILP (Vnext_selection_coding_system) ? 527 Vselection_coding_system : Vnext_selection_coding_system; 528 if (!NILP (cfg_coding_system) 529 && EQ (cfg_coding_system, new_coding_system)) 530 return; 531 cfg_coding_system = new_coding_system; 532 533 /* Set some sensible fallbacks */ 534 cfg_codepage = ANSICP; 535 cfg_lcid = LOCALE_NEUTRAL; 536 cfg_clipboard_type = CF_TEXT; 537 538 /* Interpret the coding system symbol name */ 539 coding_name = SDATA (SYMBOL_NAME (cfg_coding_system)); 540 541 /* "(.*-)?utf-16.*" -> CF_UNICODETEXT */ 542 cp = strstr (coding_name, "utf-16"); 543 if (cp != NULL && (cp == coding_name || cp[-1] == '-')) 544 { 545 cfg_clipboard_type = CF_UNICODETEXT; 546 return; 547 } 548 549 /* "cp[0-9]+.*" or "windows-[0-9]+.*" -> CF_TEXT or CF_OEMTEXT */ 550 slen = strlen (coding_name); 551 if (slen >= 4 && coding_name[0] == 'c' && coding_name[1] == 'p') 552 cp = coding_name + 2; 553 else if (slen >= 10 && memcmp (coding_name, "windows-", 8) == 0) 554 cp = coding_name + 8; 555 else 556 return; 557 558 end = (char*)cp; 559 cfg_codepage = strtol (cp, &end, 10); 560 561 /* Error return from strtol() or number of digits < 2 -> Restore the 562 default and drop it. */ 563 if (cfg_codepage == 0 || (end-cp) < 2 ) 564 { 565 cfg_codepage = ANSICP; 566 return; 567 } 568 569 /* Is it the currently active system default? */ 570 if (cfg_codepage == ANSICP) 571 { 572 /* cfg_clipboard_type = CF_TEXT; */ 573 return; 574 } 575 if (cfg_codepage == OEMCP) 576 { 577 cfg_clipboard_type = CF_OEMTEXT; 578 return; 579 } 580 581 /* Else determine a suitable locale the hard way. */ 582 EnumSystemLocales (enum_locale_callback, LCID_INSTALLED); 583} 584 585static BOOL WINAPI 586enum_locale_callback (/*const*/ char* loc_string) 587{ 588 LCID lcid; 589 UINT codepage; 590 591 lcid = strtoul (loc_string, NULL, 16); 592 593 /* Is the wanted codepage the "ANSI" codepage for this locale? */ 594 codepage = cp_from_locale (lcid, CF_TEXT); 595 if (codepage == cfg_codepage) 596 { 597 cfg_lcid = lcid; 598 cfg_clipboard_type = CF_TEXT; 599 return FALSE; /* Stop enumeration */ 600 } 601 602 /* Is the wanted codepage the OEM codepage for this locale? */ 603 codepage = cp_from_locale (lcid, CF_OEMTEXT); 604 if (codepage == cfg_codepage) 605 { 606 cfg_lcid = lcid; 607 cfg_clipboard_type = CF_OEMTEXT; 608 return FALSE; /* Stop enumeration */ 609 } 610 611 return TRUE; /* Continue enumeration */ 612} 613 614static UINT 615cp_from_locale (LCID lcid, UINT format) 616{ 617 char buffer[20] = ""; 618 UINT variant, cp; 619 620 variant = 621 format == CF_TEXT ? LOCALE_IDEFAULTANSICODEPAGE : LOCALE_IDEFAULTCODEPAGE; 622 623 GetLocaleInfo (lcid, variant, buffer, sizeof (buffer)); 624 cp = strtoul (buffer, NULL, 10); 625 626 if (cp == CP_ACP) 627 return ANSICP; 628 else if (cp == CP_OEMCP) 629 return OEMCP; 630 else 631 return cp; 632} 633 634static Lisp_Object 635coding_from_cp (UINT codepage) 636{ 637 char buffer[30]; 638 sprintf (buffer, "cp%d-dos", (int) codepage); 639 return intern (buffer); 640 /* We don't need to check that this coding system exists right here, 641 because that is done when the coding system is actually 642 instantiated, i.e. it is passed through Fcheck_coding_system() 643 there. */ 644} 645 646 647DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, 648 Sw32_set_clipboard_data, 1, 2, 0, 649 doc: /* This sets the clipboard data to the given text. */) 650 (string, ignored) 651 Lisp_Object string, ignored; 652{ 653 BOOL ok = TRUE; 654 int nbytes; 655 unsigned char *src; 656 unsigned char *dst; 657 unsigned char *end; 658 659 /* This parameter used to be the current frame, but we don't use 660 that any more. */ 661 (void) ignored; 662 663 CHECK_STRING (string); 664 665 setup_config (); 666 667 current_text = string; 668 current_coding_system = cfg_coding_system; 669 current_clipboard_type = cfg_clipboard_type; 670 current_lcid = cfg_lcid; 671 current_num_nls = 0; 672 current_requires_encoding = 0; 673 674 BLOCK_INPUT; 675 676 /* Check for non-ASCII characters. While we are at it, count the 677 number of LFs, so we know how many CRs we will have to add later 678 (just in the case where we can use our internal ASCII rendering, 679 see code and comment in convert_to_handle_as_ascii() above). */ 680 nbytes = SBYTES (string); 681 src = SDATA (string); 682 683 for (dst = src, end = src+nbytes; dst < end; dst++) 684 { 685 if (*dst == '\n') 686 current_num_nls++; 687 else if (*dst >= 0x80 || *dst == 0) 688 { 689 current_requires_encoding = 1; 690 break; 691 } 692 } 693 694 if (!current_requires_encoding) 695 { 696 /* If all we have is ASCII we don't need to pretend we offer 697 anything fancy. */ 698 current_coding_system = Qraw_text; 699 current_clipboard_type = CF_TEXT; 700 current_lcid = LOCALE_NEUTRAL; 701 } 702 703 if (!OpenClipboard (clipboard_owner)) 704 goto error; 705 706 ++modifying_clipboard; 707 ok = EmptyClipboard (); 708 --modifying_clipboard; 709 710 /* If we have something non-ASCII we may want to set a locale. We 711 do that directly (non-delayed), as it's just a small bit. */ 712 if (ok) 713 ok = !NILP(render_locale()); 714 715 if (ok) 716 { 717 if (clipboard_owner == NULL) 718 { 719 /* If for some reason we don't have a clipboard_owner, we 720 just set the text format as chosen by the configuration 721 and than forget about the whole thing. */ 722 ok = !NILP(render (make_number (current_clipboard_type))); 723 current_text = Qnil; 724 current_coding_system = Qnil; 725 } 726 else 727 { 728 /* Advertise all supported formats so that whatever the 729 requester chooses, only one encoding step needs to be 730 made. This is intentionally different from what we do in 731 the handler for WM_RENDERALLFORMATS. */ 732 SetClipboardData (CF_UNICODETEXT, NULL); 733 SetClipboardData (CF_TEXT, NULL); 734 SetClipboardData (CF_OEMTEXT, NULL); 735 } 736 } 737 738 CloseClipboard (); 739 740 /* With delayed rendering we haven't really "used" this coding 741 system yet, and it's even unclear if we ever will. But this is a 742 way to tell the upper level what we *would* use under ideal 743 circumstances. 744 745 We don't signal the actually used coding-system later when we 746 finally render, because that can happen at any time and we don't 747 want to disturb the "foreground" action. */ 748 if (ok) 749 Vlast_coding_system_used = current_coding_system; 750 751 Vnext_selection_coding_system = Qnil; 752 753 if (ok) goto done; 754 755 error: 756 757 ok = FALSE; 758 current_text = Qnil; 759 current_coding_system = Qnil; 760 761 done: 762 UNBLOCK_INPUT; 763 764 return (ok ? string : Qnil); 765} 766 767 768DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, 769 Sw32_get_clipboard_data, 0, 1, 0, 770 doc: /* This gets the clipboard data in text format. */) 771 (ignored) 772 Lisp_Object ignored; 773{ 774 HGLOBAL htext; 775 Lisp_Object ret = Qnil; 776 UINT actual_clipboard_type; 777 int use_configured_coding_system = 1; 778 779 /* This parameter used to be the current frame, but we don't use 780 that any more. */ 781 (void) ignored; 782 783 /* Don't pass our own text from the clipboard (which might be 784 troublesome if the killed text includes null characters). */ 785 if (!NILP (current_text)) 786 return ret; 787 788 setup_config (); 789 actual_clipboard_type = cfg_clipboard_type; 790 791 BLOCK_INPUT; 792 793 if (!OpenClipboard (clipboard_owner)) 794 goto done; 795 796 if ((htext = GetClipboardData (actual_clipboard_type)) == NULL) 797 { 798 /* If we want CF_UNICODETEXT but can't get it, the current 799 coding system is useless. OTOH we can still try and decode 800 CF_TEXT based on the locale that the system gives us and that 801 we get down below. */ 802 if (actual_clipboard_type == CF_UNICODETEXT) 803 { 804 htext = GetClipboardData (CF_TEXT); 805 if (htext != NULL) 806 { 807 actual_clipboard_type = CF_TEXT; 808 use_configured_coding_system = 0; 809 } 810 } 811 } 812 if (htext == NULL) 813 goto closeclip; 814 815 { 816 unsigned char *src; 817 unsigned char *dst; 818 int nbytes; 819 int truelen; 820 int require_decoding = 0; 821 822 if ((src = (unsigned char *) GlobalLock (htext)) == NULL) 823 goto closeclip; 824 825 /* If the clipboard data contains any non-ascii code, we need to 826 decode it with a coding system. */ 827 if (actual_clipboard_type == CF_UNICODETEXT) 828 { 829 nbytes = lstrlenW ((WCHAR *)src) * 2; 830 require_decoding = 1; 831 } 832 else 833 { 834 int i; 835 836 nbytes = strlen (src); 837 838 for (i = 0; i < nbytes; i++) 839 { 840 if (src[i] >= 0x80) 841 { 842 require_decoding = 1; 843 break; 844 } 845 } 846 } 847 848 if (require_decoding) 849 { 850 int bufsize; 851 unsigned char *buf; 852 struct coding_system coding; 853 Lisp_Object coding_system = Qnil; 854 855 /* `next-selection-coding-system' should override everything, 856 even when the locale passed by the system disagrees. The 857 only exception is when `next-selection-coding-system' 858 requested CF_UNICODETEXT and we couldn't get that. */ 859 if (use_configured_coding_system 860 && !NILP (Vnext_selection_coding_system)) 861 coding_system = Vnext_selection_coding_system; 862 863 /* If we have CF_TEXT or CF_OEMTEXT, we want to check out 864 CF_LOCALE, too. */ 865 else if (actual_clipboard_type != CF_UNICODETEXT) 866 { 867 HGLOBAL hlocale; 868 LCID lcid = DEFAULT_LCID; 869 UINT cp; 870 871 /* Documentation says that the OS always generates 872 CF_LOCALE info automatically, so the locale handle 873 should always be present. Fact is that this is not 874 always true on 9x ;-(. */ 875 hlocale = GetClipboardData (CF_LOCALE); 876 if (hlocale != NULL) 877 { 878 const LCID * lcid_ptr; 879 lcid_ptr = (const LCID *) GlobalLock (hlocale); 880 if (lcid_ptr != NULL) 881 { 882 lcid = *lcid_ptr; 883 GlobalUnlock (hlocale); 884 } 885 886 /* 9x has garbage as the sort order (to be exact there 887 is another instance of the language id in the upper 888 word). We don't care about sort order anyway, so 889 we just filter out the unneeded mis-information to 890 avoid irritations. */ 891 lcid = MAKELCID (LANGIDFROMLCID (lcid), SORT_DEFAULT); 892 } 893 894 /* If we are using fallback from CF_UNICODETEXT, we can't 895 use the configured coding system. Also we don't want 896 to use it, if the system has supplied us with a locale 897 and it is not just the system default. */ 898 if (!use_configured_coding_system || lcid != DEFAULT_LCID) 899 { 900 cp = cp_from_locale (lcid, actual_clipboard_type); 901 /* If it's just our current standard setting anyway, 902 use the coding system that the user has selected. 903 Otherwise create a new spec to match the locale 904 that was specified by the other side or the 905 system. */ 906 if (!use_configured_coding_system || cp != cfg_codepage) 907 coding_system = coding_from_cp (cp); 908 } 909 } 910 911 if (NILP (coding_system)) 912 coding_system = Vselection_coding_system; 913 Vnext_selection_coding_system = Qnil; 914 915 setup_coding_system (Fcheck_coding_system (coding_system), &coding); 916 coding.src_multibyte = 0; 917 coding.dst_multibyte = 1; 918 coding.mode |= CODING_MODE_LAST_BLOCK; 919 /* We explicitely disable composition handling because 920 selection data should not contain any composition 921 sequence. */ 922 coding.composing = COMPOSITION_DISABLED; 923 /* Force DOS line-ends. */ 924 coding.eol_type = CODING_EOL_CRLF; 925 926 bufsize = decoding_buffer_size (&coding, nbytes); 927 buf = (unsigned char *) xmalloc (bufsize); 928 decode_coding (&coding, src, buf, nbytes, bufsize); 929 Vlast_coding_system_used = coding.symbol; 930 ret = make_string_from_bytes ((char *) buf, 931 coding.produced_char, coding.produced); 932 xfree (buf); 933 if (SYMBOLP (coding.post_read_conversion) 934 && !NILP (Ffboundp (coding.post_read_conversion))) 935 ret = run_pre_post_conversion_on_str (ret, &coding, 0); 936 } 937 else 938 { 939 /* FIXME: We may want to repeat the code in this branch for 940 the Unicode case. */ 941 942 /* Need to know final size after CR chars are removed because 943 we can't change the string size manually, and doing an 944 extra copy is silly. We only remove CR when it appears as 945 part of CRLF. */ 946 947 truelen = nbytes; 948 dst = src; 949 /* avoid using strchr because it recomputes the length everytime */ 950 while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL) 951 { 952 if (dst[1] == '\n') /* safe because of trailing '\0' */ 953 truelen--; 954 dst++; 955 } 956 957 ret = make_uninit_string (truelen); 958 959 /* Convert CRLF line endings (the standard CF_TEXT clipboard 960 format) to LF endings as used internally by Emacs. */ 961 962 dst = SDATA (ret); 963 while (1) 964 { 965 unsigned char *next; 966 /* copy next line or remaining bytes excluding '\0' */ 967 next = _memccpy (dst, src, '\r', nbytes); 968 if (next) 969 { 970 /* copied one line ending with '\r' */ 971 int copied = next - dst; 972 nbytes -= copied; 973 dst += copied; 974 src += copied; 975 if (*src == '\n') 976 dst--; /* overwrite '\r' with '\n' */ 977 } 978 else 979 /* copied remaining partial line -> now finished */ 980 break; 981 } 982 983 Vlast_coding_system_used = Qraw_text; 984 } 985 986 GlobalUnlock (htext); 987 } 988 989 closeclip: 990 CloseClipboard (); 991 992 done: 993 UNBLOCK_INPUT; 994 995 return (ret); 996} 997 998/* Support checking for a clipboard selection. */ 999 1000DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, 1001 0, 1, 0, 1002 doc: /* Whether there is an owner for the given X Selection. 1003The arg should be the name of the selection in question, typically one of 1004the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. 1005\(Those are literal upper-case symbol names, since that's what X expects.) 1006For convenience, the symbol nil is the same as `PRIMARY', 1007and t is the same as `SECONDARY'. */) 1008 (selection) 1009 Lisp_Object selection; 1010{ 1011 CHECK_SYMBOL (selection); 1012 1013 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check 1014 if the clipboard currently has valid text format contents. */ 1015 1016 if (EQ (selection, QCLIPBOARD)) 1017 { 1018 Lisp_Object val = Qnil; 1019 1020 if (OpenClipboard (NULL)) 1021 { 1022 UINT format = 0; 1023 setup_config (); 1024 while ((format = EnumClipboardFormats (format))) 1025 /* Check CF_TEXT in addition to cfg_clipboard_type, 1026 because we can fall back on that if CF_UNICODETEXT is 1027 not available. Actually a check for CF_TEXT only 1028 should be enough. */ 1029 if (format == cfg_clipboard_type || format == CF_TEXT) 1030 { 1031 val = Qt; 1032 break; 1033 } 1034 CloseClipboard (); 1035 } 1036 return val; 1037 } 1038 return Qnil; 1039} 1040 1041/* One-time init. Called in the un-dumped Emacs, but not in the 1042 dumped version. */ 1043 1044void 1045syms_of_w32select () 1046{ 1047 defsubr (&Sw32_set_clipboard_data); 1048 defsubr (&Sw32_get_clipboard_data); 1049 defsubr (&Sx_selection_exists_p); 1050 1051 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, 1052 doc: /* Coding system for communicating with other programs. 1053When sending or receiving text via cut_buffer, selection, and 1054clipboard, the text is encoded or decoded by this coding system. 1055The default value is the current system default encoding on 9x/Me and 1056`utf-16le-dos' (Unicode) on NT/W2K/XP. */); 1057 /* The actual value is set dynamically in the dumped Emacs, see 1058 below. */ 1059 Vselection_coding_system = Qnil; 1060 1061 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system, 1062 doc: /* Coding system for the next communication with other programs. 1063Usually, `selection-coding-system' is used for communicating with 1064other programs. But, if this variable is set, it is used for the 1065next communication only. After the communication, this variable is 1066set to nil. */); 1067 Vnext_selection_coding_system = Qnil; 1068 1069 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD); 1070 1071 cfg_coding_system = Qnil; staticpro (&cfg_coding_system); 1072 current_text = Qnil; staticpro (¤t_text); 1073 current_coding_system = Qnil; staticpro (¤t_coding_system); 1074 1075 QUNICODE = intern ("utf-16le-dos"); staticpro (&QUNICODE); 1076 QANSICP = Qnil; staticpro (&QANSICP); 1077 QOEMCP = Qnil; staticpro (&QOEMCP); 1078} 1079 1080/* One-time init. Called in the dumped Emacs, but not in the 1081 un-dumped version. */ 1082 1083void 1084globals_of_w32select () 1085{ 1086 DEFAULT_LCID = GetUserDefaultLCID (); 1087 /* Drop the sort order from the LCID, so we can compare this with 1088 CF_LOCALE objects that have the same fix on 9x. */ 1089 DEFAULT_LCID = MAKELCID (LANGIDFROMLCID (DEFAULT_LCID), SORT_DEFAULT); 1090 1091 ANSICP = GetACP (); 1092 OEMCP = GetOEMCP (); 1093 1094 QANSICP = coding_from_cp (ANSICP); 1095 QOEMCP = coding_from_cp (OEMCP); 1096 1097 if (os_subtype == OS_NT) 1098 Vselection_coding_system = QUNICODE; 1099 else if (inhibit_window_system) 1100 Vselection_coding_system = QOEMCP; 1101 else 1102 Vselection_coding_system = QANSICP; 1103 1104 clipboard_owner = create_owner (); 1105} 1106 1107/* arch-tag: c96e9724-5eb1-4dad-be07-289f092fd2af 1108 (do not change this comment) */ 1109