callproc.c 39.2 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Synchronous subprocess invocation for GNU Emacs.
Karl Heuer's avatar
Karl Heuer committed
2
   Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
3 4 5 6 7

This file is part of GNU Emacs.

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

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
along with GNU Emacs; see the file COPYING.  If not, write to
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
20 21 22


#include <signal.h>
23
#include <errno.h>
Jim Blandy's avatar
Jim Blandy committed
24

25
#include <config.h>
26
#include <stdio.h>
Jim Blandy's avatar
Jim Blandy committed
27

28
extern int errno;
29
extern char *strerror ();
30

Jim Blandy's avatar
Jim Blandy committed
31 32 33 34 35 36 37
/* Define SIGCHLD as an alias for SIGCLD.  */

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

#include <sys/types.h>
38

Jim Blandy's avatar
Jim Blandy committed
39 40
#include <sys/file.h>
#ifdef USG5
41
#define INCLUDED_FCNTL
Jim Blandy's avatar
Jim Blandy committed
42 43 44
#include <fcntl.h>
#endif

Dave Love's avatar
Dave Love committed
45 46 47 48
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif

49 50 51 52 53
#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
54
#include "w32.h"
55 56 57
#define _P_NOWAIT 1	/* from process.h */
#endif

58
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
59
#define INCLUDED_FCNTL
60 61 62 63 64 65
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/param.h>
#include <errno.h>
#endif /* MSDOS */

Jim Blandy's avatar
Jim Blandy committed
66 67 68 69 70 71 72 73 74 75 76
#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"
Karl Heuer's avatar
Karl Heuer committed
77
#include "charset.h"
Kenichi Handa's avatar
Kenichi Handa committed
78
#include "ccl.h"
Karl Heuer's avatar
Karl Heuer committed
79
#include "coding.h"
80
#include <epaths.h>
Jim Blandy's avatar
Jim Blandy committed
81
#include "process.h"
82
#include "syssignal.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
83
#include "systty.h"
Jim Blandy's avatar
Jim Blandy committed
84

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

Jim Blandy's avatar
Jim Blandy committed
89 90 91 92 93 94 95 96
#ifdef VMS
extern noshare char **environ;
#else
extern char **environ;
#endif

#define max(a, b) ((a) > (b) ? (a) : (b))

97
Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
98
Lisp_Object Vconfigure_info_directory;
99
Lisp_Object Vtemp_file_name_pattern;
Jim Blandy's avatar
Jim Blandy committed
100 101 102 103 104

Lisp_Object Vshell_file_name;

Lisp_Object Vprocess_environment;

105
#ifdef DOS_NT
106
Lisp_Object Qbuffer_file_type;
107
#endif /* DOS_NT */
108

Jim Blandy's avatar
Jim Blandy committed
109 110 111 112 113 114 115 116 117 118
/* True iff we are about to fork off a synchronous process or if we
   are waiting for it.  */
int synch_process_alive;

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

/* If synch_process_death is zero,
   this is exit code of synchronous subprocess.  */
int synch_process_retcode;
119 120

extern Lisp_Object Vdoc_file_name;
121

122
extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
Jim Blandy's avatar
Jim Blandy committed
123

124 125 126 127 128 129 130
/* 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;

Jim Blandy's avatar
Jim Blandy committed
131 132
#ifndef VMS  /* VMS version is in vmsproc.c.  */

