callproc.c 47.2 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Synchronous subprocess invocation for GNU Emacs.
2
   Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
Glenn Morris's avatar
Glenn Morris committed
3
                 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Glenn Morris's avatar
Glenn Morris committed
4
                 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


22
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
23
#include <signal.h>
24
#include <errno.h>
25
#include <stdio.h>
26
#include <setjmp.h>
Jim Blandy's avatar
Jim Blandy committed
27 28 29 30 31 32 33 34

/* Define SIGCHLD as an alias for SIGCLD.  */

#if !defined (SIGCHLD) && defined (SIGCLD)
#define SIGCHLD SIGCLD
#endif /* SIGCLD */

#include <sys/types.h>
35

36 37 38 39
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

Jim Blandy's avatar
Jim Blandy committed
40
#include <sys/file.h>
Dave Love's avatar
Dave Love committed
41
#ifdef HAVE_FCNTL_H
Jim Blandy's avatar
Jim Blandy committed
42 43 44
#include <fcntl.h>
#endif

45 46 47 48 49
#ifdef WINDOWSNT
#define NOMINMAX
#include <windows.h>
#include <stdlib.h>	/* for proper declaration of environ */
#include <fcntl.h>
Geoff Voelker's avatar
Geoff Voelker committed
50
#include "w32.h"
51 52 53
#define _P_NOWAIT 1	/* from process.h */
#endif

54 55 56 57 58 59
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/param.h>
#endif /* MSDOS */

Jim Blandy's avatar
Jim Blandy committed
60 61 62 63 64 65 66 67 68 69 70
#ifndef O_RDONLY
#define O_RDONLY 0
#endif

#ifndef O_WRONLY
#define O_WRONLY 1
#endif

#include "lisp.h"
#include "commands.h"
#include "buffer.h"
71
#include "character.h"
Kenichi Handa's avatar
Kenichi Handa committed
72
#include "ccl.h"
Karl Heuer's avatar
Karl Heuer committed
73
#include "coding.h"
Kenichi Handa's avatar
Kenichi Handa committed
74
#include "composite.h"
75
#include <epaths.h>
Jim Blandy's avatar
Jim Blandy committed
76
#include "process.h"
77
#include "syssignal.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
78
#include "systty.h"
Kim F. Storm's avatar
Kim F. Storm committed
79
#include "blockinput.h"
80 81
#include "frame.h"
#include "termhooks.h"
Jim Blandy's avatar
Jim Blandy committed
82

Eli Zaretskii's avatar
Eli Zaretskii committed
83 84 85 86
#ifdef MSDOS
#include "msdos.h"
#endif

87
#ifndef USE_CRT_DLL
Jim Blandy's avatar
Jim Blandy committed
88 89 90
extern char **environ;
#endif

91
#ifdef HAVE_SETPGID
Dan Nicolaescu's avatar
Dan Nicolaescu committed
92
#if !defined (USG)
93
#undef setpgrp
94 95
#define setpgrp setpgid
#endif
96
#endif
97

Stefan Monnier's avatar
Stefan Monnier committed
98 99
Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
Lisp_Object Vdata_directory, Vdoc_directory;
100
Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
101 102 103 104 105

/* Pattern used by call-process-region to make temp files.  */
static Lisp_Object Vtemp_file_name_pattern;

extern Lisp_Object Vtemporary_file_directory;
Jim Blandy's avatar
Jim Blandy committed
106 107 108

Lisp_Object Vshell_file_name;

109
Lisp_Object Vprocess_environment, Vinitial_environment;
Jim Blandy's avatar
Jim Blandy committed
110

111
#ifdef DOS_NT
112
Lisp_Object Qbuffer_file_type;
113
#endif /* DOS_NT */
114

Glenn Morris's avatar
Glenn Morris committed
115
/* True if we are about to fork off a synchronous process or if we
Jim Blandy's avatar
Jim Blandy committed
116 117 118 119 120 121
   are waiting for it.  */
int synch_process_alive;

/* Nonzero => this is a string explaining death of synchronous subprocess.  */
char *synch_process_death;

Kenichi Handa's avatar
Kenichi Handa committed
122 123 124
/* Nonzero => this is the signal number that terminated the subprocess.  */
int synch_process_termsig;

