(WINNT_SUPPORT): Add common-win.elc, like src/Makefile.in did.
[bpt/emacs.git] / src / callproc.c
index a3b7b7a..cab3047 100644 (file)
@@ -1,14 +1,14 @@
 /* Synchronous subprocess invocation for GNU Emacs.
    Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
-                 2002, 2003, 2004, 2005, 2006, 2007, 2008
+                 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
                  Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -16,9 +16,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
+along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
 #include <config.h>
@@ -92,13 +90,9 @@ extern int errno;
 #include "msdos.h"
 #endif
 
-#ifdef VMS
-extern noshare char **environ;
-#else
 #ifndef USE_CRT_DLL
 extern char **environ;
 #endif
-#endif
 
 #ifdef HAVE_SETPGID
 #if !defined (USG) || defined (BSD_PGRPS)
@@ -110,7 +104,11 @@ extern char **environ;
 Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
 Lisp_Object Vdata_directory, Vdoc_directory;
 Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
-Lisp_Object Vtemp_file_name_pattern;
+
+/* Pattern used by call-process-region to make temp files.  */
+static Lisp_Object Vtemp_file_name_pattern;
+
+extern Lisp_Object Vtemporary_file_directory;
 
 Lisp_Object Vshell_file_name;
 
@@ -144,8 +142,6 @@ static int call_process_exited;
 
 EXFUN (Fgetenv_internal, 2);
 
-#ifndef VMS  /* VMS version is in vmsproc.c.  */
-
 static Lisp_Object
 call_process_kill (fdpid)
      Lisp_Object fdpid;
@@ -157,18 +153,26 @@ call_process_kill (fdpid)
 }
 
 Lisp_Object
-call_process_cleanup (fdpid)
-     Lisp_Object fdpid;
+call_process_cleanup (arg)
+     Lisp_Object arg;
 {
+  Lisp_Object fdpid = Fcdr (arg);
+#if defined (MSDOS)
+  Lisp_Object file;
+#else
+  int pid;
+#endif
+
+  Fset_buffer (Fcar (arg));
+
 #if defined (MSDOS)
   /* for MSDOS fdpid is really (fd . tempfile)  */
-  register Lisp_Object file;
   file = Fcdr (fdpid);
   emacs_close (XFASTINT (Fcar (fdpid)));
   if (strcmp (SDATA (file), NULL_DEVICE) != 0)
     unlink (SDATA (file));
 #else /* not MSDOS */
-  register int pid = XFASTINT (Fcdr (fdpid));
+  pid = XFASTINT (Fcdr (fdpid));
 
   if (call_process_exited)
     {
@@ -234,18 +238,13 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
   int bufsize = CALLPROC_BUFFER_SIZE_MIN;
   int count = SPECPDL_INDEX ();
 
-  register const unsigned char **new_argv
-    = (const unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
-  struct buffer *old = current_buffer;
+  register const unsigned char **new_argv;
   /* File to use for stderr in the child.
      t means use same as standard output.  */
   Lisp_Object error_file;
 #ifdef MSDOS   /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
   char *outf, *tempfile;
   int outfilefd;
-#endif
-#if 0
-  int mask;
 #endif
   struct coding_system process_coding; /* coding-system of process output */
   struct coding_system argument_coding;        /* coding-system of arguments */
@@ -376,9 +375,14 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
 
     GCPRO4 (infile, buffer, current_dir, error_file);
 
-    current_dir
-      = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
-                               Qnil);
+    current_dir = Funhandled_file_name_directory (current_dir);
+    if (NILP (current_dir))
+      /* If the file name handler says that current_dir is unreachable, use
+        a sensible default. */
+      current_dir = build_string ("~/");
+    current_dir = expand_and_dir_to_file (current_dir, Qnil);
+    current_dir = Ffile_name_as_directory (current_dir);
+
     if (NILP (Ffile_accessible_directory_p (current_dir)))
       report_file_error ("Setting current directory",
                         Fcons (current_buffer->directory, Qnil));
@@ -402,9 +406,9 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
     }
   /* Search for program; barf if not found.  */
   {
-    struct gcpro gcpro1;
+    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
-    GCPRO1 (current_dir);
+    GCPRO4 (infile, buffer, current_dir, error_file);
     openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
     UNGCPRO;
   }
@@ -420,13 +424,14 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
       && SREF (path, 1) == ':')
     path = Fsubstring (path, make_number (2), Qnil);
 
