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