133 134 135 136 137 138 139 140 141 142
static Lisp_Object
call_process_kill (fdpid)
     Lisp_Object fdpid;
{
  close (XFASTINT (Fcar (fdpid)));
  EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
  synch_process_alive = 0;
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
143 144 145 146
Lisp_Object
call_process_cleanup (fdpid)
     Lisp_Object fdpid;
{
147 148
#ifdef MSDOS
  /* for MSDOS fdpid is really (fd . tempfile)  */
149 150
  register Lisp_Object file;
  file = Fcdr (fdpid);
151 152 153 154
  close (XFASTINT (Fcar (fdpid)));
  if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
    unlink (XSTRING (file)->data);
#else /* not MSDOS */
155 156
  register int pid = XFASTINT (Fcdr (fdpid));

157

158
  if (call_process_exited)
159 160 161 162
    {
      close (XFASTINT (Fcar (fdpid)));
      return Qnil;
    }
163

164 165 166 167 168 169 170 171 172 173 174 175
  if (EMACS_KILLPG (pid, SIGINT) == 0)
    {
      int count = specpdl_ptr - specpdl;
      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
176
  synch_process_alive = 0;
177
  close (XFASTINT (Fcar (fdpid)));
178
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
179 180 181 182 183
  return Qnil;
}

DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
  "Call PROGRAM synchronously in separate process.\n\
Kenichi Handa's avatar
Kenichi Handa committed
184
The remaining arguments are optional.\n\
Jim Blandy's avatar
Jim Blandy committed
185 186 187
The program's input comes from file INFILE (nil means `/dev/null').\n\
Insert output in BUFFER before point; t means current buffer;\n\
 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
188 189 190 191 192 193
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
REAL-BUFFER says what to do with standard output, as above,\n\
while STDERR-FILE says what to do with standard error in the child.\n\
STDERR-FILE may be nil (discard standard error output),\n\
t (mix it with ordinary output), or a file name string.\n\
\n\
Jim Blandy's avatar
Jim Blandy committed
194 195
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining arguments are strings passed as command arguments to PROGRAM.\n\
196 197 198
\n\
If BUFFER is 0, `call-process' returns immediately with value nil.\n\
Otherwise it waits for PROGRAM to terminate\n\
199
and returns a numeric exit status or a signal description string.\n\
200
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
Jim Blandy's avatar
Jim Blandy committed
201 202 203 204
  (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
205
  Lisp_Object infile, buffer, current_dir, display, path;
Jim Blandy's avatar
Jim Blandy committed
206 207 208
  int fd[2];
  int filefd;
  register int pid;
209 210 211
  char buf[16384];
  char *bufptr = buf;
  int bufsize = 16384;
Jim Blandy's avatar
Jim Blandy committed
212
  int count = specpdl_ptr - specpdl;
213

Jim Blandy's avatar
Jim Blandy committed
214 215 216
  register unsigned char **new_argv
    = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
  struct buffer *old = current_buffer;
217 218 219
  /* File to use for stderr in the child.
     t means use same as standard output.  */
  Lisp_Object error_file;
220 221 222 223
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
  char *outf, *tempfile;
  int outfilefd;
#endif
Jim Blandy's avatar
Jim Blandy committed
224 225 226
#if 0
  int mask;
#endif
Karl Heuer's avatar
Karl Heuer committed
227 228
  struct coding_system process_coding; /* coding-system of process output */
  struct coding_system argument_coding;	/* coding-system of arguments */
229 230 231 232 233
  /* 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
234

Jim Blandy's avatar
Jim Blandy committed
235 236
  CHECK_STRING (args[0], 0);

237 238
  error_file = Qt;

239 240
#ifndef subprocesses
  /* Without asynchronous processes we cannot have BUFFER == 0.  */
241
  if (nargs >= 3 
242
      && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
243 244 245
    error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */

246
  /* Decide the coding-system for giving arguments.  */
Karl Heuer's avatar
Karl Heuer committed
247 248 249 250 251 252 253
  {
    Lisp_Object val, *args2;
    int i;

    /* If arguments are supplied, we may have to encode them.  */
    if (nargs >= 5)
      {
254 255
	int must_encode = 0;

256 257 258
	for (i = 4; i < nargs; i++)
	  CHECK_STRING (args[i], i);

259
	for (i = 4; i < nargs; i++)
260 261 262
	  if (STRING_MULTIBYTE (args[i]))
	    must_encode = 1;

263 264
	if (!NILP (Vcoding_system_for_write))
	  val = Vcoding_system_for_write;
265
	else if (! must_encode)
266 267
	  val = Qnil;
	else
Karl Heuer's avatar
Karl Heuer committed
268 269 270 271
	  {
	    args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
	    args2[0] = Qcall_process;
	    for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
272
	    coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
273 274 275 276
	    if (CONSP (coding_systems))
	      val = XCONS (coding_systems)->cdr;
	    else if (CONSP (Vdefault_process_coding_system))
	      val = XCONS (Vdefault_process_coding_system)->cdr;
277 278
	    else
	      val = Qnil;
Karl Heuer's avatar
Karl Heuer committed
279 280 281 282 283
	  }
	setup_coding_system (Fcheck_coding_system (val), &argument_coding);
      }
  }

284 285 286 287 288
  if (nargs >= 2 && ! NILP (args[1]))
    {
      infile = Fexpand_file_name (args[1], current_buffer->directory);
      CHECK_STRING (infile, 1);
    }
Jim Blandy's avatar
Jim Blandy committed
289
  else
290
    infile = build_string (NULL_DEVICE);
Jim Blandy's avatar
Jim Blandy committed
291

292 293
  if (nargs >= 3)
    {
294 295 296 297 298 299 300
      buffer = args[2];

      /* If BUFFER is a list, its meaning is
	 (BUFFER-FOR-STDOUT FILE-FOR-STDERR).  */
      if (CONSP (buffer))
	{
	  if (CONSP (XCONS (buffer)->cdr))
301
	    {
302
	      Lisp_Object stderr_file;
303 304 305 306 307 308 309 310
	      stderr_file = XCONS (XCONS (buffer)->cdr)->car;

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

311 312
	  buffer = XCONS (buffer)->car;
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
313

314 315
      if (!(EQ (buffer, Qnil)
	    || EQ (buffer, Qt)
316
	    || INTEGERP (buffer)))
317
	{
318 319
	  Lisp_Object spec_buffer;
	  spec_buffer = buffer;
320
	  buffer = Fget_buffer_create (buffer);
321 322 323
	  /* Mention the buffer name for a better error message.  */
	  if (NILP (buffer))
	    CHECK_BUFFER (spec_buffer, 2);
324 325 326 327 328
	  CHECK_BUFFER (buffer, 2);
	}
    }
  else 
    buffer = Qnil;
Jim Blandy's avatar
Jim Blandy committed
329

330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346
  /* 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.  */
  {
    struct gcpro gcpro1, gcpro2, gcpro3;

    current_dir = current_buffer->directory;

    GCPRO3 (infile, buffer, current_dir);

347 348 349
    current_dir
      = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
				Qnil);
350 351 352 353 354 355 356
    if (NILP (Ffile_accessible_directory_p (current_dir)))
      report_file_error ("Setting current directory",
			 Fcons (current_buffer->directory, Qnil));

    UNGCPRO;
  }

357
  display = nargs >= 4 ? args[3] : Qnil;
Jim Blandy's avatar
Jim Blandy committed
358

359
  filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
360 361
  if (filefd < 0)
    {
362
      report_file_error ("Opening process input file", Fcons (infile, Qnil));
Jim Blandy's avatar
Jim Blandy committed
363 364
    }
  /* Search for program; barf if not found.  */
365 366 367 368 369 370 371
  {
    struct gcpro gcpro1;

    GCPRO1 (current_dir);
    openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
    UNGCPRO;
  }
372
  if (NILP (path))
Jim Blandy's avatar
Jim Blandy committed
373 374 375 376 377
    {
      close (filefd);
      report_file_error ("Searching for program", Fcons (args[0], Qnil));
    }
  new_argv[0] = XSTRING (path)->data;
378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395
  if (nargs > 4)
    {
      register int i;

      if (! CODING_REQUIRE_ENCODING (&argument_coding))
	{
	  for (i = 4; i < nargs; i++)
	    new_argv[i - 3] = XSTRING (args[i])->data;
	}
      else
	{
	  /* We must encode the arguments.  */
	  struct gcpro gcpro1, gcpro2, gcpro3;

	  GCPRO3 (infile, buffer, current_dir);
	  for (i = 4; i < nargs; i++)
	    {
	      int size = encoding_buffer_size (&argument_coding,
396
					       STRING_BYTES (XSTRING (args[i])));
397
	      unsigned char *dummy1 = (unsigned char *) alloca (size);
398
	      int dummy;
399 400 401

	      /* The Irix 4.0 compiler barfs if we eliminate dummy.  */
	      new_argv[i - 3] = dummy1;
Kenichi Handa's avatar
Kenichi Handa committed
402
	      argument_coding.mode |= CODING_MODE_LAST_BLOCK;
403 404 405
	      encode_coding (&argument_coding,
			     XSTRING (args[i])->data,
			     new_argv[i - 3],
406
			     STRING_BYTES (XSTRING (args[i])),
407 408
			     size);
	      new_argv[i - 3][argument_coding.produced] = 0;
Kenichi Handa's avatar
Kenichi Handa committed
409 410 411
	      /* We have to initialize CCL program status again.  */
	      if (argument_coding.type == coding_type_ccl)
		setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
412 413 414
	    }
	  UNGCPRO;
	}
415
      new_argv[nargs - 3] = 0;
416
    }
417 418
  else
    new_argv[1] = 0;
Jim Blandy's avatar
Jim Blandy committed
419

420
#ifdef MSDOS /* MW, July 1993 */
421
  if ((outf = egetenv ("TMPDIR")))
422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437
    strcpy (tempfile = alloca (strlen (outf) + 20), outf);
  else
    {
      tempfile = alloca (20);
      *tempfile = '\0';
    }
  dostounix_filename (tempfile);
  if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/') 
    strcat (tempfile, "/");
  strcat (tempfile, "detmp.XXX");
  mktemp (tempfile);

  outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
  if (outfilefd < 0)
    {
      close (filefd);
Miles Bader's avatar
Miles Bader committed
438 439
      report_file_error ("Opening process output file",
			 Fcons (build_string (tempfile), Qnil));
440
    }
Miles Bader's avatar
Miles Bader committed
441
  fd[0] = filefd;
442
  fd[1] = outfilefd;
Miles Bader's avatar
Miles Bader committed
443
#endif /* MSDOS */
444

445
  if (INTEGERP (buffer))
446
    fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
Jim Blandy's avatar
Jim Blandy committed
447 448
  else
    {
449
#ifndef MSDOS
Jim Blandy's avatar
Jim Blandy committed
450
      pipe (fd);
451
#endif
Jim Blandy's avatar
Jim Blandy committed
452 453 454 455 456 457 458 459 460 461 462
#if 0
      /* Replaced by close_process_descs */
      set_exclusive_use (fd[0]);
#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];
463
    int fd_error = fd1;
Jim Blandy's avatar
Jim Blandy committed
464 465

#if 0  /* Some systems don't have sigblock.  */
Jim Blandy's avatar
Jim Blandy committed
466
    mask = sigblock (sigmask (SIGCHLD));
Jim Blandy's avatar
Jim Blandy committed
467 468 469 470 471
#endif

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

472 473 474 475 476 477
    /* 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;

478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
    if (NILP (error_file))
      fd_error = open (NULL_DEVICE, O_WRONLY);
    else if (STRINGP (error_file))
      {
#ifdef DOS_NT
	fd_error = open (XSTRING (error_file)->data,
			 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
			 S_IREAD | S_IWRITE);
#else  /* not DOS_NT */
	fd_error = creat (XSTRING (error_file)->data, 0666);
#endif /* not DOS_NT */
      }

    if (fd_error < 0)
      {
	close (filefd);
Miles Bader's avatar
Miles Bader committed
494 495
	if (fd[0] != filefd)
	  close (fd[0]);
496 497
	if (fd1 >= 0)
	  close (fd1);
Miles Bader's avatar
Miles Bader committed
498 499 500 501 502 503 504
#ifdef MSDOS
	unlink (tempfile);
#endif
	report_file_error ("Cannot redirect stderr",
			   Fcons ((NILP (error_file)
				   ? build_string (NULL_DEVICE) : error_file),
				  Qnil));
505
      }
506

507
    current_dir = ENCODE_FILE (current_dir);
508

509
#ifdef MSDOS /* MW, July 1993 */
510
    /* Note that on MSDOS `child_setup' actually returns the child process
511 512
       exit status, not its PID, so we assign it to `synch_process_retcode'
       below.  */
513 514
    pid = child_setup (filefd, outfilefd, fd_error, (char **) new_argv,
		       0, current_dir);
515

516 517 518 519 520
    /* 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 */
Richard M. Stallman's avatar
Richard M. Stallman committed
521
      synch_process_death = strerror (errno);
522 523 524 525 526

    close (outfilefd);
    if (fd_error != outfilefd)
      close (fd_error);
    fd1 = -1; /* No harm in closing that one!  */
Karl Heuer's avatar
Karl Heuer committed
527 528 529
    /* Since CRLF is converted to LF within `decode_coding', we can
       always open a file with binary mode.  */
    fd[0] = open (tempfile, O_BINARY);
530 531 532 533 534 535 536
    if (fd[0] < 0)
      {
	unlink (tempfile);
	close (filefd);
	report_file_error ("Cannot re-open temporary file", Qnil);
      }
#else /* not MSDOS */
537
#ifdef WINDOWSNT
538 539
    pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
		       0, current_dir);