-  new_argv[0] = SDATA (path);
+  new_argv = (const unsigned char **)
+    alloca (max (2, nargs - 2) * sizeof (char *));
   if (nargs > 4)
     {
       register int i;
-      struct gcpro gcpro1, gcpro2, gcpro3;
+      struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 
-      GCPRO3 (infile, buffer, current_dir);
+      GCPRO5 (infile, buffer, current_dir, path, error_file);
       argument_coding.dst_multibyte = 0;
       for (i = 4; i < nargs; i++)
        {
@@ -434,13 +439,15 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
          if (CODING_REQUIRE_ENCODING (&argument_coding))
            /* We must encode this argument.  */
            args[i] = encode_coding_string (&argument_coding, args[i], 1);
-         new_argv[i - 3] = SDATA (args[i]);
        }
       UNGCPRO;
-      new_argv[nargs - 3] = 0;
+      for (i = 4; i < nargs; i++)
+       new_argv[i - 3] = SDATA (args[i]);
+      new_argv[i - 3] = 0;
     }
   else
     new_argv[1] = 0;
+  new_argv[0] = SDATA (path);
 
 #ifdef MSDOS /* MW, July 1993 */
   if ((outf = egetenv ("TMPDIR")))
@@ -478,10 +485,6 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
          emacs_close (filefd);
          report_file_error ("Creating process pipe", Qnil);
        }
-#endif
-#if 0
-      /* Replaced by close_process_descs */
-      set_exclusive_use (fd[0]);
 #endif
     }
 
@@ -634,10 +637,13 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
 #if defined(MSDOS)
   /* MSDOS needs different cleanup information.  */
   record_unwind_protect (call_process_cleanup,
-                        Fcons (make_number (fd[0]), build_string (tempfile)));
+                        Fcons (Fcurrent_buffer (),
+                               Fcons (make_number (fd[0]),
+                                      build_string (tempfile))));
 #else
   record_unwind_protect (call_process_cleanup,
-                        Fcons (make_number (fd[0]), make_number (pid)));
+                        Fcons (Fcurrent_buffer (),
+                               Fcons (make_number (fd[0]), make_number (pid))));
 #endif /* not MSDOS */
 
 
@@ -736,10 +742,18 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
            else
              {                 /* We have to decode the input.  */
                Lisp_Object curbuf;
+               int count1 = SPECPDL_INDEX ();
 
                XSETBUFFER (curbuf, current_buffer);
+               /* We cannot allow after-change-functions be run
+                  during decoding, because that might modify the
+                  buffer, while we rely on process_coding.produced to
+                  faithfully reflect inserted text until we
+                  TEMP_SET_PT_BOTH below.  */
+               specbind (Qinhibit_modification_hooks, Qt);
                decode_coding_c_string (&process_coding, buf, nread,
                                        curbuf);
+               unbind_to (count1, Qnil);
                if (display_on_the_fly
                    && CODING_REQUIRE_DETECTION (&saved_coding)
                    && ! CODING_REQUIRE_DETECTION (&process_coding))
@@ -808,7 +822,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
        coding-system used to decode the process output.  */
     if (inherit_process_coding_system)
       call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
-              make_number (total_read));
+            make_number (total_read));
   }
 
   /* Wait for it to terminate, unless it already has.  */
@@ -816,8 +830,6 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
 
   immediate_quit = 0;
 
-  set_buffer_internal (old);
-
   /* Don't kill any children that the subprocess may have left behind
      when exiting.  */
   call_process_exited = 1;
@@ -842,7 +854,6 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
                                         Vlocale_coding_system, 0);
   return make_number (synch_process_retcode);
 }
-#endif
 \f
 static Lisp_Object
 delete_temp_file (name)
@@ -891,36 +902,32 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
   Lisp_Object coding_systems;
   Lisp_Object val, *args2;
   int i;
-#ifdef DOS_NT
   char *tempfile;
-  char *outf = '\0';
+  Lisp_Object tmpdir, pattern;
 
-  if ((outf = egetenv ("TMPDIR"))
-      || (outf = egetenv ("TMP"))
-      || (outf = egetenv ("TEMP")))
-    strcpy (tempfile = alloca (strlen (outf) + 20), outf);
+  if (STRINGP (Vtemporary_file_directory))
+    tmpdir = Vtemporary_file_directory;
   else
     {
-      tempfile = alloca (20);
-      *tempfile = '\0';
-    }
-  if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1]))
-    strcat (tempfile, "/");
-  if ('/' == DIRECTORY_SEP)
-    dostounix_filename (tempfile);
-  else
-    unixtodos_filename (tempfile);
-#ifdef WINDOWSNT
-  strcat (tempfile, "emXXXXXX");
-#else
-  strcat (tempfile, "detmp.XXX");
+#ifndef DOS_NT
+      if (getenv ("TMPDIR"))
+       tmpdir = build_string (getenv ("TMPDIR"));
+      else
+       tmpdir = build_string ("/tmp/");
+#else /* DOS_NT */
+      char *outf;
+      if ((outf = egetenv ("TMPDIR"))
+         || (outf = egetenv ("TMP"))
+         || (outf = egetenv ("TEMP")))
+       tmpdir = build_string (outf);
+      else
+       tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
 #endif
