+
+ return htext;
+}
+
+/* This function assumes that there are multibyte or NUL characters in
+ current_text, or that we need to construct Unicode. It runs the
+ text through the encoding machinery. */
+
+static HGLOBAL
+convert_to_handle_as_coded (Lisp_Object coding_system)
+{
+ HGLOBAL htext = NULL, htext2;
+ int nbytes;
+ unsigned char *src;
+ unsigned char *dst = NULL;
+ int bufsize;
+ struct coding_system coding;
+ Lisp_Object string = Qnil;
+
+ ONTRACE (fprintf (stderr, "convert_to_handle_as_coded: %s\n",
+ SDATA (SYMBOL_NAME (coding_system))));
+
+ setup_coding_system (Fcheck_coding_system (coding_system), &coding);
+ coding.src_multibyte = 1;
+ coding.dst_multibyte = 0;
+ /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in
+ encode_coding_iso2022 trying to dereference a null pointer. */
+ coding.composing = COMPOSITION_DISABLED;
+ if (coding.type == coding_type_iso2022)
+ coding.flags |= CODING_FLAG_ISO_SAFE;
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ /* Force DOS line-ends. */
+ coding.eol_type = CODING_EOL_CRLF;
+
+ if (SYMBOLP (coding.pre_write_conversion)
+ && !NILP (Ffboundp (coding.pre_write_conversion)))
+ string = run_pre_post_conversion_on_str (current_text, &coding, 1);
+ else
+ string = current_text;
+
+ nbytes = SBYTES (string);
+ src = SDATA (string);
+
+ bufsize = encoding_buffer_size (&coding, nbytes) +2;
+ htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize);
+
+ if (htext != NULL)
+ dst = (unsigned char *) GlobalLock (htext);
+
+ if (dst != NULL)
+ {
+ encode_coding (&coding, src, dst, nbytes, bufsize-2);
+ /* Add the string terminator. Add two NULs in case we are
+ producing Unicode here. */
+ dst[coding.produced] = dst[coding.produced+1] = '\0';
+ }
+
+ if (dst != NULL)
+ GlobalUnlock (htext);
+
+ if (htext != NULL)
+ {
+ /* Shrink data block to actual size. */
+ htext2 = GlobalReAlloc (htext, coding.produced+2,
+ GMEM_MOVEABLE | GMEM_DDESHARE);
+ if (htext2 != NULL) htext = htext2;
+ }
+
+ return htext;
+}
+
+static Lisp_Object
+render (Lisp_Object oformat)
+{
+ HGLOBAL htext = NULL;
+ UINT format = XFASTINT (oformat);
+
+ ONTRACE (fprintf (stderr, "render\n"));
+
+ if (NILP (current_text))
+ return Qnil;
+
+ if (current_requires_encoding || format == CF_UNICODETEXT)
+ {
+ if (format == current_clipboard_type)
+ htext = convert_to_handle_as_coded (current_coding_system);
+ else
+ switch (format)
+ {
+ case CF_UNICODETEXT:
+ htext = convert_to_handle_as_coded (QUNICODE);
+ break;
+ case CF_TEXT:
+ case CF_OEMTEXT:
+ {
+ Lisp_Object cs;
+ cs = coding_from_cp (cp_from_locale (current_lcid, format));
+ htext = convert_to_handle_as_coded (cs);
+ break;
+ }
+ }
+ }
+ else
+ htext = convert_to_handle_as_ascii ();
+
+ ONTRACE (fprintf (stderr, "render: htext = 0x%08X\n", (unsigned) htext));
+
+ if (htext == NULL)
+ return Qnil;
+
+ if (SetClipboardData (format, htext) == NULL)
+ {
+ GlobalFree(htext);
+ return Qnil;
+ }
+
+ return Qt;
+}
+
+static Lisp_Object
+render_locale (void)
+{
+ HANDLE hlocale = NULL;
+ LCID * lcid_ptr;
+
+ ONTRACE (fprintf (stderr, "render_locale\n"));
+
+ if (current_lcid == LOCALE_NEUTRAL || current_lcid == DEFAULT_LCID)
+ return Qt;
+
+ hlocale = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, sizeof (current_lcid));
+ if (hlocale == NULL)
+ return Qnil;
+
+ if ((lcid_ptr = (LCID *) GlobalLock (hlocale)) == NULL)
+ {
+ GlobalFree(hlocale);
+ return Qnil;
+ }
+
+ *lcid_ptr = current_lcid;
+ GlobalUnlock (hlocale);
+
+ if (SetClipboardData (CF_LOCALE, hlocale) == NULL)
+ {
+ GlobalFree(hlocale);
+ return Qnil;
+ }
+
+ return Qt;
+}
+
+/* At the end of the program, we want to ensure that our clipboard
+ data survives us. This code will do that. */
+
+static Lisp_Object
+render_all (void)
+{
+ ONTRACE (fprintf (stderr, "render_all\n"));
+
+ /* According to the docs we should not call OpenClipboard() here,
+ but testing on W2K and working code in other projects shows that
+ it is actually necessary. */
+
+ OpenClipboard (NULL);
+
+ /* There is no usefull means to report errors here, there are none
+ expected anyway, and even if there were errors, they wouldn't do
+ any harm. So we just go ahead and do what has to be done without
+ bothering with error handling. */
+
+ ++modifying_clipboard;
+ EmptyClipboard ();
+ --modifying_clipboard;
+
+ /* For text formats that we don't render here, the OS can use its
+ own translation rules instead, so we don't really need to offer
+ everything. To minimize memory consumption we cover three
+ possible situations based on our primary format as detected from
+ selection-coding-system (see setup_config()):
+
+ - Post CF_TEXT only. Let the OS convert to CF_OEMTEXT and the OS
+ (on NT) or the application (on 9x/Me) convert to
+ CF_UNICODETEXT.
+
+ - Post CF_OEMTEXT only. Similar automatic conversions happen as
+ for CF_TEXT.
+
+ - Post CF_UNICODETEXT + CF_TEXT. 9x itself ignores
+ CF_UNICODETEXT, even though some applications can still handle
+ it.
+
+ Note 1: We render the less capable CF_TEXT *before* the more
+ capable CF_UNICODETEXT, to prevent clobbering through automatic
+ conversions, just in case.
+
+ Note 2: We could check os_subtype here and only render the
+ additional CF_TEXT on 9x/Me. But OTOH with
+ current_clipboard_type == CF_UNICODETEXT we don't involve the
+ automatic conversions anywhere else, so to get consistent
+ results, we probably don't want to rely on it here either. */
+
+ render_locale();
+
+ if (current_clipboard_type == CF_UNICODETEXT)
+ render (make_number (CF_TEXT));
+ render (make_number (current_clipboard_type));
+
+ CloseClipboard ();
+
+ return Qnil;
+}
+
+static void
+run_protected (Lisp_Object (*code) (), Lisp_Object arg)
+{
+ /* FIXME: This works but it doesn't feel right. Too much fiddling
+ with global variables and calling strange looking functions. Is
+ this really the right way to run Lisp callbacks? */
+
+ extern int waiting_for_input;
+ int owfi;
+
+ BLOCK_INPUT;
+
+ /* Fsignal calls abort() if it sees that waiting_for_input is
+ set. */
+ owfi = waiting_for_input;
+ waiting_for_input = 0;
+
+ internal_condition_case_1 (code, arg, Qt, lisp_error_handler);
+
+ waiting_for_input = owfi;
+
+ UNBLOCK_INPUT;
+}
+
+static Lisp_Object
+lisp_error_handler (Lisp_Object error)
+{
+ Vsignaling_function = Qnil;
+ cmd_error_internal (error, "Error in delayed clipboard rendering: ");
+ Vinhibit_quit = Qt;
+ return Qt;
+}
+
+
+static LRESULT CALLBACK
+owner_callback (HWND win, UINT msg, WPARAM wp, LPARAM lp)
+{
+ switch (msg)
+ {
+ case WM_RENDERFORMAT:
+ ONTRACE (fprintf (stderr, "WM_RENDERFORMAT\n"));
+ run_protected (render, make_number (wp));
+ return 0;
+
+ case WM_RENDERALLFORMATS:
+ ONTRACE (fprintf (stderr, "WM_RENDERALLFORMATS\n"));
+ run_protected (render_all, Qnil);
+ return 0;
+
+ case WM_DESTROYCLIPBOARD:
+ if (!modifying_clipboard)
+ {
+ ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (other)\n"));
+ current_text = Qnil;
+ current_coding_system = Qnil;
+ }
+ else
+ {
+ ONTRACE (fprintf (stderr, "WM_DESTROYCLIPBOARD (self)\n"));
+ }
+ return 0;
+
+ case WM_DESTROY:
+ if (win == clipboard_owner)
+ clipboard_owner = NULL;
+ break;
+ }
+
+ return DefWindowProc (win, msg, wp, lp);
+}
+
+static HWND
+create_owner (void)
+{
+ static const char CLASSNAME[] = "Emacs Clipboard";
+ WNDCLASS wc;
+
+ memset (&wc, 0, sizeof (wc));
+ wc.lpszClassName = CLASSNAME;
+ wc.lpfnWndProc = owner_callback;
+ RegisterClass (&wc);
+
+ return CreateWindow (CLASSNAME, CLASSNAME, 0, 0, 0, 0, 0, NULL, NULL,
+ NULL, NULL);
+}
+
+/* Called on exit by term_ntproc() in w32.c */
+
+void
+term_w32select (void)
+{
+ /* This is needed to trigger WM_RENDERALLFORMATS. */
+ if (clipboard_owner != NULL)
+ DestroyWindow (clipboard_owner);
+}
+
+static void
+setup_config (void)
+{
+ const char *coding_name;
+ const char *cp;
+ char *end;
+ int slen;
+ Lisp_Object new_coding_system;
+
+ CHECK_SYMBOL (Vselection_coding_system);
+
+ /* Check if we have it cached */
+ new_coding_system = NILP (Vnext_selection_coding_system) ?
+ Vselection_coding_system : Vnext_selection_coding_system;
+ if (!NILP (cfg_coding_system)
+ && EQ (cfg_coding_system, new_coding_system))
+ return;
+ cfg_coding_system = new_coding_system;