(init_sys_modes) [!HAVE_X_WINDOWS (MSDOS)]: Always call set_terminal_modes.
[bpt/emacs.git] / src / callproc.c
index 04c390a..6ea2fe0 100644 (file)
@@ -1,5 +1,5 @@
 /* Synchronous subprocess invocation for GNU Emacs.
-   Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -179,10 +179,17 @@ DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
 The program's input comes from file INFILE (nil means `/dev/null').\n\
 Insert output in BUFFER before point; t means current buffer;\n\
  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
+REAL-BUFFER says what to do with standard output, as above,\n\
+while STDERR-FILE says what to do with standard error in the child.\n\
+STDERR-FILE may be nil (discard standard error output),\n\
+t (mix it with ordinary output), or a file name string.\n\
+\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 0, returns immediately with value nil.\n\
-Otherwise waits for PROGRAM to terminate\n\
+\n\
+If BUFFER is 0, `call-process' returns immediately with value nil.\n\
+Otherwise it waits for PROGRAM to terminate\n\
 and returns a numeric exit status or a signal description string.\n\
 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   (nargs, args)
@@ -193,11 +200,16 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   int fd[2];
   int filefd;
   register int pid;
-  char buf[1024];
+  char buf[16384];
+  char *bufptr = buf;
+  int bufsize = 16384;
   int count = specpdl_ptr - specpdl;
   register unsigned char **new_argv
     = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
   struct buffer *old = current_buffer;
+  /* 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;
@@ -207,6 +219,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 #endif
   CHECK_STRING (args[0], 0);
 
+  error_file = Qt;
+
 #ifndef subprocesses
   /* Without asynchronous processes we cannot have BUFFER == 0.  */
   if (nargs >= 3 && INTEGERP (args[2]))
@@ -223,14 +237,28 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
   if (nargs >= 3)
     {
-      register Lisp_Object tem;
+      buffer = args[2];
+
+      /* If BUFFER is a list, its meaning is
+        (BUFFER-FOR-STDOUT FILE-FOR-STDERR).  */
+      if (CONSP (buffer))
+       {
+         if (CONSP (XCONS (buffer)->cdr))
+           error_file = Fexpand_file_name (XCONS (XCONS (buffer)->cdr)->car,
+                                           Qnil);
+         buffer = XCONS (buffer)->car;
+       }
 
-      buffer = tem = args[2];
-      if (!(EQ (tem, Qnil)
-           || EQ (tem, Qt)
-           || XFASTINT (tem) == 0))
+      if (!(EQ (buffer, Qnil)
+           || EQ (buffer, Qt)
+           || XFASTINT (buffer) == 0))
        {
-         buffer = Fget_buffer (tem);
+         Lisp_Object spec_buffer;
+         spec_buffer = buffer;
+         buffer = Fget_buffer (buffer);
+         /* Mention the buffer name for a better error message.  */
+         if (NILP (buffer))
+           CHECK_BUFFER (spec_buffer, 2);
          CHECK_BUFFER (buffer, 2);
        }
     }
@@ -345,6 +373,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
        Protect it from permanent change.  */
     register char **save_environ = environ;
     register int fd1 = fd[1];
+    int fd_error = fd1;
 
 #if 0  /* Some systems don't have sigblock.  */
     mask = sigblock (sigmask (SIGCHLD));
@@ -373,8 +402,31 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
        report_file_error ("Cannot re-open temporary file", Qnil);
       }
 #else /* not MSDOS */
+
+    if (NILP (error_file))
+      fd_error = open (NULL_DEVICE, O_WRONLY);
+    else if (STRINGP (error_file))
+      {
+#ifdef DOS_NT
+       fd_error = open (XSTRING (error_file)->data,
+                        O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
+                        S_IREAD | S_IWRITE);
+#else  /* not DOS_NT */
+       fd_error = creat (XSTRING (error_file)->data, 0666);
+#endif /* not DOS_NT */
+      }
+
+    if (fd_error < 0)
+      {
+       close (filefd);
+       close (fd[0]);
+       if (fd1 >= 0)
+         close (fd1);
+       report_file_error ("Cannot open", error_file);
+      }
+
 #ifdef WINDOWSNT
