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