+ return Qnil;
+}
+
+DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
+ 0, 0, 0,
+ doc: /* Unload the Windows socket library `winsock' if loaded.
+This is provided to allow dial-up socket connections to be disconnected
+when no longer needed. Returns nil without unloading winsock if any
+socket connections still exist. */)
+ ()
+{
+ return term_winsock () ? Qt : Qnil;
+}
+
+#endif /* HAVE_SOCKETS */
+
+\f
+/* Some miscellaneous functions that are Windows specific, but not GUI
+ specific (ie. are applicable in terminal or batch mode as well). */
+
+/* lifted from fileio.c */
+#define CORRECT_DIR_SEPS(s) \
+ do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
+ else unixtodos_filename (s); \
+ } while (0)
+
+DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
+ doc: /* Return the short file name version (8.3) of the full path of FILENAME.
+If FILENAME does not exist, return nil.
+All path elements in FILENAME are converted to their short names. */)
+ (filename)
+ Lisp_Object filename;
+{
+ char shortname[MAX_PATH];
+
+ CHECK_STRING (filename);
+
+ /* first expand it. */
+ filename = Fexpand_file_name (filename, Qnil);
+
+ /* luckily, this returns the short version of each element in the path. */
+ if (GetShortPathName (SDATA (filename), shortname, MAX_PATH) == 0)
+ return Qnil;
+
+ CORRECT_DIR_SEPS (shortname);
+
+ return build_string (shortname);
+}
+
+
+DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
+ 1, 1, 0,
+ doc: /* Return the long file name version of the full path of FILENAME.
+If FILENAME does not exist, return nil.
+All path elements in FILENAME are converted to their long names. */)
+ (filename)
+ Lisp_Object filename;
+{
+ char longname[ MAX_PATH ];
+
+ CHECK_STRING (filename);
+
+ /* first expand it. */
+ filename = Fexpand_file_name (filename, Qnil);
+
+ if (!w32_get_long_filename (SDATA (filename), longname, MAX_PATH))
+ return Qnil;
+
+ CORRECT_DIR_SEPS (longname);
+
+ return build_string (longname);
+}
+
+DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
+ Sw32_set_process_priority, 2, 2, 0,
+ doc: /* Set the priority of PROCESS to PRIORITY.
+If PROCESS is nil, the priority of Emacs is changed, otherwise the
+priority of the process whose pid is PROCESS is changed.
+PRIORITY should be one of the symbols high, normal, or low;
+any other symbol will be interpreted as normal.
+
+If successful, the return value is t, otherwise nil. */)
+ (process, priority)
+ Lisp_Object process, priority;
+{
+ HANDLE proc_handle = GetCurrentProcess ();
+ DWORD priority_class = NORMAL_PRIORITY_CLASS;
+ Lisp_Object result = Qnil;
+
+ CHECK_SYMBOL (priority);
+
+ if (!NILP (process))
+ {
+ DWORD pid;
+ child_process *cp;
+
+ CHECK_NUMBER (process);
+
+ /* Allow pid to be an internally generated one, or one obtained
+ externally. This is necessary because real pids on Win95 are
+ negative. */
+
+ pid = XINT (process);
+ cp = find_child_pid (pid);
+ if (cp != NULL)
+ pid = cp->procinfo.dwProcessId;
+
+ proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
+ }
+
+ if (EQ (priority, Qhigh))
+ priority_class = HIGH_PRIORITY_CLASS;
+ else if (EQ (priority, Qlow))
+ priority_class = IDLE_PRIORITY_CLASS;
+
+ if (proc_handle != NULL)
+ {
+ if (SetPriorityClass (proc_handle, priority_class))
+ result = Qt;
+ if (!NILP (process))
+ CloseHandle (proc_handle);
+ }
+
+ return result;
+}
+
+
+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;
+ }