540
#else  /* not WINDOWSNT */
Jim Blandy's avatar
Jim Blandy committed
541 542 543 544 545 546
    pid = vfork ();

    if (pid == 0)
      {
	if (fd[0] >= 0)
	  close (fd[0]);
547 548 549 550
#ifdef HAVE_SETSID
        setsid ();
#endif
#if defined (USG) && !defined (BSD_PGRPS)
Jim Blandy's avatar
Jim Blandy committed
551 552 553 554
        setpgrp ();
#else
        setpgrp (pid, pid);
#endif /* USG */
555 556
	child_setup (filefd, fd1, fd_error, (char **) new_argv,
		     0, current_dir);
Jim Blandy's avatar
Jim Blandy committed
557
      }
558
#endif /* not WINDOWSNT */
559 560 561 562

    /* The MSDOS case did this already.  */
    if (fd_error >= 0)
      close (fd_error);
563
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
564 565 566

    environ = save_environ;

567 568
    /* Close most of our fd's, but not fd[0]
       since we will use that to read input from.  */
Jim Blandy's avatar
Jim Blandy committed
569
    close (filefd);
570
    if (fd1 >= 0 && fd1 != fd_error)
571
      close (fd1);
Jim Blandy's avatar
Jim Blandy committed
572 573 574 575
  }

  if (pid < 0)
    {
576 577
      if (fd[0] >= 0)
	close (fd[0]);
Jim Blandy's avatar
Jim Blandy committed
578 579 580
      report_file_error ("Doing vfork", Qnil);
    }

