Add support for large files, plus some locale improvements.
[bpt/emacs.git] / src / callproc.c
index 9fa852e..de6856b 100644 (file)
@@ -36,6 +36,10 @@ extern char *strerror ();
 
 #include <sys/types.h>
 
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
 #include <sys/file.h>
 #ifdef USG5
 #define INCLUDED_FCNTL
@@ -71,8 +75,9 @@ extern char *strerror ();
 #include "commands.h"
 #include "buffer.h"
 #include "charset.h"
+#include "ccl.h"
 #include "coding.h"
-#include <paths.h>
+#include <epaths.h>
 #include "process.h"
 #include "syssignal.h"
 #include "systty.h"
@@ -139,17 +144,16 @@ Lisp_Object
 call_process_cleanup (fdpid)
      Lisp_Object fdpid;
 {
-#ifdef MSDOS
+#if defined (MSDOS) || defined (macintosh)
   /* for MSDOS fdpid is really (fd . tempfile)  */
   register Lisp_Object file;
   file = Fcdr (fdpid);
   close (XFASTINT (Fcar (fdpid)));
   if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
     unlink (XSTRING (file)->data);
-#else /* not MSDOS */
+#else /* not MSDOS and not macintosh */
   register int pid = XFASTINT (Fcdr (fdpid));
 
-
   if (call_process_exited)
     {
       close (XFASTINT (Fcar (fdpid)));
@@ -176,6 +180,7 @@ call_process_cleanup (fdpid)
 
 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
   "Call PROGRAM synchronously in separate process.\n\
+The remaining arguments are optional.\n\
 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\
@@ -215,11 +220,20 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   char *outf, *tempfile;
   int outfilefd;
 #endif
+#ifdef macintosh
+  char *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 */
+  /* Set to the return value of Ffind_operation_coding_system.  */
+  Lisp_Object coding_systems;
+
+  /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
+  coding_systems = Qt;
 
   CHECK_STRING (args[0], 0);
 
@@ -227,16 +241,14 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
 #ifndef subprocesses
   /* Without asynchronous processes we cannot have BUFFER == 0.  */
-  if (nargs >= 3 && INTEGERP (args[2]))
+  if (nargs >= 3 
+      && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
     error ("Operating system cannot handle asynchronous subprocesses");
 #endif /* subprocesses */
 
-  /* Decide the coding-system for giving arguments and reading process
-     output.  */
+  /* Decide the coding-system for giving arguments.  */
   {
     Lisp_Object val, *args2;
-    /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
-    Lisp_Object coding_systems = Qt;
     int i;
 
     /* If arguments are supplied, we may have to encode them.  */
@@ -244,6 +256,9 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
       {
        int must_encode = 0;
 
+       for (i = 4; i < nargs; i++)
+         CHECK_STRING (args[i], i);
+
        for (i = 4; i < nargs; i++)
          if (STRING_MULTIBYTE (args[i]))
            must_encode = 1;
@@ -259,46 +274,14 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
            for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
            coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
            if (CONSP (coding_systems))
-             val = XCONS (coding_systems)->cdr;
+             val = XCDR (coding_systems);
            else if (CONSP (Vdefault_process_coding_system))
-             val = XCONS (Vdefault_process_coding_system)->cdr;
+             val = XCDR (Vdefault_process_coding_system);
            else
              val = Qnil;
          }
        setup_coding_system (Fcheck_coding_system (val), &argument_coding);
       }
-
-    /* If BUFFER is nil, we must read process output once and then
-       discard it, so setup coding system but with nil.  If BUFFER is
-       an integer, we can discard it without reading.  */
-    if (nargs < 3 || NILP (args[2]))
-      setup_coding_system (Qnil, &process_coding);
-    else if (!INTEGERP (args[2]))
-      {
-       val = Qnil;
-       if (!NILP (Vcoding_system_for_read))
-         val = Vcoding_system_for_read;
-       else if (NILP (current_buffer->enable_multibyte_characters))
-         val = Qraw_text;
-       else
-         {
-           if (!EQ (coding_systems, Qt))
-             {
-               args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
-               args2[0] = Qcall_process;
-               for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
-               coding_systems
-                 = Ffind_operation_coding_system (nargs + 1, args2);
-             }
-           if (CONSP (coding_systems))
-             val = XCONS (coding_systems)->car;
-           else if (CONSP (Vdefault_process_coding_system))
-             val = XCONS (Vdefault_process_coding_system)->car;
-           else
-             val = Qnil;
-         }
-       setup_coding_system (Fcheck_coding_system (val), &process_coding);
-      }
   }
 
   if (nargs >= 2 && ! NILP (args[1]))
@@ -317,10 +300,10 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
         (BUFFER-FOR-STDOUT FILE-FOR-STDERR).  */
       if (CONSP (buffer))
        {
-         if (CONSP (XCONS (buffer)->cdr))
+         if (CONSP (XCDR (buffer)))
            {
              Lisp_Object stderr_file;
-             stderr_file = XCONS (XCONS (buffer)->cdr)->car;
+             stderr_file = XCAR (XCDR (buffer));
 
              if (NILP (stderr_file) || EQ (Qt, stderr_file))
                error_file = stderr_file;
@@ -328,12 +311,12 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
                error_file = Fexpand_file_name (stderr_file, Qnil);
            }
 
-         buffer = XCONS (buffer)->car;
+         buffer = XCAR (buffer);
        }
 
       if (!(EQ (buffer, Qnil)
            || EQ (buffer, Qt)
-           || XFASTINT (buffer) == 0))
+           || INTEGERP (buffer)))
        {
          Lisp_Object spec_buffer;
          spec_buffer = buffer;
@@ -399,8 +382,6 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     {
       register int i;
 
-      for (i = 4; i < nargs; i++) CHECK_STRING (args[i], i);
-
       if (! CODING_REQUIRE_ENCODING (&argument_coding))
        {
          for (i = 4; i < nargs; i++)
@@ -417,16 +398,19 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
              int size = encoding_buffer_size (&argument_coding,
                                               STRING_BYTES (XSTRING (args[i])));
              unsigned char *dummy1 = (unsigned char *) alloca (size);
-             int dummy;
 
              /* The Irix 4.0 compiler barfs if we eliminate dummy.  */
              new_argv[i - 3] = dummy1;
+             argument_coding.mode |= CODING_MODE_LAST_BLOCK;
              encode_coding (&argument_coding,
                             XSTRING (args[i])->data,
                             new_argv[i - 3],
                             STRING_BYTES (XSTRING (args[i])),
                             size);
              new_argv[i - 3][argument_coding.produced] = 0;
+             /* We have to initialize CCL program status again.  */
+             if (argument_coding.type == coding_type_ccl)
+               setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
            }
          UNGCPRO;
        }
@@ -436,7 +420,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     new_argv[1] = 0;
 
 #ifdef MSDOS /* MW, July 1993 */
-  if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
+  if ((outf = egetenv ("TMPDIR")))
     strcpy (tempfile = alloca (strlen (outf) + 20), outf);
   else
     {
@@ -460,13 +444,35 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   fd[1] = outfilefd;
 #endif /* MSDOS */
 
+#ifdef macintosh
+  /* Since we don't have pipes on the Mac, create a temporary file to
+     hold the output of the subprocess.  */
+  tempfile = (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
+  bcopy (XSTRING (Vtemp_file_name_pattern)->data, tempfile,
+        STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
+
+  mktemp (tempfile);
+
+  outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
+  if (outfilefd < 0)
+    {
+      close (filefd);
+      report_file_error ("Opening process output file",
+                        Fcons (build_string (tempfile), Qnil));
+    }
+  fd[0] = filefd;
+  fd[1] = outfilefd;
+#endif /* macintosh */
+
   if (INTEGERP (buffer))
     fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
   else
     {
 #ifndef MSDOS
+#ifndef macintosh
       pipe (fd);
 #endif
+#endif
 #if 0
       /* Replaced by close_process_descs */
       set_exclusive_use (fd[0]);
@@ -524,6 +530,49 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
     current_dir = ENCODE_FILE (current_dir);
 
+#ifdef macintosh
+    {
+      /* Call run_mac_command in sysdep.c here directly instead of doing
+         a child_setup as for MSDOS and other platforms.  Note that this
+         code does not handle passing the environment to the synchronous
+         Mac subprocess.  */
+      char *infn, *outfn, *errfn, *currdn;
+      
+      /* close these files so subprocess can write to them */
+      close (outfilefd);
+      if (fd_error != outfilefd)
+        close (fd_error);
+      fd1 = -1; /* No harm in closing that one! */
+
+      infn = XSTRING (infile)->data;
+      outfn = tempfile;
+      if (NILP (error_file))
+        errfn = NULL_DEVICE;
+      else if (EQ (Qt, error_file))
+        errfn = outfn;
+      else
+        errfn = XSTRING (error_file)->data;
+      currdn = XSTRING (current_dir)->data;
+      pid = run_mac_command (new_argv, currdn, infn, outfn, errfn);
+
+      /* Record that the synchronous process exited and note its
+         termination status.  */
+      synch_process_alive = 0;
+      synch_process_retcode = pid;
+      if (synch_process_retcode < 0)  /* means it couldn't be exec'ed */
+        synch_process_death = strerror (errno);
+
+      /* Since CRLF is converted to LF within `decode_coding', we can
+         always open a file with binary mode.  */
+      fd[0] = open (tempfile, O_BINARY);
+      if (fd[0] < 0)
+       {
+         unlink (tempfile);
+         close (filefd);
+         report_file_error ("Cannot re-open temporary file", Qnil);
+       }
+    }
+#else /* not macintosh */
 #ifdef MSDOS /* MW, July 1993 */
     /* Note that on MSDOS `child_setup' actually returns the child process
        exit status, not its PID, so we assign it to `synch_process_retcode'
@@ -579,6 +628,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     if (fd_error >= 0)
       close (fd_error);
 #endif /* not MSDOS */
+#endif /* not macintosh */
 
     environ = save_environ;
 
@@ -612,19 +662,60 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   /* Enable sending signal if user quits below.  */
   call_process_exited = 0;
 
-#ifdef MSDOS
+#if defined(MSDOS) || defined(macintosh)
   /* MSDOS needs different cleanup information.  */
   record_unwind_protect (call_process_cleanup,
                         Fcons (make_number (fd[0]), build_string (tempfile)));
 #else
   record_unwind_protect (call_process_cleanup,
                         Fcons (make_number (fd[0]), make_number (pid)));
-#endif /* not MSDOS */
+#endif /* not MSDOS and not macintosh */
 
 
   if (BUFFERP (buffer))
     Fset_buffer (buffer);
 
+  if (NILP (buffer))
+    {
+      /* If BUFFER is nil, we must read process output once and then
+        discard it, so setup coding system but with nil.  */
+      setup_coding_system (Qnil, &process_coding);
+    }
+  else
+    {
+      Lisp_Object val, *args2;
+
+      val = Qnil;
+      if (!NILP (Vcoding_system_for_read))
+       val = Vcoding_system_for_read;
+      else
+       {
+         if (EQ (coding_systems, Qt))
+           {
+             int i;
+
+             args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
+             args2[0] = Qcall_process;
+             for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+             coding_systems
+               = Ffind_operation_coding_system (nargs + 1, args2);
+           }
+         if (CONSP (coding_systems))
+           val = XCAR (coding_systems);
+         else if (CONSP (Vdefault_process_coding_system))
+           val = XCAR (Vdefault_process_coding_system);
+         else
+           val = Qnil;
+       }
+      setup_coding_system (Fcheck_coding_system (val), &process_coding);
+      /* In unibyte mode, character code conversion should not take
+        place but EOL conversion should.  So, setup raw-text or one
+        of the subsidiary according to the information just setup.  */
+      if (NILP (current_buffer->enable_multibyte_characters)
+         && !NILP (val))
+       setup_raw_text_coding_system (&process_coding);
+    }
+
   immediate_quit = 1;
   QUIT;
 
@@ -633,13 +724,16 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     int first = 1;
     int total_read = 0;
     int carryover = 0;
+    int display_on_the_fly = !NILP (display) && INTERACTIVE;
+    struct coding_system saved_coding;
+
+    saved_coding = process_coding;
 
     while (1)
       {
        /* 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 bufferful.  */
-
        nread = carryover;
        while (nread < bufsize - 1024)
          {
@@ -649,21 +743,20 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
              goto give_up;
 
            if (this_read == 0)
-             goto give_up_1;
+             {
+               process_coding.mode |= CODING_MODE_LAST_BLOCK;
+               break;
+             }
 
            nread += this_read;
-         }
+           total_read += this_read;
 
-      give_up_1:
+           if (display_on_the_fly)
+             break;
+         }
 
        /* Now NREAD is the total amount of data in the buffer.  */
-       if (nread == carryover)
-         /* Here, just tell decode_coding that we are processing the
-             last block.  We break the loop after decoding.  */
-         process_coding.mode |= CODING_MODE_LAST_BLOCK;
-
        immediate_quit = 0;
-       total_read += nread - carryover;
        
        if (!NILP (buffer))
          {
@@ -672,12 +765,27 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
            else
              {                 /* We have to decode the input.  */
                int size = decoding_buffer_size (&process_coding, nread);
-               char *decoding_buf = get_conversion_buffer (size);
+               char *decoding_buf = (char *) xmalloc (size);
 
                decode_coding (&process_coding, bufptr, decoding_buf,
                               nread, size);
+               if (display_on_the_fly
+                   && saved_coding.type == coding_type_undecided
+                   && process_coding.type != coding_type_undecided)
+                 {
+                   /* We have detected some coding system.  But,
+                      there's a possibility that the detection was
+                      done by insufficient data.  So, we give up
+                      displaying on the fly.  */
+                   xfree (decoding_buf);
+                   display_on_the_fly = 0;
+                   process_coding = saved_coding;
+                   carryover = nread;
+                   continue;
+                 }
                if (process_coding.produced > 0)
                  insert (decoding_buf, process_coding.produced);
+               xfree (decoding_buf);
                carryover = nread - process_coding.consumed;
                if (carryover > 0)
                  {
@@ -758,6 +866,7 @@ delete_temp_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\
+The remaining arguments are optional.\n\
 Delete the text if fourth arg DELETE is non-nil.\n\
 \n\
 Insert output in BUFFER before point; t means current buffer;\n\
@@ -784,14 +893,16 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   register Lisp_Object start, end;
   int count = specpdl_ptr - specpdl;
   /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
-  Lisp_Object coding_systems = Qt;
+  Lisp_Object coding_systems;
   Lisp_Object val, *args2;
   int i;
 #ifdef DOS_NT
   char *tempfile;
   char *outf = '\0';
 
-  if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
+  if ((outf = egetenv ("TMPDIR"))
+      || (outf = egetenv ("TMP"))
+      || (outf = egetenv ("TEMP")))
     strcpy (tempfile = alloca (strlen (outf) + 20), outf);
   else
     {
@@ -815,6 +926,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
         STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
 #endif /* not DOS_NT */
 
+  coding_systems = Qt;
+
   mktemp (tempfile);
 
   filename_string = build_string (tempfile);
@@ -833,9 +946,9 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
       for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
       coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
       if (CONSP (coding_systems))
-       val = XCONS (coding_systems)->cdr;
+       val = XCDR (coding_systems);
       else if (CONSP (Vdefault_process_coding_system))
-       val = XCONS (Vdefault_process_coding_system)->cdr;
+       val = XCDR (Vdefault_process_coding_system);
       else
        val = Qnil;
     }
@@ -854,12 +967,22 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
   record_unwind_protect (delete_temp_file, filename_string);
 
-  if (!NILP (args[3]))
+  if (nargs > 3 && !NILP (args[3]))
     Fdelete_region (start, end);
 
-  args[3] = filename_string;
+  if (nargs > 3)
+    {
+      args += 2;
+      nargs -= 2;
+    }
+  else
+    {
+      args[0] = args[2];
+      nargs = 2;
+    }
+  args[1] = filename_string;
 
-  RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs - 2, args + 2)));
+  RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
 }
 \f
 #ifndef VMS /* VMS version is in vmsproc.c.  */
@@ -968,8 +1091,8 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 
     new_length = 0;
     for (tem = Vprocess_environment;
-        CONSP (tem) && STRINGP (XCONS (tem)->car);
-        tem = XCONS (tem)->cdr)
+        CONSP (tem) && STRINGP (XCAR (tem));
+        tem = XCDR (tem))
       new_length++;
 
     /* new_length + 2 to include PWD and terminating 0.  */
@@ -982,11 +1105,11 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 
     /* Copy the Vprocess_environment strings into new_env.  */
     for (tem = Vprocess_environment;
-        CONSP (tem) && STRINGP (XCONS (tem)->car);
-        tem = XCONS (tem)->cdr)
+        CONSP (tem) && STRINGP (XCAR (tem));
+        tem = XCDR (tem))
       {
        char **ep = env;
-       char *string = (char *) XSTRING (XCONS (tem)->car)->data;
+       char *string = (char *) XSTRING (XCAR (tem))->data;
        /* See if this string duplicates any string already in the env.
           If so, don't put it in.
           When an env var has multiple definitions,
@@ -1135,11 +1258,11 @@ getenv_internal (var, varlen, value, valuelen)
 {
   Lisp_Object scan;
 
-  for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
+  for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
     {
       Lisp_Object entry;
 
-      entry = XCONS (scan)->car;
+      entry = XCAR (scan);
       if (STRINGP (entry)
          && STRING_BYTES (XSTRING (entry)) > varlen
          && XSTRING (entry)->data[varlen] == '='
@@ -1211,7 +1334,7 @@ init_callproc_1 ()
                                             : PATH_DOC));
 
   /* Check the EMACSPATH environment variable, defaulting to the
-     PATH_EXEC path from paths.h.  */
+     PATH_EXEC path from epaths.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);
@@ -1227,20 +1350,19 @@ init_callproc ()
   register char * sh;
   Lisp_Object tempdir;
 
-  if (initialized && !NILP (Vinstallation_directory))
+  if (!NILP (Vinstallation_directory))
     {
       /* Add to the path the lib-src subdir of the installation dir.  */
       Lisp_Object tem;
       tem = Fexpand_file_name (build_string ("lib-src"),
                               Vinstallation_directory);
-      if (NILP (Fmember (tem, Vexec_path)))
-       {
 #ifndef DOS_NT
          /* MSDOS uses wrapped binaries, so don't do this.  */
-         Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
-         Vexec_directory = Ffile_name_as_directory (tem);
+      if (NILP (Fmember (tem, Vexec_path)))
+       Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
+      
+      Vexec_directory = Ffile_name_as_directory (tem);
 #endif /* not DOS_NT */
-       }
 
       /* Maybe use ../etc as well as ../lib-src.  */
       if (data_dir == 0)