(construct_menu_click, construct_mouse_click):
[bpt/emacs.git] / src / callproc.c
index 77b97f5..9bf6d23 100644 (file)
@@ -20,6 +20,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 #include <signal.h>
 #include <errno.h>
+#include <stdio.h>
 
 #include <config.h>
 
@@ -74,7 +75,7 @@ extern char **environ;
 Lisp_Object Vbinary_process;
 #endif
 
-Lisp_Object Vexec_path, Vexec_directory, Vdata_directory;
+Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
 Lisp_Object Vconfigure_info_directory;
 
 Lisp_Object Vshell_file_name;
@@ -94,6 +95,13 @@ int synch_process_retcode;
 
 extern Lisp_Object Vdoc_file_name;
 \f
+/* Clean up when exiting Fcall_process.
+   On MSDOS, delete the temporary file on any kind of termination.
+   On Unix, kill the process and any children on termination by signal.  */
+
+/* Nonzero if this is termination due to exit.  */
+static int call_process_exited;
+
 #ifndef VMS  /* VMS version is in vmsproc.c.  */
 
 static Lisp_Object
@@ -112,13 +120,21 @@ call_process_cleanup (fdpid)
 {
 #ifdef MSDOS
   /* for MSDOS fdpid is really (fd . tempfile)  */
-  register Lisp_Object file = Fcdr (fdpid);
+  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 */
   register int pid = XFASTINT (Fcdr (fdpid));
 
+
+  if (call_process_exited)
+    {
+      close (XFASTINT (Fcar (fdpid)));
+      return Qnil;
+    }
+
   if (EMACS_KILLPG (pid, SIGINT) == 0)
     {
       int count = specpdl_ptr - specpdl;
@@ -217,9 +233,9 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
     GCPRO3 (infile, buffer, current_dir);
 
-    current_dir = 
-      expand_and_dir_to_file
-       (Funhandled_file_name_directory (current_dir), Qnil);
+    current_dir
+      = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
+                               Qnil);
     if (NILP (Ffile_accessible_directory_p (current_dir)))
       report_file_error ("Setting current directory",
                         Fcons (current_buffer->directory, Qnil));
@@ -229,31 +245,34 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
   display = nargs >= 4 ? args[3] : Qnil;
 
-  {
-    register int i;
-    for (i = 4; i < nargs; i++)
-      {
-       CHECK_STRING (args[i], i);
-       new_argv[i - 3] = XSTRING (args[i])->data;
-      }
-    /* Program name is first command arg */
-    new_argv[0] = XSTRING (args[0])->data;
-    new_argv[i - 3] = 0;
-  }
-
   filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
   if (filefd < 0)
     {
       report_file_error ("Opening process input file", Fcons (infile, Qnil));
     }
   /* Search for program; barf if not found.  */
-  openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
+  {
+    struct gcpro gcpro1;
+
+    GCPRO1 (current_dir);
+    openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
+    UNGCPRO;
+  }
   if (NILP (path))
     {
       close (filefd);
       report_file_error ("Searching for program", Fcons (args[0], Qnil));
     }
   new_argv[0] = XSTRING (path)->data;
+  {
+    register int i;
+    for (i = 4; i < nargs; i++)
+      {
+       CHECK_STRING (args[i], i);
+       new_argv[i - 3] = XSTRING (args[i])->data;
+      }
+    new_argv[i - 3] = 0;
+  }
 
 #ifdef MSDOS /* MW, July 1993 */
   /* These vars record information from process termination.
@@ -316,6 +335,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     synch_process_retcode = 0;
 
 #ifdef MSDOS /* MW, July 1993 */
+    /* ??? Someone who knows MSDOG needs to check whether this properly
+       closes all descriptors that it opens.  */
     pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd);
     close (outfilefd);
     fd1 = -1; /* No harm in closing that one!  */
@@ -323,6 +344,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
     if (fd[0] < 0)
       {
        unlink (tempfile);
+       close (filefd);
        report_file_error ("Cannot re-open temporary file", Qnil);
       }
 #else /* not MSDOS */
@@ -341,15 +363,10 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
       }
 #endif /* not MSDOS */
 
-#if 0
-    /* Tell SIGCHLD handler to look for this pid.  */
-    synch_process_pid = pid;
-    /* Now let SIGCHLD come through.  */
-    sigsetmask (mask);
-#endif
-
     environ = save_environ;
 
+    /* Close most of our fd's, but not fd[0]
+       since we will use that to read input from.  */
     close (filefd);
     if (fd1 >= 0)
       close (fd1);
@@ -357,12 +374,15 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
   if (pid < 0)
     {
-      close (fd[0]);
+      if (fd[0] >= 0)
+       close (fd[0]);
       report_file_error ("Doing vfork", Qnil);
     }
 
   if (XTYPE (buffer) == Lisp_Int)
     {
+      if (fd[0] >= 0)
+       close (fd[0]);
 #ifndef subprocesses
       /* If Emacs has been built with asynchronous subprocess support,
         we don't need to do this, I think because it will then have
@@ -372,6 +392,9 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
       return Qnil;
     }
 
+  /* Enable sending signal if user quits below.  */
+  call_process_exited = 0;
+
 #ifdef MSDOS
   /* MSDOS needs different cleanup information.  */
   record_unwind_protect (call_process_cleanup,
@@ -416,6 +439,10 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 
   set_buffer_internal (old);
 
+  /* Don't kill any children that the subprocess may have left behind
+     when exiting.  */
+  call_process_exited = 1;
+
   unbind_to (count, Qnil);
 
   if (synch_process_death)
@@ -619,8 +646,13 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
      started with its standard in, out, or error closed, as might
      happen under X.  */
   in = relocate_fd (in, 3);
-  out = relocate_fd (out, 3);
-  err = relocate_fd (err, 3);
+  if (out == err)
+    err = out = relocate_fd (out, 3);
+  else
+    {
+      out = relocate_fd (out, 3);
+      err = relocate_fd (err, 3);
+    }
 
   close (0);
   close (1);
@@ -699,8 +731,9 @@ getenv_internal (var, varlen, value, valuelen)
 
   for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
     {
-      Lisp_Object entry = XCONS (scan)->car;
-      
+      Lisp_Object entry;
+
+      entry = XCONS (scan)->car;
       if (XTYPE (entry) == Lisp_String
          && XSTRING (entry)->size > varlen
          && XSTRING (entry)->data[varlen] == '='
@@ -755,10 +788,14 @@ egetenv (var)
 init_callproc_1 ()
 {
   char *data_dir = egetenv ("EMACSDATA");
-    
+  char *doc_dir = egetenv ("EMACSDOC");
+
   Vdata_directory
     = Ffile_name_as_directory (build_string (data_dir ? data_dir 
                                             : PATH_DATA));
+  Vdoc_directory
+    = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
+                                            : PATH_DOC));
 
   /* Check the EMACSPATH environment variable, defaulting to the
      PATH_EXEC path from paths.h.  */
@@ -801,16 +838,18 @@ init_callproc ()
   tempdir = Fdirectory_file_name (Vexec_directory);
   if (access (XSTRING (tempdir)->data, 0) < 0)
     {
-      printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
-             XSTRING (Vexec_directory)->data);
+      fprintf (stderr,
+              "Warning: arch-dependent data dir (%s) does not exist.\n",
+              XSTRING (Vexec_directory)->data);
       sleep (2);
     }
 
   tempdir = Fdirectory_file_name (Vdata_directory);
   if (access (XSTRING (tempdir)->data, 0) < 0)
     {
-      printf ("Warning: arch-independent data dir (%s) does not exist.\n",
-             XSTRING (Vdata_directory)->data);
+      fprintf (stderr,
+              "Warning: arch-independent data dir (%s) does not exist.\n",
+              XSTRING (Vdata_directory)->data);
       sleep (2);
     }
 
@@ -859,6 +898,10 @@ especially executable programs intended for Emacs to invoke.");
     "Directory of architecture-independent files that come with GNU Emacs,\n\
 intended for Emacs to use.");
 
+  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.");
+
   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\