581
  if (INTEGERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
582
    {
583 584
      if (fd[0] >= 0)
	close (fd[0]);
Jim Blandy's avatar
Jim Blandy committed
585
#ifndef subprocesses
586 587 588
      /* 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
589 590 591 592 593
      wait_without_blocking ();
#endif /* subprocesses */
      return Qnil;
    }

594
  /* Enable sending signal if user quits below.  */
595 596
  call_process_exited = 0;

597 598 599 600 601
#ifdef MSDOS
  /* MSDOS needs different cleanup information.  */
  record_unwind_protect (call_process_cleanup,
			 Fcons (make_number (fd[0]), build_string (tempfile)));
#else
Jim Blandy's avatar
Jim Blandy committed
602 603
  record_unwind_protect (call_process_cleanup,
			 Fcons (make_number (fd[0]), make_number (pid)));
604
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
605 606


607
  if (BUFFERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
608 609
    Fset_buffer (buffer);

610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650
  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))
	    val = XCONS (coding_systems)->car;
	  else if (CONSP (Vdefault_process_coding_system))
	    val = XCONS (Vdefault_process_coding_system)->car;
	  else
	    val = Qnil;
	}
      setup_coding_system (Fcheck_coding_system (val), &process_coding);
      /* 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))
	setup_raw_text_coding_system (&process_coding);
    }

Jim Blandy's avatar
Jim Blandy committed
651 652 653 654 655
  immediate_quit = 1;
  QUIT;

  {
    register int nread;
656
    int first = 1;
657
    int total_read = 0;
658
    int carryover = 0;
659
    int display_on_the_fly = !NILP (display) && INTERACTIVE;
660 661 662
    struct coding_system saved_coding;

    saved_coding = process_coding;
Jim Blandy's avatar
Jim Blandy committed
663

664
    while (1)
Jim Blandy's avatar
Jim Blandy committed
665
      {
666 667
	/* 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
668
	   less than 1024--save that for the next bufferful.  */