-    pid = child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
+    pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
 #else  /* not WINDOWSNT */
     pid = vfork ();
 
@@ -387,7 +439,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 #else
         setpgrp (pid, pid);
 #endif /* USG */
-       child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
+       child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
       }
 #endif /* not MSDOS */
 #endif /* not WINDOWSNT */
@@ -443,20 +495,49 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   {
     register int nread;
     int first = 1;
+    int total_read = 0;
 
-    while ((nread = read (fd[0], buf, sizeof buf)) != 0)
+    while (1)
       {
-       if (nread < 0)
+       /* Repeatedly read until we've filled as much as possible
+          of the buffer size we have.  But don't read
+          less than 1024--save that for the next bufferfull.  */
+
+       nread = 0;
+       while (nread < bufsize - 1024)
          {
-#if defined (__osf__) && defined (__alpha)
-           continue;           /* Work around bug in DEC OSF/1 V3.0.  */
-#else
-           break;
-#endif
+           int this_read
+             = read (fd[0], bufptr + nread, bufsize - nread);
+
+           if (this_read < 0)
+             goto give_up;
+
+           if (this_read == 0)
+             goto give_up_1;
+
+           nread += this_read;
          }
+
+      give_up_1:
+
+       /* Now NREAD is the total amount of data in the buffer.  */
+       if (nread == 0)
+         break;
+
        immediate_quit = 0;
+       total_read += nread;
+       
        if (!NILP (buffer))
-         insert (buf, nread);
+         insert (bufptr, nread);
+
+       /* Make the buffer bigger as we continue to read more data,
+          but not past 64k.  */
+       if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
+         {
+           bufsize *= 2;
+           bufptr = (char *) alloca (bufsize);
+         }
+
        if (!NILP (display) && INTERACTIVE)
          {
            if (first)
@@ -467,6 +548,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
        immediate_quit = 1;
        QUIT;
       }
+  give_up: ;
   }
 
   /* Wait for it to terminate, unless it already has.  */
@@ -492,21 +574,29 @@ static Lisp_Object
 delete_temp_file (name)
      Lisp_Object name;
 {
-  /* Use Fdelete_file because that runs a file name handler.
+  /* Use Fdelete_file (indirectly) because that runs a file name handler.
      We did that when writing the file, so we should do so when deleting.  */
-  Fdelete_file (name);
+  internal_delete_file (name);
 }
 
 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
   3, MANY, 0,
   "Send text from START to END to a synchronous process running PROGRAM.\n\
 Delete the text if fourth arg DELETE is non-nil.\n\
+\n\
 Insert output in BUFFER before point; t means current buffer;\n\
  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
+REAL-BUFFER says what to do with standard output, as above,\n\
+while STDERR-FILE says what to do with standard error in the child.\n\
+STDERR-FILE may be nil (discard standard error output),\n\
+t (mix it with ordinary output), or a file name string.\n\
+\n\
 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 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\
+\n\
+If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
+Otherwise it waits for PROGRAM to terminate\n\
 and returns a numeric exit status or a signal description string.\n\
 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   (nargs, args)
@@ -533,9 +623,13 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
       *tempfile = '\0';
     }
   dostounix_filename (tempfile);
-  if (tempfile[strlen (tempfile) - 1] != '/')
+  if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1]))
     strcat (tempfile, "/");
+#ifdef WINDOWSNT
+  strcat (tempfile, "emXXXXXX");
+#else
   strcat (tempfile, "detmp.XXX");
+#endif
 #else /* not DOS_NT */
 
 #ifdef VMS
@@ -553,10 +647,10 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   end = args[1];
 #ifdef DOS_NT
   specbind (Qbuffer_file_type, Vbinary_process_input);
-  Fwrite_region (start, end, filename_string, Qnil, Qlambda);
+  Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil);
   unbind_to (count, Qnil);
 #else  /* not DOS_NT */
