root/src/callproc.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. get_current_directory
  2. record_kill_process
  3. delete_temp_file
  4. call_process_kill
  5. call_process_cleanup
  6. call_process
  7. create_temp_file
  8. add_env
  9. exec_failed
  10. child_setup
  11. emacs_posix_spawn_init_actions
  12. emacs_posix_spawn_init_attributes
  13. emacs_spawn
  14. getenv_internal_1
  15. getenv_internal
  16. egetenv_internal
  17. make_environment_block
  18. init_callproc_1
  19. init_callproc
  20. set_initial_environment
  21. syms_of_callproc

     1 /* Synchronous subprocess invocation for GNU Emacs.
     2 
     3 Copyright (C) 1985-1988, 1993-1995, 1999-2023 Free Software Foundation,
     4 Inc.
     5 
     6 This file is part of GNU Emacs.
     7 
     8 GNU Emacs is free software: you can redistribute it and/or modify
     9 it under the terms of the GNU General Public License as published by
    10 the Free Software Foundation, either version 3 of the License, or (at
    11 your option) any later version.
    12 
    13 GNU Emacs is distributed in the hope that it will be useful,
    14 but WITHOUT ANY WARRANTY; without even the implied warranty of
    15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16 GNU General Public License for more details.
    17 
    18 You should have received a copy of the GNU General Public License
    19 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    20 
    21 
    22 #include <config.h>
    23 #include <errno.h>
    24 #include <stdlib.h>
    25 #include <sys/types.h>
    26 #include <unistd.h>
    27 
    28 #ifdef MSDOS
    29 extern char **environ;
    30 #endif
    31 
    32 #include <sys/file.h>
    33 #include <fcntl.h>
    34 
    35 /* In order to be able to use `posix_spawn', it needs to support some
    36    variant of `chdir' as well as `setsid'.  */
    37 #if defined HAVE_SPAWN_H && defined HAVE_POSIX_SPAWN        \
    38   && defined HAVE_POSIX_SPAWNATTR_SETFLAGS                  \
    39   && (defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR        \
    40       || defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) \
    41   && defined HAVE_DECL_POSIX_SPAWN_SETSID                   \
    42   && HAVE_DECL_POSIX_SPAWN_SETSID == 1                      \
    43   /* posix_spawnattr_setflags rejects POSIX_SPAWN_SETSID on \
    44      Haiku */                                               \
    45   && !defined HAIKU
    46 # include <spawn.h>
    47 # define USABLE_POSIX_SPAWN 1
    48 #else
    49 # define USABLE_POSIX_SPAWN 0
    50 #endif
    51 
    52 #include "lisp.h"
    53 
    54 #ifdef SETUP_SLAVE_PTY
    55 # include <sys/stream.h>
    56 # include <sys/stropts.h>
    57 #endif
    58 
    59 #ifdef WINDOWSNT
    60 #include <sys/socket.h> /* for fcntl */
    61 #include <windows.h>
    62 #include "w32.h"
    63 #define _P_NOWAIT 1     /* from process.h */
    64 #endif
    65 
    66 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
    67 #include <sys/stat.h>
    68 #include <sys/param.h>
    69 #endif /* MSDOS */
    70 
    71 #include "commands.h"
    72 #include "buffer.h"
    73 #include "coding.h"
    74 #include <epaths.h>
    75 #include "process.h"
    76 #include "syssignal.h"
    77 #include "syswait.h"
    78 #include "blockinput.h"
    79 #include "frame.h"
    80 #include "systty.h"
    81 #include "keyboard.h"
    82 
    83 #ifdef MSDOS
    84 #include "msdos.h"
    85 #endif
    86 
    87 #ifdef HAVE_NS
    88 #include "nsterm.h"
    89 #endif
    90 
    91 #ifdef HAVE_PGTK
    92 #include "pgtkterm.h"
    93 #endif
    94 
    95 #ifdef HAVE_ANDROID
    96 #include "android.h"
    97 #endif /* HAVE_ANDROID */
    98 
    99 /* Pattern used by call-process-region to make temp files.  */
   100 static Lisp_Object Vtemp_file_name_pattern;
   101 
   102 /* The next two variables are used while record-unwind-protect is in place
   103    during call-process for a subprocess for which record_deleted_pid has
   104    not yet been called.  At other times, synch_process_pid is zero and
   105    synch_process_tempfile's contents are irrelevant.  Doing this via static
   106    C variables is more convenient than putting them into the arguments
   107    of record-unwind-protect, as they need to be updated at randomish
   108    times in the code, and Lisp cannot always store these values as
   109    Emacs integers.  It's safe to use static variables here, as the
   110    code is never invoked reentrantly.  */
   111 
   112 /* If nonzero, a process-ID that has not been reaped.  */
   113 static pid_t synch_process_pid;
   114 
   115 /* If a string, the name of a temp file that has not been removed.  */
   116 #ifdef MSDOS
   117 static Lisp_Object synch_process_tempfile;
   118 #else
   119 # define synch_process_tempfile make_fixnum (0)
   120 #endif
   121 
   122 /* Indexes of file descriptors that need closing on call_process_kill.  */
   123 enum
   124   {
   125     /* The subsidiary process's stdout and stderr.  stdin is handled
   126        separately, in either Fcall_process_region or create_temp_file.  */
   127     CALLPROC_STDOUT, CALLPROC_STDERR,
   128 
   129     /* How to read from a pipe (or substitute) from the subsidiary process.  */
   130     CALLPROC_PIPEREAD,
   131 
   132     /* A bound on the number of file descriptors.  */
   133     CALLPROC_FDS
   134   };
   135 
   136 static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, specpdl_ref);
   137 
   138 #ifdef DOS_NT
   139 # define CHILD_SETUP_TYPE int
   140 #else
   141 # define CHILD_SETUP_TYPE _Noreturn void
   142 #endif
   143 
   144 static CHILD_SETUP_TYPE child_setup (int, int, int, char **, char **,
   145                                      const char *);
   146 
   147 /* Return the current buffer's working directory, or the home
   148    directory if it's unreachable.  If ENCODE is true, return as a string
   149    suitable for a system call; otherwise, return a string in its
   150    internal representation.  Signal an error if the result would not be
   151    an accessible directory.
   152 
   153    If the default directory lies inside a special directory which
   154    cannot be made the current working directory, and ENCODE is also
   155    set, simply return the home directory.  */
   156 
   157 Lisp_Object
   158 get_current_directory (bool encode)
   159 {
   160   Lisp_Object curdir = BVAR (current_buffer, directory);
   161   Lisp_Object dir = Funhandled_file_name_directory (curdir);
   162 
   163   /* If the file name handler says that dir is unreachable, use
   164      a sensible default. */
   165   if (NILP (dir))
   166     dir = build_string ("~");
   167 
   168 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
   169 
   170   /* If DIR is an asset directory or a content directory, return
   171      the home directory instead.  */
   172 
   173   if (encode && (!strcmp (SSDATA (dir), "/assets")
   174                  || !strncmp (SSDATA (dir), "/assets/", 8)
   175                  || !strcmp (SSDATA (dir), "/content")
   176                  || !strncmp (SSDATA (dir), "/content/", 9)))
   177     dir = build_string ("~");
   178 
   179 #endif /* HAVE_ANDROID && ANDROID_STUBIFY */
   180 
   181   dir = expand_and_dir_to_file (dir);
   182   Lisp_Object encoded_dir = ENCODE_FILE (remove_slash_colon (dir));
   183 
   184   if (! file_accessible_directory_p (encoded_dir))
   185     report_file_error ("Setting current directory", curdir);
   186 
   187   return encode ? encoded_dir : dir;
   188 }
   189 
   190 /* If P is reapable, record it as a deleted process and kill it.
   191    Do this in a critical section.  Unless PID is wedged it will be
   192    reaped on receipt of the first SIGCHLD after the critical section.  */
   193 
   194 void
   195 record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile)
   196 {
   197 #ifndef MSDOS
   198   sigset_t oldset;
   199   block_child_signal (&oldset);
   200 
   201   if (p->alive)
   202     {
   203       record_deleted_pid (p->pid, tempfile);
   204       p->alive = 0;
   205       kill (- p->pid, SIGKILL);
   206     }
   207 
   208   unblock_child_signal (&oldset);
   209 #endif  /* !MSDOS */
   210 }
   211 
   212 /* Clean up files, file descriptors and processes created by Fcall_process.  */
   213 
   214 static void
   215 delete_temp_file (Lisp_Object name)
   216 {
   217   emacs_unlink (SSDATA (name));
   218 }
   219 
   220 static void
   221 call_process_kill (void *ptr)
   222 {
   223   int *callproc_fd = ptr;
   224   int i;
   225   for (i = 0; i < CALLPROC_FDS; i++)
   226     if (0 <= callproc_fd[i])
   227       emacs_close (callproc_fd[i]);
   228 
   229   if (synch_process_pid)
   230     {
   231       struct Lisp_Process proc;
   232       proc.alive = 1;
   233       proc.pid = synch_process_pid;
   234       record_kill_process (&proc, synch_process_tempfile);
   235       synch_process_pid = 0;
   236     }
   237   else if (STRINGP (synch_process_tempfile))
   238     delete_temp_file (synch_process_tempfile);
   239 }
   240 
   241 /* Clean up when exiting Fcall_process: restore the buffer, and
   242    kill the subsidiary process group if the process still exists.  */
   243 
   244 static void
   245 call_process_cleanup (Lisp_Object buffer)
   246 {
   247   Fset_buffer (buffer);
   248 
   249 #ifndef MSDOS
   250   if (synch_process_pid)
   251     {
   252       kill (-synch_process_pid, SIGINT);
   253       message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
   254 
   255       /* This will quit on C-g.  */
   256       bool wait_ok = wait_for_termination (synch_process_pid, NULL, true);
   257       synch_process_pid = 0;
   258       message1 (wait_ok
   259                 ? "Waiting for process to die...done"
   260                 : "Waiting for process to die...internal error");
   261     }
   262 #endif  /* !MSDOS */
   263 }
   264 
   265 #ifdef DOS_NT
   266 static mode_t const default_output_mode = S_IREAD | S_IWRITE;
   267 #else
   268 static mode_t const default_output_mode = 0666;
   269 #endif
   270 
   271 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
   272        doc: /* Call PROGRAM synchronously in separate process.
   273 The remaining arguments are optional.
   274 
   275 The program's input comes from file INFILE (nil means `null-device').
   276 If INFILE is a relative path, it will be looked for relative to the
   277 directory where the process is run (see below).  If you want to make the
   278 input come from an Emacs buffer, use `call-process-region' instead.
   279 
   280 Third argument DESTINATION specifies how to handle program's output.
   281 (\"Output\" here means both standard output and standard error
   282 output.)
   283 If DESTINATION is a buffer or the name of a buffer, or t (which stands for
   284 the current buffer), it means insert output in that buffer before point.
   285 If DESTINATION is nil, it means discard output; 0 means discard
   286  and don't wait for the program to terminate.
   287 If DESTINATION is `(:file FILE)', where FILE is a file name string,
   288  it means that output should be written to that file (if the file
   289  already exists it is overwritten).
   290 DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case,
   291  REAL-BUFFER says what to do with standard output, as above,
   292  while STDERR-FILE says what to do with standard error in the child.
   293  STDERR-FILE may be nil (discard standard error output),
   294  t (mix it with ordinary output), or a file name string.
   295 
   296 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
   297 Remaining arguments ARGS are strings passed as command arguments to PROGRAM.
   298 
   299 If PROGRAM is not an absolute file name, `call-process' will look for
   300 PROGRAM in `exec-path' (which is a list of directories).
   301 
   302 If executable PROGRAM can't be found as an executable, `call-process'
   303 signals a Lisp error.  `call-process' reports errors in execution of
   304 the program only through its return and output.
   305 
   306 If DESTINATION is 0, `call-process' returns immediately with value nil.
   307 Otherwise it waits for PROGRAM to terminate
   308 and returns a numeric exit status or a signal description string.
   309 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
   310 
   311 The process runs in `default-directory' if that is local (as
   312 determined by `unhandled-file-name-directory'), or "~" otherwise.  If
   313 you want to run a process in a remote directory use `process-file'.
   314 
   315 usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS)  */)
   316   (ptrdiff_t nargs, Lisp_Object *args)
   317 {
   318   Lisp_Object infile, encoded_infile;
   319   int filefd;
   320   specpdl_ref count = SPECPDL_INDEX ();
   321 
   322   if (nargs >= 2 && ! NILP (args[1]))
   323     {
   324       /* Expand infile relative to the current buffer's current
   325          directory, or its unhandled equivalent ("~").  */
   326       infile = Fexpand_file_name (args[1], get_current_directory (false));
   327       CHECK_STRING (infile);
   328     }
   329   else
   330     infile = build_string (NULL_DEVICE);
   331 
   332   /* Remove "/:" from INFILE.  */
   333   infile = remove_slash_colon (infile);
   334 
   335   encoded_infile = ENCODE_FILE (infile);
   336 
   337   filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
   338   if (filefd < 0)
   339     report_file_error ("Opening process input file", infile);
   340   record_unwind_protect_int (close_file_unwind, filefd);
   341   return unbind_to (count, call_process (nargs, args, filefd,
   342                                          make_invalid_specpdl_ref ()));
   343 }
   344 
   345 /* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file.
   346 
   347    If TEMPFILE_INDEX is valid, it is the specpdl index of an
   348    unwinder that is intended to remove the input temporary file; in
   349    this case NARGS must be at least 2 and ARGS[1] is the file's name.
   350 
   351    At entry, the specpdl stack top entry must be close_file_unwind (FILEFD).  */
   352 
   353 static Lisp_Object
   354 call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
   355               specpdl_ref tempfile_index)
   356 {
   357   Lisp_Object buffer, current_dir, path;
   358   bool display_p;
   359   int fd0;
   360   int callproc_fd[CALLPROC_FDS];
   361   int status;
   362   ptrdiff_t i;
   363   specpdl_ref count = SPECPDL_INDEX ();
   364   USE_SAFE_ALLOCA;
   365 
   366   char **new_argv;
   367   /* File to use for stderr in the child.
   368      t means use same as standard output.  */
   369   Lisp_Object error_file;
   370   Lisp_Object output_file = Qnil;
   371 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
   372   char *tempfile = NULL;
   373 #else
   374   sigset_t oldset;
   375   pid_t pid = -1;
   376 #endif
   377   int child_errno;
   378   int fd_output, fd_error;
   379   struct coding_system process_coding; /* coding-system of process output */
   380   struct coding_system argument_coding; /* coding-system of arguments */
   381   /* Set to the return value of Ffind_operation_coding_system.  */
   382   Lisp_Object coding_systems;
   383   bool discard_output;
   384 
   385   if (synch_process_pid)
   386     error ("call-process invoked recursively");
   387 
   388   /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
   389   coding_systems = Qt;
   390 
   391   CHECK_STRING (args[0]);
   392 
   393   error_file = Qt;
   394 
   395 #ifndef subprocesses
   396   /* Without asynchronous processes we cannot have BUFFER == 0.  */
   397   if (nargs >= 3
   398       && (FIXNUMP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
   399     error ("Operating system cannot handle asynchronous subprocesses");
   400 #endif /* subprocesses */
   401 
   402   /* Decide the coding-system for giving arguments.  */
   403   {
   404     Lisp_Object val, *args2;
   405 
   406     /* If arguments are supplied, we may have to encode them.  */
   407     if (nargs >= 5)
   408       {
   409         bool must_encode = 0;
   410         Lisp_Object coding_attrs;
   411 
   412         for (i = 4; i < nargs; i++)
   413           CHECK_STRING (args[i]);
   414 
   415         for (i = 4; i < nargs; i++)
   416           if (STRING_MULTIBYTE (args[i]))
   417             must_encode = 1;
   418 
   419         if (!NILP (Vcoding_system_for_write))
   420           val = Vcoding_system_for_write;
   421         else if (! must_encode)
   422           val = Qraw_text;
   423         else
   424           {
   425             SAFE_NALLOCA (args2, 1, nargs + 1);
   426             args2[0] = Qcall_process;
   427             for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
   428             coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
   429             val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
   430           }
   431         val = complement_process_encoding_system (val);
   432         setup_coding_system (Fcheck_coding_system (val), &argument_coding);
   433         coding_attrs = CODING_ID_ATTRS (argument_coding.id);
   434         if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
   435           {
   436             /* We should not use an ASCII incompatible coding system.  */
   437             val = raw_text_coding_system (val);
   438             setup_coding_system (val, &argument_coding);
   439           }
   440       }
   441   }
   442 
   443   if (nargs < 3)
   444     buffer = Qnil;
   445   else
   446     {
   447       buffer = args[2];
   448 
   449       /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT
   450          FILE-FOR-STDERR), unless the first element is :file, in which case see
   451          the next paragraph. */
   452       if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile))
   453         {
   454           if (CONSP (XCDR (buffer)))
   455             {
   456               Lisp_Object stderr_file;
   457               stderr_file = XCAR (XCDR (buffer));
   458 
   459               if (NILP (stderr_file) || EQ (Qt, stderr_file))
   460                 error_file = stderr_file;
   461               else
   462                 error_file = Fexpand_file_name (stderr_file, Qnil);
   463             }
   464 
   465           buffer = XCAR (buffer);
   466         }
   467 
   468       /* If the buffer is (still) a list, it might be a (:file "file") spec. */
   469       if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
   470         {
   471           Lisp_Object ofile = XCDR (buffer);
   472           if (CONSP (ofile))
   473             ofile = XCAR (ofile);
   474           CHECK_STRING (ofile);
   475           output_file = Fexpand_file_name (ofile,
   476                                            BVAR (current_buffer, directory));
   477           CHECK_STRING (output_file);
   478           buffer = Qnil;
   479         }
   480 
   481       if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer)))
   482         {
   483           Lisp_Object spec_buffer = buffer;
   484           buffer = Fget_buffer_create (buffer, Qnil);
   485           /* Mention the buffer name for a better error message.  */
   486           if (NILP (buffer))
   487             CHECK_BUFFER (spec_buffer);
   488           CHECK_BUFFER (buffer);
   489         }
   490     }
   491 
   492   /* Make sure that the child will be able to chdir to the current
   493      buffer's current directory, or its unhandled equivalent.  We
   494      can't just have the child check for an error when it does the
   495      chdir, since it's in a vfork.  */
   496   current_dir = get_current_directory (true);
   497 
   498   if (STRINGP (error_file))
   499     {
   500       error_file = remove_slash_colon (error_file);
   501       error_file = ENCODE_FILE (error_file);
   502     }
   503   if (STRINGP (output_file))
   504     {
   505       output_file = remove_slash_colon (output_file);
   506       output_file = ENCODE_FILE (output_file);
   507     }
   508 
   509   display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
   510 
   511   for (i = 0; i < CALLPROC_FDS; i++)
   512     callproc_fd[i] = -1;
   513 #ifdef MSDOS
   514   synch_process_tempfile = make_fixnum (0);
   515 #endif
   516   record_unwind_protect_ptr (call_process_kill, callproc_fd);
   517 
   518   /* Search for program; barf if not found.  */
   519   {
   520     int ok;
   521 
   522     ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
   523                 make_fixnum (X_OK), false, false, NULL);
   524     if (ok < 0)
   525       report_file_error ("Searching for program", args[0]);
   526   }
   527 
   528   /* Remove "/:" from PATH.  */
   529   path = remove_slash_colon (path);
   530 
   531   SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2);
   532 
   533   if (nargs > 4)
   534     {
   535       ptrdiff_t i;
   536 
   537       argument_coding.dst_multibyte = 0;
   538       for (i = 4; i < nargs; i++)
   539         {
   540           argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
   541           if (CODING_REQUIRE_ENCODING (&argument_coding))
   542             /* We must encode this argument.  */
   543             args[i] = encode_coding_string (&argument_coding, args[i], 1);
   544         }
   545       for (i = 4; i < nargs; i++)
   546         new_argv[i - 3] = SSDATA (args[i]);
   547       new_argv[i - 3] = 0;
   548     }
   549   else
   550     new_argv[1] = 0;
   551   path = ENCODE_FILE (path);
   552   new_argv[0] = SSDATA (path);
   553 
   554   discard_output = FIXNUMP (buffer) || (NILP (buffer) && NILP (output_file));
   555 
   556 #ifdef MSDOS
   557   if (! discard_output && ! STRINGP (output_file))
   558     {
   559       char const *tmpdir = egetenv ("TMPDIR");
   560       char const *outf = tmpdir ? tmpdir : "";
   561       tempfile = alloca (strlen (outf) + 20);
   562       strcpy (tempfile, outf);
   563       dostounix_filename (tempfile);
   564       if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
   565         strcat (tempfile, "/");
   566       strcat (tempfile, "emXXXXXX");
   567       mktemp (tempfile);
   568       if (!*tempfile)
   569         report_file_error ("Opening process output file", Qnil);
   570       output_file = build_string (tempfile);
   571       synch_process_tempfile = output_file;
   572     }
   573 #endif
   574 
   575   if (discard_output)
   576     {
   577       fd_output = emacs_open (NULL_DEVICE, O_WRONLY, 0);
   578       if (fd_output < 0)
   579         report_file_error ("Opening null device", Qnil);
   580     }
   581   else if (STRINGP (output_file))
   582     {
   583       fd_output = emacs_open (SSDATA (output_file),
   584                               O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
   585                               default_output_mode);
   586       if (fd_output < 0)
   587         {
   588           int open_errno = errno;
   589           output_file = DECODE_FILE (output_file);
   590           report_file_errno ("Opening process output file",
   591                              output_file, open_errno);
   592         }
   593     }
   594   else
   595     {
   596       int fd[2];
   597       if (emacs_pipe (fd) != 0)
   598         report_file_error ("Creating process pipe", Qnil);
   599       callproc_fd[CALLPROC_PIPEREAD] = fd[0];
   600       fd_output = fd[1];
   601     }
   602   callproc_fd[CALLPROC_STDOUT] = fd_output;
   603 
   604   fd_error = fd_output;
   605 
   606   if (STRINGP (error_file) || (NILP (error_file) && !discard_output))
   607     {
   608       fd_error = emacs_open ((STRINGP (error_file)
   609                               ? SSDATA (error_file)
   610                               : NULL_DEVICE),
   611                              O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
   612                              default_output_mode);
   613       if (fd_error < 0)
   614         {
   615           int open_errno = errno;
   616           report_file_errno ("Cannot redirect stderr",
   617                              (STRINGP (error_file)
   618                               ? DECODE_FILE (error_file)
   619                               : build_string (NULL_DEVICE)),
   620                              open_errno);
   621         }
   622       callproc_fd[CALLPROC_STDERR] = fd_error;
   623     }
   624 
   625   char **env = make_environment_block (current_dir);
   626 
   627 #ifdef MSDOS /* MW, July 1993 */
   628   status = child_setup (filefd, fd_output, fd_error, new_argv, env,
   629                         SSDATA (current_dir));
   630 
   631   if (status < 0)
   632     {
   633       child_errno = errno;
   634       unbind_to (count, Qnil);
   635       synchronize_system_messages_locale ();
   636       return
   637         code_convert_string_norecord (build_string (strerror (child_errno)),
   638                                       Vlocale_coding_system, 0);
   639     }
   640 
   641   for (i = 0; i < CALLPROC_FDS; i++)
   642     if (0 <= callproc_fd[i])
   643       {
   644         emacs_close (callproc_fd[i]);
   645         callproc_fd[i] = -1;
   646       }
   647   emacs_close (filefd);
   648   clear_unwind_protect (specpdl_ref_add (count, -1));
   649 
   650   if (tempfile)
   651     {
   652       /* Since CRLF is converted to LF within `decode_coding', we
   653          can always open a file with binary mode.  */
   654       callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile, O_RDONLY, 0);
   655       if (callproc_fd[CALLPROC_PIPEREAD] < 0)
   656         {
   657           int open_errno = errno;
   658           report_file_errno ("Cannot re-open temporary file",
   659                              build_string (tempfile), open_errno);
   660         }
   661     }
   662 
   663 #endif /* MSDOS */
   664 
   665   /* Do the unwind-protect now, even though the pid is not known, so
   666      that no storage allocation is done in the critical section.
   667      The actual PID will be filled in during the critical section.  */
   668   record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
   669 
   670 #ifndef MSDOS
   671 
   672   child_signal_init ();
   673   block_input ();
   674   block_child_signal (&oldset);
   675 
   676   child_errno
   677     = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
   678                    SSDATA (current_dir), NULL, false, false, &oldset);
   679   eassert ((child_errno == 0) == (0 < pid));
   680 
   681   if (pid > 0)
   682     {
   683       synch_process_pid = pid;
   684 
   685       if (FIXNUMP (buffer))
   686         {
   687           if (!specpdl_ref_valid_p (tempfile_index))
   688             record_deleted_pid (pid, Qnil);
   689           else
   690             {
   691               eassert (1 < nargs);
   692               record_deleted_pid (pid, args[1]);
   693               clear_unwind_protect (tempfile_index);
   694             }
   695           synch_process_pid = 0;
   696         }
   697     }
   698 
   699   unblock_child_signal (&oldset);
   700   unblock_input ();
   701 
   702   if (pid < 0)
   703     report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
   704 
   705   /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD]
   706      since we will use that to read input from.  */
   707   for (i = 0; i < CALLPROC_FDS; i++)
   708     if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i])
   709       {
   710         emacs_close (callproc_fd[i]);
   711         callproc_fd[i] = -1;
   712       }
   713   emacs_close (filefd);
   714   clear_unwind_protect (specpdl_ref_add (count, -1));
   715 
   716 #endif /* not MSDOS */
   717 
   718   if (FIXNUMP (buffer))
   719     return unbind_to (count, Qnil);
   720 
   721   if (BUFFERP (buffer))
   722     Fset_buffer (buffer);
   723 
   724   fd0 = callproc_fd[CALLPROC_PIPEREAD];
   725 
   726   if (0 <= fd0)
   727     {
   728       Lisp_Object val, *args2;
   729 
   730       val = Qnil;
   731       if (!NILP (Vcoding_system_for_read))
   732         val = Vcoding_system_for_read;
   733       else
   734         {
   735           if (EQ (coding_systems, Qt))
   736             {
   737               ptrdiff_t i;
   738 
   739               SAFE_NALLOCA (args2, 1, nargs + 1);
   740               args2[0] = Qcall_process;
   741               for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
   742               coding_systems
   743                 = Ffind_operation_coding_system (nargs + 1, args2);
   744             }
   745           if (CONSP (coding_systems))
   746             val = XCAR (coding_systems);
   747           else if (CONSP (Vdefault_process_coding_system))
   748             val = XCAR (Vdefault_process_coding_system);
   749           else
   750             val = Qnil;
   751         }
   752       Fcheck_coding_system (val);
   753       /* In unibyte mode, character code conversion should not take
   754          place but EOL conversion should.  So, setup raw-text or one
   755          of the subsidiary according to the information just setup.  */
   756       if (NILP (BVAR (current_buffer, enable_multibyte_characters))
   757           && !NILP (val))
   758         val = raw_text_coding_system (val);
   759       setup_coding_system (val, &process_coding);
   760       process_coding.dst_multibyte
   761         = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
   762       process_coding.src_multibyte = 0;
   763     }
   764 
   765   if (0 <= fd0)
   766     {
   767       enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
   768       enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN };
   769       char buf[CALLPROC_BUFFER_SIZE_MAX];
   770       int bufsize = CALLPROC_BUFFER_SIZE_MIN;
   771       int nread;
   772       EMACS_INT total_read = 0;
   773       int carryover = 0;
   774       bool display_on_the_fly = display_p;
   775       struct coding_system saved_coding = process_coding;
   776       ptrdiff_t prepared_pos = 0; /* prepare_to_modify_buffer was last
   777                                      called here.  */
   778 
   779       while (1)
   780         {
   781           /* Repeatedly read until we've filled as much as possible
   782              of the buffer size we have.  But don't read
   783              less than 1024--save that for the next bufferful.  */
   784           nread = carryover;
   785           while (nread < bufsize - 1024)
   786             {
   787               int this_read = emacs_read_quit (fd0, buf + nread,
   788                                                bufsize - nread);
   789 
   790               if (this_read < 0)
   791                 goto give_up;
   792 
   793               if (this_read == 0)
   794                 {
   795                   process_coding.mode |= CODING_MODE_LAST_BLOCK;
   796                   break;
   797                 }
   798 
   799               nread += this_read;
   800               total_read += this_read;
   801 
   802               if (display_on_the_fly)
   803                 break;
   804             }
   805           /* CHANGE FUNCTIONS
   806              For each iteration of the enclosing while (1) loop which
   807              yields data (i.e. nread > 0), before- and
   808              after-change-functions are each invoked exactly once.
   809              This is done directly from the current function only, by
   810              calling prepare_to_modify_buffer and signal_after_change.
   811              It is not done here by directing another function such as
   812              insert_1_both to call them.  The call to
   813              prepare_to_modify_buffer follows this comment, and there
   814              is one call to signal_after_change in each of the
   815              branches of the next `else if'.
   816 
   817              Exceptionally, the insertion into the buffer is aborted
   818              at the call to del_range_2 ~45 lines further down, this
   819              function removing the newly inserted data.  At this stage
   820              prepare_to_modify_buffer has been called, but
   821              signal_after_change hasn't.  A continue statement
   822              restarts the enclosing while (1) loop.  A second,
   823              unwanted, call to `prepare_to_modify_buffer' is inhibited
   824              by the test prepared_pos < PT.  The data are inserted
   825              again, and this time signal_after_change gets called,
   826              balancing the previous call to prepare_to_modify_buffer.  */
   827           if ((prepared_pos < PT) && nread)
   828             {
   829               prepare_to_modify_buffer (PT, PT, NULL);
   830               prepared_pos = PT;
   831             }
   832 
   833           /* Now NREAD is the total amount of data in the buffer.  */
   834 
   835           if (!nread)
   836             ;
   837           else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
   838                    && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
   839             {
   840               insert_1_both (buf, nread, nread, 0, 0, 0);
   841               signal_after_change (PT - nread, 0, nread);
   842             }
   843           else
   844             {                   /* We have to decode the input.  */
   845               Lisp_Object curbuf;
   846               specpdl_ref count1 = SPECPDL_INDEX ();
   847 
   848               XSETBUFFER (curbuf, current_buffer);
   849               /* We cannot allow after-change-functions be run
   850                  during decoding, because that might modify the
   851                  buffer, while we rely on process_coding.produced to
   852                  faithfully reflect inserted text until we
   853                  TEMP_SET_PT_BOTH below.  */
   854               specbind (Qinhibit_modification_hooks, Qt);
   855               decode_coding_c_string (&process_coding,
   856                                       (unsigned char *) buf, nread, curbuf);
   857               unbind_to (count1, Qnil);
   858               if (display_on_the_fly
   859                   && CODING_REQUIRE_DETECTION (&saved_coding)
   860                   && ! CODING_REQUIRE_DETECTION (&process_coding))
   861                 {
   862                   /* We have detected some coding system, but the
   863                      detection may have been via insufficient data.
   864                      So give up displaying on the fly.  */
   865                   if (process_coding.produced > 0)
   866                     del_range_2 (process_coding.dst_pos,
   867                                  process_coding.dst_pos_byte,
   868                                  (process_coding.dst_pos
   869                                   + process_coding.produced_char),
   870                                  (process_coding.dst_pos_byte
   871                                   + process_coding.produced),
   872                                  0);
   873                   display_on_the_fly = false;
   874                   process_coding = saved_coding;
   875                   carryover = nread;
   876                   /* Make the above condition always fail in the future.  */
   877                   saved_coding.common_flags
   878                     &= ~CODING_REQUIRE_DETECTION_MASK;
   879                   continue;
   880                 }
   881 
   882               TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
   883                                 PT_BYTE + process_coding.produced);
   884               signal_after_change (PT - process_coding.produced_char,
   885                                    0, process_coding.produced_char);
   886               carryover = process_coding.carryover_bytes;
   887               if (carryover > 0)
   888                 memcpy (buf, process_coding.carryover,
   889                         process_coding.carryover_bytes);
   890             }
   891 
   892           if (process_coding.mode & CODING_MODE_LAST_BLOCK)
   893             break;
   894 
   895           /* Make the buffer bigger as we continue to read more data,
   896              but not past CALLPROC_BUFFER_SIZE_MAX.  */
   897           if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
   898             if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
   899               bufsize = CALLPROC_BUFFER_SIZE_MAX;
   900 
   901           if (display_p)
   902             {
   903               redisplay_preserve_echo_area (1);
   904               /* This variable might have been set to 0 for code
   905                  detection.  In that case, set it back to 1 because
   906                  we should have already detected a coding system.  */
   907               display_on_the_fly = true;
   908             }
   909         }
   910     give_up: ;
   911 
   912       Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
   913       /* If the caller required, let the buffer inherit the
   914          coding-system used to decode the process output.  */
   915       if (inherit_process_coding_system)
   916         call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
   917                make_fixnum (total_read));
   918     }
   919 
   920   bool wait_ok = true;
   921 #ifndef MSDOS
   922   /* Wait for it to terminate, unless it already has.  */
   923   wait_ok = wait_for_termination (pid, &status, fd0 < 0);
   924 #endif
   925 
   926   /* Don't kill any children that the subprocess may have left behind
   927      when exiting.  */
   928   synch_process_pid = 0;
   929 
   930   SAFE_FREE_UNBIND_TO (count, Qnil);
   931 
   932   if (!wait_ok)
   933     return build_unibyte_string ("internal error");
   934 
   935   if (WIFSIGNALED (status))
   936     {
   937       const char *signame;
   938 
   939       synchronize_system_messages_locale ();
   940       signame = strsignal (WTERMSIG (status));
   941 
   942       if (signame == 0)
   943         signame = "unknown";
   944 
   945       return code_convert_string_norecord (build_string (signame),
   946                                            Vlocale_coding_system, 0);
   947     }
   948 
   949   eassert (WIFEXITED (status));
   950   return make_fixnum (WEXITSTATUS (status));
   951 }
   952 
   953 /* Create a temporary file suitable for storing the input data of
   954    call-process-region.  NARGS and ARGS are the same as for
   955    call-process-region.  Store into *FILENAME_STRING_PTR a Lisp string
   956    naming the file, and return a file descriptor for reading.
   957    Unwind-protect the file, so that the file descriptor will be closed
   958    and the file removed when the caller unwinds the specpdl stack.  */
   959 
   960 static int
   961 create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
   962                   Lisp_Object *filename_string_ptr)
   963 {
   964   int fd;
   965   Lisp_Object filename_string;
   966   Lisp_Object val, start, end;
   967   Lisp_Object tmpdir;
   968 
   969   if (STRINGP (Vtemporary_file_directory))
   970     tmpdir = Vtemporary_file_directory;
   971   else
   972     {
   973       char *outf;
   974 #ifndef DOS_NT
   975       outf = getenv ("TMPDIR");
   976       tmpdir = build_string (outf ? outf : "/tmp/");
   977 #else /* DOS_NT */
   978       if ((outf = egetenv ("TMPDIR"))
   979           || (outf = egetenv ("TMP"))
   980           || (outf = egetenv ("TEMP")))
   981         tmpdir = build_string (outf);
   982       else
   983         tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
   984 #endif
   985     }
   986 
   987   {
   988     Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
   989     char *tempfile;
   990 
   991 #ifdef WINDOWSNT
   992     /* Cannot use the result of Fexpand_file_name, because it
   993        downcases the XXXXXX part of the pattern, and mktemp then
   994        doesn't recognize it.  */
   995     if (!NILP (Vw32_downcase_file_names))
   996       {
   997         Lisp_Object dirname = Ffile_name_directory (pattern);
   998 
   999         if (NILP (dirname))
  1000           pattern = Vtemp_file_name_pattern;
  1001         else
  1002           pattern = concat2 (dirname, Vtemp_file_name_pattern);
  1003       }
  1004 #endif
  1005 
  1006     filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
  1007     tempfile = SSDATA (filename_string);
  1008 
  1009     specpdl_ref count = SPECPDL_INDEX ();
  1010     record_unwind_protect_nothing ();
  1011     fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC);
  1012     if (fd < 0)
  1013       report_file_error ("Failed to open temporary file using pattern",
  1014                          pattern);
  1015     set_unwind_protect (count, delete_temp_file, filename_string);
  1016     record_unwind_protect_int (close_file_unwind, fd);
  1017   }
  1018 
  1019   start = args[0];
  1020   end = args[1];
  1021   /* Decide coding-system of the contents of the temporary file.  */
  1022   if (!NILP (Vcoding_system_for_write))
  1023     val = Vcoding_system_for_write;
  1024   else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  1025     val = Qraw_text;
  1026   else
  1027     {
  1028       Lisp_Object coding_systems;
  1029       Lisp_Object *args2;
  1030       USE_SAFE_ALLOCA;
  1031       SAFE_NALLOCA (args2, 1, nargs + 1);
  1032       args2[0] = Qcall_process_region;
  1033       memcpy (args2 + 1, args, nargs * sizeof *args);
  1034       coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
  1035       val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
  1036       SAFE_FREE ();
  1037     }
  1038   val = complement_process_encoding_system (val);
  1039 
  1040   {
  1041     specpdl_ref count1 = SPECPDL_INDEX ();
  1042 
  1043     specbind (intern ("coding-system-for-write"), val);
  1044     /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
  1045        happen to get a ".Z" suffix.  */
  1046     specbind (Qfile_name_handler_alist, Qnil);
  1047     write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
  1048 
  1049     unbind_to (count1, Qnil);
  1050   }
  1051 
  1052   if (lseek (fd, 0, SEEK_SET) < 0)
  1053     report_file_error ("Setting file position", filename_string);
  1054 
  1055   /* Note that Fcall_process takes care of binding
  1056      coding-system-for-read.  */
  1057 
  1058   *filename_string_ptr = filename_string;
  1059   return fd;
  1060 }
  1061 
  1062 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
  1063        3, MANY, 0,
  1064        doc: /* Send text from START to END to a synchronous process running PROGRAM.
  1065 
  1066 START and END are normally buffer positions specifying the part of the
  1067 buffer to send to the process.
  1068 If START is nil, that means to use the entire buffer contents; END is
  1069 ignored.
  1070 If START is a string, then send that string to the process
  1071 instead of any buffer contents; END is ignored.
  1072 The remaining arguments are optional.
  1073 Delete the text if fourth arg DELETE is non-nil.
  1074 
  1075 Insert output in BUFFER before point; t means current buffer; nil for
  1076  BUFFER means discard it; 0 means discard and don't wait; and `(:file
  1077  FILE)', where FILE is a file name string, means that it should be
  1078  written to that file (if the file already exists it is overwritten).
  1079 BUFFER can be a string which is the name of a buffer.
  1080 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
  1081 REAL-BUFFER says what to do with standard output, as above,
  1082 while STDERR-FILE says what to do with standard error in the child.
  1083 STDERR-FILE may be nil (discard standard error output),
  1084 t (mix it with ordinary output), or a file name string.
  1085 
  1086 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
  1087 Remaining arguments ARGS are passed to PROGRAM at startup as command-line
  1088 arguments.
  1089 
  1090 If PROGRAM is not an absolute file name, `call-process-region' will
  1091 look for PROGRAM in `exec-path' (which is a list of directories).
  1092 
  1093 If BUFFER is 0, `call-process-region' returns immediately with value nil.
  1094 Otherwise it waits for PROGRAM to terminate
  1095 and returns a numeric exit status or a signal description string.
  1096 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
  1097 
  1098 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)  */)
  1099   (ptrdiff_t nargs, Lisp_Object *args)
  1100 {
  1101   Lisp_Object infile, val;
  1102   specpdl_ref count = SPECPDL_INDEX ();
  1103   Lisp_Object start = args[0];
  1104   Lisp_Object end = args[1];
  1105   bool empty_input;
  1106   int fd;
  1107 
  1108   if (STRINGP (start))
  1109     empty_input = SCHARS (start) == 0;
  1110   else if (NILP (start))
  1111     empty_input = BEG == Z;
  1112   else
  1113     {
  1114       validate_region (&args[0], &args[1]);
  1115       start = args[0];
  1116       end = args[1];
  1117       empty_input = XFIXNUM (start) == XFIXNUM (end);
  1118     }
  1119 
  1120   if (!empty_input)
  1121     fd = create_temp_file (nargs, args, &infile);
  1122   else
  1123     {
  1124       infile = Qnil;
  1125       fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
  1126       if (fd < 0)
  1127         report_file_error ("Opening null device", Qnil);
  1128       record_unwind_protect_int (close_file_unwind, fd);
  1129     }
  1130 
  1131   if (nargs > 3 && !NILP (args[3]))
  1132     {
  1133       if (NILP (start))
  1134         {
  1135           /* No need to save restrictions since we delete everything
  1136              anyway.  */
  1137           labeled_restrictions_remove_in_current_buffer ();
  1138           Fwiden ();
  1139           del_range (BEG, Z);
  1140         }
  1141       else
  1142         Fdelete_region (start, end);
  1143     }
  1144 
  1145   if (nargs > 3)
  1146     {
  1147       args += 2;
  1148       nargs -= 2;
  1149     }
  1150   else
  1151     {
  1152       args[0] = args[2];
  1153       nargs = 2;
  1154     }
  1155   args[1] = infile;
  1156 
  1157   val = call_process (nargs, args, fd,
  1158                       empty_input ? make_invalid_specpdl_ref () : count);
  1159   return unbind_to (count, val);
  1160 }
  1161 
  1162 static char **
  1163 add_env (char **env, char **new_env, char *string)
  1164 {
  1165   char **ep;
  1166   bool ok = 1;
  1167   if (string == NULL)
  1168     return new_env;
  1169 
  1170   /* See if this string duplicates any string already in the env.
  1171      If so, don't put it in.
  1172      When an env var has multiple definitions,
  1173      we keep the definition that comes first in process-environment.  */
  1174   for (ep = env; ok && ep != new_env; ep++)
  1175     {
  1176       char *p = *ep, *q = string;
  1177       while (ok)
  1178         {
  1179           if (*p && *q != *p)
  1180             break;
  1181           if (*q == 0)
  1182             /* The string is a lone variable name; keep it for now, we
  1183                will remove it later.  It is a placeholder for a
  1184                variable that is not to be included in the environment.  */
  1185             break;
  1186           if (*q == '=')
  1187             ok = 0;
  1188           p++, q++;
  1189         }
  1190     }
  1191   if (ok)
  1192     *new_env++ = string;
  1193   return new_env;
  1194 }
  1195 
  1196 #ifndef DOS_NT
  1197 
  1198 /* 'exec' failed inside a child running NAME, with error number ERR.
  1199    Possibly a vforked child needed to allocate a large vector on the
  1200    stack; such a child cannot fall back on malloc because that might
  1201    mess up the allocator's data structures in the parent.
  1202    Report the error and exit the child.  */
  1203 
  1204 static AVOID
  1205 exec_failed (char const *name, int err)
  1206 {
  1207   /* Avoid deadlock if the child's perror writes to a full pipe; the
  1208      pipe's reader is the parent, but with vfork the parent can't
  1209      run until the child exits.  Truncate the diagnostic instead.  */
  1210   fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
  1211 
  1212   errno = err;
  1213   emacs_perror (name);
  1214   _exit (err == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
  1215 }
  1216 
  1217 #endif
  1218 
  1219 /* This is the last thing run in a newly forked inferior
  1220    either synchronous or asynchronous.
  1221    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
  1222    Initialize inferior's priority, pgrp, connected dir and environment.
  1223    then exec another program based on new_argv.
  1224 
  1225    CURRENT_DIR is an elisp string giving the path of the current
  1226    directory the subprocess should have.  Since we can't really signal
  1227    a decent error from within the child, this should be verified as an
  1228    executable directory by the parent.
  1229 
  1230    On GNUish hosts, either exec or return an error number.
  1231    On MS-Windows, either return a pid or return -1 and set errno.
  1232    On MS-DOS, either return an exit status or signal an error.  */
  1233 
  1234 static CHILD_SETUP_TYPE
  1235 child_setup (int in, int out, int err, char **new_argv, char **env,
  1236              const char *current_dir)
  1237 {
  1238 #ifdef MSDOS
  1239   char *pwd_var;
  1240   char *temp;
  1241   ptrdiff_t i;
  1242 #endif
  1243 #ifdef WINDOWSNT
  1244   int cpid;
  1245   HANDLE handles[3];
  1246 #else
  1247   pid_t pid = getpid ();
  1248 #endif /* WINDOWSNT */
  1249 
  1250   /* Note that use of alloca is always safe here.  It's obvious for systems
  1251      that do not have true vfork or that have true (stack) alloca.
  1252      If using vfork and C_ALLOCA (when Emacs used to include
  1253      src/alloca.c) it is safe because that changes the superior's
  1254      static variables as if the superior had done alloca and will be
  1255      cleaned up in the usual way. */
  1256 
  1257 #ifndef DOS_NT
  1258     /* We can't signal an Elisp error here; we're in a vfork.  Since
  1259        the callers check the current directory before forking, this
  1260        should only return an error if the directory's permissions
  1261        are changed between the check and this chdir, but we should
  1262        at least check.  */
  1263     if (chdir (current_dir) < 0)
  1264       _exit (EXIT_CANCELED);
  1265 #endif
  1266 
  1267 #ifdef WINDOWSNT
  1268   prepare_standard_handles (in, out, err, handles);
  1269   set_process_dir (current_dir);
  1270   /* Spawn the child.  (See w32proc.c:sys_spawnve).  */
  1271   cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
  1272   reset_standard_handles (in, out, err, handles);
  1273   return cpid;
  1274 
  1275 #else  /* not WINDOWSNT */
  1276 
  1277 #ifndef MSDOS
  1278 
  1279   restore_nofile_limit ();
  1280 
  1281   /* Redirect file descriptors and clear the close-on-exec flag on the
  1282      redirected ones.  IN, OUT, and ERR are close-on-exec so they
  1283      need not be closed explicitly.  */
  1284   dup2 (in, STDIN_FILENO);
  1285   dup2 (out, STDOUT_FILENO);
  1286   dup2 (err, STDERR_FILENO);
  1287 
  1288   setpgid (0, 0);
  1289   tcsetpgrp (0, pid);
  1290 
  1291   int errnum = emacs_exec_file (new_argv[0], new_argv, env);
  1292   exec_failed (new_argv[0], errnum);
  1293 
  1294 #else /* MSDOS */
  1295   i = strlen (current_dir);
  1296   pwd_var = xmalloc (i + 5);
  1297   temp = pwd_var + 4;
  1298   memcpy (pwd_var, "PWD=", 4);
  1299   stpcpy (temp, current_dir);
  1300 
  1301   if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
  1302     {
  1303       temp += 2;
  1304       i -= 2;
  1305     }
  1306 
  1307   /* Strip trailing slashes for PWD, but leave "/" and "//" alone.  */
  1308   while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
  1309     temp[--i] = 0;
  1310 
  1311   pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
  1312   xfree (pwd_var);
  1313   if (pid == -1)
  1314     /* An error occurred while trying to run the subprocess.  */
  1315     report_file_error ("Spawning child process", Qnil);
  1316   return pid;
  1317 #endif  /* MSDOS */
  1318 #endif  /* not WINDOWSNT */
  1319 }
  1320 
  1321 #if USABLE_POSIX_SPAWN
  1322 
  1323 /* Set up ACTIONS and ATTRIBUTES for `posix_spawn'.  Return an error
  1324    number.  */
  1325 
  1326 static int
  1327 emacs_posix_spawn_init_actions (posix_spawn_file_actions_t *actions,
  1328                                 int std_in, int std_out, int std_err,
  1329                                 const char *cwd)
  1330 {
  1331   int error = posix_spawn_file_actions_init (actions);
  1332   if (error != 0)
  1333     return error;
  1334 
  1335   error = posix_spawn_file_actions_adddup2 (actions, std_in,
  1336                                             STDIN_FILENO);
  1337   if (error != 0)
  1338     goto out;
  1339 
  1340   error = posix_spawn_file_actions_adddup2 (actions, std_out,
  1341                                             STDOUT_FILENO);
  1342   if (error != 0)
  1343     goto out;
  1344 
  1345   error = posix_spawn_file_actions_adddup2 (actions,
  1346                                             std_err < 0 ? std_out
  1347                                                         : std_err,
  1348                                             STDERR_FILENO);
  1349   if (error != 0)
  1350     goto out;
  1351 
  1352   /* Haiku appears to have linkable posix_spawn_file_actions_chdir,
  1353      but it always fails.  So use the _np function instead.  */
  1354 #if defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR && !defined HAIKU
  1355   error = posix_spawn_file_actions_addchdir (actions, cwd);
  1356 #else
  1357   error = posix_spawn_file_actions_addchdir_np (actions, cwd);
  1358 #endif
  1359   if (error != 0)
  1360     goto out;
  1361 
  1362  out:
  1363   if (error != 0)
  1364     posix_spawn_file_actions_destroy (actions);
  1365   return error;
  1366 }
  1367 
  1368 static int
  1369 emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes,
  1370                                    const sigset_t *oldset)
  1371 {
  1372   int error = posix_spawnattr_init (attributes);
  1373   if (error != 0)
  1374     return error;
  1375 
  1376   error = posix_spawnattr_setflags (attributes,
  1377                                     POSIX_SPAWN_SETSID
  1378                                     | POSIX_SPAWN_SETSIGDEF
  1379                                     | POSIX_SPAWN_SETSIGMASK);
  1380   if (error != 0)
  1381     goto out;
  1382 
  1383   sigset_t sigdefault;
  1384   sigemptyset (&sigdefault);
  1385 
  1386 #ifdef DARWIN_OS
  1387   /* Work around a macOS bug, where SIGCHLD is apparently
  1388      delivered to a vforked child instead of to its parent.  See:
  1389      https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
  1390   */
  1391   sigaddset (&sigdefault, SIGCHLD);
  1392 #endif
  1393 
  1394   sigaddset (&sigdefault, SIGINT);
  1395   sigaddset (&sigdefault, SIGQUIT);
  1396 #ifdef SIGPROF
  1397   sigaddset (&sigdefault, SIGPROF);
  1398 #endif
  1399 
  1400   /* Emacs ignores SIGPIPE, but the child should not.  */
  1401   sigaddset (&sigdefault, SIGPIPE);
  1402   /* Likewise for SIGPROF.  */
  1403 #ifdef SIGPROF
  1404   sigaddset (&sigdefault, SIGPROF);
  1405 #endif
  1406 
  1407   error = posix_spawnattr_setsigdefault (attributes, &sigdefault);
  1408   if (error != 0)
  1409     goto out;
  1410 
  1411   /* Stop blocking SIGCHLD in the child.  */
  1412   error = posix_spawnattr_setsigmask (attributes, oldset);
  1413   if (error != 0)
  1414     goto out;
  1415 
  1416  out:
  1417   if (error != 0)
  1418     posix_spawnattr_destroy (attributes);
  1419 
  1420   return error;
  1421 }
  1422 
  1423 #endif
  1424 
  1425 /* Start a new asynchronous subprocess.  If successful, return zero
  1426    and store the process identifier of the new process in *NEWPID.
  1427    Use STDIN, STDOUT, and STDERR as standard streams for the new
  1428    process.  Use ARGV as argument vector for the new process; use
  1429    process image file ARGV[0].  Use ENVP for the environment block for
  1430    the new process.  Use CWD as working directory for the new process.
  1431    If PTY is not NULL, it must be a pseudoterminal device.  If PTY is
  1432    NULL, don't perform any terminal setup.  OLDSET must be a pointer
  1433    to a signal set initialized by `block_child_signal'.  Before
  1434    calling this function, call `block_input' and `block_child_signal';
  1435    afterwards, call `unblock_input' and `unblock_child_signal'.  Be
  1436    sure to call `unblock_child_signal' only after registering NEWPID
  1437    in a list where `handle_child_signal' can find it!  */
  1438 
  1439 int
  1440 emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
  1441              char **argv, char **envp, const char *cwd,
  1442              const char *pty_name, bool pty_in, bool pty_out,
  1443              const sigset_t *oldset)
  1444 {
  1445 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
  1446   /* Android 10 and later don't allow directly executing programs
  1447      installed in the application data directory.  Emacs provides a
  1448      loader binary which replaces the `execve' system call for it and
  1449      all its children.  On these systems, rewrite the command line to
  1450      call that loader binary instead.  */
  1451 
  1452   if (android_rewrite_spawn_argv ((const char ***) &argv))
  1453     return 1;
  1454 #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
  1455 
  1456 
  1457 #if USABLE_POSIX_SPAWN
  1458   /* Prefer the simpler `posix_spawn' if available.  `posix_spawn'
  1459      doesn't yet support setting up pseudoterminals, so we fall back
  1460      to `vfork' if we're supposed to use a pseudoterminal.  */
  1461 
  1462   bool use_posix_spawn = pty_name == NULL;
  1463 
  1464   posix_spawn_file_actions_t actions;
  1465   posix_spawnattr_t attributes;
  1466 
  1467   if (use_posix_spawn)
  1468     {
  1469       /* Initialize optional attributes before blocking. */
  1470       int error = emacs_posix_spawn_init_actions (&actions, std_in,
  1471                                               std_out, std_err, cwd);
  1472       if (error != 0)
  1473         return error;
  1474 
  1475       error = emacs_posix_spawn_init_attributes (&attributes, oldset);
  1476       if (error != 0)
  1477         return error;
  1478     }
  1479 #endif
  1480 
  1481   int pid;
  1482   int vfork_error;
  1483 
  1484   eassert (input_blocked_p ());
  1485 
  1486 #if USABLE_POSIX_SPAWN
  1487   if (use_posix_spawn)
  1488     {
  1489       vfork_error = posix_spawn (&pid, argv[0], &actions, &attributes,
  1490                                  argv, envp);
  1491       if (vfork_error != 0)
  1492         pid = -1;
  1493 
  1494       int error = posix_spawn_file_actions_destroy (&actions);
  1495       if (error != 0)
  1496         {
  1497           errno = error;
  1498           emacs_perror ("posix_spawn_file_actions_destroy");
  1499         }
  1500 
  1501       error = posix_spawnattr_destroy (&attributes);
  1502       if (error != 0)
  1503         {
  1504           errno = error;
  1505           emacs_perror ("posix_spawnattr_destroy");
  1506         }
  1507 
  1508       goto fork_done;
  1509     }
  1510 #endif
  1511 
  1512 #ifndef WINDOWSNT
  1513   /* vfork, and prevent local vars from being clobbered by the vfork.  */
  1514   pid_t *volatile newpid_volatile = newpid;
  1515   const char *volatile cwd_volatile = cwd;
  1516   const char *volatile ptyname_volatile = pty_name;
  1517   bool volatile ptyin_volatile = pty_in;
  1518   bool volatile ptyout_volatile = pty_out;
  1519   char **volatile argv_volatile = argv;
  1520   int volatile stdin_volatile = std_in;
  1521   int volatile stdout_volatile = std_out;
  1522   int volatile stderr_volatile = std_err;
  1523   char **volatile envp_volatile = envp;
  1524   const sigset_t *volatile oldset_volatile = oldset;
  1525 
  1526 #ifdef DARWIN_OS
  1527   /* Darwin doesn't let us run setsid after a vfork, so use fork when
  1528      necessary.  Below, we reset SIGCHLD handling after a vfork, as
  1529      apparently macOS can mistakenly deliver SIGCHLD to the child.  */
  1530   if (pty_in || pty_out)
  1531     pid = fork ();
  1532   else
  1533     pid = VFORK ();
  1534 #else
  1535   pid = vfork ();
  1536 #endif
  1537 
  1538   newpid = newpid_volatile;
  1539   cwd = cwd_volatile;
  1540   pty_name = ptyname_volatile;
  1541   pty_in = ptyin_volatile;
  1542   pty_out = ptyout_volatile;
  1543   argv = argv_volatile;
  1544   std_in = stdin_volatile;
  1545   std_out = stdout_volatile;
  1546   std_err = stderr_volatile;
  1547   envp = envp_volatile;
  1548   oldset = oldset_volatile;
  1549 
  1550   if (pid == 0)
  1551 #endif /* not WINDOWSNT */
  1552     {
  1553       /* Make the pty be the controlling terminal of the process.  */
  1554 #ifdef HAVE_PTYS
  1555       dissociate_controlling_tty ();
  1556 
  1557       /* Make the pty's terminal the controlling terminal.  */
  1558       if (pty_in && std_in >= 0)
  1559         {
  1560 #ifdef TIOCSCTTY
  1561           /* We ignore the return value
  1562              because faith@cs.unc.edu says that is necessary on Linux.  */
  1563           ioctl (std_in, TIOCSCTTY, 0);
  1564 #endif
  1565         }
  1566 #if defined (LDISC1)
  1567       if (pty_in && std_in >= 0)
  1568         {
  1569           struct termios t;
  1570           tcgetattr (std_in, &t);
  1571           t.c_lflag = LDISC1;
  1572           if (tcsetattr (std_in, TCSANOW, &t) < 0)
  1573             emacs_perror ("create_process/tcsetattr LDISC1");
  1574         }
  1575 #else
  1576 #if defined (NTTYDISC) && defined (TIOCSETD)
  1577       if (pty_in && std_in >= 0)
  1578         {
  1579           /* Use new line discipline.  */
  1580           int ldisc = NTTYDISC;
  1581           ioctl (std_in, TIOCSETD, &ldisc);
  1582         }
  1583 #endif
  1584 #endif
  1585 
  1586 #if !defined (DONT_REOPEN_PTY)
  1587 /*** There is a suggestion that this ought to be a
  1588      conditional on TIOCSPGRP, or !defined TIOCSCTTY.
  1589      Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
  1590      that system does seem to need this code, even though
  1591      both TIOCSCTTY is defined.  */
  1592         /* Now close the pty (if we had it open) and reopen it.
  1593            This makes the pty the controlling terminal of the subprocess.  */
  1594       if (pty_name)
  1595         {
  1596 
  1597           /* I wonder if emacs_close (emacs_open (pty, ...))
  1598              would work?  */
  1599           if (pty_in && std_in >= 0)
  1600             emacs_close (std_in);
  1601           int ptyfd = emacs_open_noquit (pty_name, O_RDWR, 0);
  1602           if (pty_in)
  1603             std_in = ptyfd;
  1604           if (pty_out)
  1605             std_out = ptyfd;
  1606           if (std_in < 0)
  1607             {
  1608               emacs_perror (pty_name);
  1609               _exit (EXIT_CANCELED);
  1610             }
  1611 
  1612         }
  1613 #endif /* not DONT_REOPEN_PTY */
  1614 
  1615 #ifdef SETUP_SLAVE_PTY
  1616       if (pty_in && std_in >= 0)
  1617         {
  1618           SETUP_SLAVE_PTY;
  1619         }
  1620 #endif /* SETUP_SLAVE_PTY */
  1621 #endif /* HAVE_PTYS */
  1622 
  1623 #ifdef DARWIN_OS
  1624       /* Work around a macOS bug, where SIGCHLD is apparently
  1625          delivered to a vforked child instead of to its parent.  See:
  1626          https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
  1627       */
  1628       signal (SIGCHLD, SIG_DFL);
  1629 #endif
  1630 
  1631       signal (SIGINT, SIG_DFL);
  1632       signal (SIGQUIT, SIG_DFL);
  1633 #ifdef SIGPROF
  1634       signal (SIGPROF, SIG_DFL);
  1635 #endif
  1636 
  1637       /* Emacs ignores SIGPIPE, but the child should not.  */
  1638       signal (SIGPIPE, SIG_DFL);
  1639       /* Likewise for SIGPROF.  */
  1640 #ifdef SIGPROF
  1641       signal (SIGPROF, SIG_DFL);
  1642 #endif
  1643 
  1644 #ifdef subprocesses
  1645       /* Stop blocking SIGCHLD in the child.  */
  1646       unblock_child_signal (oldset);
  1647 
  1648       if (pty_out)
  1649         child_setup_tty (std_out);
  1650 #endif
  1651 
  1652       if (std_err < 0)
  1653         std_err = std_out;
  1654 #ifdef WINDOWSNT
  1655       pid = child_setup (std_in, std_out, std_err, argv, envp, cwd);
  1656 #else  /* not WINDOWSNT */
  1657       child_setup (std_in, std_out, std_err, argv, envp, cwd);
  1658 #endif /* not WINDOWSNT */
  1659     }
  1660 
  1661   /* Back in the parent process.  */
  1662 
  1663   vfork_error = pid < 0 ? errno : 0;
  1664 
  1665 #if USABLE_POSIX_SPAWN
  1666  fork_done:
  1667 #endif
  1668   if (pid < 0)
  1669     {
  1670       eassert (0 < vfork_error);
  1671       return vfork_error;
  1672     }
  1673 
  1674   eassert (0 < pid);
  1675   *newpid = pid;
  1676   return 0;
  1677 }
  1678 
  1679 static bool
  1680 getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
  1681                    ptrdiff_t *valuelen, Lisp_Object env)
  1682 {
  1683   for (; CONSP (env); env = XCDR (env))
  1684     {
  1685       Lisp_Object entry = XCAR (env);
  1686       if (STRINGP (entry)
  1687           && SBYTES (entry) >= varlen
  1688 #ifdef WINDOWSNT
  1689           /* NT environment variables are case insensitive.  */
  1690           && ! strnicmp (SSDATA (entry), var, varlen)
  1691 #else  /* not WINDOWSNT */
  1692           && ! memcmp (SDATA (entry), var, varlen)
  1693 #endif /* not WINDOWSNT */
  1694           )
  1695         {
  1696           if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
  1697             {
  1698               *value = SSDATA (entry) + (varlen + 1);
  1699               *valuelen = SBYTES (entry) - (varlen + 1);
  1700               return 1;
  1701             }
  1702           else if (SBYTES (entry) == varlen)
  1703             {
  1704               /* Lone variable names in Vprocess_environment mean that
  1705                  variable should be removed from the environment. */
  1706               *value = NULL;
  1707               return 1;
  1708             }
  1709         }
  1710     }
  1711   return 0;
  1712 }
  1713 
  1714 static bool
  1715 getenv_internal (const char *var, ptrdiff_t varlen, char **value,
  1716                  ptrdiff_t *valuelen, Lisp_Object frame)
  1717 {
  1718   /* Try to find VAR in Vprocess_environment first.  */
  1719   if (getenv_internal_1 (var, varlen, value, valuelen,
  1720                          Vprocess_environment))
  1721     return *value ? 1 : 0;
  1722 
  1723   /* On Windows we make some modifications to Emacs' environment
  1724      without recording them in Vprocess_environment.  */
  1725 #ifdef WINDOWSNT
  1726   {
  1727     char *tmpval = getenv (var);
  1728     if (tmpval)
  1729       {
  1730         *value = tmpval;
  1731         *valuelen = strlen (tmpval);
  1732         return 1;
  1733       }
  1734   }
  1735 #endif
  1736 
  1737   /* For DISPLAY try to get the values from the frame or the initial env.  */
  1738   if (strcmp (var, "DISPLAY") == 0)
  1739     {
  1740 #ifndef HAVE_PGTK
  1741       Lisp_Object display
  1742         = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
  1743       if (STRINGP (display))
  1744         {
  1745           *value    = SSDATA (display);
  1746           *valuelen = SBYTES (display);
  1747           return 1;
  1748         }
  1749 #endif
  1750       /* If still not found, Look for DISPLAY in Vinitial_environment.  */
  1751       if (getenv_internal_1 (var, varlen, value, valuelen,
  1752                              Vinitial_environment))
  1753         return *value ? 1 : 0;
  1754     }
  1755 
  1756   return 0;
  1757 }
  1758 
  1759 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
  1760        doc: /* Get the value of environment variable VARIABLE.
  1761 VARIABLE should be a string.  Value is nil if VARIABLE is undefined in
  1762 the environment.  Otherwise, value is a string.
  1763 
  1764 This function searches `process-environment' for VARIABLE.
  1765 
  1766 If optional parameter ENV is a list, then search this list instead of
  1767 `process-environment', and return t when encountering a negative entry
  1768 \(an entry for a variable with no value).  */)
  1769   (Lisp_Object variable, Lisp_Object env)
  1770 {
  1771   char *value;
  1772   ptrdiff_t valuelen;
  1773 
  1774   CHECK_STRING (variable);
  1775   if (CONSP (env))
  1776     {
  1777       if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
  1778                              &value, &valuelen, env))
  1779         return value ? make_string (value, valuelen) : Qt;
  1780       else
  1781         return Qnil;
  1782     }
  1783   else if (getenv_internal (SSDATA (variable), SBYTES (variable),
  1784                             &value, &valuelen, env))
  1785     return make_string (value, valuelen);
  1786   else
  1787     return Qnil;
  1788 }
  1789 
  1790 /* A version of getenv that consults the Lisp environment lists,
  1791    easily callable from C.  This is usually called from egetenv.  */
  1792 char *
  1793 egetenv_internal (const char *var, ptrdiff_t len)
  1794 {
  1795   char *value;
  1796   ptrdiff_t valuelen;
  1797 
  1798   if (getenv_internal (var, len, &value, &valuelen, Qnil))
  1799     return value;
  1800   else
  1801     return 0;
  1802 }
  1803 
  1804 /* Create a new environment block.  You can pass the returned pointer
  1805    to `execve'.  Add unwind protections for all newly-allocated
  1806    objects.  Don't call any Lisp code or the garbage collector while
  1807    the block is active.  */
  1808 
  1809 char **
  1810 make_environment_block (Lisp_Object current_dir)
  1811 {
  1812   char **env;
  1813   char *pwd_var;
  1814 
  1815   {
  1816     char *temp;
  1817     ptrdiff_t i;
  1818 
  1819     i = SBYTES (current_dir);
  1820     pwd_var = xmalloc (i + 5);
  1821     record_unwind_protect_ptr (xfree, pwd_var);
  1822     temp = pwd_var + 4;
  1823     memcpy (pwd_var, "PWD=", 4);
  1824     lispstpcpy (temp, current_dir);
  1825 
  1826 #ifdef DOS_NT
  1827     /* Get past the drive letter, so that d:/ is left alone.  */
  1828     if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
  1829       {
  1830         temp += 2;
  1831         i -= 2;
  1832       }
  1833 #endif /* DOS_NT */
  1834 
  1835     /* Strip trailing slashes for PWD, but leave "/" and "//" alone.  */
  1836     while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
  1837       temp[--i] = 0;
  1838   }
  1839 
  1840   /* Set `env' to a vector of the strings in the environment.  */
  1841 
  1842   {
  1843     register Lisp_Object tem;
  1844     register char **new_env;
  1845     char **p, **q;
  1846     register int new_length;
  1847     Lisp_Object display = Qnil;
  1848 
  1849     new_length = 0;
  1850 
  1851     for (tem = Vprocess_environment;
  1852          CONSP (tem) && STRINGP (XCAR (tem));
  1853          tem = XCDR (tem))
  1854       {
  1855         if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
  1856             && (SDATA (XCAR (tem)) [7] == '\0'
  1857                 || SDATA (XCAR (tem)) [7] == '='))
  1858           /* DISPLAY is specified in process-environment.  */
  1859           display = Qt;
  1860         new_length++;
  1861       }
  1862 
  1863     /* If not provided yet, use the frame's DISPLAY.  */
  1864     if (NILP (display))
  1865       {
  1866         Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
  1867 
  1868 #ifdef HAVE_PGTK
  1869         /* The only time GDK actually returns correct information is
  1870            when it's running under X Windows.  DISPLAY shouldn't be
  1871            set to a Wayland display either, since that's an X specific
  1872            variable.  */
  1873         if (FRAME_WINDOW_P (SELECTED_FRAME ())
  1874             && strcmp (G_OBJECT_TYPE_NAME (FRAME_X_DISPLAY (SELECTED_FRAME ())),
  1875                        "GdkX11Display"))
  1876           tmp = Qnil;
  1877 #endif
  1878 
  1879         if (!STRINGP (tmp) && CONSP (Vinitial_environment))
  1880           /* If still not found, Look for DISPLAY in Vinitial_environment.  */
  1881           tmp = Fgetenv_internal (build_string ("DISPLAY"),
  1882                                   Vinitial_environment);
  1883         if (STRINGP (tmp))
  1884           {
  1885             display = tmp;
  1886             new_length++;
  1887           }
  1888       }
  1889 
  1890     /* new_length + 2 to include PWD and terminating 0.  */
  1891     env = new_env = xnmalloc (new_length + 2, sizeof *env);
  1892     record_unwind_protect_ptr (xfree, env);
  1893     /* If we have a PWD envvar, pass one down,
  1894        but with corrected value.  */
  1895     if (egetenv ("PWD"))
  1896       *new_env++ = pwd_var;
  1897 
  1898     if (STRINGP (display))
  1899       {
  1900         char *vdata = xmalloc (sizeof "DISPLAY=" + SBYTES (display));
  1901         record_unwind_protect_ptr (xfree, vdata);
  1902         lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
  1903         new_env = add_env (env, new_env, vdata);
  1904       }
  1905 
  1906     /* Overrides.  */
  1907     for (tem = Vprocess_environment;
  1908          CONSP (tem) && STRINGP (XCAR (tem));
  1909          tem = XCDR (tem))
  1910       new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
  1911 
  1912     *new_env = 0;
  1913 
  1914     /* Remove variable names without values.  */
  1915     p = q = env;
  1916     while (*p != 0)
  1917       {
  1918         while (*q != 0 && strchr (*q, '=') == NULL)
  1919           q++;
  1920         *p = *q++;
  1921         if (*p != 0)
  1922           p++;
  1923       }
  1924   }
  1925 
  1926   return env;
  1927 }
  1928 
  1929 
  1930 /* This is run before init_cmdargs.  */
  1931 
  1932 void
  1933 init_callproc_1 (void)
  1934 {
  1935   Vdata_directory = decode_env_path ("EMACSDATA", PATH_DATA, 0);
  1936   Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
  1937 
  1938   Vdoc_directory = decode_env_path ("EMACSDOC", PATH_DOC, 0);
  1939   Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
  1940 
  1941   /* Check the EMACSPATH environment variable, defaulting to the
  1942      PATH_EXEC path from epaths.h.  */
  1943   Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC, 0);
  1944   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
  1945   /* FIXME?  For ns, path_exec should go at the front?  */
  1946   Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
  1947 }
  1948 
  1949 /* This is run after init_cmdargs, when Vinstallation_directory is valid.  */
  1950 
  1951 void
  1952 init_callproc (void)
  1953 {
  1954   bool data_dir = egetenv ("EMACSDATA") != 0;
  1955 
  1956   char *sh;
  1957   Lisp_Object tempdir;
  1958 
  1959   if (!NILP (Vinstallation_directory))
  1960     {
  1961       /* Add to the path the lib-src subdir of the installation dir.  */
  1962       Lisp_Object tem;
  1963       tem = Fexpand_file_name (build_string ("lib-src"),
  1964                                Vinstallation_directory);
  1965 #ifndef MSDOS
  1966           /* MSDOS uses wrapped binaries, so don't do this.  */
  1967       if (NILP (Fmember (tem, Vexec_path)))
  1968         {
  1969           /* Running uninstalled, so default to tem rather than PATH_EXEC.  */
  1970           Vexec_path = decode_env_path ("EMACSPATH", SSDATA (tem), 0);
  1971           Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
  1972         }
  1973 
  1974       Vexec_directory = Ffile_name_as_directory (tem);
  1975 #endif /* not MSDOS */
  1976 
  1977       /* Maybe use ../etc as well as ../lib-src.  */
  1978       if (data_dir == 0)
  1979         {
  1980           tem = Fexpand_file_name (build_string ("etc"),
  1981                                    Vinstallation_directory);
  1982           Vdoc_directory = Ffile_name_as_directory (tem);
  1983         }
  1984     }
  1985 
  1986   /* Look for the files that should be in etc.  We don't use
  1987      Vinstallation_directory, because these files are never installed
  1988      near the executable, and they are never in the build
  1989      directory when that's different from the source directory.
  1990 
  1991      Instead, if these files are not in the nominal place, we try the
  1992      source directory.  */
  1993   if (data_dir == 0)
  1994     {
  1995       Lisp_Object tem, srcdir;
  1996       Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
  1997 
  1998       srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
  1999 
  2000       tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
  2001       if (!NILP (Fequal (srcdir, Vinvocation_directory))
  2002           || NILP (Ffile_exists_p (tem)) || !NILP (Vinstallation_directory))
  2003         {
  2004           Lisp_Object newdir;
  2005           newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
  2006           tem = Fexpand_file_name (build_string ("NEWS"), newdir);
  2007           if (!NILP (Ffile_exists_p (tem)))
  2008             Vdata_directory = newdir;
  2009         }
  2010     }
  2011 
  2012   if (!will_dump_p ())
  2013     {
  2014       tempdir = Fdirectory_file_name (Vexec_directory);
  2015       if (! file_accessible_directory_p (tempdir))
  2016         dir_warning ("arch-dependent data dir", Vexec_directory);
  2017     }
  2018 
  2019   tempdir = Fdirectory_file_name (Vdata_directory);
  2020   if (! file_accessible_directory_p (tempdir))
  2021     dir_warning ("arch-independent data dir", Vdata_directory);
  2022 
  2023   sh = getenv ("SHELL");
  2024 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
  2025   /* The Android shell is found under /system/bin, not /bin.  */
  2026   Vshell_file_name = build_string (sh ? sh : "/system/bin/sh");
  2027 #else
  2028   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
  2029 #endif
  2030 
  2031   Lisp_Object gamedir = Qnil;
  2032   if (PATH_GAME)
  2033     {
  2034       const char *cpath_game = PATH_GAME;
  2035 #ifdef WINDOWSNT
  2036       /* On MS-Windows, PATH_GAME normally starts with a literal
  2037          "%emacs_dir%", so it will never work without some tweaking.  */
  2038       cpath_game = w32_relocate (cpath_game);
  2039 #endif
  2040       Lisp_Object path_game = build_unibyte_string (cpath_game);
  2041       if (file_accessible_directory_p (path_game))
  2042         gamedir = path_game;
  2043       else if (errno != ENOENT && errno != ENOTDIR
  2044 #ifdef DOS_NT
  2045                /* DOS/Windows sometimes return EACCES for bad file names  */
  2046                && errno != EACCES
  2047 #endif
  2048                )
  2049         dir_warning ("game dir", path_game);
  2050     }
  2051   Vshared_game_score_directory = gamedir;
  2052 }
  2053 
  2054 void
  2055 set_initial_environment (void)
  2056 {
  2057   char **envp;
  2058   for (envp = environ; *envp; envp++)
  2059     Vprocess_environment = Fcons (build_string (*envp),
  2060                                   Vprocess_environment);
  2061   /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
  2062      to use `delete' and friends on process-environment.  */
  2063   Vinitial_environment = Fcopy_sequence (Vprocess_environment);
  2064 }
  2065 
  2066 void
  2067 syms_of_callproc (void)
  2068 {
  2069 #ifndef DOS_NT
  2070   Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
  2071 #else  /* DOS_NT */
  2072   Vtemp_file_name_pattern = build_string ("emXXXXXX");
  2073 #endif
  2074   staticpro (&Vtemp_file_name_pattern);
  2075 
  2076 #ifdef MSDOS
  2077   synch_process_tempfile = make_fixnum (0);
  2078   staticpro (&synch_process_tempfile);
  2079 #endif
  2080 
  2081   DEFVAR_LISP ("shell-file-name", Vshell_file_name,
  2082                doc: /* File name to load inferior shells from.
  2083 Initialized from the SHELL environment variable, or to a system-dependent
  2084 default if SHELL is unset.  See Info node `(elisp)Security Considerations'.  */);
  2085 
  2086   DEFVAR_LISP ("exec-path", Vexec_path,
  2087                doc: /* List of directories to search programs to run in subprocesses.
  2088 Each element is a string (directory name) or nil (try default directory).
  2089 
  2090 By default the last element of this list is `exec-directory'. The
  2091 last element is not always used, for example in shell completion
  2092 \(`shell-dynamic-complete-command').  */);
  2093 
  2094   DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
  2095                doc: /* List of suffixes to try to find executable file names.
  2096 Each element is a string.  */);
  2097   Vexec_suffixes = Qnil;
  2098 
  2099   DEFVAR_LISP ("exec-directory", Vexec_directory,
  2100                doc: /* Directory for executables for Emacs to invoke.
  2101 More generally, this includes any architecture-dependent files
  2102 that are built and installed from the Emacs distribution.  */);
  2103 
  2104   DEFVAR_LISP ("data-directory", Vdata_directory,
  2105                doc: /* Directory of machine-independent files that come with GNU Emacs.
  2106 These are files intended for Emacs to use while it runs.  */);
  2107 
  2108   DEFVAR_LISP ("doc-directory", Vdoc_directory,
  2109                doc: /* Directory containing the DOC file that comes with GNU Emacs.
  2110 This is usually the same as `data-directory'.  */);
  2111 
  2112   DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
  2113                doc: /* For internal use by the build procedure only.
  2114 This is the name of the directory in which the build procedure installed
  2115 Emacs's info files; the default value for `Info-default-directory-list'
  2116 includes this.  */);
  2117   Vconfigure_info_directory = build_string (PATH_INFO);
  2118 
  2119   DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
  2120                doc: /* Directory of score files for games which come with GNU Emacs.
  2121 If this variable is nil, then Emacs is unable to use a shared directory.  */);
  2122 
  2123   DEFVAR_LISP ("initial-environment", Vinitial_environment,
  2124                doc: /* List of environment variables inherited from the parent process.
  2125 Each element should be a string of the form ENVVARNAME=VALUE.
  2126 The elements must normally be decoded (using `locale-coding-system') for use.  */);
  2127   Vinitial_environment = Qnil;
  2128 
  2129   DEFVAR_LISP ("process-environment", Vprocess_environment,
  2130                doc: /* List of overridden environment variables for subprocesses to inherit.
  2131 Each element should be a string of the form ENVVARNAME=VALUE.
  2132 
  2133 Entries in this list take precedence to those in the frame-local
  2134 environments.  Therefore, let-binding `process-environment' is an easy
  2135 way to temporarily change the value of an environment variable,
  2136 irrespective of where it comes from.  To use `process-environment' to
  2137 remove an environment variable, include only its name in the list,
  2138 without "=VALUE".
  2139 
  2140 This variable is set to nil when Emacs starts.
  2141 
  2142 If multiple entries define the same variable, the first one always
  2143 takes precedence.
  2144 
  2145 Non-ASCII characters are encoded according to the initial value of
  2146 `locale-coding-system', i.e. the elements must normally be decoded for
  2147 use.
  2148 
  2149 See `setenv' and `getenv'.  */);
  2150   Vprocess_environment = Qnil;
  2151 
  2152   DEFVAR_LISP ("ctags-program-name", Vctags_program_name,
  2153     doc: /* Name of the `ctags' program distributed with Emacs.
  2154 Use this instead of calling `ctags' directly, as `ctags' may have been
  2155 renamed to comply with executable naming restrictions on the system.  */);
  2156 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2157   Vctags_program_name = build_pure_c_string ("ctags");
  2158 #else
  2159   Vctags_program_name = build_pure_c_string ("libctags.so");
  2160 #endif
  2161 
  2162   DEFVAR_LISP ("etags-program-name", Vetags_program_name,
  2163     doc: /* Name of the `etags' program distributed with Emacs.
  2164 Use this instead of calling `etags' directly, as `etags' may have been
  2165 renamed to comply with executable naming restrictions on the system.  */);
  2166 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2167   Vetags_program_name = build_pure_c_string ("etags");
  2168 #else
  2169   Vetags_program_name = build_pure_c_string ("libetags.so");
  2170 #endif
  2171 
  2172   DEFVAR_LISP ("hexl-program-name", Vhexl_program_name,
  2173     doc: /* Name of the `hexl' program distributed with Emacs.
  2174 Use this instead of calling `hexl' directly, as `hexl' may have been
  2175 renamed to comply with executable naming restrictions on the system.  */);
  2176 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2177   Vhexl_program_name = build_pure_c_string ("hexl");
  2178 #else
  2179   Vhexl_program_name = build_pure_c_string ("libhexl.so");
  2180 #endif
  2181 
  2182   DEFVAR_LISP ("emacsclient-program-name", Vemacsclient_program_name,
  2183     doc: /* Name of the `emacsclient' program distributed with Emacs.
  2184 Use this instead of calling `emacsclient' directly, as `emacsclient'
  2185 may have been renamed to comply with executable naming restrictions on
  2186 the system.  */);
  2187 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2188   Vemacsclient_program_name = build_pure_c_string ("emacsclient");
  2189 #else
  2190   Vemacsclient_program_name = build_pure_c_string ("libemacsclient.so");
  2191 #endif
  2192 
  2193   DEFVAR_LISP ("movemail-program-name", Vmovemail_program_name,
  2194     doc: /* Name of the `movemail' program distributed with Emacs.
  2195 Use this instead of calling `movemail' directly, as `movemail'
  2196 may have been renamed to comply with executable naming restrictions on
  2197 the system.  */);
  2198   /* Don't change the name of `movemail' if Emacs is being built to
  2199      use movemail from another source.  */
  2200 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY    \
  2201   || defined HAVE_MAILUTILS
  2202   Vmovemail_program_name = build_pure_c_string ("movemail");
  2203 #else
  2204   Vmovemail_program_name = build_pure_c_string ("libmovemail.so");
  2205 #endif
  2206 
  2207   DEFVAR_LISP ("ebrowse-program-name", Vebrowse_program_name,
  2208     doc: /* Name of the `ebrowse' program distributed with Emacs.
  2209 Use this instead of calling `ebrowse' directly, as `ebrowse'
  2210 may have been renamed to comply with executable naming restrictions on
  2211 the system.  */);
  2212 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2213   Vebrowse_program_name = build_pure_c_string ("ebrowse");
  2214 #else
  2215   Vebrowse_program_name = build_pure_c_string ("libebrowse.so");
  2216 #endif
  2217 
  2218   defsubr (&Scall_process);
  2219   defsubr (&Sgetenv_internal);
  2220   defsubr (&Scall_process_region);
  2221 }

/* [<][>][^][v][top][bottom][index][help] */