669
	nread = carryover;
670
	while (nread < bufsize - 1024)
671
	  {
672
	    int this_read = read (fd[0], bufptr + nread, bufsize - nread);
673 674 675 676 677

	    if (this_read < 0)
	      goto give_up;

	    if (this_read == 0)
678 679 680 681
	      {
		process_coding.mode |= CODING_MODE_LAST_BLOCK;
		break;
	      }
682 683

	    nread += this_read;
684
	    total_read += this_read;
685

686 687 688
	    if (display_on_the_fly)
	      break;
	  }
689 690

	/* Now NREAD is the total amount of data in the buffer.  */
Jim Blandy's avatar
Jim Blandy committed
691
	immediate_quit = 0;
692
	
693
	if (!NILP (buffer))
Karl Heuer's avatar
Karl Heuer committed
694 695 696 697 698
	  {
	    if (process_coding.type == coding_type_no_conversion)
	      insert (bufptr, nread);
	    else
	      {			/* We have to decode the input.  */
699
		int size = decoding_buffer_size (&process_coding, nread);
700
		char *decoding_buf = (char *) xmalloc (size);
Karl Heuer's avatar
Karl Heuer committed
701

702 703
		decode_coding (&process_coding, bufptr, decoding_buf,
			       nread, size);
704 705 706 707 708 709 710 711
		if (display_on_the_fly
		    && saved_coding.type == coding_type_undecided
		    && process_coding.type != coding_type_undecided)
		  {
		    /* 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.  */
712
		    xfree (decoding_buf);
713 714 715 716 717
		    display_on_the_fly = 0;
		    process_coding = saved_coding;
		    carryover = nread;
		    continue;
		  }
718 719
		if (process_coding.produced > 0)
		  insert (decoding_buf, process_coding.produced);
720
		xfree (decoding_buf);
721
		carryover = nread - process_coding.consumed;
722 723 724 725 726 727 728 729 730 731
		if (carryover > 0)
		  {
		    /* As CARRYOVER should not be that large, we had
		       better avoid overhead of bcopy.  */
		    char *p = bufptr + process_coding.consumed;
		    char *pend = p + carryover;
		    char *dst = bufptr;

		    while (p < pend) *dst++ = *p++;
		  }
Karl Heuer's avatar
Karl Heuer committed
732 733
	      }
	  }
