Mercurial > hg > xemacs-beta

comparison src/process-nt.c @ 355:182f72e8cd0d r21-1-7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-7
author cvs
date Mon, 13 Aug 2007 10:56:21 +0200
parents 4f79e16b1112
children 8e84bee8ddd0
comparison
equal deleted inserted replaced
354:3729bef672e0 355:182f72e8cd0d
401 * The method must return PID of the new proces, a (positive??? ####) number 401 * The method must return PID of the new proces, a (positive??? ####) number
402 * which fits into Lisp_Int. No return value indicates an error, the method 402 * which fits into Lisp_Int. No return value indicates an error, the method
403 * must signal an error instead. 403 * must signal an error instead.
404 */ 404 */
405 405
406 /* #### This function completely ignores Vprocess_environment */
407
408 static void 406 static void
409 signal_cannot_launch (Lisp_Object image_file, DWORD err) 407 signal_cannot_launch (Lisp_Object image_file, DWORD err)
410 { 408 {
411 mswindows_set_errno (err); 409 mswindows_set_errno (err);
412 signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno)); 410 signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno));
418 Lisp_Object program, Lisp_Object cur_dir) 416 Lisp_Object program, Lisp_Object cur_dir)
419 { 417 {
420 HANDLE hmyshove, hmyslurp, hprocin, hprocout; 418 HANDLE hmyshove, hmyslurp, hprocin, hprocout;
421 LPTSTR command_line; 419 LPTSTR command_line;
422 BOOL do_io, windowed; 420 BOOL do_io, windowed;
421 char *proc_env;
423 422
424 /* Find out whether the application is windowed or not */ 423 /* Find out whether the application is windowed or not */
425 { 424 {
426 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most 425 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
427 errors. This leads to bogus error message. */ 426 errors. This leads to bogus error message. */
505 strcat (command_line, XSTRING_DATA (args_or_ret)); 504 strcat (command_line, XSTRING_DATA (args_or_ret));
506 505
507 UNGCPRO; /* args_or_ret */ 506 UNGCPRO; /* args_or_ret */
508 } 507 }
509 508
509 /* Set `proc_env' to a nul-separated array of the strings in
510 Vprocess_environment terminated by 2 nuls. */
511
512 {
513 extern int compare_env (const char **strp1, const char **strp2);
514 char **env;
515 REGISTER Lisp_Object tem;
516 REGISTER char **new_env;
517 REGISTER int new_length = 0, i, new_space;
518 char *penv;
519
520 for (tem = Vprocess_environment;
521 (CONSP (tem)
522 && STRINGP (XCAR (tem)));
523 tem = XCDR (tem))
524 new_length++;
525
526 /* new_length + 1 to include terminating 0. */
527 env = new_env = alloca_array (char *, new_length + 1);
528
529 /* Copy the Vprocess_environment strings into new_env. */
530 for (tem = Vprocess_environment;
531 (CONSP (tem)
532 && STRINGP (XCAR (tem)));
533 tem = XCDR (tem))
534 {
535 char **ep = env;
536 char *string = (char *) XSTRING_DATA (XCAR (tem));
537 /* See if this string duplicates any string already in the env.
538 If so, don't put it in.
539 When an env var has multiple definitions,
540 we keep the definition that comes first in process-environment. */
541 for (; ep != new_env; ep++)
542 {
543 char *p = *ep, *q = string;
544 while (1)
545 {
546 if (*q == 0)
547 /* The string is malformed; might as well drop it. */
548 goto duplicate;
549 if (*q != *p)
550 break;
551 if (*q == '=')
552 goto duplicate;
553 p++, q++;
554 }
555 }
556 *new_env++ = string;
557 duplicate: ;
558 }
559 *new_env = 0;
560
561 /* Sort the environment variables */
562 new_length = new_env - env;
563 qsort (env, new_length, sizeof (char *), compare_env);
564
565 /* Work out how much space to allocate */
566 new_space = 0;
567 for (i = 0; i < new_length; i++)
568 {
569 new_space += strlen(env[i]) + 1;
570 }
571 new_space++;
572
573 /* Allocate space and copy variables into it */
574 penv = proc_env = alloca(new_space);
575 for (i = 0; i < new_length; i++)
576 {
577 strcpy(penv, env[i]);
578 penv += strlen(env[i]) + 1;
579 }
580 *penv = 0;
581 }
582
510 /* Create process */ 583 /* Create process */
511 { 584 {
512 STARTUPINFO si; 585 STARTUPINFO si;
513 PROCESS_INFORMATION pi; 586 PROCESS_INFORMATION pi;
514 DWORD err; 587 DWORD err;
525 } 598 }
526 599
527 err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, 600 err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE,
528 CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP 601 CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP
529 | CREATE_SUSPENDED, 602 | CREATE_SUSPENDED,
530 NULL, (char *) XSTRING_DATA (cur_dir), &si, &pi) 603 proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi)
531 ? 0 : GetLastError ()); 604 ? 0 : GetLastError ());
532 605
533 if (do_io) 606 if (do_io)
534 { 607 {
535 /* These just have been inherited; we do not need a copy */ 608 /* These just have been inherited; we do not need a copy */