-#else /* not DOS_NT */
-  char *tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
-  bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
-        SBYTES (Vtemp_file_name_pattern) + 1);
-#endif /* not DOS_NT */
+    }
 
+  pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
+  tempfile = (char *) alloca (SBYTES (pattern) + 1);
+  bcopy (SDATA (pattern), tempfile, SBYTES (pattern) + 1);
   coding_systems = Qt;
 
 #ifdef HAVE_MKSTEMP
@@ -998,8 +1005,6 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
   RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
 }
 \f
-#ifndef VMS /* VMS version is in vmsproc.c.  */
-
 static int relocate_fd ();
 
 static char **
@@ -1401,15 +1406,11 @@ DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
 VARIABLE should be a string.  Value is nil if VARIABLE is undefined in
 the environment.  Otherwise, value is a string.
 
-This function searches `process-environment' for VARIABLE.  If it is
-not found there, then it continues the search in the environment list
-of the selected frame.
+This function searches `process-environment' for VARIABLE.
 
 If optional parameter ENV is a list, then search this list instead of
-`process-environment', and return t when encountering a negative entry.
-
-If it is a frame, then this function will ignore `process-environment' and
-will simply look up the variable in that frame's environment.  */)
+`process-environment', and return t when encountering a negative entry
+\(an entry for a variable with no value).  */)
      (variable, env)
      Lisp_Object variable, env;
 {
@@ -1447,7 +1448,6 @@ egetenv (var)
     return 0;
 }
 
-#endif /* not VMS */
 \f
 /* This is run before init_cmdargs.  */
 
@@ -1550,26 +1550,8 @@ init_callproc ()
     dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
                 Vdata_directory);
 
-#ifdef VMS
-  Vshell_file_name = build_string ("*dcl*");
-#else
   sh = (char *) getenv ("SHELL");
   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
-#endif
-
-#ifdef VMS
-  Vtemp_file_name_pattern = build_string ("tmp:emacsXXXXXX.");
-#else
-  if (getenv ("TMPDIR"))
-    {
-      char *dir = getenv ("TMPDIR");
-      Vtemp_file_name_pattern
-       = Fexpand_file_name (build_string ("emacsXXXXXX"),
-                            build_string (dir));
-    }
-  else
-    Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
-#endif
 
 #ifdef DOS_NT
   Vshared_game_score_directory = Qnil;
@@ -1586,8 +1568,11 @@ set_initial_environment ()
   register char **envp;
 #ifndef CANNOT_DUMP
   if (initialized)
-#endif
     {
+#else
+    {
+      Vprocess_environment = Qnil;
+#endif
       for (envp = environ; *envp; envp++)
        Vprocess_environment = Fcons (build_string (*envp),
                                      Vprocess_environment);
@@ -1605,6 +1590,15 @@ syms_of_callproc ()
   staticpro (&Qbuffer_file_type);
 #endif /* DOS_NT */
 
+#ifndef DOS_NT
+  Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
+#elif defined (WINDOWSNT)
+  Vtemp_file_name_pattern = build_string ("emXXXXXX");
+#else
+  Vtemp_file_name_pattern = build_string ("detmp.XXX");
+#endif
+  staticpro (&Vtemp_file_name_pattern);
+
   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
               doc: /* *File name to load inferior shells from.
 Initialized from the SHELL environment variable, or to a system-dependent
@@ -1648,11 +1642,6 @@ If this variable is nil, then Emacs is unable to use a shared directory.  */);
   Vshared_game_score_directory = build_string (PATH_GAME);
 #endif
 
-  DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern,
-              doc: /* Pattern for making names for temporary files.
-This is used by `call-process-region'.  */);
-  /* This variable is initialized in init_callproc.  */
-
   DEFVAR_LISP ("initial-environment", &Vinitial_environment,
               doc: /* List of environment variables inherited from the parent process.
 Each element should be a string of the form ENVVARNAME=VALUE.
@@ -1682,10 +1671,8 @@ use.
 See `setenv' and `getenv'.  */);
   Vprocess_environment = Qnil;
 
-#ifndef VMS
   defsubr (&Scall_process);
   defsubr (&Sgetenv_internal);
-#endif
   defsubr (&Scall_process_region);
 }