734 735 736 737 738 739
	if (process_coding.mode & CODING_MODE_LAST_BLOCK)
	  {
	    if (carryover > 0)
	      insert (bufptr, carryover);
	    break;
	  }
740 741 742 743 744 745 746 747 748

	/* Make the buffer bigger as we continue to read more data,
	   but not past 64k.  */
	if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
	  {
	    bufsize *= 2;
	    bufptr = (char *) alloca (bufsize);
	  }

749
	if (!NILP (display) && INTERACTIVE)
750 751 752 753 754 755
	  {
	    if (first)
	      prepare_menu_bars ();
	    first = 0;
	    redisplay_preserve_echo_area ();
	  }
Jim Blandy's avatar
Jim Blandy committed
756 757 758
	immediate_quit = 1;
	QUIT;
      }
759
  give_up: ;
Jim Blandy's avatar
Jim Blandy committed
760

761 762
  Vlast_coding_system_used = process_coding.symbol;

Eli Zaretskii's avatar
Eli Zaretskii committed
763 764 765 766 767 768 769
  /* 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"),
	   make_number (total_read));
  }

Jim Blandy's avatar
Jim Blandy committed
770 771 772 773 774 775 776
  /* Wait for it to terminate, unless it already has.  */
  wait_for_termination (pid);

  immediate_quit = 0;

  set_buffer_internal (old);

777 778 779 780
  /* 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
781 782 783 784 785 786 787 788
  unbind_to (count, Qnil);

  if (synch_process_death)
    return build_string (synch_process_death);
  return make_number (synch_process_retcode);
}
#endif

789
static Lisp_Object
Jim Blandy's avatar
Jim Blandy committed
790 791 792
delete_temp_file (name)
     Lisp_Object name;
{
793
  /* Use Fdelete_file (indirectly) because that runs a file name handler.
794
     We did that when writing the file, so we should do so when deleting.  */
