Add support for large files, plus some locale improvements.
[bpt/emacs.git] / src / callproc.c
index 61b25e1..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
@@ -140,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)));
@@ -217,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);
 
@@ -234,12 +246,9 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     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.  */
@@ -265,47 +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])
-       || (CONSP (args[2]) && NILP (XCAR (args[2]))))
-      setup_coding_system (Qnil, &process_coding);
-    else if (!INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : 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]))
@@ -324,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;
@@ -335,7 +311,7 @@ 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)
@@ -422,7 +398,6 @@ 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;
@@ -469,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]);
@@ -533,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'
@@ -588,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;
 
@@ -621,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;
 
@@ -811,7 +893,7 @@ 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
@@ -844,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);
@@ -862,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;
     }
@@ -1007,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.  */
@@ -1021,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,
@@ -1174,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] == '='