src/callproc.c

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