795
  internal_delete_file (name);
Jim Blandy's avatar
Jim Blandy committed
796 797 798 799 800
}

DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
  3, MANY, 0,
  "Send text from START to END to a synchronous process running PROGRAM.\n\
Kenichi Handa's avatar
Kenichi Handa committed
801
The remaining arguments are optional.\n\
Jim Blandy's avatar
Jim Blandy committed
802
Delete the text if fourth arg DELETE is non-nil.\n\
803
\n\
Jim Blandy's avatar
Jim Blandy committed
804 805
Insert output in BUFFER before point; t means current buffer;\n\
 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
806 807 808 809 810 811
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
REAL-BUFFER says what to do with standard output, as above,\n\
while STDERR-FILE says what to do with standard error in the child.\n\
STDERR-FILE may be nil (discard standard error output),\n\
t (mix it with ordinary output), or a file name string.\n\
\n\
Jim Blandy's avatar
Jim Blandy committed
812 813
Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining args are passed to PROGRAM at startup as command args.\n\
814 815 816
\n\
If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
Otherwise it waits for PROGRAM to terminate\n\
817
and returns a numeric exit status or a signal description string.\n\
818
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
Jim Blandy's avatar
Jim Blandy committed
819 820 821 822
  (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
823 824 825
  struct gcpro gcpro1;
  Lisp_Object filename_string;
  register Lisp_Object start, end;
826
  int count = specpdl_ptr - specpdl;
827
  /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
828
  Lisp_Object coding_systems;
Karl Heuer's avatar
Karl Heuer committed
829 830
  Lisp_Object val, *args2;
  int i;
831
#ifdef DOS_NT
832 833 834
  char *tempfile;
  char *outf = '\0';

835 836 837
  if ((outf = egetenv ("TMPDIR"))
      || (outf = egetenv ("TMP"))
      || (outf = egetenv ("TEMP")))
838 839 840 841 842 843
    strcpy (tempfile = alloca (strlen (outf) + 20), outf);
  else
    {
      tempfile = alloca (20);
      *tempfile = '\0';
    }
844
  if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1]))
845
    strcat (tempfile, "/");
846 847 848 849
  if ('/' == DIRECTORY_SEP)
    dostounix_filename (tempfile);
  else
    unixtodos_filename (tempfile);
850 851 852
#ifdef WINDOWSNT
  strcat (tempfile, "emXXXXXX");
#else
853
  strcat (tempfile, "detmp.XXX");
854
#endif
855
#else /* not DOS_NT */
856
  char *tempfile = (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
857
  bcopy (XSTRING (Vtemp_file_name_pattern)->data, tempfile,
858
	 STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
859
#endif /* not DOS_NT */
860

861 862
  coding_systems = Qt;

Jim Blandy's avatar
Jim Blandy committed
863 864 865
  mktemp (tempfile);

  filename_string = build_string (tempfile);
866
  GCPRO1 (filename_string);
Jim Blandy's avatar
Jim Blandy committed
867 868
  start = args[0];
  end = args[1];
Karl Heuer's avatar
Karl Heuer committed
869
  /* Decide coding-system of the contents of the temporary file.  */
870 871 872
  if (!NILP (Vcoding_system_for_write))
    val = Vcoding_system_for_write;
  else if (NILP (current_buffer->enable_multibyte_characters))
Karl Heuer's avatar
Karl Heuer committed
873 874
    val = Qnil;
  else
875
    {
876 877 878 879 880 881 882 883
      args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
      args2[0] = Qcall_process_region;
      for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
      coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
      if (CONSP (coding_systems))
	val = XCONS (coding_systems)->cdr;
      else if (CONSP (Vdefault_process_coding_system))
	val = XCONS (Vdefault_process_coding_system)->cdr;
884
      else
885
	val = Qnil;
886
    }
Karl Heuer's avatar
Karl Heuer committed
887

888 889 890 891 892 893 894 895
  {
    int count1 = specpdl_ptr - specpdl;

    specbind (intern ("coding-system-for-write"), val);
    Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);

    unbind_to (count1, Qnil);
  }
896 897 898

  /* Note that Fcall_process takes care of binding 
     coding-system-for-read.  */
899

Jim Blandy's avatar
Jim Blandy committed
900 901
  record_unwind_protect (delete_temp_file, filename_string);

Kenichi Handa's avatar
Kenichi Handa committed
902
  if (nargs > 3 && !NILP (args[3]))
Jim Blandy's avatar
Jim Blandy committed
903 904
    Fdelete_region (start, end);

Kenichi Handa's avatar
Kenichi Handa committed
905 906 907 908 909 910 911 912 913 914 915
  if (nargs > 3)
    {
      args += 2;
      nargs -= 2;
    }
  else
    {
      args[0] = args[2];
      nargs = 2;
    }
  args[1] = filename_string;
Jim Blandy's avatar
Jim Blandy committed
916

Kenichi Handa's avatar
Kenichi Handa committed
917
  RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
Jim Blandy's avatar
Jim Blandy committed
918 919 920 921
}

