# HG changeset patch # User Jim Blandy # Date 713190533 0 # Node ID 928ed74adf4f7010170ef44a1bc60358035a470a # Parent c45ba80a9da9baef4e6876edaa2d307411f3b657 Restored up-to-date version of this file from pogo. What is going on here? diff -r c45ba80a9da9 -r 928ed74adf4f src/callproc.c --- a/src/callproc.c Fri Aug 07 01:13:47 1992 +0000 +++ b/src/callproc.c Fri Aug 07 12:28:53 1992 +0000 @@ -1,5 +1,5 @@ /* Synchronous subprocess invocation for GNU Emacs. - Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -19,6 +19,7 @@ #include +#include #include "config.h" @@ -57,16 +58,11 @@ #define max(a, b) ((a) > (b) ? (a) : (b)) -Lisp_Object Vexec_path, Vexec_directory; +Lisp_Object Vexec_path, Vexec_directory, Vdata_directory; Lisp_Object Vshell_file_name; -#ifndef MAINTAIN_ENVIRONMENT -/* List of strings to append to front of environment of - all subprocesses when they are started. */ - Lisp_Object Vprocess_environment; -#endif /* True iff we are about to fork off a synchronous process or if we are waiting for it. */ @@ -101,15 +97,15 @@ nil for BUFFER means discard it; 0 means discard and don't wait.\n\ Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ Remaining arguments are strings passed as command arguments to PROGRAM.\n\ -If BUFFER is nil or 0, returns immediately with value nil.\n\ +If BUFFER is 0, returns immediately with value nil.\n\ Otherwise waits for PROGRAM to terminate\n\ -and returns a numeric exit status or a signal name as a string.\n\ +and returns a numeric exit status or a signal description string.\n\ If you quit, the process is killed with SIGKILL.") (nargs, args) int nargs; register Lisp_Object *args; { - Lisp_Object display, buffer, path; + Lisp_Object display, infile, buffer, path, current_dir; int fd[2]; int filefd; register int pid; @@ -121,34 +117,37 @@ #if 0 int mask; #endif - struct gcpro gcpro1; - - GCPRO1 (*args); - gcpro1.nvars = nargs; - CHECK_STRING (args[0], 0); - if (nargs <= 1 || NILP (args[1])) - args[1] = build_string ("/dev/null"); + if (nargs >= 2 && ! NILP (args[1])) + { + infile = Fexpand_file_name (args[1], current_buffer->directory); + CHECK_STRING (infile, 1); + } else - args[1] = Fexpand_file_name (args[1], current_buffer->directory); - - CHECK_STRING (args[1], 1); +#ifdef VMS + infile = build_string ("NLA0:"); +#else + infile = build_string ("/dev/null"); +#endif /* not VMS */ - { - register Lisp_Object tem; - buffer = tem = args[2]; - if (nargs <= 2) - buffer = Qnil; - else if (!(EQ (tem, Qnil) || EQ (tem, Qt) - || XFASTINT (tem) == 0)) - { - buffer = Fget_buffer (tem); - CHECK_BUFFER (buffer, 2); - } - } + if (nargs >= 3) + { + register Lisp_Object tem; - display = nargs >= 3 ? args[3] : Qnil; + buffer = tem = args[2]; + if (!(EQ (tem, Qnil) + || EQ (tem, Qt) + || XFASTINT (tem) == 0)) + { + buffer = Fget_buffer (tem); + CHECK_BUFFER (buffer, 2); + } + } + else + buffer = Qnil; + + display = nargs >= 4 ? args[3] : Qnil; { register int i; @@ -162,10 +161,10 @@ new_argv[i - 3] = 0; } - filefd = open (XSTRING (args[1])->data, O_RDONLY, 0); + filefd = open (XSTRING (infile)->data, O_RDONLY, 0); if (filefd < 0) { - report_file_error ("Opening process input file", Fcons (args[1], Qnil)); + report_file_error ("Opening process input file", Fcons (infile, Qnil)); } /* Search for program; barf if not found. */ openp (Vexec_path, args[0], "", &path, 1); @@ -187,19 +186,19 @@ #endif } + /* Make sure that the child will be able to chdir to the current + buffer's current directory. We can't just have the child check + for an error when it does the chdir, since it's in a vfork. */ + current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil); + if (NILP (Ffile_accessible_directory_p (current_dir))) + report_file_error ("Setting current directory", + Fcons (current_buffer->directory, Qnil)); + { /* child_setup must clobber environ in systems with true vfork. Protect it from permanent change. */ register char **save_environ = environ; register int fd1 = fd[1]; - char **env; - -#ifdef MAINTAIN_ENVIRONMENT - env = (char **) alloca (size_of_current_environ ()); - get_current_environ (env); -#else - env = environ; -#endif /* MAINTAIN_ENVIRONMENT */ #if 0 /* Some systems don't have sigblock. */ mask = sigblock (sigmask (SIGCHLD)); @@ -219,7 +218,7 @@ #else setpgrp (pid, pid); #endif /* USG */ - child_setup (filefd, fd1, fd1, new_argv, env, 0); + child_setup (filefd, fd1, fd1, new_argv, 0, current_dir); } #if 0 @@ -244,13 +243,17 @@ if (XTYPE (buffer) == Lisp_Int) { #ifndef subprocesses + /* If Emacs has been built with asynchronous subprocess support, + we don't need to do this, I think because it will then have + the facilities for handling SIGCHLD. */ wait_without_blocking (); #endif /* subprocesses */ - - UNGCPRO; return Qnil; } + synch_process_death = 0; + synch_process_retcode = 0; + record_unwind_protect (call_process_cleanup, Fcons (make_number (fd[0]), make_number (pid))); @@ -285,8 +288,6 @@ unbind_to (count, Qnil); - UNGCPRO; - if (synch_process_death) return build_string (synch_process_death); return make_number (synch_process_retcode); @@ -310,7 +311,7 @@ Remaining args are passed to PROGRAM at startup as command args.\n\ If BUFFER is nil, returns immediately with value nil.\n\ Otherwise waits for PROGRAM to terminate\n\ -and returns a numeric exit status or a signal name as a string.\n\ +and returns a numeric exit status or a signal description string.\n\ If you quit, the process is killed with SIGKILL.") (nargs, args) int nargs; @@ -319,10 +320,6 @@ register Lisp_Object filename_string, start, end; char tempfile[20]; int count = specpdl_ptr - specpdl; - struct gcpro gcpro1; - - GCPRO1 (*args); - gcpro1.nvars = 2; #ifdef VMS strcpy (tempfile, "tmp:emacsXXXXXX."); @@ -343,7 +340,6 @@ args[3] = filename_string; Fcall_process (nargs - 2, args + 2); - UNGCPRO; return unbind_to (count, Qnil); } @@ -362,14 +358,21 @@ ENV is the environment for the subprocess. SET_PGRP is nonzero if we should put the subprocess into a separate - process group. */ + process group. -child_setup (in, out, err, new_argv, env, set_pgrp) + CURRENT_DIR is an elisp string giving the path of the current + directory the subprocess should have. Since we can't really signal + a decent error from within the child, this should be verified as an + executable directory by the parent. */ + +child_setup (in, out, err, new_argv, set_pgrp, current_dir) int in, out, err; register char **new_argv; - char **env; int set_pgrp; + Lisp_Object current_dir; { + char **env; + register int pid = getpid(); setpriority (PRIO_PROCESS, pid, 0); @@ -384,24 +387,25 @@ If using vfork and C_ALLOCA it is safe because that changes the superior's static variables as if the superior had done alloca and will be cleaned up in the usual way. */ + { + register unsigned char *temp; + register int i; - if (XTYPE (current_buffer->directory) == Lisp_String) - { - register unsigned char *temp; - register int i; + i = XSTRING (current_dir)->size; + temp = (unsigned char *) alloca (i + 2); + bcopy (XSTRING (current_dir)->data, temp, i); + if (temp[i - 1] != '/') temp[i++] = '/'; + temp[i] = 0; - i = XSTRING (current_buffer->directory)->size; - temp = (unsigned char *) alloca (i + 2); - bcopy (XSTRING (current_buffer->directory)->data, temp, i); - if (temp[i - 1] != '/') temp[i++] = '/'; - temp[i] = 0; - /* Switch to that directory, and report any error. */ - if (chdir (temp) < 0) - report_file_error ("In chdir", - Fcons (current_buffer->directory, Qnil)); - } + /* We can't signal an Elisp error here; we're in a vfork. Since + the callers check the current directory before forking, this + should only return an error if the directory's permissions + are changed between the check and this chdir, but we should + at least check. */ + if (chdir (temp) < 0) + exit (errno); + } -#ifndef MAINTAIN_ENVIRONMENT /* Set `env' to a vector of the strings in Vprocess_environment. */ { register Lisp_Object tem; @@ -418,7 +422,7 @@ /* new_length + 1 to include terminating 0 */ env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *)); - /* Copy the env strings into new_env. */ + /* Copy the Vprocess_alist strings into new_env. */ for (tem = Vprocess_environment; (XTYPE (tem) == Lisp_Cons && XTYPE (XCONS (tem)->car) == Lisp_String); @@ -426,7 +430,6 @@ *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data; *new_env = 0; } -#endif /* Not MAINTAIN_ENVIRONMENT */ close (0); close (1); @@ -439,6 +442,11 @@ close (out); close (err); +#ifdef USG + setpgrp (); /* No arguments but equivalent in this case */ +#else + setpgrp (pid, pid); +#endif /* USG */ setpgrp_of_tty (pid); #ifdef vipc @@ -468,7 +476,7 @@ for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr) { Lisp_Object entry = XCONS (scan)->car; - + if (XTYPE (entry) == Lisp_String && XSTRING (entry)->size > varlen && XSTRING (entry)->data[varlen] == '=' @@ -502,10 +510,10 @@ } /* A version of getenv that consults process_environment, easily - callable from C. */ + callable from C. */ char * egetenv (var) - char *var; + char *var; { char *value; int valuelen; @@ -522,32 +530,45 @@ { register char * sh; register char **envp; - Lisp_Object execdir; + Lisp_Object tempdir; - /* Turn PATH_EXEC into a path. `==' is just a string which we know - will not be the name of an environment variable. */ - Vexec_path = decode_env_path ("==", PATH_EXEC); + { + char *data_dir = egetenv ("EMACSDATA"); + + Vdata_directory = + Ffile_name_as_directory + (build_string (data_dir ? data_dir : PATH_DATA)); + } + + /* Check the EMACSPATH environment variable, defaulting to the + PATH_EXEC path from paths.h. */ + Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC); Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); - execdir = Fdirectory_file_name (Vexec_directory); - if (access (XSTRING (execdir)->data, 0) < 0) + tempdir = Fdirectory_file_name (Vexec_directory); + if (access (XSTRING (tempdir)->data, 0) < 0) { - printf ("Warning: executable/documentation dir (%s) does not exist.\n", + printf ("Warning: arch-dependent data dir (%s) does not exist.\n", XSTRING (Vexec_directory)->data); sleep (2); } + tempdir = Fdirectory_file_name (Vdata_directory); + if (access (XSTRING (tempdir)->data, 0) < 0) + { + printf ("Warning: arch-independent data dir (%s) does not exist.\n", + XSTRING (Vdata_directory)->data); + sleep (2); + } + #ifdef VMS Vshell_file_name = build_string ("*dcl*"); #else - sh = (char *) egetenv ("SHELL"); + sh = (char *) getenv ("SHELL"); Vshell_file_name = build_string (sh ? sh : "/bin/sh"); #endif -#ifndef MAINTAIN_ENVIRONMENT - /* The equivalent of this operation was done - in init_environ in environ.c if MAINTAIN_ENVIRONMENT */ Vprocess_environment = Qnil; #ifndef CANNOT_DUMP if (initialized) @@ -555,7 +576,6 @@ for (envp = environ; *envp; envp++) Vprocess_environment = Fcons (build_string (*envp), Vprocess_environment); -#endif /* MAINTAIN_ENVIRONMENT */ } syms_of_callproc () @@ -569,18 +589,22 @@ Each element is a string (directory name) or nil (try default directory)."); DEFVAR_LISP ("exec-directory", &Vexec_directory, - "Directory that holds programs that come with GNU Emacs,\n\ -intended for Emacs to invoke."); + "Directory of architecture-dependent files that come with GNU Emacs,\n\ +especially executable programs intended for Emacs to invoke."); -#ifndef MAINTAIN_ENVIRONMENT + DEFVAR_LISP ("data-directory", &Vdata_directory, + "Directory of architecture-independent files that come with GNU Emacs,\n\ +intended for Emacs to use."); + DEFVAR_LISP ("process-environment", &Vprocess_environment, - "List of strings to append to environment of subprocesses that are started.\n\ -Each string should have the format ENVVARNAME=VALUE."); -#endif + "List of environment variables for subprocesses to inherit.\n\ +Each element should be a string of the form ENVVARNAME=VALUE.\n\ +The environment which Emacs inherits is placed in this variable\n\ +when Emacs starts."); #ifndef VMS defsubr (&Scall_process); #endif + defsubr (&Sgetenv); defsubr (&Scall_process_region); - defsubr (&Sgetenv); }