-  Fwrite_region (start, end, filename_string, Qnil, Qlambda);
+  Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil);
 #endif /* not DOS_NT */
 
   record_unwind_protect (delete_temp_file, filename_string);
@@ -713,14 +807,25 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
      descriptors zero, one, or two; this could happen if Emacs is
      started with its standard in, out, or error closed, as might
      happen under X.  */
-  in = relocate_fd (in, 3);
-  if (out == err)
-    err = out = relocate_fd (out, 3);
-  else
-    {
+  {
+    int oin = in, oout = out;
+
+    /* We have to avoid relocating the same descriptor twice!  */
+
+    in = relocate_fd (in, 3);
+
+    if (out == oin)
+      out = in;
+    else
       out = relocate_fd (out, 3);
+
+    if (err == oin)
+      err = in;
+    else if (err == oout)
+      err = out;
+    else
       err = relocate_fd (err, 3);
-    }
+  }
 
   close (0);
   close (1);
@@ -751,9 +856,9 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 #ifdef WINDOWSNT
   /* Spawn the child.  (See ntproc.c:Spawnve).  */
   cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
-  if (cpid == -1) {    ????
-      report_file_error ("Spawning child process", Qnil);
-  }
+  if (cpid == -1)
+    /* An error occurred while trying to spawn the process.  */
+    report_file_error ("Spawning child process", Qnil);
   reset_standard_handles (in, out, err, handles);
   return cpid;
 #else /* not WINDOWSNT */
@@ -763,8 +868,9 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
   environ = env;
   execvp (new_argv[0], new_argv);
 
-  write (1, "Couldn't exec the program ", 26);
+  write (1, "Can't exec program: ", 26);
   write (1, new_argv[0], strlen (new_argv[0]));
+  write (1, "\n", 1);
   _exit (1);
 #endif /* not WINDOWSNT */
 #endif /* not MSDOS */
@@ -818,10 +924,11 @@ getenv_internal (var, varlen, value, valuelen)
          && XSTRING (entry)->data[varlen] == '='
 #ifdef WINDOWSNT
          /* NT environment variables are case insensitive.  */
-         && ! strnicmp (XSTRING (entry)->data, var, varlen))
+         && ! strnicmp (XSTRING (entry)->data, var, varlen)
 #else  /* not WINDOWSNT */
-         && ! bcmp (XSTRING (entry)->data, var, varlen))
+         && ! bcmp (XSTRING (entry)->data, var, varlen)
 #endif /* not WINDOWSNT */
+         )
        {
          *value    = (char *) XSTRING (entry)->data + (varlen + 1);
          *valuelen = XSTRING (entry)->size - (varlen + 1);
@@ -888,7 +995,7 @@ init_callproc_1 ()
   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 }
 
-/* This is run after init_cmdargs, so that Vinvocation_directory is valid.  */
+/* This is run after init_cmdargs, when Vinstallation_directory is valid.  */
 
 init_callproc ()
 {
@@ -910,21 +1017,20 @@ init_callproc ()
          Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
          Vexec_directory = Ffile_name_as_directory (tem);
 #endif /* not DOS_NT */
+       }
 
-         /* If we use ../lib-src, maybe use ../etc as well.
-            Do so if ../etc exists and has our DOC-... file in it.  */
-         if (data_dir == 0)
-           {
-             tem = Fexpand_file_name (build_string ("etc"),
-                                      Vinstallation_directory);
-             Vdoc_directory = Ffile_name_as_directory (tem);
-           }
+      /* Maybe use ../etc as well as ../lib-src.  */
+      if (data_dir == 0)
+       {
+         tem = Fexpand_file_name (build_string ("etc"),
+                                  Vinstallation_directory);
+         Vdoc_directory = Ffile_name_as_directory (tem);
        }
     }
 
   /* Look for the files that should be in etc.  We don't use
      Vinstallation_directory, because these files are never installed
-     in /bin near the executable, and they are never in the build
+     near the executable, and they are never in the build
      directory when that's different from the source directory.
 
      Instead, if these files are not in the nominal place, we try the