Mercurial > hg > xemacs-beta
comparison src/callproc.c @ 432:3a7e78e1142d r21-2-24
Import from CVS: tag r21-2-24
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:29:58 +0200 |
parents | a5df635868b2 |
children | 8de8e3f6228a |
comparison
equal
deleted
inserted
replaced
431:a97165e56215 | 432:3a7e78e1142d |
---|---|
102 static Lisp_Object | 102 static Lisp_Object |
103 call_process_cleanup (Lisp_Object fdpid) | 103 call_process_cleanup (Lisp_Object fdpid) |
104 { | 104 { |
105 int fd = XINT (Fcar (fdpid)); | 105 int fd = XINT (Fcar (fdpid)); |
106 int pid = XINT (Fcdr (fdpid)); | 106 int pid = XINT (Fcdr (fdpid)); |
107 #ifdef WINDOWSNT | |
108 HANDLE pHandle; | |
109 #endif | |
107 | 110 |
108 if (!call_process_exited && | 111 if (!call_process_exited && |
109 EMACS_KILLPG (pid, SIGINT) == 0) | 112 EMACS_KILLPG (pid, SIGINT) == 0) |
110 { | 113 { |
111 int speccount = specpdl_depth (); | 114 int speccount = specpdl_depth (); |
112 | 115 |
113 record_unwind_protect (call_process_kill, fdpid); | 116 record_unwind_protect (call_process_kill, fdpid); |
114 /* #### "c-G" -- need non-consing Single-key-description */ | 117 /* #### "c-G" -- need non-consing Single-key-description */ |
115 message ("Waiting for process to die...(type C-g again to kill it instantly)"); | 118 message ("Waiting for process to die...(type C-g again to kill it instantly)"); |
116 | 119 |
120 #ifdef WINDOWSNT | |
121 pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid); | |
122 if (pHandle == NULL) | |
123 { | |
124 warn_when_safe (Qprocess, Qwarning, | |
125 "cannot open process (PID %d) for cleanup", pid); | |
126 } | |
127 wait_for_termination (pHandle); | |
128 #else | |
117 wait_for_termination (pid); | 129 wait_for_termination (pid); |
130 #endif | |
118 | 131 |
119 /* "Discard" the unwind protect. */ | 132 /* "Discard" the unwind protect. */ |
120 XCAR (fdpid) = Qnil; | 133 XCAR (fdpid) = Qnil; |
121 XCDR (fdpid) = Qnil; | 134 XCDR (fdpid) = Qnil; |
122 unbind_to (speccount, Qnil); | 135 unbind_to (speccount, Qnil); |
168 { | 181 { |
169 /* This function can GC */ | 182 /* This function can GC */ |
170 Lisp_Object infile, buffer, current_dir, display, path; | 183 Lisp_Object infile, buffer, current_dir, display, path; |
171 int fd[2]; | 184 int fd[2]; |
172 int filefd; | 185 int filefd; |
186 #ifdef WINDOWSNT | |
187 HANDLE pHandle; | |
188 #endif | |
173 int pid; | 189 int pid; |
174 char buf[16384]; | 190 char buf[16384]; |
175 char *bufptr = buf; | 191 char *bufptr = buf; |
176 int bufsize = 16384; | 192 int bufsize = 16384; |
177 int speccount = specpdl_depth (); | 193 int speccount = specpdl_depth (); |
357 | 373 |
358 fork_error = Qnil; | 374 fork_error = Qnil; |
359 #ifdef WINDOWSNT | 375 #ifdef WINDOWSNT |
360 pid = child_setup (filefd, fd1, fd_error, new_argv, | 376 pid = child_setup (filefd, fd1, fd_error, new_argv, |
361 (char *) XSTRING_DATA (current_dir)); | 377 (char *) XSTRING_DATA (current_dir)); |
378 if (!INTP (buffer)) | |
379 { | |
380 /* OpenProcess() as soon after child_setup as possible. It's too | |
381 late once the process terminated. */ | |
382 pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid); | |
383 #if 0 | |
384 if (pHandle == NULL) | |
385 { | |
386 /* #### seems to cause crash in unbind_to(...) below. APA */ | |
387 warn_when_safe (Qprocess, Qwarning, | |
388 "cannot open process to wait for"); | |
389 } | |
390 #endif | |
391 } | |
392 /* Close STDERR into the parent process. We no longer need it. */ | |
393 if (fd_error >= 0) | |
394 close (fd_error); | |
362 #else /* not WINDOWSNT */ | 395 #else /* not WINDOWSNT */ |
363 pid = fork (); | 396 pid = fork (); |
364 | 397 |
365 if (pid == 0) | 398 if (pid == 0) |
366 { | 399 { |
392 } | 425 } |
393 | 426 |
394 if (!NILP (fork_error)) | 427 if (!NILP (fork_error)) |
395 signal_error (Qfile_error, fork_error); | 428 signal_error (Qfile_error, fork_error); |
396 | 429 |
430 #ifndef WINDOWSNT | |
397 if (pid < 0) | 431 if (pid < 0) |
398 { | 432 { |
399 if (fd[0] >= 0) | 433 if (fd[0] >= 0) |
400 close (fd[0]); | 434 close (fd[0]); |
401 report_file_error ("Doing fork", Qnil); | 435 report_file_error ("Doing fork", Qnil); |
402 } | 436 } |
437 #endif | |
403 | 438 |
404 if (INTP (buffer)) | 439 if (INTP (buffer)) |
405 { | 440 { |
406 if (fd[0] >= 0) | 441 if (fd[0] >= 0) |
407 close (fd[0]); | 442 close (fd[0]); |
505 Lstream_close (XLSTREAM (instream)); | 540 Lstream_close (XLSTREAM (instream)); |
506 NUNGCPRO; | 541 NUNGCPRO; |
507 | 542 |
508 QUIT; | 543 QUIT; |
509 /* Wait for it to terminate, unless it already has. */ | 544 /* Wait for it to terminate, unless it already has. */ |
545 #ifdef WINDOWSNT | |
546 wait_for_termination (pHandle); | |
547 #else | |
510 wait_for_termination (pid); | 548 wait_for_termination (pid); |
549 #endif | |
511 | 550 |
512 /* Don't kill any children that the subprocess may have left behind | 551 /* Don't kill any children that the subprocess may have left behind |
513 when exiting. */ | 552 when exiting. */ |
514 call_process_exited = 1; | 553 call_process_exited = 1; |
515 unbind_to (speccount, Qnil); | 554 unbind_to (speccount, Qnil); |