Jim Blandy's avatar
Jim Blandy committed
125 126 127
/* If synch_process_death is zero,
   this is exit code of synchronous subprocess.  */
int synch_process_retcode;
128

Jim Blandy's avatar
Jim Blandy committed
129

130 131 132 133 134 135 136
/* Clean up when exiting Fcall_process.
   On MSDOS, delete the temporary file on any kind of termination.
   On Unix, kill the process and any children on termination by signal.  */

/* Nonzero if this is termination due to exit.  */
static int call_process_exited;

137 138
EXFUN (Fgetenv_internal, 2);

139 140 141 142
static Lisp_Object
call_process_kill (fdpid)
     Lisp_Object fdpid;
{
143
  emacs_close (XFASTINT (Fcar (fdpid)));
144 145 146 147 148
  EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
  synch_process_alive = 0;
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
149
Lisp_Object
150 151
call_process_cleanup (arg)
     Lisp_Object arg;
Jim Blandy's avatar
Jim Blandy committed
152
{
153 154 155 156 157 158 159 160 161
  Lisp_Object fdpid = Fcdr (arg);
#if defined (MSDOS)
  Lisp_Object file;
#else
  int pid;
#endif

  Fset_buffer (Fcar (arg));

Dan Nicolaescu's avatar
Dan Nicolaescu committed
162
#if defined (MSDOS)
163
  /* for MSDOS fdpid is really (fd . tempfile)  */
164
  file = Fcdr (fdpid);
165
  emacs_close (XFASTINT (Fcar (fdpid)));
166 167
  if (strcmp (SDATA (file), NULL_DEVICE) != 0)
    unlink (SDATA (file));
Dan Nicolaescu's avatar
Dan Nicolaescu committed
168
#else /* not MSDOS */
169
  pid = XFASTINT (Fcdr (fdpid));
170

171
  if (call_process_exited)
172
    {
173
      emacs_close (XFASTINT (Fcar (fdpid)));
174 175
      return Qnil;
    }
176

177 178
  if (EMACS_KILLPG (pid, SIGINT) == 0)
    {
Juanma Barranquero's avatar
Juanma Barranquero committed
179
      int count = SPECPDL_INDEX ();
180 181 182 183 184 185 186 187 188
      record_unwind_protect (call_process_kill, fdpid);
      message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
      immediate_quit = 1;
      QUIT;
      wait_for_termination (pid);
      immediate_quit = 0;
      specpdl_ptr = specpdl + count; /* Discard the unwind protect.  */
      message1 ("Waiting for process to die...done");
    }
Jim Blandy's avatar
Jim Blandy committed
189
  synch_process_alive = 0;
190
  emacs_close (XFASTINT (Fcar (fdpid)));
191
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
192 193 194 195
  return Qnil;
}

DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
196 197 198 199 200 201 202 203 204 205 206 207 208 209
       doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `/dev/null').
Insert output in BUFFER before point; t means current buffer;
 nil for BUFFER means discard it; 0 means discard and don't wait.
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
REAL-BUFFER says what to do with standard output, as above,
while STDERR-FILE says what to do with standard error in the child.
STDERR-FILE may be nil (discard standard error output),
t (mix it with ordinary output), or a file name string.

Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
Remaining arguments are strings passed as command arguments to PROGRAM.

210 211 212 213
If executable PROGRAM can't be found as an executable, `call-process'
signals a Lisp error.  `call-process' reports errors in execution of
the program only through its return and output.

214 215 216
If BUFFER is 0, `call-process' returns immediately with value nil.
Otherwise it waits for PROGRAM to terminate
and returns a numeric exit status or a signal description string.
217 218 219
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.

usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
220
     (nargs, args)
Jim Blandy's avatar
Jim Blandy committed
221 222 223
     int nargs;
     register Lisp_Object *args;
{
224 225
  Lisp_Object infile, buffer, current_dir, path;
  int display_p;
Jim Blandy's avatar
Jim Blandy committed
226 227 228
  int fd[2];
  int filefd;
  register int pid;
229 230 231 232
#define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
#define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
  char buf[CALLPROC_BUFFER_SIZE_MAX];
  int bufsize = CALLPROC_BUFFER_SIZE_MIN;
Juanma Barranquero's avatar
Juanma Barranquero committed
233
  int count = SPECPDL_INDEX ();
234

235
  register const unsigned char **new_argv;
236 237 238
  /* File to use for stderr in the child.
     t means use same as standard output.  */
  Lisp_Object error_file;
239 240 241
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
  char *outf, *tempfile;
  int outfilefd;
Jim Blandy's avatar
Jim Blandy committed
242
#endif
Karl Heuer's avatar
Karl Heuer committed
243 244
  struct coding_system process_coding; /* coding-system of process output */
  struct coding_system argument_coding;	/* coding-system of arguments */
245 246 247 248 249
  /* Set to the return value of Ffind_operation_coding_system.  */
  Lisp_Object coding_systems;

  /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
  coding_systems = Qt;
Karl Heuer's avatar
Karl Heuer committed
250

251
  CHECK_STRING (args[0]);
Jim Blandy's avatar
Jim Blandy committed
252

253 254
  error_file = Qt;

255 256
#ifndef subprocesses
  /* Without asynchronous processes we cannot have BUFFER == 0.  */
257
  if (nargs >= 3
258
      && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
259 260 261
    error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */

262
  /* Decide the coding-system for giving arguments.  */
Karl Heuer's avatar
Karl Heuer committed
263 264 265 266 267 268 269
  {
    Lisp_Object val, *args2;
    int i;

    /* If arguments are supplied, we may have to encode them.  */
    if (nargs >= 5)
      {
270
	int must_encode = 0;
271
	Lisp_Object coding_attrs;
272

273
	for (i = 4; i < nargs; i++)
274
	  CHECK_STRING (args[i]);
275

276
	for (i = 4; i < nargs; i++)
277 278 279
	  if (STRING_MULTIBYTE (args[i]))
	    must_encode = 1;

280 281
	if (!NILP (Vcoding_system_for_write))
	  val = Vcoding_system_for_write;
282
	else if (! must_encode)
283 284
	  val = Qnil;
	else
Karl Heuer's avatar
Karl Heuer committed
285 286 287 288
	  {
	    args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
	    args2[0] = Qcall_process;
	    for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
289
	    coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
290
	    if (CONSP (coding_systems))
291
	      val = XCDR (coding_systems);
292
	    else if (CONSP (Vdefault_process_coding_system))
293
	      val = XCDR (Vdefault_process_coding_system);
294 295
	    else
	      val = Qnil;
Karl Heuer's avatar
Karl Heuer committed
296
	  }
297
	val = coding_inherit_eol_type (val, Qnil);
Karl Heuer's avatar
Karl Heuer committed
298
	setup_coding_system (Fcheck_coding_system (val), &argument_coding);
299 300 301 302 303 304 305
	coding_attrs = CODING_ID_ATTRS (argument_coding.id);
	if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
	  {
	    /* We should not use an ASCII incompatible coding system.  */
	    val = raw_text_coding_system (val);
	    setup_coding_system (val, &argument_coding);
	  }
Karl Heuer's avatar
Karl Heuer committed
306 307 308
      }
  }

309 310 311
  if (nargs >= 2 && ! NILP (args[1]))
    {
      infile = Fexpand_file_name (args[1], current_buffer->directory);
312
      CHECK_STRING (infile);
313
    }
Jim Blandy's avatar
Jim Blandy committed
314
  else
315
    infile = build_string (NULL_DEVICE);
Jim Blandy's avatar
Jim Blandy committed
316

317 318
  if (nargs >= 3)
    {
319 320 321 322 323 324
      buffer = args[2];

      /* If BUFFER is a list, its meaning is
	 (BUFFER-FOR-STDOUT FILE-FOR-STDERR).  */
      if (CONSP (buffer))
	{
325
	  if (CONSP (XCDR (buffer)))
326
	    {
327
	      Lisp_Object stderr_file;
328
	      stderr_file = XCAR (XCDR (buffer));
329 330 331 332 333 334 335

	      if (NILP (stderr_file) || EQ (Qt, stderr_file))
		error_file = stderr_file;
	      else
		error_file = Fexpand_file_name (stderr_file, Qnil);
	    }

336
	  buffer = XCAR (buffer);
337
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
338

339 340
      if (!(EQ (buffer, Qnil)
	    || EQ (buffer, Qt)
341
	    || INTEGERP (buffer)))
342
	{
343 344
	  Lisp_Object spec_buffer;
	  spec_buffer = buffer;
345
	  buffer = Fget_buffer_create (buffer);
346 347
	  /* Mention the buffer name for a better error message.  */
	  if (NILP (buffer))
348 349
	    CHECK_BUFFER (spec_buffer);
	  CHECK_BUFFER (buffer);
350 351
	}
    }
352
  else
353
    buffer = Qnil;
Jim Blandy's avatar
Jim Blandy committed
354

355 356 357 358 359 360 361 362 363 364 365
  /* Make sure that the child will be able to chdir to the current
     buffer's current directory, or its unhandled equivalent.  We
     can't just have the child check for an error when it does the
     chdir, since it's in a vfork.

     We have to GCPRO around this because Fexpand_file_name,
     Funhandled_file_name_directory, and Ffile_accessible_directory_p
     might call a file name handling function.  The argument list is
     protected by the caller, so all we really have to worry about is
     buffer.  */
  {
366
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
367 368 369

    current_dir = current_buffer->directory;

370
    GCPRO4 (infile, buffer, current_dir, error_file);
371

Stefan Monnier's avatar
Stefan Monnier committed
372 373 374 375 376 377
    current_dir = Funhandled_file_name_directory (current_dir);
    if (NILP (current_dir))
      /* If the file name handler says that current_dir is unreachable, use
	 a sensible default. */
      current_dir = build_string ("~/");
    current_dir = expand_and_dir_to_file (current_dir, Qnil);
378 379
    current_dir = Ffile_name_as_directory (current_dir);

380 381 382 383
    if (NILP (Ffile_accessible_directory_p (current_dir)))
      report_file_error ("Setting current directory",
			 Fcons (current_buffer->directory, Qnil));

384 385 386 387 388 389
    if (STRING_MULTIBYTE (infile))
      infile = ENCODE_FILE (infile);
    if (STRING_MULTIBYTE (current_dir))
      current_dir = ENCODE_FILE (current_dir);
    if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
      error_file = ENCODE_FILE (error_file);
390 391 392
    UNGCPRO;
  }

393
  display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
Jim Blandy's avatar
Jim Blandy committed
394

395
  filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
396 397
  if (filefd < 0)
    {
398
      infile = DECODE_FILE (infile);
399
      report_file_error ("Opening process input file", Fcons (infile, Qnil));
Jim Blandy's avatar
Jim Blandy committed
400 401
    }
  /* Search for program; barf if not found.  */
402
  {
403
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
404

405
    GCPRO4 (infile, buffer, current_dir, error_file);
406
    openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
407 408
    UNGCPRO;
  }
409
  if (NILP (path))
Jim Blandy's avatar
Jim Blandy committed
410
    {
411
      emacs_close (filefd);
Jim Blandy's avatar
Jim Blandy committed
412 413
      report_file_error ("Searching for program", Fcons (args[0], Qnil));
    }
414 415 416 417 418 419 420

  /* If program file name starts with /: for quoting a magic name,
     discard that.  */
  if (SBYTES (path) > 2 && SREF (path, 0) == '/'
      && SREF (path, 1) == ':')
    path = Fsubstring (path, make_number (2), Qnil);

421 422
  new_argv = (const unsigned char **)
    alloca (max (2, nargs - 2) * sizeof (char *));
423 424 425
  if (nargs > 4)
    {
      register int i;
426
      struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
427

428
      GCPRO5 (infile, buffer, current_dir, path, error_file);
429 430
      argument_coding.dst_multibyte = 0;
      for (i = 4; i < nargs; i++)
431
	{
432 433
	  argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
	  if (CODING_REQUIRE_ENCODING (&argument_coding))
434 435
	    /* We must encode this argument.  */
	    args[i] = encode_coding_string (&argument_coding, args[i], 1);
436
	}
437
      UNGCPRO;
438 439 440
      for (i = 4; i < nargs; i++)
	new_argv[i - 3] = SDATA (args[i]);
      new_argv[i - 3] = 0;
441
    }
442 443
  else
    new_argv[1] = 0;
444
  new_argv[0] = SDATA (path);
Jim Blandy's avatar
Jim Blandy committed
445

446
#ifdef MSDOS /* MW, July 1993 */
447
  if ((outf = egetenv ("TMPDIR")))
448 449 450 451 452 453 454
    strcpy (tempfile = alloca (strlen (outf) + 20), outf);
  else
    {
      tempfile = alloca (20);
      *tempfile = '\0';
    }
  dostounix_filename (tempfile);
455
  if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
456 457 458 459 460 461 462
    strcat (tempfile, "/");
  strcat (tempfile, "detmp.XXX");
  mktemp (tempfile);

  outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
  if (outfilefd < 0)
    {
463
      emacs_close (filefd);
Miles Bader's avatar
Miles Bader committed
464 465
      report_file_error ("Opening process output file",
			 Fcons (build_string (tempfile), Qnil));
466
    }
Miles Bader's avatar
Miles Bader committed
467
  fd[0] = filefd;
468
  fd[1] = outfilefd;
Miles Bader's avatar
Miles Bader committed
469
#endif /* MSDOS */
470

471
  if (INTEGERP (buffer))
472
    fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
Jim Blandy's avatar
Jim Blandy committed
473 474
  else
    {
475
#ifndef MSDOS
476 477 478 479 480 481
      errno = 0;
      if (pipe (fd) == -1)
	{
	  emacs_close (filefd);
	  report_file_error ("Creating process pipe", Qnil);
	}
Jim Blandy's avatar
Jim Blandy committed
482 483 484 485 486 487 488 489
#endif
    }

  {
    /* child_setup must clobber environ in systems with true vfork.
       Protect it from permanent change.  */
    register char **save_environ = environ;
    register int fd1 = fd[1];
490
    int fd_error = fd1;
Jim Blandy's avatar
Jim Blandy committed
491 492

#if 0  /* Some systems don't have sigblock.  */
Jim Blandy's avatar
Jim Blandy committed
493
    mask = sigblock (sigmask (SIGCHLD));
Jim Blandy's avatar
Jim Blandy committed
494 495 496 497 498
#endif

    /* Record that we're about to create a synchronous process.  */
    synch_process_alive = 1;

499 500 501 502 503
    /* These vars record information from process termination.
       Clear them now before process can possibly terminate,
       to avoid timing error if process terminates soon.  */
    synch_process_death = 0;
    synch_process_retcode = 0;
Kenichi Handa's avatar
Kenichi Handa committed
504
    synch_process_termsig = 0;
505

506
    if (NILP (error_file))
507
      fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
508 509 510
    else if (STRINGP (error_file))
      {
#ifdef DOS_NT
511
	fd_error = emacs_open (SDATA (error_file),
512 513
			       O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
			       S_IREAD | S_IWRITE);
514
#else  /* not DOS_NT */
515
	fd_error = creat (SDATA (error_file), 0666);
516 517 518 519 520
#endif /* not DOS_NT */
      }

    if (fd_error < 0)
      {
521
	emacs_close (filefd);
Miles Bader's avatar
Miles Bader committed
522
	if (fd[0] != filefd)
523
	  emacs_close (fd[0]);
524
	if (fd1 >= 0)
525
	  emacs_close (fd1);
Miles Bader's avatar
Miles Bader committed
526 527 528
#ifdef MSDOS
	unlink (tempfile);
#endif
529 530 531 532 533
	if (NILP (error_file))
	  error_file = build_string (NULL_DEVICE);
	else if (STRINGP (error_file))
	  error_file = DECODE_FILE (error_file);
	report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
534
      }
535

536
#ifdef MSDOS /* MW, July 1993 */
537
    /* Note that on MSDOS `child_setup' actually returns the child process
538 539
       exit status, not its PID, so we assign it to `synch_process_retcode'
       below.  */
540 541
    pid = child_setup (filefd, outfilefd, fd_error, (char **) new_argv,
		       0, current_dir);
542

543 544 545 546 547
    /* Record that the synchronous process exited and note its
       termination status.  */
    synch_process_alive = 0;
    synch_process_retcode = pid;
    if (synch_process_retcode < 0)  /* means it couldn't be exec'ed */
548
      {
549
	synchronize_system_messages_locale ();
550 551
	synch_process_death = strerror (errno);
      }
552

553
    emacs_close (outfilefd);
554
    if (fd_error != outfilefd)
555
      emacs_close (fd_error);
556
    fd1 = -1; /* No harm in closing that one!  */
Karl Heuer's avatar
Karl Heuer committed
557 558
    /* Since CRLF is converted to LF within `decode_coding', we can
       always open a file with binary mode.  */
559
    fd[0] = emacs_open (tempfile, O_RDONLY | O_BINARY, 0);
560 561 562
    if (fd[0] < 0)
      {
	unlink (tempfile);
563
	emacs_close (filefd);
564 565 566
	report_file_error ("Cannot re-open temporary file", Qnil);
      }
#else /* not MSDOS */
567
#ifdef WINDOWSNT
568 569
    pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
		       0, current_dir);
570
#else  /* not WINDOWSNT */
Kim F. Storm's avatar
Kim F. Storm committed
571 572
    BLOCK_INPUT;

Jim Blandy's avatar
Jim Blandy committed
573 574 575 576 577
    pid = vfork ();

    if (pid == 0)
      {
	if (fd[0] >= 0)
578
	  emacs_close (fd[0]);
579 580 581
#ifdef HAVE_SETSID
        setsid ();
#endif
Dan Nicolaescu's avatar
Dan Nicolaescu committed
582
#if defined (USG)
Jim Blandy's avatar
Jim Blandy committed
583 584 585 586
        setpgrp ();
#else
        setpgrp (pid, pid);
#endif /* USG */
587 588
	child_setup (filefd, fd1, fd_error, (char **) new_argv,
		     0, current_dir);
Jim Blandy's avatar
Jim Blandy committed
589
      }
Kim F. Storm's avatar
Kim F. Storm committed
590 591

    UNBLOCK_INPUT;
592
#endif /* not WINDOWSNT */
593 594 595

    /* The MSDOS case did this already.  */
    if (fd_error >= 0)
596
      emacs_close (fd_error);
597
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
598 599 600

    environ = save_environ;

601 602
    /* Close most of our fd's, but not fd[0]
       since we will use that to read input from.  */
603
    emacs_close (filefd);
604
    if (fd1 >= 0 && fd1 != fd_error)
605
      emacs_close (fd1);
Jim Blandy's avatar
Jim Blandy committed
606 607 608 609
  }

  if (pid < 0)
    {
610
      if (fd[0] >= 0)
611
	emacs_close (fd[0]);
Jim Blandy's avatar
Jim Blandy committed
612 613 614
      report_file_error ("Doing vfork", Qnil);
    }

615
  if (INTEGERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
616
    {
617
      if (fd[0] >= 0)
618
	emacs_close (fd[0]);
Jim Blandy's avatar
Jim Blandy committed
619
#ifndef subprocesses
620 621 622
      /* If Emacs has been built with asynchronous subprocess support,
	 we don't need to do this, I think because it will then have
	 the facilities for handling SIGCHLD.  */
Jim Blandy's avatar
Jim Blandy committed
623 624 625 626 627
      wait_without_blocking ();
#endif /* subprocesses */
      return Qnil;
    }

628
  /* Enable sending signal if user quits below.  */
629 630
  call_process_exited = 0;

Dan Nicolaescu's avatar
Dan Nicolaescu committed
631
#if defined(MSDOS)
632 633
  /* MSDOS needs different cleanup information.  */
  record_unwind_protect (call_process_cleanup,
634 635 636
			 Fcons (Fcurrent_buffer (),
				Fcons (make_number (fd[0]),
				       build_string (tempfile))));
637
#else
Jim Blandy's avatar
Jim Blandy committed
638
  record_unwind_protect (call_process_cleanup,
639 640
			 Fcons (Fcurrent_buffer (),
				Fcons (make_number (fd[0]), make_number (pid))));
Dan Nicolaescu's avatar
Dan Nicolaescu committed
641
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
642 643


644
  if (BUFFERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
645 646
    Fset_buffer (buffer);

647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672
  if (NILP (buffer))
    {
      /* If BUFFER is nil, we must read process output once and then
	 discard it, so setup coding system but with nil.  */
      setup_coding_system (Qnil, &process_coding);
    }
  else
    {
      Lisp_Object val, *args2;

      val = Qnil;
      if (!NILP (Vcoding_system_for_read))
	val = Vcoding_system_for_read;
      else
	{
	  if (EQ (coding_systems, Qt))
	    {
	      int i;

	      args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
	      args2[0] = Qcall_process;
	      for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
	      coding_systems
		= Ffind_operation_coding_system (nargs + 1, args2);
	    }
	  if (CONSP (coding_systems))
673
	    val = XCAR (coding_systems);
674
	  else if (CONSP (Vdefault_process_coding_system))
675
	    val = XCAR (Vdefault_process_coding_system);
676 677 678
	  else
	    val = Qnil;
	}
679
      Fcheck_coding_system (val);
680 681 682 683 684
      /* In unibyte mode, character code conversion should not take
	 place but EOL conversion should.  So, setup raw-text or one
	 of the subsidiary according to the information just setup.  */
      if (NILP (current_buffer->enable_multibyte_characters)
	  && !NILP (val))
685 686
	val = raw_text_coding_system (val);
      setup_coding_system (val, &process_coding);
687 688
    }

Jim Blandy's avatar
Jim Blandy committed
689 690 691 692 693
  immediate_quit = 1;
  QUIT;

  {
    register int nread;
694
    int first = 1;
695
    int total_read = 0;
696
    int carryover = 0;
697
    int display_on_the_fly = display_p;
698 699 700
    struct coding_system saved_coding;

    saved_coding = process_coding;
701
    while (1)
Jim Blandy's avatar
Jim Blandy committed
702
      {
703 704
	/* Repeatedly read until we've filled as much as possible
	   of the buffer size we have.  But don't read
Karl Heuer's avatar
Karl Heuer committed
705
	   less than 1024--save that for the next bufferful.  */
706
	nread = carryover;
707
	while (nread < bufsize - 1024)
708
	  {
709
	    int this_read = emacs_read (fd[0], buf + nread,
710
					bufsize - nread);
711 712 713 714 715

	    if (this_read < 0)
	      goto give_up;

	    if (this_read == 0)
716 717 718 719
	      {
		process_coding.mode |= CODING_MODE_LAST_BLOCK;
		break;
	      }
720 721

	    nread += this_read;
722
	    total_read += this_read;
723

724 725 726
	    if (display_on_the_fly)
	      break;
	  }
727 728

	/* Now NREAD is the total amount of data in the buffer.  */
Jim Blandy's avatar
Jim Blandy committed
729
	immediate_quit = 0;
730

731
	if (!NILP (buffer))
Karl Heuer's avatar
Karl Heuer committed
732
	  {
733 734
	    if (NILP (current_buffer->enable_multibyte_characters)
		&& ! CODING_MAY_REQUIRE_DECODING (&process_coding))
735
	      insert_1_both (buf, nread, nread, 0, 1, 0);
Karl Heuer's avatar
Karl Heuer committed
736 737
	    else
	      {			/* We have to decode the input.  */
738
		Lisp_Object curbuf;
739
		int count1 = SPECPDL_INDEX ();
740

741
		XSETBUFFER (curbuf, current_buffer);
742 743 744 745 746 747
		/* We cannot allow after-change-functions be run
		   during decoding, because that might modify the
		   buffer, while we rely on process_coding.produced to
		   faithfully reflect inserted text until we
		   TEMP_SET_PT_BOTH below.  */
		specbind (Qinhibit_modification_hooks, Qt);
748 749
		decode_coding_c_string (&process_coding, buf, nread,
					curbuf);
750
		unbind_to (count1, Qnil);
751
		if (display_on_the_fly
752 753
		    && CODING_REQUIRE_DETECTION (&saved_coding)
		    && ! CODING_REQUIRE_DETECTION (&process_coding))
754 755 756 757 758
		  {
		    /* We have detected some coding system.  But,
		       there's a possibility that the detection was
		       done by insufficient data.  So, we give up
		       displaying on the fly.  */
759 760 761 762 763 764 765
		    if (process_coding.produced > 0)
		      del_range_2 (process_coding.dst_pos,
				   process_coding.dst_pos_byte,
				   process_coding.dst_pos
				   + process_coding.produced_char,
				   process_coding.dst_pos_byte
				   + process_coding.produced, 0);
766 767 768
		    display_on_the_fly = 0;
		    process_coding = saved_coding;
		    carryover = nread;
769 770
		    /* This is to make the above condition always
		       fails in the future.  */
771 772
		    saved_coding.common_flags
		      &= ~CODING_REQUIRE_DETECTION_MASK;
773 774
		    continue;
		  }
775

776 777
		TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
				  PT_BYTE + process_coding.produced);
778
		carryover = process_coding.carryover_bytes;
779
		if (carryover > 0)
780 781
		  /* As CARRYOVER should not be that large, we had
		     better avoid overhead of bcopy.  */
782
		  BCOPY_SHORT (process_coding.carryover, buf,
783
			       process_coding.carryover_bytes);
Karl Heuer's avatar
Karl Heuer committed
784 785
	      }
	  }
786

787
	if (process_coding.mode & CODING_MODE_LAST_BLOCK)
788
	  break;
789 790

	/* Make the buffer bigger as we continue to read more data,
791 792 793 794
	   but not past CALLPROC_BUFFER_SIZE_MAX.  */
	if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
	  if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
	    bufsize = CALLPROC_BUFFER_SIZE_MAX;
795

796
	if (display_p)
797 798 799 800
	  {
	    if (first)
	      prepare_menu_bars ();
	    first = 0;
801
	    redisplay_preserve_echo_area (1);
802 803 804 805
	    /* This variable might have been set to 0 for code
	       detection.  In that case, we set it back to 1 because
	       we should have already detected a coding system.  */
	    display_on_the_fly = 1;
806
	  }
Jim Blandy's avatar
Jim Blandy committed
807 808 809
	immediate_quit = 1;
	QUIT;
      }
810
  give_up: ;
Jim Blandy's avatar
Jim Blandy committed
811

812 813 814 815 816
    Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
    /* If the caller required, let the buffer inherit the
       coding-system used to decode the process output.  */
    if (inherit_process_coding_system)
      call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
817
	     make_number (total_read));
Eli Zaretskii's avatar
Eli Zaretskii committed
818 819
  }

Jim Blandy's avatar
Jim Blandy committed
820 821 822 823 824
  /* Wait for it to terminate, unless it already has.  */
  wait_for_termination (pid);

  immediate_quit = 0;

825 826 827 828
  /* Don't kill any children that the subprocess may have left behind
     when exiting.  */
  call_process_exited = 1;

Jim Blandy's avatar
Jim Blandy committed
829 830
  unbind_to (count, Qnil);

Kenichi Handa's avatar
Kenichi Handa committed
831 832 833 834 835 836 837 838 839 840 841 842 843
  if (synch_process_termsig)
    {
      char *signame;

      synchronize_system_messages_locale ();
      signame = strsignal (synch_process_termsig);

      if (signame == 0)
        signame = "unknown";

      synch_process_death = signame;
    }

Jim Blandy's avatar
Jim Blandy committed
844
  if (synch_process_death)
845 846
    return code_convert_string_norecord (build_string (synch_process_death),
					 Vlocale_coding_system, 0);
Jim Blandy's avatar
Jim Blandy committed
847 848 849
  return make_number (synch_process_retcode);
}

850
static Lisp_Object
Jim Blandy's avatar
Jim Blandy committed
851 852 853
delete_temp_file (name)
     Lisp_Object name;
{
854 855 856
  /* Suppress jka-compr handling, etc.  */
  int count = SPECPDL_INDEX ();
  specbind (intern ("file-name-handler-alist"), Qnil);
857
  internal_delete_file (name);
858
  unbind_to (count, Qnil);
859
  return Qnil;
Jim Blandy's avatar
Jim Blandy committed
860 861 862
}

DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,