*** empty log message ***
[emacs.git] / src / w32select.c
blob99825c2391183f057ad9ce9c6783a5f6fb51caf4
1 /* Selection processing for Emacs on the Microsoft W32 API.
2 Copyright (C) 1993, 1994, 2002, 2003, 2004,
3 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Written by Kevin Gallo, Benjamin Riefenstahl */
26 * Notes on usage of selection-coding-system and
27 * next-selection-coding-system on MS Windows:
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).
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.
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.
48 * Scenarios to use the facilities for customizing the selection
49 * coding system are:
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)
55 * Or
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)
68 * Ideas for further directions:
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.
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"
88 static HGLOBAL convert_to_handle_as_ascii (void);
89 static HGLOBAL convert_to_handle_as_coded (Lisp_Object coding_system);
90 static Lisp_Object render (Lisp_Object oformat);
91 static Lisp_Object render_locale (void);
92 static Lisp_Object render_all (void);
93 static void run_protected (Lisp_Object (*code) (), Lisp_Object arg);
94 static Lisp_Object lisp_error_handler (Lisp_Object error);
95 static LRESULT CALLBACK owner_callback (HWND win, UINT msg,
96 WPARAM wp, LPARAM lp);
97 static HWND create_owner (void);
99 static void setup_config (void);
100 static BOOL WINAPI enum_locale_callback (/*const*/ char* loc_string);
101 static UINT cp_from_locale (LCID lcid, UINT format);
102 static Lisp_Object coding_from_cp (UINT codepage);
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. */
108 Lisp_Object QCLIPBOARD;
110 /* Coding system for communicating with other programs via the
111 clipboard. */
112 static Lisp_Object Vselection_coding_system;
114 /* Coding system for the next communication with other programs. */
115 static Lisp_Object Vnext_selection_coding_system;
117 /* Internal pseudo-constants, initialized in globals_of_w32select()
118 based on current system parameters. */
119 static LCID DEFAULT_LCID;
120 static UINT ANSICP, OEMCP;
121 static Lisp_Object QUNICODE, QANSICP, QOEMCP;
123 /* A hidden window just for the clipboard management. */
124 static HWND clipboard_owner;
125 /* A flag to tell WM_DESTROYCLIPBOARD who is to blame this time (just
126 checking GetClipboardOwner() doesn't work, sadly). */
127 static int modifying_clipboard = 0;
129 /* Configured transfer parameters, based on the last inspection of
130 selection-coding-system. */
131 static Lisp_Object cfg_coding_system;
132 static UINT cfg_codepage;
133 static LCID cfg_lcid;
134 static UINT cfg_clipboard_type;
136 /* The current state for delayed rendering. */
137 static Lisp_Object current_text;
138 static Lisp_Object current_coding_system;
139 static int current_requires_encoding, current_num_nls;
140 static UINT current_clipboard_type;
141 static LCID current_lcid;
143 #if TRACE
144 #define ONTRACE(stmt) stmt
145 #else
146 #define ONTRACE(stmt) /*stmt*/
147 #endif
150 /* This function assumes that there is no multibyte character in
151 current_text, so we can short-cut encoding. */
153 static HGLOBAL
154 convert_to_handle_as_ascii (void)
156 HGLOBAL htext = NULL;
157 int nbytes;
158 int truelen;
159 unsigned char *src;
160 unsigned char *dst;
162 ONTRACE (fprintf (stderr, "convert_to_handle_as_ascii\n"));
164 nbytes = SBYTES (current_text) + 1;
165 src = SDATA (current_text);
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). */
171 truelen = nbytes + current_num_nls;
173 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
174 return NULL;
176 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
178 GlobalFree (htext);
179 return NULL;
182 /* convert to CRLF line endings expected by clipboard */
183 while (1)
185 unsigned char *next;
186 /* copy next line or remaining bytes including '\0' */
187 next = _memccpy (dst, src, '\n', nbytes);
188 if (next)
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;
199 else
200 /* copied remaining partial line -> now finished */
201 break;
204 GlobalUnlock (htext);
206 return htext;
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. */
213 static HGLOBAL
214 convert_to_handle_as_coded (Lisp_Object coding_system)
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;
224 ONTRACE (fprintf (stderr, "convert_to_handle_as_coded: %s\n",
225 SDATA (SYMBOL_NAME (coding_system))));
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;
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;
245 nbytes = SBYTES (string);
246 src = SDATA (string);
248 bufsize = encoding_buffer_size (&coding, nbytes) +2;
249 htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize);
251 if (htext != NULL)
252 dst = (unsigned char *) GlobalLock (htext);
254 if (dst != NULL)
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';
262 if (dst != NULL)
263 GlobalUnlock (htext);
265 if (htext != NULL)
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;
273 return htext;
276 static Lisp_Object
277 render (Lisp_Object oformat)
279 HGLOBAL htext = NULL;
280 UINT format = XFASTINT (oformat);
282 ONTRACE (fprintf (stderr, "render\n"));
284 if (NILP (current_text))
285 return Qnil;
287 if (current_requires_encoding || format == CF_UNICODETEXT)
289 if (format == current_clipboard_type)
290 htext = convert_to_handle_as_coded (current_coding_system);
291 else
292 switch (format)
294 case CF_UNICODETEXT:
295 htext = convert_to_handle_as_coded (QUNICODE);
296 break;
297 case CF_TEXT:
298 case CF_OEMTEXT:
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;
307 else
308 htext = convert_to_handle_as_ascii ();
310 ONTRACE (fprintf (stderr, "render: htext = 0x%08X\n", (unsigned) htext));
312 if (htext == NULL)
313 return Qnil;
315 if (SetClipboardData (format, htext) == NULL)
317 GlobalFree(htext);
318 return Qnil;
321 return Qt;
324 static Lisp_Object
325 render_locale (void)
327 HANDLE hlocale = NULL;
328 LCID * lcid_ptr;
330 ONTRACE (fprintf (stderr, "render_locale\n"));
332 if (current_lcid == LOCALE_NEUTRAL || current_lcid == DEFAULT_LCID)
333 return Qt;
335 hlocale = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, sizeof (current_lcid));
336 if (hlocale == NULL)
337 return Qnil;
339 if ((lcid_ptr = (LCID *) GlobalLock (hlocale)) == NULL)
341 GlobalFree(hlocale);
342 return Qnil;
345 *lcid_ptr = current_lcid;
346 GlobalUnlock (hlocale);
348 if (SetClipboardData (CF_LOCALE, hlocale) == NULL)
350 GlobalFree(hlocale);
351 return Qnil;
354 return Qt;
357 /* At the end of the program, we want to ensure that our clipboard
358 data survives us. This code will do that. */
360 static Lisp_Object
361 render_all (void)
363 ONTRACE (fprintf (stderr, "render_all\n"));
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. */
369 OpenClipboard (NULL);
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. */
376 ++modifying_clipboard;
377 EmptyClipboard ();
378 --modifying_clipboard;
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()):
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.
390 - Post CF_OEMTEXT only. Similar automatic conversions happen as
391 for CF_TEXT.
393 - Post CF_UNICODETEXT + CF_TEXT. 9x itself ignores
394 CF_UNICODETEXT, even though some applications can still handle
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.
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. */
407 render_locale();
409 if (current_clipboard_type == CF_UNICODETEXT)
410 render (make_number (CF_TEXT));
411 render (make_number (current_clipboard_type));
413 CloseClipboard ();
415 return Qnil;
418 static void
419 run_protected (Lisp_Object (*code) (), Lisp_Object arg)
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? */
425 extern int waiting_for_input;
426 int owfi;
428 BLOCK_INPUT;
430 /* Fsignal calls abort() if it sees that waiting_for_input is
431 set. */
432 owfi = waiting_for_input;
433 waiting_for_input = 0;
435 internal_condition_case_1 (code, arg, Qt, lisp_error_handler);
437 waiting_for_input = owfi;
439 UNBLOCK_INPUT;
442 static Lisp_Object
443 lisp_error_handler (Lisp_Object error)
445 Vsignaling_function = Qnil;
446 cmd_error_internal (error, "Error in delayed clipboard rendering: ");
447 Vinhibit_quit = Qt;
448 return Qt;
452 static LRESULT CALLBACK
453 owner_callback (HWND win, UINT msg, WPARAM wp, LPARAM lp)
455 switch (msg)
457 case WM_RENDERFORMAT:
458 ONTRACE (fprintf (stderr, "WM_RENDERFORMAT\n"));
459 run_protected (render, make_number (wp));
460 return 0;
462 case WM_RENDERALLFORMATS:
463 ONTRACE (fprintf (stderr, "WM_RENDERALLFORMATS\n"));
464 run_protected (render_all, Qnil);
465 return 0;
467 case WM_DESTROYCLIPBOARD:
468 if (!modifying_clipboard)
470 ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (other)\n"));
471 current_text = Qnil;
472 current_coding_system = Qnil;
474 else
476 ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (self)\n"));
478 return 0;
480 case WM_DESTROY:
481 if (win == clipboard_owner)
482 clipboard_owner = NULL;
483 break;
486 return DefWindowProc (win, msg, wp, lp);
489 static HWND
490 create_owner (void)
492 static const char CLASSNAME[] = "Emacs Clipboard";
493 WNDCLASS wc;
495 memset (&wc, 0, sizeof (wc));
496 wc.lpszClassName = CLASSNAME;
497 wc.lpfnWndProc = owner_callback;
498 RegisterClass (&wc);
500 return CreateWindow (CLASSNAME, CLASSNAME, 0, 0, 0, 0, 0, NULL, NULL,
501 NULL, NULL);
504 /* Called on exit by term_ntproc() in w32.c */
506 void
507 term_w32select (void)
509 /* This is needed to trigger WM_RENDERALLFORMATS. */
510 if (clipboard_owner != NULL)
511 DestroyWindow (clipboard_owner);
514 static void
515 setup_config (void)
517 const char *coding_name;
518 const char *cp;
519 char *end;
520 int slen;
521 Lisp_Object new_coding_system;
523 CHECK_SYMBOL (Vselection_coding_system);
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;
533 /* Set some sensible fallbacks */
534 cfg_codepage = ANSICP;
535 cfg_lcid = LOCALE_NEUTRAL;
536 cfg_clipboard_type = CF_TEXT;
538 /* Interpret the coding system symbol name */
539 coding_name = SDATA (SYMBOL_NAME (cfg_coding_system));
541 /* "(.*-)?utf-16.*" -> CF_UNICODETEXT */
542 cp = strstr (coding_name, "utf-16");
543 if (cp != NULL && (cp == coding_name || cp[-1] == '-'))
545 cfg_clipboard_type = CF_UNICODETEXT;
546 return;
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;
558 end = (char*)cp;
559 cfg_codepage = strtol (cp, &end, 10);
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 )
565 cfg_codepage = ANSICP;
566 return;
569 /* Is it the currently active system default? */
570 if (cfg_codepage == ANSICP)
572 /* cfg_clipboard_type = CF_TEXT; */
573 return;
575 if (cfg_codepage == OEMCP)
577 cfg_clipboard_type = CF_OEMTEXT;
578 return;
581 /* Else determine a suitable locale the hard way. */
582 EnumSystemLocales (enum_locale_callback, LCID_INSTALLED);
585 static BOOL WINAPI
586 enum_locale_callback (/*const*/ char* loc_string)
588 LCID lcid;
589 UINT codepage;
591 lcid = strtoul (loc_string, NULL, 16);
593 /* Is the wanted codepage the "ANSI" codepage for this locale? */
594 codepage = cp_from_locale (lcid, CF_TEXT);
595 if (codepage == cfg_codepage)
597 cfg_lcid = lcid;
598 cfg_clipboard_type = CF_TEXT;
599 return FALSE; /* Stop enumeration */
602 /* Is the wanted codepage the OEM codepage for this locale? */
603 codepage = cp_from_locale (lcid, CF_OEMTEXT);
604 if (codepage == cfg_codepage)
606 cfg_lcid = lcid;
607 cfg_clipboard_type = CF_OEMTEXT;
608 return FALSE; /* Stop enumeration */
611 return TRUE; /* Continue enumeration */
614 static UINT
615 cp_from_locale (LCID lcid, UINT format)
617 char buffer[20] = "";
618 UINT variant, cp;
620 variant =
621 format == CF_TEXT ? LOCALE_IDEFAULTANSICODEPAGE : LOCALE_IDEFAULTCODEPAGE;
623 GetLocaleInfo (lcid, variant, buffer, sizeof (buffer));
624 cp = strtoul (buffer, NULL, 10);
626 if (cp == CP_ACP)
627 return ANSICP;
628 else if (cp == CP_OEMCP)
629 return OEMCP;
630 else
631 return cp;
634 static Lisp_Object
635 coding_from_cp (UINT codepage)
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. */
647 DEFUN ("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;
653 BOOL ok = TRUE;
654 int nbytes;
655 unsigned char *src;
656 unsigned char *dst;
657 unsigned char *end;
659 /* This parameter used to be the current frame, but we don't use
660 that any more. */
661 (void) ignored;
663 CHECK_STRING (string);
665 setup_config ();
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;
674 BLOCK_INPUT;
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);
683 for (dst = src, end = src+nbytes; dst < end; dst++)
685 if (*dst == '\n')
686 current_num_nls++;
687 else if (*dst >= 0x80 || *dst == 0)
689 current_requires_encoding = 1;
690 break;
694 if (!current_requires_encoding)
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;
703 if (!OpenClipboard (clipboard_owner))
704 goto error;
706 ++modifying_clipboard;
707 ok = EmptyClipboard ();
708 --modifying_clipboard;
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());
715 if (ok)
717 if (clipboard_owner == NULL)
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;
726 else
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);
738 CloseClipboard ();
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.
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;
751 Vnext_selection_coding_system = Qnil;
753 if (ok) goto done;
755 error:
757 ok = FALSE;
758 current_text = Qnil;
759 current_coding_system = Qnil;
761 done:
762 UNBLOCK_INPUT;
764 return (ok ? string : Qnil);
768 DEFUN ("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;
774 HGLOBAL htext;
775 Lisp_Object ret = Qnil;
776 UINT actual_clipboard_type;
777 int use_configured_coding_system = 1;
779 /* This parameter used to be the current frame, but we don't use
780 that any more. */
781 (void) ignored;
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;
788 setup_config ();
789 actual_clipboard_type = cfg_clipboard_type;
791 BLOCK_INPUT;
793 if (!OpenClipboard (clipboard_owner))
794 goto done;
796 if ((htext = GetClipboardData (actual_clipboard_type)) == NULL)
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)
804 htext = GetClipboardData (CF_TEXT);
805 if (htext != NULL)
807 actual_clipboard_type = CF_TEXT;
808 use_configured_coding_system = 0;
812 if (htext == NULL)
813 goto closeclip;
816 unsigned char *src;
817 unsigned char *dst;
818 int nbytes;
819 int truelen;
820 int require_decoding = 0;
822 if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
823 goto closeclip;
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)
829 nbytes = lstrlenW ((WCHAR *)src) * 2;
830 require_decoding = 1;
832 else
834 int i;
836 nbytes = strlen (src);
838 for (i = 0; i < nbytes; i++)
840 if (src[i] >= 0x80)
842 require_decoding = 1;
843 break;
848 if (require_decoding)
850 int bufsize;
851 unsigned char *buf;
852 struct coding_system coding;
853 Lisp_Object coding_system = Qnil;
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;
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)
867 HGLOBAL hlocale;
868 LCID lcid = DEFAULT_LCID;
869 UINT cp;
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)
878 const LCID * lcid_ptr;
879 lcid_ptr = (const LCID *) GlobalLock (hlocale);
880 if (lcid_ptr != NULL)
882 lcid = *lcid_ptr;
883 GlobalUnlock (hlocale);
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);
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)
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);
911 if (NILP (coding_system))
912 coding_system = Vselection_coding_system;
913 Vnext_selection_coding_system = Qnil;
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;
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);
937 else
939 /* FIXME: We may want to repeat the code in this branch for
940 the Unicode case. */
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. */
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)
952 if (dst[1] == '\n') /* safe because of trailing '\0' */
953 truelen--;
954 dst++;
957 ret = make_uninit_string (truelen);
959 /* Convert CRLF line endings (the standard CF_TEXT clipboard
960 format) to LF endings as used internally by Emacs. */
962 dst = SDATA (ret);
963 while (1)
965 unsigned char *next;
966 /* copy next line or remaining bytes excluding '\0' */
967 next = _memccpy (dst, src, '\r', nbytes);
968 if (next)
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' */
978 else
979 /* copied remaining partial line -> now finished */
980 break;
983 Vlast_coding_system_used = Qraw_text;
986 GlobalUnlock (htext);
989 closeclip:
990 CloseClipboard ();
992 done:
993 UNBLOCK_INPUT;
995 return (ret);
998 /* Support checking for a clipboard selection. */
1000 DEFUN ("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.
1003 The arg should be the name of the selection in question, typically one of
1004 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1005 \(Those are literal upper-case symbol names, since that's what X expects.)
1006 For convenience, the symbol nil is the same as `PRIMARY',
1007 and t is the same as `SECONDARY'. */)
1008 (selection)
1009 Lisp_Object selection;
1011 CHECK_SYMBOL (selection);
1013 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
1014 if the clipboard currently has valid text format contents. */
1016 if (EQ (selection, QCLIPBOARD))
1018 Lisp_Object val = Qnil;
1020 if (OpenClipboard (NULL))
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)
1031 val = Qt;
1032 break;
1034 CloseClipboard ();
1036 return val;
1038 return Qnil;
1041 /* One-time init. Called in the un-dumped Emacs, but not in the
1042 dumped version. */
1044 void
1045 syms_of_w32select ()
1047 defsubr (&Sw32_set_clipboard_data);
1048 defsubr (&Sw32_get_clipboard_data);
1049 defsubr (&Sx_selection_exists_p);
1051 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
1052 doc: /* Coding system for communicating with other programs.
1053 When sending or receiving text via cut_buffer, selection, and
1054 clipboard, the text is encoded or decoded by this coding system.
1055 The 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;
1061 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
1062 doc: /* Coding system for the next communication with other programs.
1063 Usually, `selection-coding-system' is used for communicating with
1064 other programs. But, if this variable is set, it is used for the
1065 next communication only. After the communication, this variable is
1066 set to nil. */);
1067 Vnext_selection_coding_system = Qnil;
1069 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
1071 cfg_coding_system = Qnil; staticpro (&cfg_coding_system);
1072 current_text = Qnil; staticpro (&current_text);
1073 current_coding_system = Qnil; staticpro (&current_coding_system);
1075 QUNICODE = intern ("utf-16le-dos"); staticpro (&QUNICODE);
1076 QANSICP = Qnil; staticpro (&QANSICP);
1077 QOEMCP = Qnil; staticpro (&QOEMCP);
1080 /* One-time init. Called in the dumped Emacs, but not in the
1081 un-dumped version. */
1083 void
1084 globals_of_w32select ()
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);
1091 ANSICP = GetACP ();
1092 OEMCP = GetOEMCP ();
1094 QANSICP = coding_from_cp (ANSICP);
1095 QOEMCP = coding_from_cp (OEMCP);
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;
1104 clipboard_owner = create_owner ();
1107 /* arch-tag: c96e9724-5eb1-4dad-be07-289f092fd2af
1108 (do not change this comment) */