src/callproc.c

   1 /* Synchronous subprocess invocation for GNU Emacs.
   2    Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 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)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <signal.h>
  22 #include <errno.h>
  23 #include <stdio.h>
  24
  25 #include <config.h>
  26
  27 extern int errno;
  28 extern char *strerror ();
  29
  30 /* Define SIGCHLD as an alias for SIGCLD.  */
  31
  32 #if !defined (SIGCHLD) && defined (SIGCLD)
  33 #define SIGCHLD SIGCLD
  34 #endif /* SIGCLD */
  35
  36 #include <sys/types.h>
  37
  38 #include <sys/file.h>
  39 #ifdef USG5
  40 #include <fcntl.h>
  41 #endif
  42
  43 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
  44 #include <fcntl.h>
  45 #include <sys/stat.h>
  46 #include <sys/param.h>
  47 #include <errno.h>
  48 #endif /* MSDOS */
  49
  50 #ifndef O_RDONLY
  51 #define O_RDONLY 0
  52 #endif
  53
  54 #ifndef O_WRONLY
  55 #define O_WRONLY 1
  56 #endif
  57
  58 #include "lisp.h"
  59 #include "commands.h"
  60 #include "buffer.h"
  61 #include <paths.h>
  62 #include "process.h"
  63 #include "syssignal.h"
  64 #include "systty.h"
  65
  66 #ifdef VMS
  67 extern noshare char **environ;
  68 #else
  69 extern char **environ;
  70 #endif
  71
  72 #define max(a, b) ((a) > (b) ? (a) : (b))
  73
  74 #ifdef MSDOS
  75 Lisp_Object Vbinary_process;
  76 #endif
  77
  78 Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
  79 Lisp_Object Vconfigure_info_directory;
  80
  81 Lisp_Object Vshell_file_name;
  82
  83 Lisp_Object Vprocess_environment;
  84
  85 /* True iff we are about to fork off a synchronous process or if we
  86    are waiting for it.  */
  87 int synch_process_alive;
  88
  89 /* Nonzero => this is a string explaining death of synchronous subprocess.  */
  90 char *synch_process_death;
  91
  92 /* If synch_process_death is zero,
  93    this is exit code of synchronous subprocess.  */
  94 int synch_process_retcode;
  95
  96 extern Lisp_Object Vdoc_file_name;
  97 \f
  98 #ifndef VMS  /* VMS version is in vmsproc.c.  */
  99
 100 static Lisp_Object
 101 call_process_kill (fdpid)
 102      Lisp_Object fdpid;
 103 {
 104   close (XFASTINT (Fcar (fdpid)));
 105   EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
 106   synch_process_alive = 0;
 107   return Qnil;
 108 }
 109
 110 Lisp_Object
 111 call_process_cleanup (fdpid)
 112      Lisp_Object fdpid;
 113 {
 114 #ifdef MSDOS
 115   /* for MSDOS fdpid is really (fd . tempfile)  */
 116   register Lisp_Object file = Fcdr (fdpid);
 117   close (XFASTINT (Fcar (fdpid)));
 118   if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
 119     unlink (XSTRING (file)->data);
 120 #else /* not MSDOS */
 121   register int pid = XFASTINT (Fcdr (fdpid));
 122
 123   if (EMACS_KILLPG (pid, SIGINT) == 0)
 124     {
 125       int count = specpdl_ptr - specpdl;
 126       record_unwind_protect (call_process_kill, fdpid);
 127       message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
 128       immediate_quit = 1;
 129       QUIT;
 130       wait_for_termination (pid);
 131       immediate_quit = 0;
 132       specpdl_ptr = specpdl + count; /* Discard the unwind protect.  */
 133       message1 ("Waiting for process to die...done");
 134     }
 135   synch_process_alive = 0;
 136   close (XFASTINT (Fcar (fdpid)));
 137 #endif /* not MSDOS */
 138   return Qnil;
 139 }
 140
 141 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
 142   "Call PROGRAM synchronously in separate process.\n\
 143 The program's input comes from file INFILE (nil means `/dev/null').\n\
 144 Insert output in BUFFER before point; t means current buffer;\n\
 145  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 146 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 147 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
 148 If BUFFER is 0, returns immediately with value nil.\n\
 149 Otherwise waits for PROGRAM to terminate\n\
 150 and returns a numeric exit status or a signal description string.\n\
 151 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 152   (nargs, args)
 153      int nargs;
 154      register Lisp_Object *args;
 155 {
 156   Lisp_Object infile, buffer, current_dir, display, path;
 157   int fd[2];
 158   int filefd;
 159   register int pid;
 160   char buf[1024];
 161   int count = specpdl_ptr - specpdl;
 162   register unsigned char **new_argv
 163     = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
 164   struct buffer *old = current_buffer;
 165 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
 166   char *outf, *tempfile;
 167   int outfilefd;
 168 #endif
 169 #if 0
 170   int mask;
 171 #endif
 172   CHECK_STRING (args[0], 0);
 173
 174 #ifndef subprocesses
 175   /* Without asynchronous processes we cannot have BUFFER == 0.  */
 176   if (nargs >= 3 && XTYPE (args[2]) == Lisp_Int)
 177     error ("Operating system cannot handle asynchronous subprocesses");
 178 #endif /* subprocesses */
 179
 180   if (nargs >= 2 && ! NILP (args[1]))
 181     {
 182       infile = Fexpand_file_name (args[1], current_buffer->directory);
 183       CHECK_STRING (infile, 1);
 184     }
 185   else
 186     infile = build_string (NULL_DEVICE);
 187
 188   if (nargs >= 3)
 189     {
 190       register Lisp_Object tem;
 191
 192       buffer = tem = args[2];
 193       if (!(EQ (tem, Qnil)
 194             || EQ (tem, Qt)
 195             || XFASTINT (tem) == 0))
 196         {
 197           buffer = Fget_buffer (tem);
 198           CHECK_BUFFER (buffer, 2);
 199         }
 200     }
 201   else
 202     buffer = Qnil;
 203
 204   /* Make sure that the child will be able to chdir to the current
 205      buffer's current directory, or its unhandled equivalent.  We
 206      can't just have the child check for an error when it does the
 207      chdir, since it's in a vfork.
 208
 209      We have to GCPRO around this because Fexpand_file_name,
 210      Funhandled_file_name_directory, and Ffile_accessible_directory_p
 211      might call a file name handling function.  The argument list is
 212      protected by the caller, so all we really have to worry about is
 213      buffer.  */
 214   {
 215     struct gcpro gcpro1, gcpro2, gcpro3;
 216
 217     current_dir = current_buffer->directory;
 218
 219     GCPRO3 (infile, buffer, current_dir);
 220
 221     current_dir =
 222       expand_and_dir_to_file
 223         (Funhandled_file_name_directory (current_dir), Qnil);
 224     if (NILP (Ffile_accessible_directory_p (current_dir)))
 225       report_file_error ("Setting current directory",
 226                          Fcons (current_buffer->directory, Qnil));
 227
 228     UNGCPRO;
 229   }
 230
 231   display = nargs >= 4 ? args[3] : Qnil;
 232
 233   {
 234     register int i;
 235     for (i = 4; i < nargs; i++)
 236       {
 237         CHECK_STRING (args[i], i);
 238         new_argv[i - 3] = XSTRING (args[i])->data;
 239       }
 240     /* Program name is first command arg */
 241     new_argv[0] = XSTRING (args[0])->data;
 242     new_argv[i - 3] = 0;
 243   }
 244
 245   filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
 246   if (filefd < 0)
 247     {
 248       report_file_error ("Opening process input file", Fcons (infile, Qnil));
 249     }
 250   /* Search for program; barf if not found.  */
 251   openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
 252   if (NILP (path))
 253     {
 254       close (filefd);
 255       report_file_error ("Searching for program", Fcons (args[0], Qnil));
 256     }
 257   new_argv[0] = XSTRING (path)->data;
 258
 259 #ifdef MSDOS /* MW, July 1993 */
 260   /* These vars record information from process termination.
 261      Clear them now before process can possibly terminate,
 262      to avoid timing error if process terminates soon.  */
 263   synch_process_death = 0;
 264   synch_process_retcode = 0;
 265
 266   if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
 267     strcpy (tempfile = alloca (strlen (outf) + 20), outf);
 268   else
 269     {
 270       tempfile = alloca (20);
 271       *tempfile = '\0';
 272     }
 273   dostounix_filename (tempfile);
 274   if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
 275     strcat (tempfile, "/");
 276   strcat (tempfile, "detmp.XXX");
 277   mktemp (tempfile);
 278
 279   outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
 280   if (outfilefd < 0)
 281     {
 282       close (filefd);
 283       report_file_error ("Opening process output file", Fcons (tempfile, Qnil));
 284     }
 285 #endif
 286
 287   if (XTYPE (buffer) == Lisp_Int)
 288     fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
 289   else
 290     {
 291 #ifndef MSDOS
 292       pipe (fd);
 293 #endif
 294 #if 0
 295       /* Replaced by close_process_descs */
 296       set_exclusive_use (fd[0]);
 297 #endif
 298     }
 299
 300   {
 301     /* child_setup must clobber environ in systems with true vfork.
 302        Protect it from permanent change.  */
 303     register char **save_environ = environ;
 304     register int fd1 = fd[1];
 305
 306 #if 0  /* Some systems don't have sigblock.  */
 307     mask = sigblock (sigmask (SIGCHLD));
 308 #endif
 309
 310     /* Record that we're about to create a synchronous process.  */
 311     synch_process_alive = 1;
 312
 313     /* These vars record information from process termination.
 314        Clear them now before process can possibly terminate,
 315        to avoid timing error if process terminates soon.  */
 316     synch_process_death = 0;
 317     synch_process_retcode = 0;
 318
 319 #ifdef MSDOS /* MW, July 1993 */
 320     pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd);
 321     close (outfilefd);
 322     fd1 = -1; /* No harm in closing that one!  */
 323     fd[0] = open (tempfile, NILP (Vbinary_process) ? O_TEXT : O_BINARY);
 324     if (fd[0] < 0)
 325       {
 326         unlink (tempfile);
 327         report_file_error ("Cannot re-open temporary file", Qnil);
 328       }
 329 #else /* not MSDOS */
 330     pid = vfork ();
 331
 332     if (pid == 0)
 333       {
 334         if (fd[0] >= 0)
 335           close (fd[0]);
 336 #ifdef USG
 337         setpgrp ();
 338 #else
 339         setpgrp (pid, pid);
 340 #endif /* USG */
 341         child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
 342       }
 343 #endif /* not MSDOS */
 344
 345 #if 0
 346     /* Tell SIGCHLD handler to look for this pid.  */
 347     synch_process_pid = pid;
 348     /* Now let SIGCHLD come through.  */
 349     sigsetmask (mask);
 350 #endif
 351
 352     environ = save_environ;
 353
 354     close (filefd);
 355     if (fd1 >= 0)
 356       close (fd1);
 357   }
 358
 359   if (pid < 0)
 360     {
 361       close (fd[0]);
 362       report_file_error ("Doing vfork", Qnil);
 363     }
 364
 365   if (XTYPE (buffer) == Lisp_Int)
 366     {
 367 #ifndef subprocesses
 368       /* If Emacs has been built with asynchronous subprocess support,
 369          we don't need to do this, I think because it will then have
 370          the facilities for handling SIGCHLD.  */
 371       wait_without_blocking ();
 372 #endif /* subprocesses */
 373       return Qnil;
 374     }
 375
 376 #ifdef MSDOS
 377   /* MSDOS needs different cleanup information.  */
 378   record_unwind_protect (call_process_cleanup,
 379                          Fcons (make_number (fd[0]), build_string (tempfile)));
 380 #else
 381   record_unwind_protect (call_process_cleanup,
 382                          Fcons (make_number (fd[0]), make_number (pid)));
 383 #endif /* not MSDOS */
 384
 385
 386   if (XTYPE (buffer) == Lisp_Buffer)
 387     Fset_buffer (buffer);
 388
 389   immediate_quit = 1;
 390   QUIT;
 391
 392   {
 393     register int nread;
 394     int first = 1;
 395
 396     while ((nread = read (fd[0], buf, sizeof buf)) > 0)
 397       {
 398         immediate_quit = 0;
 399         if (!NILP (buffer))
 400           insert (buf, nread);
 401         if (!NILP (display) && INTERACTIVE)
 402           {
 403             if (first)
 404               prepare_menu_bars ();
 405             first = 0;
 406             redisplay_preserve_echo_area ();
 407           }
 408         immediate_quit = 1;
 409         QUIT;
 410       }
 411   }
 412
 413   /* Wait for it to terminate, unless it already has.  */
 414   wait_for_termination (pid);
 415
 416   immediate_quit = 0;
 417
 418   set_buffer_internal (old);
 419
 420   unbind_to (count, Qnil);
 421
 422   if (synch_process_death)
 423     return build_string (synch_process_death);
 424   return make_number (synch_process_retcode);
 425 }
 426 #endif
 427 \f
 428 static Lisp_Object
 429 delete_temp_file (name)
 430      Lisp_Object name;
 431 {
 432   unlink (XSTRING (name)->data);
 433 }
 434
 435 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
 436   3, MANY, 0,
 437   "Send text from START to END to a synchronous process running PROGRAM.\n\
 438 Delete the text if fourth arg DELETE is non-nil.\n\
 439 Insert output in BUFFER before point; t means current buffer;\n\
 440  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 441 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 442 Remaining args are passed to PROGRAM at startup as command args.\n\
 443 If BUFFER is nil, returns immediately with value nil.\n\
 444 Otherwise waits for PROGRAM to terminate\n\
 445 and returns a numeric exit status or a signal description string.\n\
 446 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 447   (nargs, args)
 448      int nargs;
 449      register Lisp_Object *args;
 450 {
 451   register Lisp_Object filename_string, start, end;
 452 #ifdef MSDOS
 453   char *tempfile;
 454 #else
 455   char tempfile[20];
 456 #endif
 457   int count = specpdl_ptr - specpdl;
 458 #ifdef MSDOS
 459   char *outf = '\0';
 460
 461   if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
 462     strcpy (tempfile = alloca (strlen (outf) + 20), outf);
 463   else
 464     {
 465       tempfile = alloca (20);
 466       *tempfile = '\0';
 467     }
 468   dostounix_filename (tempfile);
 469   if (tempfile[strlen (tempfile) - 1] != '/')
 470     strcat (tempfile, "/");
 471   strcat (tempfile, "detmp.XXX");
 472 #else /* not MSDOS */
 473
 474 #ifdef VMS
 475   strcpy (tempfile, "tmp:emacsXXXXXX.");
 476 #else
 477   strcpy (tempfile, "/tmp/emacsXXXXXX");
 478 #endif
 479 #endif /* not MSDOS */
 480
 481   mktemp (tempfile);
 482
 483   filename_string = build_string (tempfile);
 484   start = args[0];
 485   end = args[1];
 486   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
 487   record_unwind_protect (delete_temp_file, filename_string);
 488
 489   if (!NILP (args[3]))
 490     Fdelete_region (start, end);
 491
 492   args[3] = filename_string;
 493
 494   return unbind_to (count, Fcall_process (nargs - 2, args + 2));
 495 }
 496 \f
 497 #ifndef VMS /* VMS version is in vmsproc.c.  */
 498
 499 /* This is the last thing run in a newly forked inferior
 500    either synchronous or asynchronous.
 501    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
 502    Initialize inferior's priority, pgrp, connected dir and environment.
 503    then exec another program based on new_argv.
 504
 505    This function may change environ for the superior process.
 506    Therefore, the superior process must save and restore the value
 507    of environ around the vfork and the call to this function.
 508
 509    ENV is the environment for the subprocess.
 510
 511    SET_PGRP is nonzero if we should put the subprocess into a separate
 512    process group.
 513
 514    CURRENT_DIR is an elisp string giving the path of the current
 515    directory the subprocess should have.  Since we can't really signal
 516    a decent error from within the child, this should be verified as an
 517    executable directory by the parent.  */
 518
 519 child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 520      int in, out, err;
 521      register char **new_argv;
 522      int set_pgrp;
 523      Lisp_Object current_dir;
 524 {
 525 #ifdef MSDOS
 526   /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
 527      instead.  */
 528 #else /* not MSDOS */
 529   char **env;
 530
 531   int pid = getpid ();
 532
 533   {
 534     extern int emacs_priority;
 535
 536     nice (- emacs_priority);
 537   }
 538
 539 #ifdef subprocesses
 540   /* Close Emacs's descriptors that this process should not have.  */
 541   close_process_descs ();
 542 #endif
 543   close_load_descs ();
 544
 545   /* Note that use of alloca is always safe here.  It's obvious for systems
 546      that do not have true vfork or that have true (stack) alloca.
 547      If using vfork and C_ALLOCA it is safe because that changes
 548      the superior's static variables as if the superior had done alloca
 549      and will be cleaned up in the usual way.  */
 550   {
 551     register unsigned char *temp;
 552     register int i;
 553
 554     i = XSTRING (current_dir)->size;
 555     temp = (unsigned char *) alloca (i + 2);
 556     bcopy (XSTRING (current_dir)->data, temp, i);
 557     if (temp[i - 1] != '/') temp[i++] = '/';
 558     temp[i] = 0;
 559
 560     /* We can't signal an Elisp error here; we're in a vfork.  Since
 561        the callers check the current directory before forking, this
 562        should only return an error if the directory's permissions
 563        are changed between the check and this chdir, but we should
 564        at least check.  */
 565     if (chdir (temp) < 0)
 566       exit (errno);
 567   }
 568
 569   /* Set `env' to a vector of the strings in Vprocess_environment.  */
 570   {
 571     register Lisp_Object tem;
 572     register char **new_env;
 573     register int new_length;
 574
 575     new_length = 0;
 576     for (tem = Vprocess_environment;
 577          (XTYPE (tem) == Lisp_Cons
 578           && XTYPE (XCONS (tem)->car) == Lisp_String);
 579          tem = XCONS (tem)->cdr)
 580       new_length++;
 581
 582     /* new_length + 1 to include terminating 0.  */
 583     env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
 584
 585     /* Copy the Vprocess_environment strings into new_env.  */
 586     for (tem = Vprocess_environment;
 587          (XTYPE (tem) == Lisp_Cons
 588           && XTYPE (XCONS (tem)->car) == Lisp_String);
 589          tem = XCONS (tem)->cdr)
 590       {
 591         char **ep = env;
 592         char *string = (char *) XSTRING (XCONS (tem)->car)->data;
 593         /* See if this string duplicates any string already in the env.
 594            If so, don't put it in.
 595            When an env var has multiple definitions,
 596            we keep the definition that comes first in process-environment.  */
 597         for (; ep != new_env; ep++)
 598           {
 599             char *p = *ep, *q = string;
 600             while (1)
 601               {
 602                 if (*q == 0)
 603                   /* The string is malformed; might as well drop it.  */
 604                   goto duplicate;
 605                 if (*q != *p)
 606                   break;
 607                 if (*q == '=')
 608                   goto duplicate;
 609                 p++, q++;
 610               }
 611           }
 612         *new_env++ = string;
 613       duplicate: ;
 614       }
 615     *new_env = 0;
 616   }
 617
 618   /* Make sure that in, out, and err are not actually already in
 619      descriptors zero, one, or two; this could happen if Emacs is
 620      started with its standard in, out, or error closed, as might
 621      happen under X.  */
 622   in = relocate_fd (in, 3);
 623   out = relocate_fd (out, 3);
 624   err = relocate_fd (err, 3);
 625
 626   close (0);
 627   close (1);
 628   close (2);
 629
 630   dup2 (in, 0);
 631   dup2 (out, 1);
 632   dup2 (err, 2);
 633   close (in);
 634   close (out);
 635   close (err);
 636
 637 #ifdef USG
 638 #ifndef SETPGRP_RELEASES_CTTY
 639   setpgrp ();                   /* No arguments but equivalent in this case */
 640 #endif
 641 #else
 642   setpgrp (pid, pid);
 643 #endif /* USG */
 644   /* setpgrp_of_tty is incorrect here; it uses input_fd.  */
 645   EMACS_SET_TTY_PGRP (0, &pid);
 646
 647 #ifdef vipc
 648   something missing here;
 649 #endif /* vipc */
 650
 651   /* execvp does not accept an environment arg so the only way
 652      to pass this environment is to set environ.  Our caller
 653      is responsible for restoring the ambient value of environ.  */
 654   environ = env;
 655   execvp (new_argv[0], new_argv);
 656
 657   write (1, "Couldn't exec the program ", 26);
 658   write (1, new_argv[0], strlen (new_argv[0]));
 659   _exit (1);
 660 #endif /* not MSDOS */
 661 }
 662
 663 /* Move the file descriptor FD so that its number is not less than MIN.
 664    If the file descriptor is moved at all, the original is freed.  */
 665 int
 666 relocate_fd (fd, min)
 667      int fd, min;
 668 {
 669   if (fd >= min)
 670     return fd;
 671   else
 672     {
 673       int new = dup (fd);
 674       if (new == -1)
 675         {
 676           char *message1 = "Error while setting up child: ";
 677           char *errmessage = strerror (errno);
 678           char *message2 = "\n";
 679           write (2, message1, strlen (message1));
 680           write (2, errmessage, strlen (errmessage));
 681           write (2, message2, strlen (message2));
 682           _exit (1);
 683         }
 684       /* Note that we hold the original FD open while we recurse,
 685          to guarantee we'll get a new FD if we need it.  */
 686       new = relocate_fd (new, min);
 687       close (fd);
 688       return new;
 689     }
 690 }
 691
 692 static int
 693 getenv_internal (var, varlen, value, valuelen)
 694      char *var;
 695      int varlen;
 696      char **value;
 697      int *valuelen;
 698 {
 699   Lisp_Object scan;
 700
 701   for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
 702     {
 703       Lisp_Object entry = XCONS (scan)->car;
 704
 705       if (XTYPE (entry) == Lisp_String
 706           && XSTRING (entry)->size > varlen
 707           && XSTRING (entry)->data[varlen] == '='
 708           && ! bcmp (XSTRING (entry)->data, var, varlen))
 709         {
 710           *value    = (char *) XSTRING (entry)->data + (varlen + 1);
 711           *valuelen = XSTRING (entry)->size - (varlen + 1);
 712           return 1;
 713         }
 714     }
 715
 716   return 0;
 717 }
 718
 719 DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0,
 720   "Return the value of environment variable VAR, as a string.\n\
 721 VAR should be a string.  Value is nil if VAR is undefined in the environment.\n\
 722 This function consults the variable ``process-environment'' for its value.")
 723   (var)
 724      Lisp_Object var;
 725 {
 726   char *value;
 727   int valuelen;
 728
 729   CHECK_STRING (var, 0);
 730   if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
 731                        &value, &valuelen))
 732     return make_string (value, valuelen);
 733   else
 734     return Qnil;
 735 }
 736
 737 /* A version of getenv that consults process_environment, easily
 738    callable from C.  */
 739 char *
 740 egetenv (var)
 741      char *var;
 742 {
 743   char *value;
 744   int valuelen;
 745
 746   if (getenv_internal (var, strlen (var), &value, &valuelen))
 747     return value;
 748   else
 749     return 0;
 750 }
 751
 752 #endif /* not VMS */
 753 \f
 754 /* This is run before init_cmdargs.  */
 755
 756 init_callproc_1 ()
 757 {
 758   char *data_dir = egetenv ("EMACSDATA");
 759   char *doc_dir = egetenv ("EMACSDOC");
 760
 761   Vdata_directory
 762     = Ffile_name_as_directory (build_string (data_dir ? data_dir
 763                                              : PATH_DATA));
 764   Vdoc_directory
 765     = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
 766                                              : PATH_DOC));
 767
 768   /* Check the EMACSPATH environment variable, defaulting to the
 769      PATH_EXEC path from paths.h.  */
 770   Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
 771   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
 772   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 773 }
 774
 775 /* This is run after init_cmdargs, so that Vinvocation_directory is valid.  */
 776
 777 init_callproc ()
 778 {
 779   char *data_dir = egetenv ("EMACSDATA");
 780
 781   register char * sh;
 782   Lisp_Object tempdir;
 783
 784   if (initialized && !NILP (Vinstallation_directory))
 785     {
 786       /* Add to the path the lib-src subdir of the installation dir.  */
 787       Lisp_Object tem;
 788       tem = Fexpand_file_name (build_string ("lib-src"),
 789                                Vinstallation_directory);
 790       if (NILP (Fmember (tem, Vexec_path)))
 791         {
 792           Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
 793           Vexec_directory = Ffile_name_as_directory (tem);
 794
 795           /* If we use ../lib-src, maybe use ../etc as well.
 796              Do so if ../etc exists and has our DOC-... file in it.  */
 797           if (data_dir == 0)
 798             {
 799               tem = Fexpand_file_name (build_string ("etc"),
 800                                        Vinstallation_directory);
 801               Vdata_directory = Ffile_name_as_directory (tem);
 802             }
 803         }
 804     }
 805
 806   tempdir = Fdirectory_file_name (Vexec_directory);
 807   if (access (XSTRING (tempdir)->data, 0) < 0)
 808     {
 809       fprintf (stderr,
 810                "Warning: arch-dependent data dir (%s) does not exist.\n",
 811                XSTRING (Vexec_directory)->data);
 812       sleep (2);
 813     }
 814
 815   tempdir = Fdirectory_file_name (Vdata_directory);
 816   if (access (XSTRING (tempdir)->data, 0) < 0)
 817     {
 818       fprintf (stderr,
 819                "Warning: arch-independent data dir (%s) does not exist.\n",
 820                XSTRING (Vdata_directory)->data);
 821       sleep (2);
 822     }
 823
 824 #ifdef VMS
 825   Vshell_file_name = build_string ("*dcl*");
 826 #else
 827   sh = (char *) getenv ("SHELL");
 828   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
 829 #endif
 830 }
 831
 832 set_process_environment ()
 833 {
 834   register char **envp;
 835
 836   Vprocess_environment = Qnil;
 837 #ifndef CANNOT_DUMP
 838   if (initialized)
 839 #endif
 840     for (envp = environ; *envp; envp++)
 841       Vprocess_environment = Fcons (build_string (*envp),
 842                                     Vprocess_environment);
 843 }
 844
 845 syms_of_callproc ()
 846 {
 847 #ifdef MSDOS
 848   DEFVAR_LISP ("binary-process", &Vbinary_process,
 849     "*If non-nil then new subprocesses are assumed to produce binary output.");
 850   Vbinary_process = Qnil;
 851 #endif
 852
 853   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
 854     "*File name to load inferior shells from.\n\
 855 Initialized from the SHELL environment variable.");
 856
 857   DEFVAR_LISP ("exec-path", &Vexec_path,
 858     "*List of directories to search programs to run in subprocesses.\n\
 859 Each element is a string (directory name) or nil (try default directory).");
 860
 861   DEFVAR_LISP ("exec-directory", &Vexec_directory,
 862     "Directory of architecture-dependent files that come with GNU Emacs,\n\
 863 especially executable programs intended for Emacs to invoke.");
 864
 865   DEFVAR_LISP ("data-directory", &Vdata_directory,
 866     "Directory of architecture-independent files that come with GNU Emacs,\n\
 867 intended for Emacs to use.");
 868
 869   DEFVAR_LISP ("doc-directory", &Vdoc_directory,
 870     "Directory containing the DOC file that comes with GNU Emacs.\n\
 871 This is usually the same as data-directory.");
 872
 873   DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
 874     "For internal use by the build procedure only.\n\
 875 This is the name of the directory in which the build procedure installed\n\
 876 Emacs's info files; the default value for Info-default-directory-list\n\
 877 includes this.");
 878   Vconfigure_info_directory = build_string (PATH_INFO);
 879
 880   DEFVAR_LISP ("process-environment", &Vprocess_environment,
 881     "List of environment variables for subprocesses to inherit.\n\
 882 Each element should be a string of the form ENVVARNAME=VALUE.\n\
 883 The environment which Emacs inherits is placed in this variable\n\
 884 when Emacs starts.");
 885
 886 #ifndef VMS
 887   defsubr (&Scall_process);
 888   defsubr (&Sgetenv);
 889 #endif
 890   defsubr (&Scall_process_region);
 891 }