1 /* Selection processing for Emacs on the Microsoft W32 API.
3 Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Written by Kevin Gallo, Benjamin Riefenstahl */
25 * Notes on usage of selection-coding-system and
26 * next-selection-coding-system on MS Windows:
28 * The selection coding system variables apply only to the version of
29 * the clipboard data that is closest in type, i.e. when a 16-bit
30 * Unicode coding system is given, they apply to he Unicode clipboard
31 * (CF_UNICODETEXT), when a well-known console codepage is given, they
32 * apply to the console version of the clipboard data (CF_OEMTEXT),
33 * else they apply to the normal 8-bit text clipboard (CF_TEXT).
35 * When pasting (getting data from the OS), the clipboard format that
36 * matches the {next-}selection-coding-system is retrieved. If
37 * Unicode is requested, but not available, 8-bit text (CF_TEXT) is
38 * used. In all other cases the OS will transparently convert
39 * formats, so no other fallback is needed.
41 * When copying or cutting (sending data to the OS), the data is
42 * announced and stored internally, but only actually rendered on
43 * request. The requester determines the format provided. The
44 * {next-}selection-coding-system is only used, when its corresponding
45 * clipboard type matches the type requested.
47 * Scenarios to use the facilities for customizing the selection
50 * ;; Generally use KOI8-R instead of the russian MS codepage for
51 * ;; the 8-bit clipboard.
52 * (set-selection-coding-system 'koi8-r-dos)
56 * ;; Create a special clipboard copy function that uses codepage
57 * ;; 1253 (Greek) to copy Greek text to a specific non-Unicode
59 * (defun greek-copy (beg end)
61 * (set-next-selection-coding-system 'cp1253-dos)
62 * (copy-region-as-kill beg end))
63 * (global-set-key "\C-c\C-c" 'greek-copy)
67 * Ideas for further directions:
69 * The encoding and decoding routines could be moved to Lisp code
70 * similar to how xselect.c does it (using well-known routine names
71 * for the delayed rendering). If the definition of which clipboard
72 * types should be supported is also moved to Lisp, functionality
73 * could be expanded to CF_HTML, CF_RTF and maybe other types.
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() */
85 #include "character.h"
86 #include "composite.h"
89 static HGLOBAL
convert_to_handle_as_ascii (void);
90 static HGLOBAL
convert_to_handle_as_coded (Lisp_Object coding_system
);
91 static Lisp_Object
render (Lisp_Object oformat
);
92 static Lisp_Object
render_locale (void);
93 static Lisp_Object
render_all (Lisp_Object ignore
);
94 static void run_protected (Lisp_Object (*code
) (Lisp_Object
), Lisp_Object arg
);
95 static Lisp_Object
lisp_error_handler (Lisp_Object error
);
96 static LRESULT CALLBACK
owner_callback (HWND win
, UINT msg
,
97 WPARAM wp
, LPARAM lp
);
98 static HWND
create_owner (void);
100 static void setup_config (void);
101 static BOOL WINAPI
enum_locale_callback (/*const*/ char* loc_string
);
102 static UINT
cp_from_locale (LCID lcid
, UINT format
);
103 static Lisp_Object
coding_from_cp (UINT codepage
);
104 static Lisp_Object
validate_coding_system (Lisp_Object coding_system
);
105 static void setup_windows_coding_system (Lisp_Object coding_system
,
106 struct coding_system
* coding
);
109 /* A remnant from X11: Symbol for the CLIPBORD selection type. Other
110 selections are not used on Windows, so we don't need symbols for
111 PRIMARY and SECONDARY. */
112 Lisp_Object QCLIPBOARD
;
114 /* Coding system for communicating with other programs via the
116 static Lisp_Object Vselection_coding_system
;
118 /* Coding system for the next communication with other programs. */
119 static Lisp_Object Vnext_selection_coding_system
;
121 /* Internal pseudo-constants, initialized in globals_of_w32select()
122 based on current system parameters. */
123 static LCID DEFAULT_LCID
;
124 static UINT ANSICP
, OEMCP
;
125 static Lisp_Object QUNICODE
, QANSICP
, QOEMCP
;
127 /* A hidden window just for the clipboard management. */
128 static HWND clipboard_owner
;
129 /* A flag to tell WM_DESTROYCLIPBOARD who is to blame this time (just
130 checking GetClipboardOwner() doesn't work, sadly). */
131 static int modifying_clipboard
= 0;
133 /* Configured transfer parameters, based on the last inspection of
134 selection-coding-system. */
135 static Lisp_Object cfg_coding_system
;
136 static UINT cfg_codepage
;
137 static LCID cfg_lcid
;
138 static UINT cfg_clipboard_type
;
140 /* The current state for delayed rendering. */
141 static Lisp_Object current_text
;
142 static Lisp_Object current_coding_system
;
143 static int current_requires_encoding
, current_num_nls
;
144 static UINT current_clipboard_type
;
145 static LCID current_lcid
;
148 #define ONTRACE(stmt) stmt
150 #define ONTRACE(stmt) /*stmt*/
154 /* This function assumes that there is no multibyte character in
155 current_text, so we can short-cut encoding. */
158 convert_to_handle_as_ascii (void)
160 HGLOBAL htext
= NULL
;
166 ONTRACE (fprintf (stderr
, "convert_to_handle_as_ascii\n"));
168 nbytes
= SBYTES (current_text
) + 1;
169 src
= SDATA (current_text
);
171 /* We need to add to the size the number of LF chars where we have
172 to insert CR chars (the standard CF_TEXT clipboard format uses
173 CRLF line endings, while Emacs uses just LF internally). */
175 truelen
= nbytes
+ current_num_nls
;
177 if ((htext
= GlobalAlloc (GMEM_MOVEABLE
| GMEM_DDESHARE
, truelen
)) == NULL
)
180 if ((dst
= (unsigned char *) GlobalLock (htext
)) == NULL
)
186 /* convert to CRLF line endings expected by clipboard */
190 /* copy next line or remaining bytes including '\0' */
191 next
= _memccpy (dst
, src
, '\n', nbytes
);
194 /* copied one line ending with '\n' */
195 int copied
= next
- dst
;
198 /* insert '\r' before '\n' */
204 /* copied remaining partial line -> now finished */
208 GlobalUnlock (htext
);
213 /* This function assumes that there are multibyte or NUL characters in
214 current_text, or that we need to construct Unicode. It runs the
215 text through the encoding machinery. */
218 convert_to_handle_as_coded (Lisp_Object coding_system
)
221 unsigned char *dst
= NULL
;
222 struct coding_system coding
;
224 ONTRACE (fprintf (stderr
, "convert_to_handle_as_coded: %s\n",
225 SDATA (SYMBOL_NAME (coding_system
))));
227 setup_windows_coding_system (coding_system
, &coding
);
228 coding
.dst_bytes
= SBYTES (current_text
) * 2;
229 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
);
230 encode_coding_object (&coding
, current_text
, 0, 0,
231 SCHARS (current_text
), SBYTES (current_text
), Qnil
);
233 htext
= GlobalAlloc (GMEM_MOVEABLE
| GMEM_DDESHARE
, coding
.produced
+2);
236 dst
= (unsigned char *) GlobalLock (htext
);
240 memcpy (dst
, coding
.destination
, coding
.produced
);
241 /* Add the string terminator. Add two NULs in case we are
242 producing Unicode here. */
243 dst
[coding
.produced
] = dst
[coding
.produced
+1] = '\0';
245 GlobalUnlock (htext
);
248 xfree (coding
.destination
);
254 render (Lisp_Object oformat
)
256 HGLOBAL htext
= NULL
;
257 UINT format
= XFASTINT (oformat
);
259 ONTRACE (fprintf (stderr
, "render\n"));
261 if (NILP (current_text
))
264 if (current_requires_encoding
|| format
== CF_UNICODETEXT
)
266 if (format
== current_clipboard_type
)
267 htext
= convert_to_handle_as_coded (current_coding_system
);
272 htext
= convert_to_handle_as_coded (QUNICODE
);
278 cs
= coding_from_cp (cp_from_locale (current_lcid
, format
));
279 htext
= convert_to_handle_as_coded (cs
);
285 htext
= convert_to_handle_as_ascii ();
287 ONTRACE (fprintf (stderr
, "render: htext = 0x%08X\n", (unsigned) htext
));
292 if (SetClipboardData (format
, htext
) == NULL
)
304 HANDLE hlocale
= NULL
;
307 ONTRACE (fprintf (stderr
, "render_locale\n"));
309 if (current_lcid
== LOCALE_NEUTRAL
|| current_lcid
== DEFAULT_LCID
)
312 hlocale
= GlobalAlloc (GMEM_MOVEABLE
| GMEM_DDESHARE
, sizeof (current_lcid
));
316 if ((lcid_ptr
= (LCID
*) GlobalLock (hlocale
)) == NULL
)
318 GlobalFree (hlocale
);
322 *lcid_ptr
= current_lcid
;
323 GlobalUnlock (hlocale
);
325 if (SetClipboardData (CF_LOCALE
, hlocale
) == NULL
)
327 GlobalFree (hlocale
);
334 /* At the end of the program, we want to ensure that our clipboard
335 data survives us. This code will do that. */
338 render_all (Lisp_Object ignore
)
340 ONTRACE (fprintf (stderr
, "render_all\n"));
342 /* According to the docs we should not call OpenClipboard() here,
343 but testing on W2K and working code in other projects shows that
344 it is actually necessary. */
346 OpenClipboard (NULL
);
348 /* There is no usefull means to report errors here, there are none
349 expected anyway, and even if there were errors, they wouldn't do
350 any harm. So we just go ahead and do what has to be done without
351 bothering with error handling. */
353 ++modifying_clipboard
;
355 --modifying_clipboard
;
357 /* For text formats that we don't render here, the OS can use its
358 own translation rules instead, so we don't really need to offer
359 everything. To minimize memory consumption we cover three
360 possible situations based on our primary format as detected from
361 selection-coding-system (see setup_config()):
363 - Post CF_TEXT only. Let the OS convert to CF_OEMTEXT and the OS
364 (on NT) or the application (on 9x/Me) convert to
367 - Post CF_OEMTEXT only. Similar automatic conversions happen as
370 - Post CF_UNICODETEXT + CF_TEXT. 9x itself ignores
371 CF_UNICODETEXT, even though some applications can still handle
374 Note 1: We render the less capable CF_TEXT *before* the more
375 capable CF_UNICODETEXT, to prevent clobbering through automatic
376 conversions, just in case.
378 Note 2: We could check os_subtype here and only render the
379 additional CF_TEXT on 9x/Me. But OTOH with
380 current_clipboard_type == CF_UNICODETEXT we don't involve the
381 automatic conversions anywhere else, so to get consistent
382 results, we probably don't want to rely on it here either. */
386 if (current_clipboard_type
== CF_UNICODETEXT
)
387 render (make_number (CF_TEXT
));
388 render (make_number (current_clipboard_type
));
396 run_protected (Lisp_Object (*code
) (Lisp_Object
), Lisp_Object arg
)
398 /* FIXME: This works but it doesn't feel right. Too much fiddling
399 with global variables and calling strange looking functions. Is
400 this really the right way to run Lisp callbacks? */
406 /* Fsignal calls abort() if it sees that waiting_for_input is
408 owfi
= waiting_for_input
;
409 waiting_for_input
= 0;
411 internal_condition_case_1 (code
, arg
, Qt
, lisp_error_handler
);
413 waiting_for_input
= owfi
;
419 lisp_error_handler (Lisp_Object error
)
421 Vsignaling_function
= Qnil
;
422 cmd_error_internal (error
, "Error in delayed clipboard rendering: ");
428 static LRESULT CALLBACK
429 owner_callback (HWND win
, UINT msg
, WPARAM wp
, LPARAM lp
)
433 case WM_RENDERFORMAT
:
434 ONTRACE (fprintf (stderr
, "WM_RENDERFORMAT\n"));
435 run_protected (render
, make_number (wp
));
438 case WM_RENDERALLFORMATS
:
439 ONTRACE (fprintf (stderr
, "WM_RENDERALLFORMATS\n"));
440 run_protected (render_all
, Qnil
);
443 case WM_DESTROYCLIPBOARD
:
444 if (!modifying_clipboard
)
446 ONTRACE (fprintf (stderr
, "WM_DESTROYCLIPBOARD (other)\n"));
448 current_coding_system
= Qnil
;
452 ONTRACE (fprintf (stderr
, "WM_DESTROYCLIPBOARD (self)\n"));
457 if (win
== clipboard_owner
)
458 clipboard_owner
= NULL
;
462 return DefWindowProc (win
, msg
, wp
, lp
);
468 static const char CLASSNAME
[] = "Emacs Clipboard";
471 memset (&wc
, 0, sizeof (wc
));
472 wc
.lpszClassName
= CLASSNAME
;
473 wc
.lpfnWndProc
= owner_callback
;
476 return CreateWindow (CLASSNAME
, CLASSNAME
, 0, 0, 0, 0, 0, NULL
, NULL
,
480 /* Called on exit by term_ntproc() in w32.c */
483 term_w32select (void)
485 /* This is needed to trigger WM_RENDERALLFORMATS. */
486 if (clipboard_owner
!= NULL
)
487 DestroyWindow (clipboard_owner
);
493 const char *coding_name
;
497 Lisp_Object coding_system
;
498 Lisp_Object dos_coding_system
;
500 CHECK_SYMBOL (Vselection_coding_system
);
502 coding_system
= NILP (Vnext_selection_coding_system
) ?
503 Vselection_coding_system
: Vnext_selection_coding_system
;
505 dos_coding_system
= validate_coding_system (coding_system
);
506 if (NILP (dos_coding_system
))
508 list2 (build_string ("Coding system is invalid or doesn't have "
509 "an eol variant for dos line ends"),
512 /* Check if we have it cached */
513 if (!NILP (cfg_coding_system
)
514 && EQ (cfg_coding_system
, dos_coding_system
))
516 cfg_coding_system
= dos_coding_system
;
518 /* Set some sensible fallbacks */
519 cfg_codepage
= ANSICP
;
520 cfg_lcid
= LOCALE_NEUTRAL
;
521 cfg_clipboard_type
= CF_TEXT
;
523 /* Interpret the coding system symbol name */
524 coding_name
= SDATA (SYMBOL_NAME (cfg_coding_system
));
526 /* "(.*-)?utf-16.*" -> CF_UNICODETEXT */
527 cp
= strstr (coding_name
, "utf-16");
528 if (cp
!= NULL
&& (cp
== coding_name
|| cp
[-1] == '-'))
530 cfg_clipboard_type
= CF_UNICODETEXT
;
534 /* "cp[0-9]+.*" or "windows-[0-9]+.*" -> CF_TEXT or CF_OEMTEXT */
535 slen
= strlen (coding_name
);
536 if (slen
>= 4 && coding_name
[0] == 'c' && coding_name
[1] == 'p')
537 cp
= coding_name
+ 2;
538 else if (slen
>= 10 && memcmp (coding_name
, "windows-", 8) == 0)
539 cp
= coding_name
+ 8;
544 cfg_codepage
= strtol (cp
, &end
, 10);
546 /* Error return from strtol() or number of digits < 2 -> Restore the
547 default and drop it. */
548 if (cfg_codepage
== 0 || (end
-cp
) < 2 )
550 cfg_codepage
= ANSICP
;
554 /* Is it the currently active system default? */
555 if (cfg_codepage
== ANSICP
)
557 /* cfg_clipboard_type = CF_TEXT; */
560 if (cfg_codepage
== OEMCP
)
562 cfg_clipboard_type
= CF_OEMTEXT
;
566 /* Else determine a suitable locale the hard way. */
567 EnumSystemLocales (enum_locale_callback
, LCID_INSTALLED
);
571 enum_locale_callback (/*const*/ char* loc_string
)
576 lcid
= strtoul (loc_string
, NULL
, 16);
578 /* Is the wanted codepage the "ANSI" codepage for this locale? */
579 codepage
= cp_from_locale (lcid
, CF_TEXT
);
580 if (codepage
== cfg_codepage
)
583 cfg_clipboard_type
= CF_TEXT
;
584 return FALSE
; /* Stop enumeration */
587 /* Is the wanted codepage the OEM codepage for this locale? */
588 codepage
= cp_from_locale (lcid
, CF_OEMTEXT
);
589 if (codepage
== cfg_codepage
)
592 cfg_clipboard_type
= CF_OEMTEXT
;
593 return FALSE
; /* Stop enumeration */
596 return TRUE
; /* Continue enumeration */
600 cp_from_locale (LCID lcid
, UINT format
)
602 char buffer
[20] = "";
606 format
== CF_TEXT
? LOCALE_IDEFAULTANSICODEPAGE
: LOCALE_IDEFAULTCODEPAGE
;
608 GetLocaleInfo (lcid
, variant
, buffer
, sizeof (buffer
));
609 cp
= strtoul (buffer
, NULL
, 10);
613 else if (cp
== CP_OEMCP
)
620 coding_from_cp (UINT codepage
)
623 sprintf (buffer
, "cp%d-dos", (int) codepage
);
624 return intern (buffer
);
625 /* We don't need to check that this coding system actually exists
626 right here, because that is done later for all coding systems
627 used, regardless of where they originate. */
631 validate_coding_system (Lisp_Object coding_system
)
633 Lisp_Object eol_type
;
635 /* Make sure the input is valid. */
636 if (NILP (Fcoding_system_p (coding_system
)))
639 /* Make sure we use a DOS coding system as mandated by the system
641 eol_type
= Fcoding_system_eol_type (coding_system
);
643 /* Already a DOS coding system? */
644 if (EQ (eol_type
, make_number (1)))
645 return coding_system
;
647 /* Get EOL_TYPE vector of the base of CODING_SYSTEM. */
648 if (!VECTORP (eol_type
))
650 eol_type
= Fcoding_system_eol_type (Fcoding_system_base (coding_system
));
651 if (!VECTORP (eol_type
))
655 return AREF (eol_type
, 1);
659 setup_windows_coding_system (Lisp_Object coding_system
,
660 struct coding_system
* coding
)
662 memset (coding
, 0, sizeof (*coding
));
663 setup_coding_system (coding_system
, coding
);
665 /* Unset CODING_ANNOTATE_COMPOSITION_MASK. Previous code had
666 comments about crashes in encode_coding_iso2022 trying to
667 dereference a null pointer when composition was on. Selection
668 data should not contain any composition sequence on Windows.
670 CODING_ANNOTATION_MASK also includes
671 CODING_ANNOTATE_DIRECTION_MASK and CODING_ANNOTATE_CHARSET_MASK,
672 which both apply to ISO6429 only. We don't know if these really
673 need to be unset on Windows, but it probably doesn't hurt
675 coding
->mode
&= ~CODING_ANNOTATION_MASK
;
676 coding
->mode
|= CODING_MODE_LAST_BLOCK
| CODING_MODE_SAFE_ENCODING
;
681 DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data
,
682 Sw32_set_clipboard_data
, 1, 2, 0,
683 doc
: /* This sets the clipboard data to the given text. */)
684 (Lisp_Object string
, Lisp_Object ignored
)
692 /* This parameter used to be the current frame, but we don't use
696 CHECK_STRING (string
);
700 current_text
= string
;
701 current_coding_system
= cfg_coding_system
;
702 current_clipboard_type
= cfg_clipboard_type
;
703 current_lcid
= cfg_lcid
;
705 current_requires_encoding
= 0;
709 /* Check for non-ASCII characters. While we are at it, count the
710 number of LFs, so we know how many CRs we will have to add later
711 (just in the case where we can use our internal ASCII rendering,
712 see code and comment in convert_to_handle_as_ascii() above). */
713 nbytes
= SBYTES (string
);
714 src
= SDATA (string
);
716 for (dst
= src
, end
= src
+nbytes
; dst
< end
; dst
++)
720 else if (*dst
>= 0x80 || *dst
== 0)
722 current_requires_encoding
= 1;
727 if (!current_requires_encoding
)
729 /* If all we have is ASCII we don't need to pretend we offer
731 current_coding_system
= Qraw_text
;
732 current_clipboard_type
= CF_TEXT
;
733 current_lcid
= LOCALE_NEUTRAL
;
736 if (!OpenClipboard (clipboard_owner
))
739 ++modifying_clipboard
;
740 ok
= EmptyClipboard ();
741 --modifying_clipboard
;
743 /* If we have something non-ASCII we may want to set a locale. We
744 do that directly (non-delayed), as it's just a small bit. */
746 ok
= !NILP (render_locale ());
750 if (clipboard_owner
== NULL
)
752 /* If for some reason we don't have a clipboard_owner, we
753 just set the text format as chosen by the configuration
754 and than forget about the whole thing. */
755 ok
= !NILP (render (make_number (current_clipboard_type
)));
757 current_coding_system
= Qnil
;
761 /* Advertise all supported formats so that whatever the
762 requester chooses, only one encoding step needs to be
763 made. This is intentionally different from what we do in
764 the handler for WM_RENDERALLFORMATS. */
765 SetClipboardData (CF_UNICODETEXT
, NULL
);
766 SetClipboardData (CF_TEXT
, NULL
);
767 SetClipboardData (CF_OEMTEXT
, NULL
);
773 /* With delayed rendering we haven't really "used" this coding
774 system yet, and it's even unclear if we ever will. But this is a
775 way to tell the upper level what we *would* use under ideal
778 We don't signal the actually used coding-system later when we
779 finally render, because that can happen at any time and we don't
780 want to disturb the "foreground" action. */
782 Vlast_coding_system_used
= current_coding_system
;
784 Vnext_selection_coding_system
= Qnil
;
792 current_coding_system
= Qnil
;
797 return (ok
? string
: Qnil
);
801 DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data
,
802 Sw32_get_clipboard_data
, 0, 1, 0,
803 doc
: /* This gets the clipboard data in text format. */)
804 (Lisp_Object ignored
)
807 Lisp_Object ret
= Qnil
;
808 UINT actual_clipboard_type
;
809 int use_configured_coding_system
= 1;
811 /* This parameter used to be the current frame, but we don't use
815 /* Don't pass our own text from the clipboard (which might be
816 troublesome if the killed text includes null characters). */
817 if (!NILP (current_text
))
821 actual_clipboard_type
= cfg_clipboard_type
;
825 if (!OpenClipboard (clipboard_owner
))
828 if ((htext
= GetClipboardData (actual_clipboard_type
)) == NULL
)
830 /* If we want CF_UNICODETEXT but can't get it, the current
831 coding system is useless. OTOH we can still try and decode
832 CF_TEXT based on the locale that the system gives us and that
833 we get down below. */
834 if (actual_clipboard_type
== CF_UNICODETEXT
)
836 htext
= GetClipboardData (CF_TEXT
);
839 actual_clipboard_type
= CF_TEXT
;
840 use_configured_coding_system
= 0;
852 int require_decoding
= 0;
854 if ((src
= (unsigned char *) GlobalLock (htext
)) == NULL
)
857 /* If the clipboard data contains any non-ascii code, we need to
858 decode it with a coding system. */
859 if (actual_clipboard_type
== CF_UNICODETEXT
)
861 nbytes
= lstrlenW ((WCHAR
*)src
) * 2;
862 require_decoding
= 1;
868 nbytes
= strlen (src
);
870 for (i
= 0; i
< nbytes
; i
++)
874 require_decoding
= 1;
880 if (require_decoding
)
882 struct coding_system coding
;
883 Lisp_Object coding_system
= Qnil
;
884 Lisp_Object dos_coding_system
;
886 /* `next-selection-coding-system' should override everything,
887 even when the locale passed by the system disagrees. The
888 only exception is when `next-selection-coding-system'
889 requested CF_UNICODETEXT and we couldn't get that. */
890 if (use_configured_coding_system
891 && !NILP (Vnext_selection_coding_system
))
892 coding_system
= Vnext_selection_coding_system
;
894 /* If we have CF_TEXT or CF_OEMTEXT, we want to check out
896 else if (actual_clipboard_type
!= CF_UNICODETEXT
)
899 LCID lcid
= DEFAULT_LCID
;
902 /* Documentation says that the OS always generates
903 CF_LOCALE info automatically, so the locale handle
904 should always be present. Fact is that this is not
905 always true on 9x ;-(. */
906 hlocale
= GetClipboardData (CF_LOCALE
);
909 const LCID
* lcid_ptr
;
910 lcid_ptr
= (const LCID
*) GlobalLock (hlocale
);
911 if (lcid_ptr
!= NULL
)
914 GlobalUnlock (hlocale
);
917 /* 9x has garbage as the sort order (to be exact there
918 is another instance of the language id in the upper
919 word). We don't care about sort order anyway, so
920 we just filter out the unneeded mis-information to
921 avoid irritations. */
922 lcid
= MAKELCID (LANGIDFROMLCID (lcid
), SORT_DEFAULT
);
925 /* If we are using fallback from CF_UNICODETEXT, we can't
926 use the configured coding system. Also we don't want
927 to use it, if the system has supplied us with a locale
928 and it is not just the system default. */
929 if (!use_configured_coding_system
|| lcid
!= DEFAULT_LCID
)
931 cp
= cp_from_locale (lcid
, actual_clipboard_type
);
932 /* If it's just our current standard setting anyway,
933 use the coding system that the user has selected.
934 Otherwise create a new spec to match the locale
935 that was specified by the other side or the
937 if (!use_configured_coding_system
|| cp
!= cfg_codepage
)
938 coding_system
= coding_from_cp (cp
);
942 if (NILP (coding_system
))
943 coding_system
= Vselection_coding_system
;
944 Vnext_selection_coding_system
= Qnil
;
946 dos_coding_system
= validate_coding_system (coding_system
);
947 if (!NILP (dos_coding_system
))
949 setup_windows_coding_system (dos_coding_system
, &coding
);
951 decode_coding_object (&coding
, Qnil
, 0, 0, nbytes
, nbytes
, Qt
);
952 ret
= coding
.dst_object
;
954 Vlast_coding_system_used
= CODING_ID_NAME (coding
.id
);
959 /* FIXME: We may want to repeat the code in this branch for
962 /* Need to know final size after CR chars are removed because
963 we can't change the string size manually, and doing an
964 extra copy is silly. We only remove CR when it appears as
969 /* avoid using strchr because it recomputes the length everytime */
970 while ((dst
= memchr (dst
, '\r', nbytes
- (dst
- src
))) != NULL
)
972 if (dst
[1] == '\n') /* safe because of trailing '\0' */
977 ret
= make_uninit_string (truelen
);
979 /* Convert CRLF line endings (the standard CF_TEXT clipboard
980 format) to LF endings as used internally by Emacs. */
986 /* copy next line or remaining bytes excluding '\0' */
987 next
= _memccpy (dst
, src
, '\r', nbytes
);
990 /* copied one line ending with '\r' */
991 int copied
= next
- dst
;
996 dst
--; /* overwrite '\r' with '\n' */
999 /* copied remaining partial line -> now finished */
1003 Vlast_coding_system_used
= Qraw_text
;
1006 GlobalUnlock (htext
);
1018 /* Support checking for a clipboard selection. */
1020 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1022 doc
: /* Whether there is an owner for the given X Selection.
1023 The arg should be the name of the selection in question, typically one of
1024 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1025 \(Those are literal upper-case symbol names, since that's what X expects.)
1026 For convenience, the symbol nil is the same as `PRIMARY',
1027 and t is the same as `SECONDARY'. */)
1028 (Lisp_Object selection
)
1030 CHECK_SYMBOL (selection
);
1032 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
1033 if the clipboard currently has valid text format contents. */
1035 if (EQ (selection
, QCLIPBOARD
))
1037 Lisp_Object val
= Qnil
;
1041 if (OpenClipboard (NULL
))
1044 while ((format
= EnumClipboardFormats (format
)))
1045 /* Check CF_TEXT in addition to cfg_clipboard_type,
1046 because we can fall back on that if CF_UNICODETEXT is
1047 not available. Actually a check for CF_TEXT only
1048 should be enough. */
1049 if (format
== cfg_clipboard_type
|| format
== CF_TEXT
)
1061 /* One-time init. Called in the un-dumped Emacs, but not in the
1065 syms_of_w32select (void)
1067 defsubr (&Sw32_set_clipboard_data
);
1068 defsubr (&Sw32_get_clipboard_data
);
1069 defsubr (&Sx_selection_exists_p
);
1071 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
1072 doc
: /* Coding system for communicating with other programs.
1074 For MS-Windows and MS-DOS:
1075 When sending or receiving text via selection and clipboard, the text
1076 is encoded or decoded by this coding system. The default value is
1077 the current system default encoding on 9x/Me, `utf-16le-dos'
1078 \(Unicode) on NT/W2K/XP, and `iso-latin-1-dos' on MS-DOS.
1081 When sending text via selection and clipboard, if the target
1082 data-type matches with the type of this coding system, it is used
1083 for encoding the text. Otherwise (including the case that this
1084 variable is nil), a proper coding system is used as below:
1086 data-type coding system
1087 --------- -------------
1089 COMPOUND_TEXT compound-text-with-extensions
1091 C_STRING no-conversion
1093 When receiving text, if this coding system is non-nil, it is used
1094 for decoding regardless of the data-type. If this is nil, a
1095 proper coding system is used according to the data-type as above.
1097 See also the documentation of the variable `x-select-request-type' how
1098 to control which data-type to request for receiving text.
1100 The default value is nil. */);
1101 /* The actual value is set dynamically in the dumped Emacs, see
1103 Vselection_coding_system
= Qnil
;
1105 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
1106 doc
: /* Coding system for the next communication with other programs.
1107 Usually, `selection-coding-system' is used for communicating with
1108 other programs (X Windows clients or MS Windows programs). But, if this
1109 variable is set, it is used for the next communication only.
1110 After the communication, this variable is set to nil. */);
1111 Vnext_selection_coding_system
= Qnil
;
1113 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
1115 cfg_coding_system
= Qnil
; staticpro (&cfg_coding_system
);
1116 current_text
= Qnil
; staticpro (¤t_text
);
1117 current_coding_system
= Qnil
; staticpro (¤t_coding_system
);
1119 DEFSYM (QUNICODE
, "utf-16le-dos");
1120 QANSICP
= Qnil
; staticpro (&QANSICP
);
1121 QOEMCP
= Qnil
; staticpro (&QOEMCP
);
1124 /* One-time init. Called in the dumped Emacs, but not in the
1125 un-dumped version. */
1128 globals_of_w32select (void)
1130 DEFAULT_LCID
= GetUserDefaultLCID ();
1131 /* Drop the sort order from the LCID, so we can compare this with
1132 CF_LOCALE objects that have the same fix on 9x. */
1133 DEFAULT_LCID
= MAKELCID (LANGIDFROMLCID (DEFAULT_LCID
), SORT_DEFAULT
);
1136 OEMCP
= GetOEMCP ();
1138 QANSICP
= coding_from_cp (ANSICP
);
1139 QOEMCP
= coding_from_cp (OEMCP
);
1141 if (os_subtype
== OS_NT
)
1142 Vselection_coding_system
= QUNICODE
;
1143 else if (inhibit_window_system
)
1144 Vselection_coding_system
= QOEMCP
;
1146 Vselection_coding_system
= QANSICP
;
1148 clipboard_owner
= create_owner ();