+ {
+ if (item == CODESET)
+ {
+ need_len += 2; /* for the "cp" prefix */
+ if (need_len < 8) /* for the case we call GetACP */
+ need_len = 8;
+ }
+ if (nl_langinfo_len <= need_len)
+ nl_langinfo_buf = xrealloc (nl_langinfo_buf,
+ nl_langinfo_len = need_len);
+ if (!GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
+ nl_langinfo_buf, nl_langinfo_len))
+ nl_langinfo_buf[0] = 0;
+ else if (item == CODESET)
+ {
+ if (strcmp (nl_langinfo_buf, "0") == 0 /* CP_ACP */
+ || strcmp (nl_langinfo_buf, "1") == 0) /* CP_OEMCP */
+ sprintf (nl_langinfo_buf, "cp%u", GetACP ());
+ else
+ {
+ memmove (nl_langinfo_buf + 2, nl_langinfo_buf,
+ strlen (nl_langinfo_buf) + 1);
+ nl_langinfo_buf[0] = 'c';
+ nl_langinfo_buf[1] = 'p';
+ }
+ }
+ }
+ }
+ return nl_langinfo_buf;
+}
+#endif /* HAVE_LANGINFO_CODESET */
+
+DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
+ Sw32_get_locale_info, 1, 2, 0,
+ doc: /* Return information about the Windows locale LCID.
+By default, return a three letter locale code which encodes the default
+language as the first two characters, and the country or regionial variant
+as the third letter. For example, ENU refers to `English (United States)',
+while ENC means `English (Canadian)'.
+
+If the optional argument LONGFORM is t, the long form of the locale
+name is returned, e.g. `English (United States)' instead; if LONGFORM
+is a number, it is interpreted as an LCTYPE constant and the corresponding
+locale information is returned.
+
+If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
+ (lcid, longform)
+ Lisp_Object lcid, longform;
+{
+ int got_abbrev;
+ int got_full;
+ char abbrev_name[32] = { 0 };
+ char full_name[256] = { 0 };
+
+ CHECK_NUMBER (lcid);
+
+ if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
+ return Qnil;
+
+ if (NILP (longform))
+ {
+ got_abbrev = GetLocaleInfo (XINT (lcid),
+ LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
+ abbrev_name, sizeof (abbrev_name));
+ if (got_abbrev)
+ return build_string (abbrev_name);
+ }
+ else if (EQ (longform, Qt))
+ {
+ got_full = GetLocaleInfo (XINT (lcid),
+ LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
+ full_name, sizeof (full_name));
+ if (got_full)
+ return build_string (full_name);
+ }
+ else if (NUMBERP (longform))
+ {
+ got_full = GetLocaleInfo (XINT (lcid),
+ XINT (longform),
+ full_name, sizeof (full_name));
+ if (got_full)
+ return make_unibyte_string (full_name, got_full);
+ }
+
+ return Qnil;
+}
+
+
+DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
+ Sw32_get_current_locale_id, 0, 0, 0,
+ doc: /* Return Windows locale id for current locale setting.
+This is a numerical value; use `w32-get-locale-info' to convert to a
+human-readable form. */)
+ ()
+{
+ return make_number (GetThreadLocale ());
+}
+
+DWORD int_from_hex (char * s)
+{
+ DWORD val = 0;
+ static char hex[] = "0123456789abcdefABCDEF";
+ char * p;
+
+ while (*s && (p = strchr(hex, *s)) != NULL)
+ {
+ unsigned digit = p - hex;
+ if (digit > 15)
+ digit -= 6;
+ val = val * 16 + digit;
+ s++;
+ }
+ return val;
+}
+
+/* We need to build a global list, since the EnumSystemLocale callback
+ function isn't given a context pointer. */
+Lisp_Object Vw32_valid_locale_ids;
+
+BOOL CALLBACK enum_locale_fn (LPTSTR localeNum)
+{
+ DWORD id = int_from_hex (localeNum);
+ Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
+ return TRUE;
+}
+
+DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
+ Sw32_get_valid_locale_ids, 0, 0, 0,
+ doc: /* Return list of all valid Windows locale ids.
+Each id is a numerical value; use `w32-get-locale-info' to convert to a
+human-readable form. */)
+ ()
+{
+ Vw32_valid_locale_ids = Qnil;
+
+ EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
+
+ Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
+ return Vw32_valid_locale_ids;
+}
+
+
+DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
+ doc: /* Return Windows locale id for default locale setting.
+By default, the system default locale setting is returned; if the optional
+parameter USERP is non-nil, the user default locale setting is returned.
+This is a numerical value; use `w32-get-locale-info' to convert to a
+human-readable form. */)
+ (userp)
+ Lisp_Object userp;
+{
+ if (NILP (userp))
+ return make_number (GetSystemDefaultLCID ());
+ return make_number (GetUserDefaultLCID ());
+}
+
+
+DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
+ doc: /* Make Windows locale LCID be the current locale setting for Emacs.
+If successful, the new locale id is returned, otherwise nil. */)
+ (lcid)
+ Lisp_Object lcid;
+{
+ CHECK_NUMBER (lcid);
+
+ if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
+ return Qnil;
+
+ if (!SetThreadLocale (XINT (lcid)))
+ return Qnil;
+
+ /* Need to set input thread locale if present. */
+ if (dwWindowsThreadId)
+ /* Reply is not needed. */
+ PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
+
+ return make_number (GetThreadLocale ());
+}
+
+
+/* We need to build a global list, since the EnumCodePages callback
+ function isn't given a context pointer. */
+Lisp_Object Vw32_valid_codepages;
+
+BOOL CALLBACK enum_codepage_fn (LPTSTR codepageNum)
+{
+ DWORD id = atoi (codepageNum);
+ Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
+ return TRUE;
+}
+
+DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
+ Sw32_get_valid_codepages, 0, 0, 0,
+ doc: /* Return list of all valid Windows codepages. */)
+ ()
+{
+ Vw32_valid_codepages = Qnil;
+
+ EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
+
+ Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
+ return Vw32_valid_codepages;
+}
+
+
+DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
+ Sw32_get_console_codepage, 0, 0, 0,
+ doc: /* Return current Windows codepage for console input. */)
+ ()
+{
+ return make_number (GetConsoleCP ());
+}
+
+
+DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
+ Sw32_set_console_codepage, 1, 1, 0,
+ doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
+The codepage setting affects keyboard input and display in tty mode.
+If successful, the new CP is returned, otherwise nil. */)
+ (cp)
+ Lisp_Object cp;
+{
+ CHECK_NUMBER (cp);
+
+ if (!IsValidCodePage (XINT (cp)))
+ return Qnil;
+
+ if (!SetConsoleCP (XINT (cp)))
+ return Qnil;
+
+ return make_number (GetConsoleCP ());
+}
+
+
+DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
+ Sw32_get_console_output_codepage, 0, 0, 0,
+ doc: /* Return current Windows codepage for console output. */)
+ ()
+{
+ return make_number (GetConsoleOutputCP ());
+}
+
+
+DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
+ Sw32_set_console_output_codepage, 1, 1, 0,
+ doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
+The codepage setting affects keyboard input and display in tty mode.
+If successful, the new CP is returned, otherwise nil. */)
+ (cp)
+ Lisp_Object cp;
+{
+ CHECK_NUMBER (cp);
+
+ if (!IsValidCodePage (XINT (cp)))
+ return Qnil;
+
+ if (!SetConsoleOutputCP (XINT (cp)))
+ return Qnil;
+
+ return make_number (GetConsoleOutputCP ());
+}
+
+
+DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
+ Sw32_get_codepage_charset, 1, 1, 0,
+ doc: /* Return charset of codepage CP.
+Returns nil if the codepage is not valid. */)
+ (cp)
+ Lisp_Object cp;
+{
+ CHARSETINFO info;
+
+ CHECK_NUMBER (cp);
+
+ if (!IsValidCodePage (XINT (cp)))
+ return Qnil;
+
+ if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
+ return make_number (info.ciCharset);
+
+ return Qnil;
+}
+
+
+DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
+ Sw32_get_valid_keyboard_layouts, 0, 0, 0,
+ doc: /* Return list of Windows keyboard languages and layouts.
+The return value is a list of pairs of language id and layout id. */)
+ ()
+{
+ int num_layouts = GetKeyboardLayoutList (0, NULL);
+ HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
+ Lisp_Object obj = Qnil;
+
+ if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
+ {
+ while (--num_layouts >= 0)
+ {
+ DWORD kl = (DWORD) layouts[num_layouts];
+
+ obj = Fcons (Fcons (make_number (kl & 0xffff),
+ make_number ((kl >> 16) & 0xffff)),
+ obj);
+ }
+ }
+
+ return obj;
+}
+
+
+DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
+ Sw32_get_keyboard_layout, 0, 0, 0,
+ doc: /* Return current Windows keyboard language and layout.
+The return value is the cons of the language id and the layout id. */)
+ ()
+{
+ DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
+
+ return Fcons (make_number (kl & 0xffff),
+ make_number ((kl >> 16) & 0xffff));
+}
+
+
+DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
+ Sw32_set_keyboard_layout, 1, 1, 0,
+ doc: /* Make LAYOUT be the current keyboard layout for Emacs.
+The keyboard layout setting affects interpretation of keyboard input.
+If successful, the new layout id is returned, otherwise nil. */)
+ (layout)
+ Lisp_Object layout;
+{
+ DWORD kl;
+
+ CHECK_CONS (layout);
+ CHECK_NUMBER_CAR (layout);
+ CHECK_NUMBER_CDR (layout);
+
+ kl = (XINT (XCAR (layout)) & 0xffff)
+ | (XINT (XCDR (layout)) << 16);
+
+ /* Synchronize layout with input thread. */
+ if (dwWindowsThreadId)
+ {
+ if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
+ (WPARAM) kl, 0))
+ {
+ MSG msg;
+ GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
+
+ if (msg.wParam == 0)
+ return Qnil;
+ }