comparison src/callproc.c @ 169:15872534500d r20-3b11

Import from CVS: tag r20-3b11
author cvs
date Mon, 13 Aug 2007 09:46:53 +0200
parents 85ec50267440
children 6075d714658b
comparison
equal deleted inserted replaced
168:9851d5c6556e 169:15872534500d
184 char buf[16384]; 184 char buf[16384];
185 char *bufptr = buf; 185 char *bufptr = buf;
186 int bufsize = 16384; 186 int bufsize = 16384;
187 int speccount = specpdl_depth (); 187 int speccount = specpdl_depth ();
188 struct gcpro gcpro1; 188 struct gcpro gcpro1;
189 char **new_argv 189 char **new_argv = (char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
190 = (char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
191 190
192 /* File to use for stderr in the child. 191 /* File to use for stderr in the child.
193 t means use same as standard output. */ 192 t means use same as standard output. */
194 Lisp_Object error_file; 193 Lisp_Object error_file;
195 #ifdef MSDOS 194 #ifdef MSDOS
214 /* Make sure that the child will be able to chdir to the current 213 /* Make sure that the child will be able to chdir to the current
215 buffer's current directory, or its unhandled equivalent. We 214 buffer's current directory, or its unhandled equivalent. We
216 can't just have the child check for an error when it does the 215 can't just have the child check for an error when it does the
217 chdir, since it's in a vfork. */ 216 chdir, since it's in a vfork. */
218 { 217 {
219 struct gcpro gcpro1, gcpro2; 218 struct gcpro ngcpro1, ngcpro2;
220 /* Do this test before building new_argv because GC in Lisp code 219 /* Do this test before building new_argv because GC in Lisp code
221 * called by various filename-hacking routines might relocate strings */ 220 * called by various filename-hacking routines might relocate strings */
222 /* Make sure that the child will be able to chdir to the current 221 /* Make sure that the child will be able to chdir to the current
223 buffer's current directory. We can't just have the child check 222 buffer's current directory. We can't just have the child check
224 for an error when it does the chdir, since it's in a vfork. */ 223 for an error when it does the chdir, since it's in a vfork. */
225 224
226 GCPRO2 (current_dir, path); /* Caller gcprotects args[] */ 225 NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */
227 current_dir = current_buffer->directory; 226 current_dir = current_buffer->directory;
228 current_dir = Funhandled_file_name_directory (current_dir); 227 current_dir = Funhandled_file_name_directory (current_dir);
229 current_dir = expand_and_dir_to_file (current_dir, Qnil); 228 current_dir = expand_and_dir_to_file (current_dir, Qnil);
230 #if 0 229 #if 0
231 /* I don't know how RMS intends this crock of shit to work, but it 230 /* I don't know how RMS intends this crock of shit to work, but it
233 fuck it. */ 232 fuck it. */
234 if (NILP (Ffile_accessible_directory_p (current_dir))) 233 if (NILP (Ffile_accessible_directory_p (current_dir)))
235 report_file_error ("Setting current directory", 234 report_file_error ("Setting current directory",
236 Fcons (current_buffer->directory, Qnil)); 235 Fcons (current_buffer->directory, Qnil));
237 #endif /* 0 */ 236 #endif /* 0 */
238 UNGCPRO; 237 NUNGCPRO;
239 } 238 }
240 239
241 if (nargs >= 2 && ! NILP (args[1])) 240 if (nargs >= 2 && ! NILP (args[1]))
242 { 241 {
243 struct gcpro gcpro1; 242 struct gcpro ngcpro1;
244 GCPRO1 (current_buffer->directory); 243 NGCPRO1 (current_buffer->directory);
245 infile = Fexpand_file_name (args[1], current_buffer->directory); 244 infile = Fexpand_file_name (args[1], current_buffer->directory);
246 UNGCPRO; 245 NUNGCPRO;
247 CHECK_STRING (infile); 246 CHECK_STRING (infile);
248 } 247 }
249 else 248 else
250 infile = build_string (NULL_DEVICE); 249 infile = build_string (NULL_DEVICE);
251 250
451 report_file_error ("Cannot open", Fcons(error_file, Qnil)); 450 report_file_error ("Cannot open", Fcons(error_file, Qnil));
452 } 451 }
453 452
454 fork_error = Qnil; 453 fork_error = Qnil;
455 #ifdef WINDOWSNT 454 #ifdef WINDOWSNT
456 pid = child_setup (filefd, fd1, fd_error, new_argv, current_dir); 455 pid = child_setup (filefd, fd1, fd_error, new_argv,
456 (char *) XSTRING_DATA (current_dir));
457 #else /* not WINDOWSNT */ 457 #else /* not WINDOWSNT */
458 pid = fork (); 458 pid = fork ();
459 459
460 if (pid == 0) 460 if (pid == 0)
461 { 461 {
515 { 515 {
516 int nread; 516 int nread;
517 int first = 1; 517 int first = 1;
518 int total_read = 0; 518 int total_read = 0;
519 Lisp_Object instream; 519 Lisp_Object instream;
520 struct gcpro gcpro1; 520 struct gcpro ngcpro1;
521 521
522 /* Enable sending signal if user quits below. */ 522 /* Enable sending signal if user quits below. */
523 call_process_exited = 0; 523 call_process_exited = 0;
524 524
525 #ifdef MSDOS 525 #ifdef MSDOS
542 make_decoding_input_stream 542 make_decoding_input_stream
543 (XLSTREAM (instream), 543 (XLSTREAM (instream),
544 Fget_coding_system (Vcoding_system_for_read)); 544 Fget_coding_system (Vcoding_system_for_read));
545 Lstream_set_character_mode (XLSTREAM (instream)); 545 Lstream_set_character_mode (XLSTREAM (instream));
546 #endif /* MULE */ 546 #endif /* MULE */
547 GCPRO1 (instream); 547 NGCPRO1 (instream);
548 while (1) 548 while (1)
549 { 549 {
550 QUIT; 550 QUIT;
551 /* Repeatedly read until we've filled as much as possible 551 /* Repeatedly read until we've filled as much as possible
552 of the buffer size we have. But don't read 552 of the buffer size we have. But don't read
594 redisplay (); 594 redisplay ();
595 } 595 }
596 } 596 }
597 give_up: 597 give_up:
598 Lstream_close (XLSTREAM (instream)); 598 Lstream_close (XLSTREAM (instream));
599 UNGCPRO; 599 NUNGCPRO;
600 600
601 QUIT; 601 QUIT;
602 #ifndef MSDOS 602 #ifndef MSDOS
603 /* Wait for it to terminate, unless it already has. */ 603 /* Wait for it to terminate, unless it already has. */
604 wait_for_termination (pid); 604 wait_for_termination (pid);