Mercurial > hg > xemacs-beta
annotate src/win32.c @ 5629:0d05accafc63
Don't lose bits in make_fixnum / make_char_1.
See xemacs-patches message with ID
<CAHCOHQnRTjm6c5gWVO3iizWJ9Jb7GvEyFe3aQ19hAXhcR_mrrA@mail.gmail.com>.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Wed, 28 Dec 2011 11:30:47 -0700 |
| parents | 56144c8593a8 |
| children | 68639fb08af8 |
| rev | line source |
|---|---|
| 442 | 1 /* Utility routines for XEmacs on Windows 9x, NT and Cygwin. |
| 2367 | 2 Copyright (C) 2000, 2001, 2002, 2004 Ben Wing. |
| 442 | 3 |
| 4 This file is part of XEmacs. | |
| 5 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
| 442 | 7 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
9 option) any later version. |
| 442 | 10 |
| 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 442 | 18 |
| 19 #include <config.h> | |
| 20 #include "lisp.h" | |
| 21 | |
| 22 #include "buffer.h" | |
| 771 | 23 #include "console-msw.h" |
| 2526 | 24 #include "hash.h" |
| 25 #include "profile.h" | |
| 611 | 26 |
| 771 | 27 #include "sysfile.h" |
| 28 #include "sysproc.h" | |
| 859 | 29 #include "syssignal.h" |
| 611 | 30 #include "systime.h" |
| 442 | 31 |
| 2367 | 32 |
| 33 | |
| 34 /* | |
| 35 | |
| 36 Info on Windows issues: | |
| 37 | |
| 38 (Info-goto-node "(internals)Interface to MS Windows") | |
| 39 | |
| 40 ------- @file{src/config.h}.in vs. @file{nt/xemacs.mak} ------- | |
| 41 | |
| 42 See @file{src/config.h.in} more more info. | |
| 43 */ | |
| 44 | |
| 771 | 45 /* Control conversion of upper case file names to lower case. |
| 46 nil means no, t means yes. */ | |
| 47 Lisp_Object Vmswindows_downcase_file_names; | |
| 48 | |
| 2526 | 49 struct hash_table *mswindows_read_link_hash; |
| 50 | |
| 771 | 51 int mswindows_windows9x_p; |
| 2526 | 52 Boolint mswindows_shortcuts_are_symlinks; |
| 771 | 53 |
| 442 | 54 pfSwitchToThread_t xSwitchToThread; |
| 55 | |
| 771 | 56 pfNetUserEnum_t xNetUserEnum; |
| 57 pfNetApiBufferFree_t xNetApiBufferFree; | |
| 58 | |
| 59 /* Convert a filename in standard Win32 format into our internal format | |
| 60 (which may be significantly different if we're running on Cygwin), and | |
| 61 turn it into a file: URL. Return a newly malloc()ed string. | |
| 442 | 62 |
| 771 | 63 #### This comes from code that just prepended `file:', which is not |
| 64 good. See comment in mswindows_dde_callback(), case XTYP_EXECUTE. | |
| 65 */ | |
| 867 | 66 Ibyte * |
| 67 urlify_filename (Ibyte *filename) | |
| 771 | 68 { |
| 867 | 69 Ibyte *pseudo_url; |
| 771 | 70 |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
71 INTERNAL_MSWIN_TO_LOCAL_FILE_FORMAT (filename, filename); |
| 867 | 72 pseudo_url = xnew_array (Ibyte, 5 + qxestrlen (filename) + 1); |
| 2367 | 73 qxestrcpy_ascii (pseudo_url, "file:"); |
| 771 | 74 qxestrcat (pseudo_url, filename); |
| 75 /* URL's only have /, no backslash */ | |
| 76 for (filename = pseudo_url; *filename; filename++) | |
| 77 { | |
| 78 if (*filename == '\\') | |
| 79 *filename = '/'; | |
| 80 } | |
| 442 | 81 |
| 771 | 82 return pseudo_url; |
| 83 } | |
| 531 | 84 |
| 826 | 85 /* Convert a Win32 file name in tstr format into a local-format file name |
| 86 in internal format. */ | |
| 87 | |
| 442 | 88 Lisp_Object |
| 826 | 89 tstr_to_local_file_format (Extbyte *path) |
| 442 | 90 { |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
91 Ibyte *pathint = TSTR_TO_ITEXT (path); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
92 INTERNAL_MSWIN_TO_LOCAL_FILE_FORMAT (pathint, pathint); |
| 771 | 93 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
94 return build_istring (pathint); |
| 771 | 95 } |
| 96 | |
| 97 /* Normalize filename by converting all path separators to the specified | |
| 98 separator. Also conditionally convert all-upper-case path name | |
| 99 components to lower case. Return a newly malloc()ed string. | |
| 100 */ | |
| 101 | |
| 867 | 102 Ibyte * |
| 103 mswindows_canonicalize_filename (Ibyte *name) | |
| 771 | 104 { |
| 867 | 105 Ibyte *fp = name; |
| 771 | 106 DECLARE_EISTRING (newname); |
| 107 DECLARE_EISTRING (component); | |
| 108 int do_casefrob = 1; | |
| 442 | 109 |
| 771 | 110 /* Always lower-case drive letters a-z, even if the filesystem |
| 111 preserves case in filenames. | |
| 112 This is so filenames can be compared by string comparison | |
| 113 functions that are case-sensitive. Even case-preserving filesystems | |
| 114 do not distinguish case in drive letters. */ | |
| 115 if (name[0] >= 'A' && name[0] <= 'Z' && name[1] == ':') | |
| 116 { | |
| 117 eicat_ch (newname, name[0] + 'a' - 'A'); | |
| 118 eicat_ch (newname, ':'); | |
| 119 fp += 2; | |
| 120 } | |
| 121 | |
| 122 while (1) | |
| 123 { | |
| 867 | 124 Ichar ch = itext_ichar (fp); |
| 771 | 125 if (LOWERCASEP (0, ch)) |
| 126 do_casefrob = 0; /* don't convert this element */ | |
| 442 | 127 |
| 771 | 128 if (ch == 0 || IS_ANY_SEP (ch)) |
| 129 { | |
| 130 if (do_casefrob && !NILP (Vmswindows_downcase_file_names)) | |
| 131 eilwr (component); | |
| 132 do_casefrob = 1; | |
| 133 eicat_ei (newname, component); | |
| 134 eireset (component); | |
| 135 if (IS_DIRECTORY_SEP (ch)) | |
| 136 eicat_ch (newname, DIRECTORY_SEP); | |
| 137 else if (ch) | |
| 138 eicat_ch (newname, ch); | |
| 139 else | |
| 140 break; | |
| 141 } | |
| 142 else | |
| 143 eicat_ch (component, ch); | |
| 144 | |
| 867 | 145 INC_IBYTEPTR (fp); |
| 771 | 146 } |
| 147 | |
| 148 return eicpyout_malloc (newname, 0); | |
| 442 | 149 } |
| 150 | |
| 814 | 151 Extbyte * |
| 152 mswindows_get_module_file_name (void) | |
| 153 { | |
| 154 Extbyte *path = NULL; | |
| 155 int bufsize = 4096; | |
| 156 int cchpathsize; | |
| 157 | |
| 158 while (1) | |
| 159 { | |
| 160 path = (Extbyte *) xrealloc (path, bufsize * XETCHAR_SIZE); | |
| 161 cchpathsize = qxeGetModuleFileName (NULL, path, bufsize); | |
| 162 if (!cchpathsize) | |
| 163 return 0; | |
| 164 if (cchpathsize + 1 <= bufsize) | |
| 165 break; | |
| 166 bufsize *= 2; | |
| 167 } | |
| 168 | |
| 169 return path; | |
| 170 } | |
| 171 | |
| 442 | 172 static void |
| 173 init_potentially_nonexistent_functions (void) | |
| 174 { | |
| 771 | 175 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32")); |
| 531 | 176 /* the following does not seem to get mapped in automatically */ |
| 771 | 177 HMODULE h_netapi = qxeLoadLibrary (XETEXT ("netapi32.dll")); |
| 442 | 178 |
| 179 if (h_kernel) | |
| 180 { | |
| 181 xSwitchToThread = | |
| 182 (pfSwitchToThread_t) GetProcAddress (h_kernel, "SwitchToThread"); | |
| 183 } | |
| 184 | |
| 531 | 185 if (h_netapi) |
| 186 { | |
| 187 xNetUserEnum = | |
| 188 (pfNetUserEnum_t) GetProcAddress (h_netapi, "NetUserEnum"); | |
| 189 xNetApiBufferFree = | |
| 190 (pfNetApiBufferFree_t) GetProcAddress (h_netapi, "NetApiBufferFree"); | |
| 191 } | |
| 442 | 192 } |
| 193 | |
| 771 | 194 static Lisp_Object |
| 195 mswindows_lisp_error_1 (int errnum, int no_recurse) | |
| 196 { | |
| 197 LPTSTR lpMsgBuf; | |
| 198 Lisp_Object result; | |
| 867 | 199 Ibyte *inres; |
| 771 | 200 Bytecount len; |
| 201 int i; | |
| 202 | |
| 203 /* The docs for FormatMessage say: | |
| 204 | |
| 205 If you pass a specific LANGID in this parameter, FormatMessage | |
| 206 will return a message for that LANGID only. If the function | |
| 207 cannot find a message for that LANGID, it returns | |
| 208 ERROR_RESOURCE_LANG_NOT_FOUND. If you pass in zero, FormatMessage | |
| 209 looks for a message for LANGIDs in the following order: | |
| 210 | |
| 211 Language neutral | |
| 212 Thread LANGID, based on the thread's locale value | |
| 213 User default LANGID, based on the user's default locale value | |
| 214 System default LANGID, based on the system default locale value | |
| 215 US English | |
| 216 | |
| 217 If FormatMessage doesn't find a message for any of the preceding | |
| 218 LANGIDs, it returns any language message string that is present. If | |
| 219 that fails, it returns ERROR_RESOURCE_LANG_NOT_FOUND. (Note, this is | |
| 220 returned through GetLastError(), not the return value.) | |
| 221 | |
| 222 #### what the hell is "language neutral"? i can find no info on this. | |
| 223 so let's do our own language first. | |
| 224 */ | |
| 225 | |
| 226 for (i = 0; ; i++) | |
| 227 { | |
| 228 int lang = 0; | |
| 229 int retval; | |
| 230 | |
| 231 switch (i) | |
| 232 { | |
| 233 #ifdef MULE | |
| 234 /* Urk! Windows 95 doesn't let you set the thread locale! | |
| 235 so we have to maintain our own. */ | |
| 236 case 0: lang = LANGIDFROMLCID (mswindows_current_locale ()); break; | |
| 237 case 1: lang = 0; break; | |
| 238 #else | |
| 239 case 0: lang = 0; break; | |
| 240 #endif | |
| 2500 | 241 default: ABORT (); |
| 771 | 242 } |
| 243 | |
| 244 retval = qxeFormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER | |
| 245 | FORMAT_MESSAGE_FROM_SYSTEM, | |
| 246 NULL, errnum, lang, | |
| 247 /* yeah, i'm casting a char ** to a char *. | |
| 248 ya gotta problem widdat? */ | |
| 249 (Extbyte *) &lpMsgBuf, 0, NULL); | |
| 250 | |
| 251 if (!retval) | |
| 252 { | |
| 253 if (lang != 0) | |
| 254 continue; | |
| 255 | |
| 256 if (no_recurse) | |
| 257 return emacs_sprintf_string | |
| 258 ("Unknown error code %d (error return %ld from FormatMessage())", | |
| 259 errnum, GetLastError ()); | |
| 260 else | |
| 261 return emacs_sprintf_string | |
| 262 ("Unknown error code %d (error return %s from FormatMessage())", | |
| 263 /* It's OK, emacs_sprintf_string disables GC explicitly */ | |
| 264 errnum, XSTRING_DATA (mswindows_lisp_error_1 (errnum, 1))); | |
| 265 } | |
| 266 else | |
| 267 break; | |
| 268 } | |
| 269 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
270 inres = TSTR_TO_ITEXT (lpMsgBuf); |
| 771 | 271 len = qxestrlen (inres); |
| 272 /* Messages tend to end with a period and newline */ | |
| 2367 | 273 if (len >= 3 && !qxestrcmp_ascii (inres + len - 3, ".\r\n")) |
| 771 | 274 len -= 3; |
| 275 result = make_string (inres, len); | |
| 276 | |
| 277 LocalFree (lpMsgBuf); | |
| 278 return result; | |
| 279 } | |
| 280 | |
| 281 Lisp_Object | |
| 282 mswindows_lisp_error (int errnum) | |
| 283 { | |
| 284 return mswindows_lisp_error_1 (errnum, 0); | |
| 285 } | |
| 286 | |
| 287 void | |
| 4932 | 288 mswindows_output_last_error (const Ascbyte *frob) |
| 771 | 289 { |
| 290 int errval = GetLastError (); | |
| 291 Lisp_Object errmess = mswindows_lisp_error (errval); | |
| 292 | |
| 293 stderr_out ("last error during %s is %d: %s\n", | |
| 294 frob, errval, XSTRING_DATA (errmess)); | |
| 295 } | |
| 296 | |
| 297 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
298 mswindows_report_process_error (const Ascbyte *reason, Lisp_Object data, |
| 771 | 299 int errnum) |
| 300 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
301 signal_error_2 (Qprocess_error, reason, mswindows_lisp_error (errnum), data); |
| 771 | 302 } |
| 303 | |
| 442 | 304 DEFUN ("mswindows-shell-execute", Fmswindows_shell_execute, 2, 4, 0, /* |
| 305 Get Windows to perform OPERATION on DOCUMENT. | |
| 306 This is a wrapper around the ShellExecute system function, which | |
| 307 invokes the application registered to handle OPERATION for DOCUMENT. | |
| 308 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be | |
| 309 nil for the default action), and DOCUMENT is typically the name of a | |
| 310 document file or URL, but can also be a program executable to run or | |
| 311 a directory to open in the Windows Explorer. | |
| 312 | |
| 313 If DOCUMENT is a program executable, PARAMETERS can be a string | |
| 314 containing command line parameters, but otherwise should be nil. | |
| 315 | |
| 316 SHOW-FLAG can be used to control whether the invoked application is hidden | |
| 317 or minimized. If SHOW-FLAG is nil, the application is displayed normally, | |
| 318 otherwise it is an integer representing a ShowWindow flag: | |
| 319 | |
| 320 0 - start hidden | |
| 321 1 - start normally | |
| 322 3 - start maximized | |
| 323 6 - start minimized | |
| 324 */ | |
| 325 (operation, document, parameters, show_flag)) | |
| 326 { | |
| 327 /* Encode filename and current directory. */ | |
| 328 Lisp_Object current_dir = Ffile_name_directory (document); | |
| 329 int ret; | |
| 330 | |
| 331 CHECK_STRING (document); | |
| 332 | |
| 333 if (NILP (current_dir)) | |
| 334 current_dir = current_buffer->directory; | |
| 335 | |
| 771 | 336 { |
| 337 Extbyte *opext = NULL; | |
| 338 Extbyte *parmext = NULL; | |
| 339 Extbyte *path = NULL; | |
| 340 Extbyte *doc = NULL; | |
| 442 | 341 |
| 771 | 342 if (STRINGP (operation)) |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
343 opext = LISP_STRING_TO_TSTR (operation); |
| 2526 | 344 /* #### What about path names, which may be links? */ |
| 771 | 345 if (STRINGP (parameters)) |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
346 parmext = LISP_STRING_TO_TSTR (parameters); |
| 771 | 347 if (STRINGP (current_dir)) |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
348 LISP_LOCAL_FILE_FORMAT_TO_TSTR (current_dir, path); |
| 826 | 349 if (STRINGP (document)) |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
350 LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR (document, doc); |
| 442 | 351 |
| 771 | 352 ret = (int) qxeShellExecute (NULL, opext, doc, parmext, path, |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
353 (FIXNUMP (show_flag) ? |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
354 XFIXNUM (show_flag) : SW_SHOWDEFAULT)); |
| 771 | 355 } |
| 442 | 356 |
| 771 | 357 if (ret <= 32) |
| 358 { | |
| 359 /* Convert to more standard errors */ | |
| 360 #define FROB(a, b) if (ret == a) ret = b | |
| 361 FROB (SE_ERR_ACCESSDENIED, ERROR_ACCESS_DENIED); | |
| 362 FROB (SE_ERR_ASSOCINCOMPLETE, ERROR_NO_ASSOCIATION); | |
| 363 FROB (SE_ERR_DDEBUSY, ERROR_DDE_FAIL); | |
| 364 FROB (SE_ERR_DDEFAIL, ERROR_DDE_FAIL); | |
| 365 FROB (SE_ERR_DDETIMEOUT, ERROR_DDE_FAIL); | |
| 366 FROB (SE_ERR_DLLNOTFOUND, ERROR_DLL_NOT_FOUND); | |
| 367 FROB (SE_ERR_FNF, ERROR_FILE_NOT_FOUND); | |
| 368 FROB (SE_ERR_NOASSOC, ERROR_NO_ASSOCIATION); | |
| 369 FROB (SE_ERR_OOM, ERROR_NOT_ENOUGH_MEMORY); | |
| 370 FROB (SE_ERR_PNF, ERROR_PATH_NOT_FOUND); | |
| 371 FROB (SE_ERR_SHARE, ERROR_SHARING_VIOLATION); | |
| 372 #undef FROB | |
| 373 | |
| 374 mswindows_report_process_error ("Running ShellExecute", | |
| 375 ret == ERROR_PATH_NOT_FOUND ? | |
| 376 list4 (Qunbound, operation, document, | |
| 377 current_dir) : | |
| 378 list3 (Qunbound, operation, document), | |
| 379 ret); | |
| 380 } | |
| 442 | 381 |
| 771 | 382 return Qt; |
| 442 | 383 } |
| 384 | |
| 673 | 385 #ifdef CYGWIN |
| 386 DEFUN ("mswindows-cygwin-to-win32-path", Fmswindows_cygwin_to_win32_path, 1, 1, 0, /* | |
| 387 Get the cygwin environment to convert the Unix PATH to win32 format. | |
| 388 No expansion is performed, all conversion is done by the cygwin runtime. | |
| 389 */ | |
| 390 (path)) | |
| 391 { | |
| 867 | 392 Ibyte *p; |
| 673 | 393 CHECK_STRING (path); |
| 394 | |
| 395 /* There appears to be a bug in the cygwin conversion routines in | |
| 396 that they are not idempotent. */ | |
| 397 p = XSTRING_DATA (path); | |
| 398 if (isalpha (p[0]) && (IS_DEVICE_SEP (p[1]))) | |
| 399 return path; | |
| 400 | |
| 401 /* Use mule and cygwin-safe APIs top get at file data. */ | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
402 LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN (p, p); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
403 return build_istring (p); |
| 673 | 404 } |
| 405 #endif | |
| 406 | |
| 2526 | 407 struct read_link_hash |
| 408 { | |
| 409 Ibyte *resolved; | |
| 410 DWORD ticks; | |
| 411 }; | |
| 412 | |
| 413 static Ibyte * | |
| 414 mswindows_read_link_1 (const Ibyte *fname) | |
| 415 { | |
|
4879
c356806cc933
fix compile errors when --with-msw=no
Ben Wing <ben@xemacs.org>
parents:
4854
diff
changeset
|
416 #if defined (NO_CYGWIN_COM_SUPPORT) || !defined (HAVE_MS_WINDOWS) |
| 2526 | 417 return NULL; |
| 418 #else | |
| 419 Ibyte *retval = NULL; | |
| 420 Extbyte *fnameext; | |
| 421 HANDLE fh; | |
| 422 struct read_link_hash *rlh; | |
| 423 DWORD ticks; | |
| 424 | |
| 425 /* The call below to resolve a link is rather time-consuming. | |
| 426 I tried implementing a simple cache based on creation and write time | |
| 427 of the file, but that didn't help enough -- maybe 30% faster but still | |
| 428 a lot of time spent here. So just do something cheesy and don't | |
| 429 check again if we've recently (< a second) done so. */ | |
| 430 | |
| 431 if (!mswindows_read_link_hash) | |
| 432 mswindows_read_link_hash = make_string_hash_table (1000); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
433 fnameext = ITEXT_TO_TSTR (fname); |
| 2526 | 434 |
| 435 /* See if we can find a cached value. */ | |
| 436 | |
| 437 /* The intermediate cast fools gcc into not outputting strict-aliasing | |
| 438 complaints */ | |
| 439 ticks = GetTickCount (); | |
| 440 if (!gethash (fname, mswindows_read_link_hash, | |
| 441 (const void **) (void *) &rlh)) | |
| 442 { | |
| 443 rlh = xnew_and_zero (struct read_link_hash); | |
| 444 puthash (qxestrdup (fname), rlh, mswindows_read_link_hash); | |
| 445 } | |
| 446 else if (ticks - rlh->ticks < 1000) | |
| 447 { | |
| 448 return rlh->resolved ? qxestrdup (rlh->resolved) : NULL; | |
| 449 } | |
| 450 | |
| 451 rlh->ticks = ticks; | |
| 452 | |
| 453 /* Retrieve creation/write time of link file. */ | |
| 454 | |
| 455 /* No access rights required to get info. */ | |
| 456 if ((fh = qxeCreateFile (fnameext, 0, 0, NULL, OPEN_EXISTING, 0, NULL)) | |
| 457 == INVALID_HANDLE_VALUE) | |
| 458 { | |
| 459 CloseHandle (fh); | |
| 460 return NULL; | |
| 461 } | |
| 462 | |
| 463 CloseHandle (fh); | |
| 464 | |
| 465 /* #### | |
| 466 | |
| 467 Note the following in the docs: | |
| 468 | |
| 469 Note: The IShellLink interface has an ANSI version | |
| 470 (IShellLinkA) and a Unicode version (IShellLinkW). The | |
| 471 version that will be used depends on whether you compile | |
| 472 for ANSI or Unicode. However, Microsoft® Windows 95 and | |
| 473 Microsoft® Windows 98 only support IShellLinkA. | |
| 474 | |
| 475 We haven't yet implemented COM support in the | |
| 476 Unicode-splitting library. I don't quite understand how | |
| 477 COM works yet, but it looks like what's happening is | |
| 478 that the ShellLink class implements both the IShellLinkA | |
| 479 and IShellLinkW interfaces. To make this work at | |
| 480 run-time, we have to do something like this: | |
| 481 | |
| 482 -- define a new interface qxeIShellLink that uses | |
| 483 Extbyte * instead of LPSTR or LPWSTR. (not totally | |
| 484 necessary since Extbyte * == LPSTR). | |
| 485 | |
| 486 -- define a new class qxeShellLink that implements | |
| 487 qxeIShellLink. the methods on this class need to create | |
| 488 a shadow ShellLink object to do all the real work, and | |
| 489 call the corresponding function from either the | |
| 490 IShellLinkA or IShellLinkW interfaces on this object, | |
| 491 depending on whether XEUNICODE_P is defined. | |
| 492 | |
| 493 -- with appropriate preprocessor magic, of course, we | |
| 494 could make things appear transparent; but we've decided | |
| 495 not to do preprocessor magic for the moment. | |
| 496 */ | |
| 497 | |
| 498 /* #### Not Unicode-split for the moment; we have to do it | |
| 499 ourselves. */ | |
| 500 if (XEUNICODE_P) | |
| 501 { | |
| 502 IShellLinkW *psl; | |
| 503 | |
| 504 if (CoCreateInstance ( | |
| 505 XECOMID (CLSID_ShellLink), | |
| 506 NULL, | |
| 507 CLSCTX_INPROC_SERVER, | |
| 508 XECOMID (IID_IShellLinkW), | |
| 509 &VOIDP_CAST (psl)) == S_OK) | |
| 510 { | |
| 511 IPersistFile *ppf; | |
| 512 | |
| 513 if (XECOMCALL2 (psl, QueryInterface, | |
| 514 XECOMID (IID_IPersistFile), | |
| 515 &VOIDP_CAST (ppf)) == S_OK) | |
| 516 { | |
| 517 Extbyte *fname_unicode; | |
| 518 WIN32_FIND_DATAW wfd; | |
| 4854 | 519 LPWSTR resolved = alloca_array (WCHAR, PATH_MAX_TCHAR + 1); |
| 2526 | 520 |
| 521 /* Always Unicode. Not obvious from the | |
| 522 IPersistFile documentation, but look under | |
| 523 "Shell Link" for example code. */ | |
| 524 fname_unicode = fnameext; | |
| 525 | |
| 526 if (XECOMCALL2 (ppf, Load, | |
| 527 (LPWSTR) fname_unicode, | |
| 528 STGM_READ) == S_OK && | |
| 529 /* #### YUCK! Docs read | |
| 530 | |
| 531 cchMaxPath | |
| 532 | |
| 533 Maximum number of bytes to copy to the buffer pointed | |
| 534 to by the pszFile parameter. | |
| 535 | |
| 536 But "cch" means "count of characters", not bytes. | |
| 537 I'll assume the doc writers messed up and the | |
| 538 programmer was correct. Also, this approach is safe | |
| 539 even if it's actually the other way around. */ | |
| 540 #if defined (CYGWIN_HEADERS) && W32API_INSTALLED_VER < W32API_VER(2,2) | |
| 541 /* Another Cygwin prototype error, | |
| 542 fixed in v2.2 of w32api */ | |
| 543 XECOMCALL4 (psl, GetPath, (LPSTR) resolved, | |
| 4854 | 544 PATH_MAX_TCHAR, &wfd, 0) |
| 2526 | 545 #else |
| 546 XECOMCALL4 (psl, GetPath, resolved, | |
| 4854 | 547 PATH_MAX_TCHAR, &wfd, 0) |
| 2526 | 548 #endif |
| 549 == S_OK) | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
550 retval = TSTR_TO_ITEXT_MALLOC (resolved); |
| 2526 | 551 |
| 552 XECOMCALL0 (ppf, Release); | |
| 553 } | |
| 554 | |
| 555 XECOMCALL0 (psl, Release); | |
| 556 } | |
| 557 } | |
| 558 else | |
| 559 { | |
| 560 IShellLinkA *psl; | |
| 561 | |
| 562 if (CoCreateInstance ( | |
| 563 XECOMID (CLSID_ShellLink), | |
| 564 NULL, | |
| 565 CLSCTX_INPROC_SERVER, | |
| 566 XECOMID (IID_IShellLinkA), | |
| 567 &VOIDP_CAST (psl)) == S_OK) | |
| 568 { | |
| 569 IPersistFile *ppf; | |
| 570 | |
| 571 if (XECOMCALL2 (psl, QueryInterface, | |
| 572 XECOMID (IID_IPersistFile), | |
| 573 &VOIDP_CAST (ppf)) == S_OK) | |
| 574 { | |
| 575 Extbyte *fname_unicode; | |
| 576 WIN32_FIND_DATAA wfd; | |
| 4854 | 577 LPSTR resolved = alloca_array (CHAR, PATH_MAX_TCHAR + 1); |
| 2526 | 578 |
| 579 /* Always Unicode. Not obvious from the | |
| 580 IPersistFile documentation, but look under | |
| 581 "Shell Link" for example code. */ | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
582 fname_unicode = ITEXT_TO_EXTERNAL (fname, Qmswindows_unicode); |
| 2526 | 583 |
| 584 if (XECOMCALL2 (ppf, Load, | |
| 585 (LPWSTR) fname_unicode, | |
| 586 STGM_READ) == S_OK | |
| 587 && XECOMCALL4 (psl, GetPath, resolved, | |
| 4854 | 588 PATH_MAX_TCHAR, &wfd, 0) == S_OK) |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
589 retval = TSTR_TO_ITEXT_MALLOC (resolved); |
| 2526 | 590 |
| 591 XECOMCALL0 (ppf, Release); | |
| 592 } | |
| 593 | |
| 594 XECOMCALL0 (psl, Release); | |
| 595 } | |
| 596 } | |
| 597 | |
| 598 /* Cache newly found value */ | |
| 599 if (rlh->resolved) | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
600 xfree (rlh->resolved); |
| 2526 | 601 rlh->resolved = retval ? qxestrdup (retval) : NULL; |
| 602 | |
| 603 return retval; | |
| 604 #endif /* NO_CYGWIN_COM_SUPPORT */ | |
| 605 } | |
| 606 | |
| 607 /* Resolve a file that may be a shortcut. Accepts either a file ending | |
| 608 with .LNK or without the ending. If a shortcut is found, returns | |
| 609 a value that you must xfree(); otherwise NULL. */ | |
| 610 | |
| 611 Ibyte * | |
| 612 mswindows_read_link (const Ibyte *fname) | |
| 613 { | |
| 614 int len = qxestrlen (fname); | |
| 615 if (len > 4 && !qxestrcasecmp_ascii (fname + len - 4, ".LNK")) | |
| 616 return mswindows_read_link_1 (fname); | |
| 617 else | |
| 618 { | |
| 619 DECLARE_EISTRING (name2); | |
| 620 | |
| 621 eicpy_rawz (name2, fname); | |
| 622 eicat_ascii (name2, ".LNK"); | |
| 623 return mswindows_read_link_1 (eidata (name2)); | |
| 624 } | |
| 625 } | |
| 626 | |
| 627 | |
| 613 | 628 #if defined (WIN32_NATIVE) || defined (CYGWIN_BROKEN_SIGNALS) |
| 629 | |
| 630 /* setitimer() does not exist on native MS Windows, and appears broken | |
| 631 on Cygwin (random lockups when BROKEN_SIGIO is defined), so we | |
| 632 emulate in both cases by using multimedia timers. Furthermore, | |
| 633 the lockups still occur on Cygwin even when we do nothing but | |
| 634 use the standard signalling mechanism -- so we have to emulate | |
| 635 that, too. (But only for timeouts -- we have to use the standard | |
| 636 mechanism for SIGCHLD. Yuck.) | |
| 637 */ | |
| 638 | |
| 639 /*--------------------------------------------------------------------*/ | |
| 640 /* Signal support */ | |
| 641 /*--------------------------------------------------------------------*/ | |
| 642 | |
| 643 #define sigmask(nsig) (1U << nsig) | |
| 644 | |
| 645 /* We can support as many signals as fit into word */ | |
| 646 #define SIG_MAX 32 | |
| 647 | |
| 648 /* Signal handlers. Initial value = 0 = SIG_DFL */ | |
| 649 static mswindows_sighandler signal_handlers[SIG_MAX] = {0}; | |
| 650 | |
| 651 /* Signal block mask: bit set to 1 means blocked */ | |
| 652 unsigned signal_block_mask = 0; | |
| 653 | |
| 654 /* Signal pending mask: bit set to 1 means sig is pending */ | |
| 655 unsigned signal_pending_mask = 0; | |
| 656 | |
| 657 mswindows_sighandler | |
| 658 mswindows_sigset (int nsig, mswindows_sighandler handler) | |
| 659 { | |
| 660 /* We delegate some signals to the system function */ | |
| 661 if (nsig == SIGFPE || nsig == SIGABRT || nsig == SIGINT) | |
| 662 return signal (nsig, handler); | |
| 663 | |
| 664 if (nsig < 0 || nsig > SIG_MAX) | |
| 665 { | |
| 666 errno = EINVAL; | |
| 667 return NULL; | |
| 668 } | |
| 669 | |
| 670 /* Store handler ptr */ | |
| 671 { | |
| 672 mswindows_sighandler old_handler = signal_handlers[nsig]; | |
| 673 signal_handlers[nsig] = handler; | |
| 674 return old_handler; | |
| 675 } | |
| 676 } | |
| 677 | |
| 678 int | |
| 679 mswindows_sighold (int nsig) | |
| 680 { | |
| 681 if (nsig < 0 || nsig > SIG_MAX) | |
| 682 return errno = EINVAL; | |
| 683 | |
| 684 signal_block_mask |= sigmask (nsig); | |
| 685 return 0; | |
| 686 } | |
| 687 | |
| 688 int | |
| 689 mswindows_sigrelse (int nsig) | |
| 690 { | |
| 691 if (nsig < 0 || nsig > SIG_MAX) | |
| 692 return errno = EINVAL; | |
| 693 | |
| 694 signal_block_mask &= ~sigmask (nsig); | |
| 695 | |
| 696 if (signal_pending_mask & sigmask (nsig)) | |
| 697 mswindows_raise (nsig); | |
| 698 | |
| 699 return 0; | |
| 700 } | |
| 701 | |
| 702 int | |
| 2286 | 703 mswindows_sigpause (int UNUSED (nsig)) |
| 613 | 704 { |
| 705 /* This is currently not called, because the only call to sigpause | |
| 706 inside XEmacs is with SIGCHLD parameter. Just in case, we put an | |
| 2286 | 707 assert here, so anyone who adds a call to sigpause will be surprised |
| 613 | 708 (or surprise someone else...) */ |
| 709 assert (0); | |
| 710 return 0; | |
| 711 } | |
| 712 | |
| 713 int | |
| 714 mswindows_raise (int nsig) | |
| 715 { | |
| 716 /* We delegate some raises to the system routine */ | |
| 717 if (nsig == SIGFPE || nsig == SIGABRT || nsig == SIGINT) | |
| 718 return raise (nsig); | |
| 719 | |
| 720 if (nsig < 0 || nsig > SIG_MAX) | |
| 721 return errno = EINVAL; | |
| 722 | |
| 723 /* If the signal is blocked, remember to issue later */ | |
| 724 if (signal_block_mask & sigmask (nsig)) | |
| 725 { | |
| 726 signal_pending_mask |= sigmask (nsig); | |
| 727 return 0; | |
| 728 } | |
| 729 | |
| 730 if (signal_handlers[nsig] == SIG_IGN) | |
| 731 return 0; | |
| 732 | |
| 733 if (signal_handlers[nsig] != SIG_DFL) | |
| 734 { | |
| 735 (*signal_handlers[nsig]) (nsig); | |
| 736 return 0; | |
| 737 } | |
| 738 | |
| 739 /* Default signal actions */ | |
| 740 if (nsig == SIGALRM || nsig == SIGPROF) | |
| 741 exit (3); | |
| 742 | |
| 743 /* Other signals are ignored by default */ | |
| 744 return 0; | |
| 745 } | |
| 746 | |
| 611 | 747 |
| 748 /*--------------------------------------------------------------------*/ | |
| 749 /* Async timers */ | |
| 750 /*--------------------------------------------------------------------*/ | |
| 751 | |
| 752 /* We emulate two timers, one for SIGALRM, another for SIGPROF. | |
| 753 | |
| 754 itimerproc() function has an implementation limitation: it does | |
| 755 not allow to set *both* interval and period. If an attempt is | |
| 756 made to set both, and then they are unequal, the function | |
| 757 asserts. | |
| 758 | |
| 759 Minimum timer resolution on Win32 systems varies, and is greater | |
| 760 than or equal than 1 ms. The resolution is always wrapped not to | |
| 761 attempt to get below the system defined limit. | |
| 762 */ | |
| 763 | |
| 764 /* Timer precision, denominator of one fraction: for 100 ms | |
| 765 interval, request 10 ms precision | |
| 766 */ | |
| 767 const int setitimer_helper_timer_prec = 10; | |
| 768 | |
| 769 /* Last itimervals, as set by calls to setitimer */ | |
| 770 static struct itimerval it_alarm; | |
| 771 static struct itimerval it_prof; | |
| 772 | |
| 773 /* Timer IDs as returned by MM */ | |
| 774 MMRESULT tid_alarm = 0; | |
| 775 MMRESULT tid_prof = 0; | |
| 776 | |
| 777 static void CALLBACK | |
| 2286 | 778 setitimer_helper_proc (UINT UNUSED (uID), UINT UNUSED (uMsg), DWORD dwUser, |
| 779 DWORD UNUSED (dw1), DWORD UNUSED (dw2)) | |
| 611 | 780 { |
| 781 /* Just raise the signal indicated by the dwUser parameter */ | |
| 782 mswindows_raise (dwUser); | |
| 783 } | |
| 784 | |
| 785 /* Divide time in ms specified by IT by DENOM. Return 1 ms | |
| 786 if division results in zero */ | |
| 787 static UINT | |
| 853 | 788 setitimer_helper_period (const struct itimerval *it, UINT denom) |
| 611 | 789 { |
| 790 static TIMECAPS time_caps; | |
| 791 | |
| 792 UINT res; | |
| 853 | 793 const struct timeval *tv = |
| 611 | 794 (it->it_value.tv_sec == 0 && it->it_value.tv_usec == 0) |
| 795 ? &it->it_interval : &it->it_value; | |
| 796 | |
| 797 /* Zero means stop timer */ | |
| 798 if (tv->tv_sec == 0 && tv->tv_usec == 0) | |
| 799 return 0; | |
| 800 | |
| 801 /* Convert to ms and divide by denom */ | |
| 802 res = (tv->tv_sec * 1000 + (tv->tv_usec + 500) / 1000) / denom; | |
| 803 | |
| 804 /* Converge to minimum timer resolution */ | |
| 805 if (time_caps.wPeriodMin == 0) | |
| 806 timeGetDevCaps (&time_caps, sizeof(time_caps)); | |
| 807 | |
| 808 if (res < time_caps.wPeriodMin) | |
| 809 res = time_caps.wPeriodMin; | |
| 810 | |
| 811 return res; | |
| 812 } | |
| 813 | |
| 814 static int | |
| 853 | 815 setitimer_helper (const struct itimerval *itnew, |
| 816 struct itimerval *itold, struct itimerval *itcurrent, | |
| 817 MMRESULT *tid, DWORD sigkind) | |
| 611 | 818 { |
| 819 UINT delay, resolution, event_type; | |
| 820 | |
| 821 /* First stop the old timer */ | |
| 822 if (*tid) | |
| 823 { | |
| 824 timeKillEvent (*tid); | |
| 825 timeEndPeriod (setitimer_helper_period (itcurrent, | |
| 826 setitimer_helper_timer_prec)); | |
| 827 *tid = 0; | |
| 828 } | |
| 829 | |
| 830 /* Return old itimerval if requested */ | |
| 831 if (itold) | |
| 832 *itold = *itcurrent; | |
| 833 | |
| 834 *itcurrent = *itnew; | |
| 835 | |
| 836 /* Determine if to start new timer */ | |
| 837 delay = setitimer_helper_period (itnew, 1); | |
| 838 if (delay) | |
| 839 { | |
| 840 resolution = setitimer_helper_period (itnew, | |
| 841 setitimer_helper_timer_prec); | |
| 842 event_type = (itnew->it_value.tv_sec == 0 && | |
| 843 itnew->it_value.tv_usec == 0) | |
| 844 ? TIME_ONESHOT : TIME_PERIODIC; | |
| 845 timeBeginPeriod (resolution); | |
| 846 *tid = timeSetEvent (delay, resolution, setitimer_helper_proc, sigkind, | |
| 847 event_type); | |
| 848 } | |
| 849 | |
| 850 return !delay || *tid; | |
| 851 } | |
| 852 | |
| 853 int | |
| 854 mswindows_setitimer (int kind, const struct itimerval *itnew, | |
| 855 struct itimerval *itold) | |
| 856 { | |
| 857 /* In this version, both interval and value are allowed | |
| 858 only if they are equal. */ | |
| 859 assert ((itnew->it_value.tv_sec == 0 && itnew->it_value.tv_usec == 0) | |
| 860 || (itnew->it_interval.tv_sec == 0 && | |
| 861 itnew->it_interval.tv_usec == 0) | |
| 862 || (itnew->it_value.tv_sec == itnew->it_interval.tv_sec && | |
| 863 itnew->it_value.tv_usec == itnew->it_interval.tv_usec)); | |
| 864 | |
| 865 if (kind == ITIMER_REAL) | |
| 866 return setitimer_helper (itnew, itold, &it_alarm, &tid_alarm, SIGALRM); | |
| 867 else if (kind == ITIMER_PROF) | |
| 868 return setitimer_helper (itnew, itold, &it_prof, &tid_prof, SIGPROF); | |
| 869 else | |
| 870 return errno = EINVAL; | |
| 871 } | |
| 872 | |
| 613 | 873 #endif /* defined (WIN32_NATIVE) || defined (CYGWIN_BROKEN_SIGNALS) */ |
| 874 | |
| 611 | 875 |
| 442 | 876 void |
| 877 syms_of_win32 (void) | |
| 878 { | |
| 879 DEFSUBR (Fmswindows_shell_execute); | |
| 673 | 880 #ifdef CYGWIN |
| 881 DEFSUBR (Fmswindows_cygwin_to_win32_path); | |
| 882 #endif | |
| 442 | 883 } |
| 884 | |
| 885 void | |
| 771 | 886 vars_of_win32 (void) |
| 887 { | |
| 2526 | 888 DEFVAR_LISP ("mswindows-downcase-file-names", |
| 889 &Vmswindows_downcase_file_names /* | |
| 771 | 890 Non-nil means convert all-upper case file names to lower case. |
| 891 This applies when performing completions and file name expansion. | |
| 892 */ ); | |
| 893 Vmswindows_downcase_file_names = Qnil; | |
| 2526 | 894 |
| 895 DEFVAR_BOOL ("mswindows-shortcuts-are-symlinks", | |
| 896 &mswindows_shortcuts_are_symlinks /* | |
| 897 Non-nil means shortcuts (.LNK files) are treated as symbolic links. | |
| 898 This works also for symlinks created under Cygwin, because they use .LNK | |
| 899 files to implement symbolic links. | |
| 900 */ ); | |
| 901 mswindows_shortcuts_are_symlinks = 1; | |
| 771 | 902 } |
| 903 | |
| 904 void | |
| 442 | 905 init_win32 (void) |
| 906 { | |
| 907 init_potentially_nonexistent_functions (); | |
| 908 } | |
| 771 | 909 |
| 910 void | |
| 2367 | 911 init_win32_very_very_early (void) |
| 771 | 912 { |
| 913 mswindows_windows9x_p = GetVersion () & 0x80000000; | |
| 914 } |