*** empty log message ***
[emacs.git] / src / w32select.c
blob43a208f02b5cb0a9da6317e4ab0c7552eb535e03
1 /* Selection processing for Emacs on the Microsoft W32 API.
2 Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* Written by Kevin Gallo, Benjamin Riefenstahl */
24 * Notes on usage of selection-coding-system and
25 * next-selection-coding-system on MS Windows:
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).
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.
40 * When copying or cutting (sending data to the OS), the data is
41 * announced and stored internally, but only actually rendered on
42 * request. The requester determines the format provided. The
43 * {next-}selection-coding-system is only used, when its corresponding
44 * clipboard type matches the type requested.
46 * Scenarios to use the facilities for customizing the selection
47 * coding system are:
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)
53 * Or
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)
66 * Ideas for further directions:
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.
75 #include <config.h>
76 #include "lisp.h"
77 #include "w32term.h" /* for all of the w32 includes */
78 #include "w32heap.h" /* os_subtype */
79 #include "blockinput.h"
80 #include "keyboard.h" /* cmd_error_internal() */
81 #include "charset.h"
82 #include "coding.h"
83 #include "character.h"
84 #include "composite.h"
87 static HGLOBAL convert_to_handle_as_ascii (void);
88 static HGLOBAL convert_to_handle_as_coded (Lisp_Object coding_system);
89 static Lisp_Object render (Lisp_Object oformat);
90 static Lisp_Object render_locale (void);
91 static Lisp_Object render_all (void);
92 static void run_protected (Lisp_Object (*code) (), Lisp_Object arg);
93 static Lisp_Object lisp_error_handler (Lisp_Object error);
94 static LRESULT CALLBACK owner_callback (HWND win, UINT msg,
95 WPARAM wp, LPARAM lp);
96 static HWND create_owner (void);
98 static void setup_config (void);
99 static BOOL WINAPI enum_locale_callback (/*const*/ char* loc_string);
100 static UINT cp_from_locale (LCID lcid, UINT format);
101 static Lisp_Object coding_from_cp (UINT codepage);
102 static Lisp_Object validate_coding_system (Lisp_Object coding_system);
103 static void setup_windows_coding_system (Lisp_Object coding_system,
104 struct coding_system * coding);
107 /* A remnant from X11: Symbol for the CLIPBORD selection type. Other
108 selections are not used on Windows, so we don't need symbols for
109 PRIMARY and SECONDARY. */
110 Lisp_Object QCLIPBOARD;
112 /* Coding system for communicating with other programs via the
113 clipboard. */
114 static Lisp_Object Vselection_coding_system;
116 /* Coding system for the next communication with other programs. */
117 static Lisp_Object Vnext_selection_coding_system;
119 /* Internal pseudo-constants, initialized in globals_of_w32select()
120 based on current system parameters. */
121 static LCID DEFAULT_LCID;
122 static UINT ANSICP, OEMCP;
123 static Lisp_Object QUNICODE, QANSICP, QOEMCP;
125 /* A hidden window just for the clipboard management. */
126 static HWND clipboard_owner;
127 /* A flag to tell WM_DESTROYCLIPBOARD who is to blame this time (just
128 checking GetClipboardOwner() doesn't work, sadly). */
129 static int modifying_clipboard = 0;
131 /* Configured transfer parameters, based on the last inspection of
132 selection-coding-system. */
133 static Lisp_Object cfg_coding_system;
134 static UINT cfg_codepage;
135 static LCID cfg_lcid;
136 static UINT cfg_clipboard_type;
138 /* The current state for delayed rendering. */
139 static Lisp_Object current_text;
140 static Lisp_Object current_coding_system;
141 static int current_requires_encoding, current_num_nls;
142 static UINT current_clipboard_type;
143 static LCID current_lcid;
145 #if TRACE
146 #define ONTRACE(stmt) stmt
147 #else
148 #define ONTRACE(stmt) /*stmt*/
149 #endif
152 /* This function assumes that there is no multibyte character in
153 current_text, so we can short-cut encoding. */
155 static HGLOBAL
156 convert_to_handle_as_ascii (void)
158 HGLOBAL htext = NULL;
159 int nbytes;
160 int truelen;
161 unsigned char *src;
162 unsigned char *dst;
164 ONTRACE (fprintf (stderr, "convert_to_handle_as_ascii\n"));
166 nbytes = SBYTES (current_text) + 1;
167 src = SDATA (current_text);
169 /* We need to add to the size the number of LF chars where we have
170 to insert CR chars (the standard CF_TEXT clipboard format uses
171 CRLF line endings, while Emacs uses just LF internally). */
173 truelen = nbytes + current_num_nls;
175 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
176 return NULL;
178 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
180 GlobalFree (htext);
181 return NULL;
184 /* convert to CRLF line endings expected by clipboard */
185 while (1)
187 unsigned char *next;
188 /* copy next line or remaining bytes including '\0' */
189 next = _memccpy (dst, src, '\n', nbytes);
190 if (next)
192 /* copied one line ending with '\n' */
193 int copied = next - dst;
194 nbytes -= copied;
195 src += copied;
196 /* insert '\r' before '\n' */
197 next[-1] = '\r';
198 next[0] = '\n';
199 dst = next + 1;
201 else
202 /* copied remaining partial line -> now finished */
203 break;
206 GlobalUnlock (htext);
208 return htext;
211 /* This function assumes that there are multibyte or NUL characters in
212 current_text, or that we need to construct Unicode. It runs the
213 text through the encoding machinery. */
215 static HGLOBAL
216 convert_to_handle_as_coded (Lisp_Object coding_system)
218 HGLOBAL htext;
219 unsigned char *dst = NULL;
220 struct coding_system coding;
222 ONTRACE (fprintf (stderr, "convert_to_handle_as_coded: %s\n",
223 SDATA (SYMBOL_NAME (coding_system))));
225 setup_windows_coding_system (coding_system, &coding);
226 coding.dst_bytes = SBYTES(current_text) * 2;
227 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
228 encode_coding_object (&coding, current_text, 0, 0,
229 SCHARS (current_text), SBYTES (current_text), Qnil);
231 htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, coding.produced +2);
233 if (htext != NULL)
234 dst = (unsigned char *) GlobalLock (htext);
236 if (dst != NULL)
238 memcpy (dst, coding.destination, coding.produced);
239 /* Add the string terminator. Add two NULs in case we are
240 producing Unicode here. */
241 dst[coding.produced] = dst[coding.produced+1] = '\0';
243 GlobalUnlock (htext);
246 xfree (coding.destination);
248 return htext;
251 static Lisp_Object
252 render (Lisp_Object oformat)
254 HGLOBAL htext = NULL;
255 UINT format = XFASTINT (oformat);
257 ONTRACE (fprintf (stderr, "render\n"));
259 if (NILP (current_text))
260 return Qnil;
262 if (current_requires_encoding || format == CF_UNICODETEXT)
264 if (format == current_clipboard_type)
265 htext = convert_to_handle_as_coded (current_coding_system);
266 else
267 switch (format)
269 case CF_UNICODETEXT:
270 htext = convert_to_handle_as_coded (QUNICODE);
271 break;
272 case CF_TEXT:
273 case CF_OEMTEXT:
275 Lisp_Object cs;
276 cs = coding_from_cp (cp_from_locale (current_lcid, format));
277 htext = convert_to_handle_as_coded (cs);
278 break;
282 else
283 htext = convert_to_handle_as_ascii ();
285 ONTRACE (fprintf (stderr, "render: htext = 0x%08X\n", (unsigned) htext));
287 if (htext == NULL)
288 return Qnil;
290 if (SetClipboardData (format, htext) == NULL)
292 GlobalFree(htext);
293 return Qnil;
296 return Qt;
299 static Lisp_Object
300 render_locale (void)
302 HANDLE hlocale = NULL;
303 LCID * lcid_ptr;
305 ONTRACE (fprintf (stderr, "render_locale\n"));
307 if (current_lcid == LOCALE_NEUTRAL || current_lcid == DEFAULT_LCID)
308 return Qt;
310 hlocale = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, sizeof (current_lcid));
311 if (hlocale == NULL)
312 return Qnil;
314 if ((lcid_ptr = (LCID *) GlobalLock (hlocale)) == NULL)
316 GlobalFree(hlocale);
317 return Qnil;
320 *lcid_ptr = current_lcid;
321 GlobalUnlock (hlocale);
323 if (SetClipboardData (CF_LOCALE, hlocale) == NULL)
325 GlobalFree(hlocale);
326 return Qnil;
329 return Qt;
332 /* At the end of the program, we want to ensure that our clipboard
333 data survives us. This code will do that. */
335 static Lisp_Object
336 render_all (void)
338 ONTRACE (fprintf (stderr, "render_all\n"));
340 /* According to the docs we should not call OpenClipboard() here,
341 but testing on W2K and working code in other projects shows that
342 it is actually necessary. */
344 OpenClipboard (NULL);
346 /* There is no usefull means to report errors here, there are none
347 expected anyway, and even if there were errors, they wouldn't do
348 any harm. So we just go ahead and do what has to be done without
349 bothering with error handling. */
351 ++modifying_clipboard;
352 EmptyClipboard ();
353 --modifying_clipboard;
355 /* For text formats that we don't render here, the OS can use its
356 own translation rules instead, so we don't really need to offer
357 everything. To minimize memory consumption we cover three
358 possible situations based on our primary format as detected from
359 selection-coding-system (see setup_config()):
361 - Post CF_TEXT only. Let the OS convert to CF_OEMTEXT and the OS
362 (on NT) or the application (on 9x/Me) convert to
363 CF_UNICODETEXT.
365 - Post CF_OEMTEXT only. Similar automatic conversions happen as
366 for CF_TEXT.
368 - Post CF_UNICODETEXT + CF_TEXT. 9x itself ignores
369 CF_UNICODETEXT, even though some applications can still handle
372 Note 1: We render the less capable CF_TEXT *before* the more
373 capable CF_UNICODETEXT, to prevent clobbering through automatic
374 conversions, just in case.
376 Note 2: We could check os_subtype here and only render the
377 additional CF_TEXT on 9x/Me. But OTOH with
378 current_clipboard_type == CF_UNICODETEXT we don't involve the
379 automatic conversions anywhere else, so to get consistent
380 results, we probably don't want to rely on it here either. */
382 render_locale();
384 if (current_clipboard_type == CF_UNICODETEXT)
385 render (make_number (CF_TEXT));
386 render (make_number (current_clipboard_type));
388 CloseClipboard ();
390 return Qnil;
393 static void
394 run_protected (Lisp_Object (*code) (), Lisp_Object arg)
396 /* FIXME: This works but it doesn't feel right. Too much fiddling
397 with global variables and calling strange looking functions. Is
398 this really the right way to run Lisp callbacks? */
400 extern int waiting_for_input;
401 int owfi;
403 BLOCK_INPUT;
405 /* Fsignal calls abort() if it sees that waiting_for_input is
406 set. */
407 owfi = waiting_for_input;
408 waiting_for_input = 0;
410 internal_condition_case_1 (code, arg, Qt, lisp_error_handler);
412 waiting_for_input = owfi;
414 UNBLOCK_INPUT;
417 static Lisp_Object
418 lisp_error_handler (Lisp_Object error)
420 Vsignaling_function = Qnil;
421 cmd_error_internal (error, "Error in delayed clipboard rendering: ");
422 Vinhibit_quit = Qt;
423 return Qt;
427 static LRESULT CALLBACK
428 owner_callback (HWND win, UINT msg, WPARAM wp, LPARAM lp)
430 switch (msg)
432 case WM_RENDERFORMAT:
433 ONTRACE (fprintf (stderr, "WM_RENDERFORMAT\n"));
434 run_protected (render, make_number (wp));
435 return 0;
437 case WM_RENDERALLFORMATS:
438 ONTRACE (fprintf (stderr, "WM_RENDERALLFORMATS\n"));
439 run_protected (render_all, Qnil);
440 return 0;
442 case WM_DESTROYCLIPBOARD:
443 if (!modifying_clipboard)
445 ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (other)\n"));
446 current_text = Qnil;
447 current_coding_system = Qnil;
449 else
451 ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (self)\n"));
453 return 0;
455 case WM_DESTROY:
456 if (win == clipboard_owner)
457 clipboard_owner = NULL;
458 break;
461 return DefWindowProc (win, msg, wp, lp);
464 static HWND
465 create_owner (void)
467 static const char CLASSNAME[] = "Emacs Clipboard";
468 WNDCLASS wc;
470 memset (&wc, 0, sizeof (wc));
471 wc.lpszClassName = CLASSNAME;
472 wc.lpfnWndProc = owner_callback;
473 RegisterClass (&wc);
475 return CreateWindow (CLASSNAME, CLASSNAME, 0, 0, 0, 0, 0, NULL, NULL,
476 NULL, NULL);
479 /* Called on exit by term_ntproc() in w32.c */
481 void
482 term_w32select (void)
484 /* This is needed to trigger WM_RENDERALLFORMATS. */
485 if (clipboard_owner != NULL)
486 DestroyWindow (clipboard_owner);
489 static void
490 setup_config (void)
492 const char *coding_name;
493 const char *cp;
494 char *end;
495 int slen;
496 Lisp_Object coding_system;
497 Lisp_Object dos_coding_system;
499 CHECK_SYMBOL (Vselection_coding_system);
501 coding_system = NILP (Vnext_selection_coding_system) ?
502 Vselection_coding_system : Vnext_selection_coding_system;
504 dos_coding_system = validate_coding_system (coding_system);
505 if (NILP (dos_coding_system))
506 Fsignal (Qerror,
507 list2 (build_string ("Coding system is invalid or doesn't have "
508 "an eol variant for dos line ends"),
509 coding_system));
511 /* Check if we have it cached */
512 if (!NILP (cfg_coding_system)
513 && EQ (cfg_coding_system, dos_coding_system))
514 return;
515 cfg_coding_system = dos_coding_system;
517 /* Set some sensible fallbacks */
518 cfg_codepage = ANSICP;
519 cfg_lcid = LOCALE_NEUTRAL;
520 cfg_clipboard_type = CF_TEXT;
522 /* Interpret the coding system symbol name */
523 coding_name = SDATA (SYMBOL_NAME (cfg_coding_system));
525 /* "(.*-)?utf-16.*" -> CF_UNICODETEXT */
526 cp = strstr (coding_name, "utf-16");
527 if (cp != NULL && (cp == coding_name || cp[-1] == '-'))
529 cfg_clipboard_type = CF_UNICODETEXT;
530 return;
533 /* "cp[0-9]+.*" or "windows-[0-9]+.*" -> CF_TEXT or CF_OEMTEXT */
534 slen = strlen (coding_name);
535 if (slen >= 4 && coding_name[0] == 'c' && coding_name[1] == 'p')
536 cp = coding_name + 2;
537 else if (slen >= 10 && memcmp (coding_name, "windows-", 8) == 0)
538 cp = coding_name + 8;
539 else
540 return;
542 end = (char*)cp;
543 cfg_codepage = strtol (cp, &end, 10);
545 /* Error return from strtol() or number of digits < 2 -> Restore the
546 default and drop it. */
547 if (cfg_codepage == 0 || (end-cp) < 2 )
549 cfg_codepage = ANSICP;
550 return;
553 /* Is it the currently active system default? */
554 if (cfg_codepage == ANSICP)
556 /* cfg_clipboard_type = CF_TEXT; */
557 return;
559 if (cfg_codepage == OEMCP)
561 cfg_clipboard_type = CF_OEMTEXT;
562 return;
565 /* Else determine a suitable locale the hard way. */
566 EnumSystemLocales (enum_locale_callback, LCID_INSTALLED);
569 static BOOL WINAPI
570 enum_locale_callback (/*const*/ char* loc_string)
572 LCID lcid;
573 UINT codepage;
575 lcid = strtoul (loc_string, NULL, 16);
577 /* Is the wanted codepage the "ANSI" codepage for this locale? */
578 codepage = cp_from_locale (lcid, CF_TEXT);
579 if (codepage == cfg_codepage)
581 cfg_lcid = lcid;
582 cfg_clipboard_type = CF_TEXT;
583 return FALSE; /* Stop enumeration */
586 /* Is the wanted codepage the OEM codepage for this locale? */
587 codepage = cp_from_locale (lcid, CF_OEMTEXT);
588 if (codepage == cfg_codepage)
590 cfg_lcid = lcid;
591 cfg_clipboard_type = CF_OEMTEXT;
592 return FALSE; /* Stop enumeration */
595 return TRUE; /* Continue enumeration */
598 static UINT
599 cp_from_locale (LCID lcid, UINT format)
601 char buffer[20] = "";
602 UINT variant, cp;
604 variant =
605 format == CF_TEXT ? LOCALE_IDEFAULTANSICODEPAGE : LOCALE_IDEFAULTCODEPAGE;
607 GetLocaleInfo (lcid, variant, buffer, sizeof (buffer));
608 cp = strtoul (buffer, NULL, 10);
610 if (cp == CP_ACP)
611 return ANSICP;
612 else if (cp == CP_OEMCP)
613 return OEMCP;
614 else
615 return cp;
618 static Lisp_Object
619 coding_from_cp (UINT codepage)
621 char buffer[30];
622 sprintf (buffer, "cp%d-dos", (int) codepage);
623 return intern (buffer);
624 /* We don't need to check that this coding system actually exists
625 right here, because that is done later for all coding systems
626 used, regardless of where they originate. */
629 static Lisp_Object
630 validate_coding_system (Lisp_Object coding_system)
632 Lisp_Object eol_type;
634 /* Make sure the input is valid. */
635 if (NILP (Fcoding_system_p (coding_system)))
636 return Qnil;
638 /* Make sure we use a DOS coding system as mandated by the system
639 specs. */
640 eol_type = Fcoding_system_eol_type (coding_system);
642 /* Already a DOS coding system? */
643 if (EQ (eol_type, make_number (1)))
644 return coding_system;
646 /* Get EOL_TYPE vector of the base of CODING_SYSTEM. */
647 if (!VECTORP (eol_type))
649 eol_type = Fcoding_system_eol_type (Fcoding_system_base (coding_system));
650 if (!VECTORP (eol_type))
651 return Qnil;
654 return AREF (eol_type, 1);
657 static void
658 setup_windows_coding_system (Lisp_Object coding_system,
659 struct coding_system * coding)
661 memset (coding, 0, sizeof (*coding));
662 setup_coding_system (coding_system, coding);
664 /* Unset CODING_ANNOTATE_COMPOSITION_MASK. Previous code had
665 comments about crashes in encode_coding_iso2022 trying to
666 dereference a null pointer when composition was on. Selection
667 data should not contain any composition sequence on Windows.
669 CODING_ANNOTATION_MASK also includes
670 CODING_ANNOTATE_DIRECTION_MASK and CODING_ANNOTATE_CHARSET_MASK,
671 which both apply to ISO6429 only. We don't know if these really
672 need to be unset on Windows, but it probably doesn't hurt
673 either. */
674 coding->mode &= ~CODING_ANNOTATION_MASK;
675 coding->mode |= CODING_MODE_LAST_BLOCK | CODING_MODE_SAFE_ENCODING;
680 DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data,
681 Sw32_set_clipboard_data, 1, 2, 0,
682 doc: /* This sets the clipboard data to the given text. */)
683 (string, ignored)
684 Lisp_Object string, ignored;
686 BOOL ok = TRUE;
687 int nbytes;
688 unsigned char *src;
689 unsigned char *dst;
690 unsigned char *end;
692 /* This parameter used to be the current frame, but we don't use
693 that any more. */
694 (void) ignored;
696 CHECK_STRING (string);
698 setup_config ();
700 current_text = string;
701 current_coding_system = cfg_coding_system;
702 current_clipboard_type = cfg_clipboard_type;
703 current_lcid = cfg_lcid;
704 current_num_nls = 0;
705 current_requires_encoding = 0;
707 BLOCK_INPUT;
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++)
718 if (*dst == '\n')
719 current_num_nls++;
720 else if (*dst >= 0x80 || *dst == 0)
722 current_requires_encoding = 1;
723 break;
727 if (!current_requires_encoding)
729 /* If all we have is ASCII we don't need to pretend we offer
730 anything fancy. */
731 current_coding_system = Qraw_text;
732 current_clipboard_type = CF_TEXT;
733 current_lcid = LOCALE_NEUTRAL;
736 if (!OpenClipboard (clipboard_owner))
737 goto error;
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. */
745 if (ok)
746 ok = !NILP(render_locale());
748 if (ok)
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)));
756 current_text = Qnil;
757 current_coding_system = Qnil;
759 else
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);
771 CloseClipboard ();
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
776 circumstances.
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. */
781 if (ok)
782 Vlast_coding_system_used = current_coding_system;
784 Vnext_selection_coding_system = Qnil;
786 if (ok) goto done;
788 error:
790 ok = FALSE;
791 current_text = Qnil;
792 current_coding_system = Qnil;
794 done:
795 UNBLOCK_INPUT;
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 (ignored)
805 Lisp_Object ignored;
807 HGLOBAL htext;
808 Lisp_Object ret = Qnil;
809 UINT actual_clipboard_type;
810 int use_configured_coding_system = 1;
812 /* This parameter used to be the current frame, but we don't use
813 that any more. */
814 (void) ignored;
816 /* Don't pass our own text from the clipboard (which might be
817 troublesome if the killed text includes null characters). */
818 if (!NILP (current_text))
819 return ret;
821 setup_config ();
822 actual_clipboard_type = cfg_clipboard_type;
824 BLOCK_INPUT;
826 if (!OpenClipboard (clipboard_owner))
827 goto done;
829 if ((htext = GetClipboardData (actual_clipboard_type)) == NULL)
831 /* If we want CF_UNICODETEXT but can't get it, the current
832 coding system is useless. OTOH we can still try and decode
833 CF_TEXT based on the locale that the system gives us and that
834 we get down below. */
835 if (actual_clipboard_type == CF_UNICODETEXT)
837 htext = GetClipboardData (CF_TEXT);
838 if (htext != NULL)
840 actual_clipboard_type = CF_TEXT;
841 use_configured_coding_system = 0;
845 if (htext == NULL)
846 goto closeclip;
849 unsigned char *src;
850 unsigned char *dst;
851 int nbytes;
852 int truelen;
853 int require_decoding = 0;
855 if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
856 goto closeclip;
858 /* If the clipboard data contains any non-ascii code, we need to
859 decode it with a coding system. */
860 if (actual_clipboard_type == CF_UNICODETEXT)
862 nbytes = lstrlenW ((WCHAR *)src) * 2;
863 require_decoding = 1;
865 else
867 int i;
869 nbytes = strlen (src);
871 for (i = 0; i < nbytes; i++)
873 if (src[i] >= 0x80)
875 require_decoding = 1;
876 break;
881 if (require_decoding)
883 struct coding_system coding;
884 Lisp_Object coding_system = Qnil;
885 Lisp_Object dos_coding_system;
887 /* `next-selection-coding-system' should override everything,
888 even when the locale passed by the system disagrees. The
889 only exception is when `next-selection-coding-system'
890 requested CF_UNICODETEXT and we couldn't get that. */
891 if (use_configured_coding_system
892 && !NILP (Vnext_selection_coding_system))
893 coding_system = Vnext_selection_coding_system;
895 /* If we have CF_TEXT or CF_OEMTEXT, we want to check out
896 CF_LOCALE, too. */
897 else if (actual_clipboard_type != CF_UNICODETEXT)
899 HGLOBAL hlocale;
900 LCID lcid = DEFAULT_LCID;
901 UINT cp;
903 /* Documentation says that the OS always generates
904 CF_LOCALE info automatically, so the locale handle
905 should always be present. Fact is that this is not
906 always true on 9x ;-(. */
907 hlocale = GetClipboardData (CF_LOCALE);
908 if (hlocale != NULL)
910 const LCID * lcid_ptr;
911 lcid_ptr = (const LCID *) GlobalLock (hlocale);
912 if (lcid_ptr != NULL)
914 lcid = *lcid_ptr;
915 GlobalUnlock (hlocale);
918 /* 9x has garbage as the sort order (to be exact there
919 is another instance of the language id in the upper
920 word). We don't care about sort order anyway, so
921 we just filter out the unneeded mis-information to
922 avoid irritations. */
923 lcid = MAKELCID (LANGIDFROMLCID (lcid), SORT_DEFAULT);
926 /* If we are using fallback from CF_UNICODETEXT, we can't
927 use the configured coding system. Also we don't want
928 to use it, if the system has supplied us with a locale
929 and it is not just the system default. */
930 if (!use_configured_coding_system || lcid != DEFAULT_LCID)
932 cp = cp_from_locale (lcid, actual_clipboard_type);
933 /* If it's just our current standard setting anyway,
934 use the coding system that the user has selected.
935 Otherwise create a new spec to match the locale
936 that was specified by the other side or the
937 system. */
938 if (!use_configured_coding_system || cp != cfg_codepage)
939 coding_system = coding_from_cp (cp);
943 if (NILP (coding_system))
944 coding_system = Vselection_coding_system;
945 Vnext_selection_coding_system = Qnil;
947 dos_coding_system = validate_coding_system (coding_system);
948 if (!NILP (dos_coding_system))
950 setup_windows_coding_system (dos_coding_system, &coding);
951 coding.source = src;
952 decode_coding_object (&coding, Qnil, 0, 0, nbytes, nbytes, Qt);
953 ret = coding.dst_object;
955 Vlast_coding_system_used = CODING_ID_NAME (coding.id);
958 else
960 /* FIXME: We may want to repeat the code in this branch for
961 the Unicode case. */
963 /* Need to know final size after CR chars are removed because
964 we can't change the string size manually, and doing an
965 extra copy is silly. We only remove CR when it appears as
966 part of CRLF. */
968 truelen = nbytes;
969 dst = src;
970 /* avoid using strchr because it recomputes the length everytime */
971 while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL)
973 if (dst[1] == '\n') /* safe because of trailing '\0' */
974 truelen--;
975 dst++;
978 ret = make_uninit_string (truelen);
980 /* Convert CRLF line endings (the standard CF_TEXT clipboard
981 format) to LF endings as used internally by Emacs. */
983 dst = SDATA (ret);
984 while (1)
986 unsigned char *next;
987 /* copy next line or remaining bytes excluding '\0' */
988 next = _memccpy (dst, src, '\r', nbytes);
989 if (next)
991 /* copied one line ending with '\r' */
992 int copied = next - dst;
993 nbytes -= copied;
994 dst += copied;
995 src += copied;
996 if (*src == '\n')
997 dst--; /* overwrite '\r' with '\n' */
999 else
1000 /* copied remaining partial line -> now finished */
1001 break;
1004 Vlast_coding_system_used = Qraw_text;
1007 GlobalUnlock (htext);
1010 closeclip:
1011 CloseClipboard ();
1013 done:
1014 UNBLOCK_INPUT;
1016 return (ret);
1019 /* Support checking for a clipboard selection. */
1021 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
1022 0, 1, 0,
1023 doc: /* Whether there is an owner for the given X Selection.
1024 The arg should be the name of the selection in question, typically one of
1025 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1026 \(Those are literal upper-case symbol names, since that's what X expects.)
1027 For convenience, the symbol nil is the same as `PRIMARY',
1028 and t is the same as `SECONDARY'. */)
1029 (selection)
1030 Lisp_Object selection;
1032 CHECK_SYMBOL (selection);
1034 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
1035 if the clipboard currently has valid text format contents. */
1037 if (EQ (selection, QCLIPBOARD))
1039 Lisp_Object val = Qnil;
1041 setup_config ();
1043 if (OpenClipboard (NULL))
1045 UINT format = 0;
1046 while ((format = EnumClipboardFormats (format)))
1047 /* Check CF_TEXT in addition to cfg_clipboard_type,
1048 because we can fall back on that if CF_UNICODETEXT is
1049 not available. Actually a check for CF_TEXT only
1050 should be enough. */
1051 if (format == cfg_clipboard_type || format == CF_TEXT)
1053 val = Qt;
1054 break;
1056 CloseClipboard ();
1058 return val;
1060 return Qnil;
1063 /* One-time init. Called in the un-dumped Emacs, but not in the
1064 dumped version. */
1066 void
1067 syms_of_w32select ()
1069 defsubr (&Sw32_set_clipboard_data);
1070 defsubr (&Sw32_get_clipboard_data);
1071 defsubr (&Sx_selection_exists_p);
1073 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
1074 doc: /* Coding system for communicating with other programs.
1075 When sending or receiving text via cut_buffer, selection, and
1076 clipboard, the text is encoded or decoded by this coding system.
1077 The default value is the current system default encoding on 9x/Me and
1078 `utf-16le-dos' (Unicode) on NT/W2K/XP. */);
1079 /* The actual value is set dynamically in the dumped Emacs, see
1080 below. */
1081 Vselection_coding_system = Qnil;
1083 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
1084 doc: /* Coding system for the next communication with other programs.
1085 Usually, `selection-coding-system' is used for communicating with
1086 other programs. But, if this variable is set, it is used for the
1087 next communication only. After the communication, this variable is
1088 set to nil. */);
1089 Vnext_selection_coding_system = Qnil;
1091 DEFSYM (QCLIPBOARD, "CLIPBOARD");
1093 cfg_coding_system = Qnil; staticpro (&cfg_coding_system);
1094 current_text = Qnil; staticpro (&current_text);
1095 current_coding_system = Qnil; staticpro (&current_coding_system);
1097 DEFSYM (QUNICODE, "utf-16le-dos");
1098 QANSICP = Qnil; staticpro (&QANSICP);
1099 QOEMCP = Qnil; staticpro (&QOEMCP);
1102 /* One-time init. Called in the dumped Emacs, but not in the
1103 un-dumped version. */
1105 void
1106 globals_of_w32select ()
1108 DEFAULT_LCID = GetUserDefaultLCID ();
1109 /* Drop the sort order from the LCID, so we can compare this with
1110 CF_LOCALE objects that have the same fix on 9x. */
1111 DEFAULT_LCID = MAKELCID (LANGIDFROMLCID (DEFAULT_LCID), SORT_DEFAULT);
1113 ANSICP = GetACP ();
1114 OEMCP = GetOEMCP ();
1116 QANSICP = coding_from_cp (ANSICP);
1117 QOEMCP = coding_from_cp (OEMCP);
1119 if (os_subtype == OS_NT)
1120 Vselection_coding_system = QUNICODE;
1121 else if (inhibit_window_system)
1122 Vselection_coding_system = QOEMCP;
1123 else
1124 Vselection_coding_system = QANSICP;
1126 clipboard_owner = create_owner ();
1129 /* arch-tag: c96e9724-5eb1-4dad-be07-289f092fd2af
1130 (do not change this comment) */