Mercurial > hg > xemacs-beta

comparison src/process-nt.c @ 424:11054d720c21 r21-2-20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 697ef44129c6
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
407 * The method must return PID of the new process, a (positive??? ####) number 407 * The method must return PID of the new process, a (positive??? ####) number
408 * which fits into Lisp_Int. No return value indicates an error, the method 408 * which fits into Lisp_Int. No return value indicates an error, the method
409 * must signal an error instead. 409 * must signal an error instead.
410 */ 410 */
411 411
412 /* #### This function completely ignores Vprocess_environment */
413
414 static void 412 static void
415 signal_cannot_launch (Lisp_Object image_file, DWORD err) 413 signal_cannot_launch (Lisp_Object image_file, DWORD err)
416 { 414 {
417 mswindows_set_errno (err); 415 mswindows_set_errno (err);
418 signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno)); 416 signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno));
424 Lisp_Object program, Lisp_Object cur_dir) 422 Lisp_Object program, Lisp_Object cur_dir)
425 { 423 {
426 HANDLE hmyshove, hmyslurp, hprocin, hprocout; 424 HANDLE hmyshove, hmyslurp, hprocin, hprocout;
427 LPTSTR command_line; 425 LPTSTR command_line;
428 BOOL do_io, windowed; 426 BOOL do_io, windowed;
427 char *proc_env;
429 428
430 /* Find out whether the application is windowed or not */ 429 /* Find out whether the application is windowed or not */
431 { 430 {
432 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most 431 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
433 errors. This leads to bogus error message. */ 432 errors. This leads to bogus error message. */
511 strcat (command_line, XSTRING_DATA (args_or_ret)); 510 strcat (command_line, XSTRING_DATA (args_or_ret));
512 511
513 UNGCPRO; /* args_or_ret */ 512 UNGCPRO; /* args_or_ret */
514 } 513 }
515 514
515 /* Set `proc_env' to a nul-separated array of the strings in
516 Vprocess_environment terminated by 2 nuls. */
517
518 {
519 extern int compare_env (const char **strp1, const char **strp2);
520 char **env;
521 REGISTER Lisp_Object tem;
522 REGISTER char **new_env;
523 REGISTER int new_length = 0, i, new_space;
524 char *penv;
525
526 for (tem = Vprocess_environment;
527 (CONSP (tem)
528 && STRINGP (XCAR (tem)));
529 tem = XCDR (tem))
530 new_length++;
531
532 /* new_length + 1 to include terminating 0. */
533 env = new_env = alloca_array (char *, new_length + 1);
534
535 /* Copy the Vprocess_environment strings into new_env. */
536 for (tem = Vprocess_environment;
537 (CONSP (tem)
538 && STRINGP (XCAR (tem)));
539 tem = XCDR (tem))
540 {
541 char **ep = env;
542 char *string = (char *) XSTRING_DATA (XCAR (tem));
543 /* See if this string duplicates any string already in the env.
544 If so, don't put it in.
545 When an env var has multiple definitions,
546 we keep the definition that comes first in process-environment. */
547 for (; ep != new_env; ep++)
548 {
549 char *p = *ep, *q = string;
550 while (1)
551 {
552 if (*q == 0)
553 /* The string is malformed; might as well drop it. */
554 goto duplicate;
555 if (*q != *p)
556 break;
557 if (*q == '=')
558 goto duplicate;
559 p++, q++;
560 }
561 }
562 *new_env++ = string;
563 duplicate: ;
564 }
565 *new_env = 0;
566
567 /* Sort the environment variables */
568 new_length = new_env - env;
569 qsort (env, new_length, sizeof (char *), compare_env);
570
571 /* Work out how much space to allocate */
572 new_space = 0;
573 for (i = 0; i < new_length; i++)
574 {
575 new_space += strlen(env[i]) + 1;
576 }
577 new_space++;
578
579 /* Allocate space and copy variables into it */
580 penv = proc_env = alloca(new_space);
581 for (i = 0; i < new_length; i++)
582 {
583 strcpy(penv, env[i]);
584 penv += strlen(env[i]) + 1;
585 }
586 *penv = 0;
587 }
588
516 /* Create process */ 589 /* Create process */
517 { 590 {
518 STARTUPINFO si; 591 STARTUPINFO si;
519 PROCESS_INFORMATION pi; 592 PROCESS_INFORMATION pi;
520 DWORD err; 593 DWORD err;
531 } 604 }
532 605
533 err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, 606 err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE,
534 CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP 607 CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP
535 | CREATE_SUSPENDED, 608 | CREATE_SUSPENDED,
536 NULL, (char *) XSTRING_DATA (cur_dir), &si, &pi) 609 proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi)
537 ? 0 : GetLastError ()); 610 ? 0 : GetLastError ());
538 611
539 if (do_io) 612 if (do_io)
540 { 613 {
541 /* These just have been inherited; we do not need a copy */ 614 /* These just have been inherited; we do not need a copy */
832 connection has no PID; you cannot signal it. All you can do is 905 connection has no PID; you cannot signal it. All you can do is
833 deactivate and close it via delete-process */ 906 deactivate and close it via delete-process */
834 907
835 static void 908 static void
836 nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, 909 nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
837 Lisp_Object family, void** vinfd, void** voutfd) 910 Lisp_Object protocol, void** vinfd, void** voutfd)
838 { 911 {
839 struct sockaddr_in address; 912 struct sockaddr_in address;
840 SOCKET s; 913 SOCKET s;
841 int port; 914 int port;
842 int retval; 915 int retval;
843 916
844 CHECK_STRING (host); 917 CHECK_STRING (host);
845 918
846 if (!EQ (family, Qtcpip)) 919 if (!EQ (protocol, Qtcp))
847 error ("Unsupported protocol family \"%s\"", 920 error ("Unsupported protocol \"%s\"",
848 string_data (symbol_name (XSYMBOL (family)))); 921 string_data (symbol_name (XSYMBOL (protocol))));
849 922
850 if (INTP (service)) 923 if (INTP (service))
851 port = htons ((unsigned short) XINT (service)); 924 port = htons ((unsigned short) XINT (service));
852 else 925 else
853 { 926 {