#ifndef VMS /* VMS version is in vmsproc.c.  */

Andreas Schwab's avatar
Andreas Schwab committed
922 923
static int relocate_fd ();

Jim Blandy's avatar
Jim Blandy committed
924 925 926 927 928 929 930 931 932 933 934
/* This is the last thing run in a newly forked inferior
   either synchronous or asynchronous.
   Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
   Initialize inferior's priority, pgrp, connected dir and environment.
   then exec another program based on new_argv.

   This function may change environ for the superior process.
   Therefore, the superior process must save and restore the value
   of environ around the vfork and the call to this function.

   SET_PGRP is nonzero if we should put the subprocess into a separate
935 936 937 938 939 940
   process group.  

   CURRENT_DIR is an elisp string giving the path of the current
   directory the subprocess should have.  Since we can't really signal
   a decent error from within the child, this should be verified as an
   executable directory by the parent.  */
Jim Blandy's avatar
Jim Blandy committed
941

Andreas Schwab's avatar
Andreas Schwab committed
942
int
943
child_setup (in, out, err, new_argv, set_pgrp, current_dir)
Jim Blandy's avatar
Jim Blandy committed
944 945 946
     int in, out, err;
     register char **new_argv;
     int set_pgrp;
947
     Lisp_Object current_dir;
Jim Blandy's avatar
Jim Blandy committed
948
{
949
  char **env;
950
  char *pwd_var;
951 952
#ifdef WINDOWSNT
  int cpid;
953
  HANDLE handles[3];
954
#endif /* WINDOWSNT */
955

956
  int pid = getpid ();
Jim Blandy's avatar
Jim Blandy committed
957

958
#ifdef SET_EMACS_PRIORITY
959 960 961
  {
    extern int emacs_priority;

962 963
    if (emacs_priority < 0)
      nice (- emacs_priority);
964
  }
965
#endif
Jim Blandy's avatar
Jim Blandy committed
966 967 968 969 970

#ifdef subprocesses
  /* Close Emacs's descriptors that this process should not have.  */
  close_process_descs ();
#endif
971 972 973
  /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
     we will lose if we call close_load_descs here.  */
#ifndef DOS_NT
974
  close_load_descs ();
975
#endif
Jim Blandy's avatar
Jim Blandy committed
976 977 978 979 980 981

  /* Note that use of alloca is always safe here.  It's obvious for systems
     that do not have true vfork or that have true (stack) alloca.
     If using vfork and C_ALLOCA it is safe because that changes
     the superior's static variables as if the superior had done alloca
     and will be cleaned up in the usual way.  */
982
  {
983
    register char *temp;
984
    register int i;
Jim Blandy's avatar
Jim Blandy committed
985

986
    i = STRING_BYTES (XSTRING (current_dir));
987 988 989
    pwd_var = (char *) alloca (i + 6);
    temp = pwd_var + 4;
    bcopy ("PWD=", pwd_var, 4);
990
    bcopy (XSTRING (current_dir)->data, temp, i);
991
    if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP