]> code.delx.au - gnu-emacs/blobdiff - src/callproc.c
(Fcall_process): Remove unused vars.
[gnu-emacs] / src / callproc.c
index 85a5eaf72d9b753d37efe3160b40cda182f54945..bee100fc3c604c964436e25ee746efe70b7c20c9 100644 (file)
@@ -1,5 +1,6 @@
 /* Synchronous subprocess invocation for GNU Emacs.
-   Copyright (C) 1985, 86,87,88,93,94,95, 1999 Free Software Foundation, Inc.
+   Copyright (C) 1985,86,87,88,93,94,95,99, 2000, 2001
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -24,7 +25,9 @@ Boston, MA 02111-1307, USA.  */
 #include <errno.h>
 #include <stdio.h>
 
+#ifndef USE_CRT_DLL
 extern int errno;
+#endif
 
 /* Define SIGCHLD as an alias for SIGCLD.  */
 
@@ -72,9 +75,10 @@ extern int errno;
 #include "lisp.h"
 #include "commands.h"
 #include "buffer.h"
-#include "charset.h"
+#include "character.h"
 #include "ccl.h"
 #include "coding.h"
+#include "composite.h"
 #include <epaths.h>
 #include "process.h"
 #include "syssignal.h"
@@ -87,12 +91,20 @@ extern int errno;
 #ifdef VMS
 extern noshare char **environ;
 #else
+#ifndef USE_CRT_DLL
 extern char **environ;
 #endif
+#endif
 
-#define max(a, b) ((a) > (b) ? (a) : (b))
+#ifdef HAVE_SETPGID
+#if !defined (USG) || defined (BSD_PGRPS)
+#undef setpgrp
+#define setpgrp setpgid
+#endif
+#endif
 
-Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
+Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
+Lisp_Object Vdata_directory, Vdoc_directory;
 Lisp_Object Vconfigure_info_directory;
 Lisp_Object Vtemp_file_name_pattern;
 
@@ -177,25 +189,27 @@ 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\
-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\
-\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)
+       doc: /* Call PROGRAM synchronously in separate process.
+The remaining arguments are optional.
+The program's input comes from file INFILE (nil means `/dev/null').
+Insert output in BUFFER before point; t means current buffer;
+ nil for BUFFER means discard it; 0 means discard and don't wait.
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+REAL-BUFFER says what to do with standard output, as above,
+while STDERR-FILE says what to do with standard error in the child.
+STDERR-FILE may be nil (discard standard error output),
+t (mix it with ordinary output), or a file name string.
+
+Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
+Remaining arguments are strings passed as command arguments to PROGRAM.
+
+If BUFFER is 0, `call-process' returns immediately with value nil.
+Otherwise it waits for PROGRAM to terminate
+and returns a numeric exit status or a signal description string.
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
+     (nargs, args)
      int nargs;
      register Lisp_Object *args;
 {
@@ -233,7 +247,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
   coding_systems = Qt;
 
-  CHECK_STRING (args[0], 0);
+  CHECK_STRING (args[0]);
 
   error_file = Qt;
 
@@ -255,7 +269,7 @@ 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);
+         CHECK_STRING (args[i]);
 
        for (i = 4; i < nargs; i++)
          if (STRING_MULTIBYTE (args[i]))
@@ -285,7 +299,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   if (nargs >= 2 && ! NILP (args[1]))
     {
       infile = Fexpand_file_name (args[1], current_buffer->directory);
-      CHECK_STRING (infile, 1);
+      CHECK_STRING (infile);
     }
   else
     infile = build_string (NULL_DEVICE);
@@ -321,8 +335,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
          buffer = Fget_buffer_create (buffer);
          /* Mention the buffer name for a better error message.  */
          if (NILP (buffer))
-           CHECK_BUFFER (spec_buffer, 2);
-         CHECK_BUFFER (buffer, 2);
+           CHECK_BUFFER (spec_buffer);
+         CHECK_BUFFER (buffer);
        }
     }
   else 
@@ -367,7 +381,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     struct gcpro gcpro1;
 
     GCPRO1 (current_dir);
-    openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
+    openp (Vexec_path, args[0], Vexec_suffixes, &path, 1);
     UNGCPRO;
   }
   if (NILP (path))
@@ -379,22 +393,19 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
   if (nargs > 4)
     {
       register int i;
+      struct gcpro gcpro1, gcpro2, gcpro3;
 
-      if (CODING_REQUIRE_ENCODING (&argument_coding))
+      GCPRO3 (infile, buffer, current_dir);
+      argument_coding.dst_multibyte = 0;
+      for (i = 4; i < nargs; i++)
        {
-         /* We must encode the arguments.  */
-         struct gcpro gcpro1, gcpro2, gcpro3;
-
-         GCPRO3 (infile, buffer, current_dir);
-         for (i = 4; i < nargs; i++)
-           {
-             args[i] = code_convert_string (args[i], &argument_coding, 1, 0);
-             setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
-           }
-         UNGCPRO;
+         argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
+         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] = XSTRING (args[i])->data;
        }
-      for (i = 4; i < nargs; i++)
-       new_argv[i - 3] = XSTRING (args[i])->data;
+      UNGCPRO;
       new_argv[nargs - 3] = 0;
     }
   else
@@ -451,7 +462,12 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     {
 #ifndef MSDOS
 #ifndef macintosh
-      pipe (fd);
+      errno = 0;
+      if (pipe (fd) == -1)
+       {
+         emacs_close (filefd);
+         report_file_error ("Creating process pipe", Qnil);
+       }
 #endif
 #endif
 #if 0
@@ -694,13 +710,14 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
          else
            val = Qnil;
        }
-      setup_coding_system (Fcheck_coding_system (val), &process_coding);
+      Fcheck_coding_system (val);
       /* 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);
+       val = raw_text_coding_system (val);
+      setup_coding_system (val, &process_coding);
     }
 
   immediate_quit = 1;
@@ -715,7 +732,6 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     struct coding_system saved_coding;
 
     saved_coding = process_coding;
-
     while (1)
       {
        /* Repeatedly read until we've filled as much as possible
@@ -748,58 +764,61 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
        
        if (!NILP (buffer))
          {
-           if (! CODING_REQUIRE_DECODING (&process_coding))
-             insert (bufptr, nread);
+           if (! CODING_MAY_REQUIRE_DECODING (&process_coding))
+             insert_1_both (bufptr, nread, nread, 0, 1, 0);
            else
              {                 /* We have to decode the input.  */
-               int size = decoding_buffer_size (&process_coding, nread);
-               char *decoding_buf = (char *) xmalloc (size);
+               Lisp_Object buf;
 
-               decode_coding (&process_coding, bufptr, decoding_buf,
-                              nread, size);
+               XSETBUFFER (buf, current_buffer);
+               decode_coding_c_string (&process_coding, bufptr, nread,
+                                       buf);
                if (display_on_the_fly
-                   && saved_coding.type == coding_type_undecided
-                   && process_coding.type != coding_type_undecided)
+                   && CODING_REQUIRE_DETECTION (&saved_coding)
+                   && ! CODING_REQUIRE_DETECTION (&process_coding))
                  {
                    /* 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);
+                   if (process_coding.produced > 0)
+                     del_range_2 (process_coding.dst_pos,
+                                  process_coding.dst_pos_byte,
+                                  process_coding.dst_pos
+                                  + process_coding.produced_char,
+                                  process_coding.dst_pos_byte
+                                  + process_coding.produced, 0);
                    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;
+               
+               TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
+                                 PT_BYTE + process_coding.produced);
+               nread -= process_coding.consumed;
+               carryover = nread;
                if (carryover > 0)
-                 {
-                   /* As CARRYOVER should not be that large, we had
-                      better avoid overhead of bcopy.  */
-                   char *p = bufptr + process_coding.consumed;
-                   char *pend = p + carryover;
-                   char *dst = bufptr;
-
-                   while (p < pend) *dst++ = *p++;
-                 }
+                 /* As CARRYOVER should not be that large, we had
+                    better avoid overhead of bcopy.  */
+                 BCOPY_SHORT (bufptr + process_coding.consumed, bufptr,
+                              carryover);
              }
          }
+
        if (process_coding.mode & CODING_MODE_LAST_BLOCK)
-         {
-           if (carryover > 0)
-             insert (bufptr, carryover);
-           break;
-         }
+         break;
 
        /* Make the buffer bigger as we continue to read more data,
           but not past 64k.  */
        if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
          {
+           char *tempptr;
            bufsize *= 2;
-           bufptr = (char *) alloca (bufsize);
+
+           tempptr = (char *) alloca (bufsize);
+           bcopy (bufptr, tempptr, bufsize / 2);
+           bufptr = tempptr;
          }
 
        if (!NILP (display) && INTERACTIVE)
@@ -807,20 +826,19 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
            if (first)
              prepare_menu_bars ();
            first = 0;
-           redisplay_preserve_echo_area ();
+           redisplay_preserve_echo_area (1);
          }
        immediate_quit = 1;
        QUIT;
       }
   give_up: ;
 
-    Vlast_coding_system_used = process_coding.symbol;
-
+    Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
     /* If the caller required, let the buffer inherit the
        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.  */
@@ -850,30 +868,33 @@ delete_temp_file (name)
   /* 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.  */
   internal_delete_file (name);
+  return Qnil;
 }
 
 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\
- 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\
-\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)
+       3, MANY, 0,
+       doc: /* Send text from START to END to a synchronous process running PROGRAM.
+The remaining arguments are optional.
+Delete the text if fourth arg DELETE is non-nil.
+
+Insert output in BUFFER before point; t means current buffer;
+ nil for BUFFER means discard it; 0 means discard and don't wait.
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+REAL-BUFFER says what to do with standard output, as above,
+while STDERR-FILE says what to do with standard error in the child.
+STDERR-FILE may be nil (discard standard error output),
+t (mix it with ordinary output), or a file name string.
+
+Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
+Remaining args are passed to PROGRAM at startup as command args.
+
+If BUFFER is nil, `call-process-region' returns immediately with value nil.
+Otherwise it waits for PROGRAM to terminate
+and returns a numeric exit status or a signal description string.
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)  */)
+     (nargs, args)
      int nargs;
      register Lisp_Object *args;
 {
@@ -917,7 +938,18 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
   coding_systems = Qt;
 
+#ifdef HAVE_MKSTEMP
+ {
+   int fd = mkstemp (tempfile);
+   if (fd == -1)
+     report_file_error ("Failed to open temporary file",
+                       Fcons (Vtemp_file_name_pattern, Qnil));
+   else
+     close (fd);
+ }
+#else
   mktemp (tempfile);
+#endif
 
   filename_string = build_string (tempfile);
   GCPRO1 (filename_string);
@@ -1041,7 +1073,14 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
     register int i;
 
     i = STRING_BYTES (XSTRING (current_dir));
+#ifdef MSDOS
+    /* MSDOS must have all environment variables malloc'ed, because
+       low-level libc functions that launch subsidiary processes rely
+       on that.  */
+    pwd_var = (char *) xmalloc (i + 6);
+#else
     pwd_var = (char *) alloca (i + 6);
+#endif
     temp = pwd_var + 4;
     bcopy ("PWD=", pwd_var, 4);
     bcopy (XSTRING (current_dir)->data, temp, i);
@@ -1175,12 +1214,9 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
   /* setpgrp_of_tty is incorrect here; it uses input_fd.  */
   EMACS_SET_TTY_PGRP (0, &pid);
 
-#ifdef vipc
-  something missing here;
-#endif /* vipc */
-
 #ifdef MSDOS
   pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
+  xfree (pwd_var);
   if (pid == -1)
     /* An error occurred while trying to run the subprocess.  */
     report_file_error ("Spawning child process", Qnil);
@@ -1272,17 +1308,17 @@ getenv_internal (var, varlen, value, valuelen)
   return 0;
 }
 
-DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0,
-  "Return the value of environment variable VAR, as a string.\n\
-VAR should be a string.  Value is nil if VAR is undefined in the environment.\n\
-This function consults the variable ``process-environment'' for its value.")
-  (var)
+DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0,
+       doc: /* Return the value of environment variable VAR, as a string.
+VAR should be a string.  Value is nil if VAR is undefined in the environment.
+This function consults the variable ``process-environment'' for its value.  */)
+     (var)
      Lisp_Object var;
 {
   char *value;
   int valuelen;
 
-  CHECK_STRING (var, 0);
+  CHECK_STRING (var);
   if (getenv_internal (XSTRING (var)->data, STRING_BYTES (XSTRING (var)),
                       &value, &valuelen))
     return make_string (value, valuelen);
@@ -1348,7 +1384,11 @@ init_callproc ()
 #ifndef DOS_NT
          /* MSDOS uses wrapped binaries, so don't do this.  */
       if (NILP (Fmember (tem, Vexec_path)))
-       Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
+       {
+         Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
+         Vexec_path = Fcons (tem, Vexec_path);
+         Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
+       }
       
       Vexec_directory = Ffile_name_as_directory (tem);
 #endif /* not DOS_NT */
@@ -1371,12 +1411,15 @@ init_callproc ()
      source directory.  */
   if (data_dir == 0)
     {
-      Lisp_Object tem, tem1, newdir;
+      Lisp_Object tem, tem1, srcdir;
 
+      srcdir = Fexpand_file_name (build_string ("../src/"),
+                                 build_string (PATH_DUMPLOADSEARCH));
       tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
       tem1 = Ffile_exists_p (tem);
-      if (NILP (tem1))
+      if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
        {
+         Lisp_Object newdir;
          newdir = Fexpand_file_name (build_string ("../etc/"),
                                      build_string (PATH_DUMPLOADSEARCH));
          tem = Fexpand_file_name (build_string ("GNU"), newdir);
@@ -1446,47 +1489,54 @@ syms_of_callproc ()
 #endif /* DOS_NT */
 
   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
-    "*File name to load inferior shells from.\n\
-Initialized from the SHELL environment variable.");
+              doc: /* *File name to load inferior shells from.
+Initialized from the SHELL environment variable.  */);
 
   DEFVAR_LISP ("exec-path", &Vexec_path,
-    "*List of directories to search programs to run in subprocesses.\n\
-Each element is a string (directory name) or nil (try default directory).");
+              doc: /* *List of directories to search programs to run in subprocesses.
+Each element is a string (directory name) or nil (try default directory).  */);
+
+  DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes,
+              doc: /* *List of suffixes to try to find executable file names.
+Each element is a string.  */);
+  Vexec_suffixes = Qnil;
 
   DEFVAR_LISP ("exec-directory", &Vexec_directory,
-    "Directory for executables for Emacs to invoke.\n\
-More generally, this includes any architecture-dependent files\n\
-that are built and installed from the Emacs distribution.");
+              doc: /* Directory for executables for Emacs to invoke.
+More generally, this includes any architecture-dependent files
+that are built and installed from the Emacs distribution.  */);
 
   DEFVAR_LISP ("data-directory", &Vdata_directory,
-    "Directory of machine-independent files that come with GNU Emacs.\n\
-These are files intended for Emacs to use while it runs.");
+              doc: /* Directory of machine-independent files that come with GNU Emacs.
+These are files intended for Emacs to use while it runs.  */);
 
   DEFVAR_LISP ("doc-directory", &Vdoc_directory,
-    "Directory containing the DOC file that comes with GNU Emacs.\n\
-This is usually the same as data-directory.");
+              doc: /* Directory containing the DOC file that comes with GNU Emacs.
+This is usually the same as data-directory.  */);
 
   DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
-    "For internal use by the build procedure only.\n\
-This is the name of the directory in which the build procedure installed\n\
-Emacs's info files; the default value for Info-default-directory-list\n\
-includes this.");
+              doc: /* For internal use by the build procedure only.
+This is the name of the directory in which the build procedure installed
+Emacs's info files; the default value for Info-default-directory-list
+includes this.  */);
   Vconfigure_info_directory = build_string (PATH_INFO);
 
   DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern,
-    "Pattern for making names for temporary files.\n\
-This is used by `call-process-region'.");
+              doc: /* Pattern for making names for temporary files.
+This is used by `call-process-region'.  */);
   /* This variable is initialized in init_callproc.  */
 
   DEFVAR_LISP ("process-environment", &Vprocess_environment,
-    "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.");
+              doc: /* List of environment variables for subprocesses to inherit.
+Each element should be a string of the form ENVVARNAME=VALUE.
+If multiple entries define the same variable, the first one always
+takes precedence.
+The environment which Emacs inherits is placed in this variable
+when Emacs starts.  */);
 
 #ifndef VMS
   defsubr (&Scall_process);
-  defsubr (&Sgetenv);
+  defsubr (&Sgetenv_internal);
 #endif
   defsubr (&Scall_process_region);
 }