]> code.delx.au - gnu-emacs/blobdiff - src/callproc.c
2002-08-10 Andrew Choi <akochoi@shaw.ca>
[gnu-emacs] / src / callproc.c
index f8709ee42d032a542b9463d0467a390f63427104..5476be065370c433388c48270702dc17f027dc7a 100644 (file)
@@ -105,7 +105,7 @@ extern char **environ;
 
 Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
 Lisp_Object Vdata_directory, Vdoc_directory;
-Lisp_Object Vconfigure_info_directory;
+Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
 Lisp_Object Vtemp_file_name_pattern;
 
 Lisp_Object Vshell_file_name;
@@ -154,14 +154,14 @@ Lisp_Object
 call_process_cleanup (fdpid)
      Lisp_Object fdpid;
 {
-#if defined (MSDOS) || defined (macintosh)
+#if defined (MSDOS) || defined (MAC_OS8)
   /* for MSDOS fdpid is really (fd . tempfile)  */
   register Lisp_Object file;
   file = Fcdr (fdpid);
   emacs_close (XFASTINT (Fcar (fdpid)));
-  if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
-    unlink (XSTRING (file)->data);
-#else /* not MSDOS and not macintosh */
+  if (strcmp (SDATA (file), NULL_DEVICE) != 0)
+    unlink (SDATA (file));
+#else /* not MSDOS and not MAC_OS8 */
   register int pid = XFASTINT (Fcdr (fdpid));
 
   if (call_process_exited)
@@ -172,7 +172,7 @@ call_process_cleanup (fdpid)
 
   if (EMACS_KILLPG (pid, SIGINT) == 0)
     {
-      int count = specpdl_ptr - specpdl;
+      int count = SPECPDL_INDEX ();
       record_unwind_protect (call_process_kill, fdpid);
       message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
       immediate_quit = 1;
@@ -206,7 +206,9 @@ 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.  */)
+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;
@@ -218,10 +220,10 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
   char buf[16384];
   char *bufptr = buf;
   int bufsize = 16384;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
 
-  register unsigned char **new_argv
-    = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
+  register const unsigned char **new_argv
+    = (const 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.  */
@@ -230,7 +232,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
   char *outf, *tempfile;
   int outfilefd;
 #endif
-#ifdef macintosh
+#ifdef MAC_OS8
   char *tempfile;
   int outfilefd;
 #endif
@@ -245,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;
 
@@ -267,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]))
@@ -297,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);
@@ -333,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 
@@ -369,7 +371,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
 
   display = nargs >= 4 ? args[3] : Qnil;
 
-  filefd = emacs_open (XSTRING (infile)->data, O_RDONLY, 0);
+  filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
   if (filefd < 0)
     {
       report_file_error ("Opening process input file", Fcons (infile, Qnil));
@@ -379,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], Vexec_suffixes, &path, 1);
+    openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
     UNGCPRO;
   }
   if (NILP (path))
@@ -387,7 +389,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
       emacs_close (filefd);
       report_file_error ("Searching for program", Fcons (args[0], Qnil));
     }
-  new_argv[0] = XSTRING (path)->data;
+  new_argv[0] = SDATA (path);
   if (nargs > 4)
     {
       register int i;
@@ -405,7 +407,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
              if (argument_coding.type == coding_type_ccl)
                setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
            }
-         new_argv[i - 3] = XSTRING (args[i])->data;
+         new_argv[i - 3] = SDATA (args[i]);
        }
       UNGCPRO;
       new_argv[nargs - 3] = 0;
@@ -438,12 +440,12 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
   fd[1] = outfilefd;
 #endif /* MSDOS */
 
-#ifdef macintosh
+#ifdef MAC_OS8
   /* 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);
+  tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
+  bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
+        SBYTES (Vtemp_file_name_pattern) + 1);
 
   mktemp (tempfile);
 
@@ -456,14 +458,14 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
     }
   fd[0] = filefd;
   fd[1] = outfilefd;
-#endif /* macintosh */
+#endif /* MAC_OS8 */
 
   if (INTEGERP (buffer))
     fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
   else
     {
 #ifndef MSDOS
-#ifndef macintosh
+#ifndef MAC_OS8
       errno = 0;
       if (pipe (fd) == -1)
        {
@@ -503,11 +505,11 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
     else if (STRINGP (error_file))
       {
 #ifdef DOS_NT
-       fd_error = emacs_open (XSTRING (error_file)->data,
+       fd_error = emacs_open (SDATA (error_file),
                               O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
                               S_IREAD | S_IWRITE);
 #else  /* not DOS_NT */
-       fd_error = creat (XSTRING (error_file)->data, 0666);
+       fd_error = creat (SDATA (error_file), 0666);
 #endif /* not DOS_NT */
       }
 
@@ -529,7 +531,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
 
     current_dir = ENCODE_FILE (current_dir);
 
-#ifdef macintosh
+#ifdef MAC_OS8
     {
       /* Call run_mac_command in sysdep.c here directly instead of doing
          a child_setup as for MSDOS and other platforms.  Note that this
@@ -543,15 +545,15 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
         close (fd_error);
       fd1 = -1; /* No harm in closing that one! */
 
-      infn = XSTRING (infile)->data;
+      infn = SDATA (infile);
       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;
+        errfn = SDATA (error_file);
+      currdn = SDATA (current_dir);
       pid = run_mac_command (new_argv, currdn, infn, outfn, errfn);
 
       /* Record that the synchronous process exited and note its
@@ -574,7 +576,7 @@ 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 macintosh */
+#else /* not MAC_OS8 */
 #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'
@@ -633,7 +635,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
     if (fd_error >= 0)
       emacs_close (fd_error);
 #endif /* not MSDOS */
-#endif /* not macintosh */
+#endif /* not MAC_OS8 */
 
     environ = save_environ;
 
@@ -667,14 +669,14 @@ 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;
 
-#if defined(MSDOS) || defined(macintosh)
+#if defined(MSDOS) || defined(MAC_OS8)
   /* 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 and not macintosh */
+#endif /* not MSDOS and not MAC_OS8 */
 
 
   if (BUFFERP (buffer))
@@ -785,6 +787,17 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
                size = decoding_buffer_size (&process_coding, nread);
                decoding_buf = (char *) xmalloc (size);
                
+               /* We can't use the macro CODING_REQUIRE_DETECTION
+                  because it always returns nonzero if the coding
+                  system requires EOL detection.  Here, we have to
+                  check only whether or not the coding system
+                  requires text-encoding detection.  */
+               if (process_coding.type == coding_type_undecided)
+                 {
+                   detect_coding (&process_coding, bufptr, nread);
+                   if (process_coding.composing != COMPOSITION_DISABLED)
+                     coding_allocate_composition_data (&process_coding, PT);
+                 }
                if (process_coding.cmp_data)
                  process_coding.cmp_data->char_offset = PT;
                
@@ -895,8 +908,12 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
           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)
@@ -919,7 +936,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
       }
 
     {
-      int post_read_count = specpdl_ptr - specpdl;
+      int post_read_count = SPECPDL_INDEX ();
 
       record_unwind_protect (save_excursion_restore, save_excursion_save ());
       inserted = PT - pt_orig;
@@ -990,7 +1007,9 @@ 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.  */)
+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;
@@ -998,7 +1017,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
   struct gcpro gcpro1;
   Lisp_Object filename_string;
   register Lisp_Object start, end;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
   Lisp_Object coding_systems;
   Lisp_Object val, *args2;
@@ -1028,9 +1047,9 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
   strcat (tempfile, "detmp.XXX");
 #endif
 #else /* not DOS_NT */
-  char *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);
+  char *tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
+  bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
+        SBYTES (Vtemp_file_name_pattern) + 1);
 #endif /* not DOS_NT */
 
   coding_systems = Qt;
@@ -1072,7 +1091,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.  *
     }
 
   {
-    int count1 = specpdl_ptr - specpdl;
+    int count1 = SPECPDL_INDEX ();
 
     specbind (intern ("coding-system-for-write"), val);
     Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
@@ -1143,7 +1162,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 
 #ifdef SET_EMACS_PRIORITY
   {
-    extern int emacs_priority;
+    extern EMACS_INT emacs_priority;
 
     if (emacs_priority < 0)
       nice (- emacs_priority);
@@ -1169,7 +1188,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
     register char *temp;
     register int i;
 
-    i = STRING_BYTES (XSTRING (current_dir));
+    i = SBYTES (current_dir);
 #ifdef MSDOS
     /* MSDOS must have all environment variables malloc'ed, because
        low-level libc functions that launch subsidiary processes rely
@@ -1180,7 +1199,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 #endif
     temp = pwd_var + 4;
     bcopy ("PWD=", pwd_var, 4);
-    bcopy (XSTRING (current_dir)->data, temp, i);
+    bcopy (SDATA (current_dir), temp, i);
     if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
     temp[i] = 0;
 
@@ -1234,7 +1253,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
         tem = XCDR (tem))
       {
        char **ep = env;
-       char *string = (char *) XSTRING (XCAR (tem))->data;
+       char *string = (char *) SDATA (XCAR (tem));
        /* 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,
@@ -1261,7 +1280,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
   }
 #ifdef WINDOWSNT
   prepare_standard_handles (in, out, err, handles);
-  set_process_dir (XSTRING (current_dir)->data);
+  set_process_dir (SDATA (current_dir));
 #else  /* not WINDOWSNT */
   /* Make sure that in, out, and err are not actually already in
      descriptors zero, one, or two; this could happen if Emacs is
@@ -1386,18 +1405,18 @@ getenv_internal (var, varlen, value, valuelen)
 
       entry = XCAR (scan);
       if (STRINGP (entry)
-         && STRING_BYTES (XSTRING (entry)) > varlen
-         && XSTRING (entry)->data[varlen] == '='
+         && SBYTES (entry) > varlen
+         && SREF (entry, varlen) == '='
 #ifdef WINDOWSNT
          /* NT environment variables are case insensitive.  */
-         && ! strnicmp (XSTRING (entry)->data, var, varlen)
+         && ! strnicmp (SDATA (entry), var, varlen)
 #else  /* not WINDOWSNT */
-         && ! bcmp (XSTRING (entry)->data, var, varlen)
+         && ! bcmp (SDATA (entry), var, varlen)
 #endif /* not WINDOWSNT */
          )
        {
-         *value    = (char *) XSTRING (entry)->data + (varlen + 1);
-         *valuelen = STRING_BYTES (XSTRING (entry)) - (varlen + 1);
+         *value    = (char *) SDATA (entry) + (varlen + 1);
+         *valuelen = SBYTES (entry) - (varlen + 1);
          return 1;
        }
     }
@@ -1415,8 +1434,8 @@ This function consults the variable ``process-environment'' for its value.  */)
   char *value;
   int valuelen;
 
-  CHECK_STRING (var, 0);
-  if (getenv_internal (XSTRING (var)->data, STRING_BYTES (XSTRING (var)),
+  CHECK_STRING (var);
+  if (getenv_internal (SDATA (var), SBYTES (var),
                       &value, &valuelen))
     return make_string (value, valuelen);
   else
@@ -1481,7 +1500,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 */
@@ -1504,12 +1527,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);
@@ -1524,13 +1550,13 @@ init_callproc ()
 #endif
     {
       tempdir = Fdirectory_file_name (Vexec_directory);
-      if (access (XSTRING (tempdir)->data, 0) < 0)
+      if (access (SDATA (tempdir), 0) < 0)
        dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
                     Vexec_directory);
     }
 
   tempdir = Fdirectory_file_name (Vdata_directory);
-  if (access (XSTRING (tempdir)->data, 0) < 0)
+  if (access (SDATA (tempdir), 0) < 0)
     dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
                 Vdata_directory);
 
@@ -1554,6 +1580,14 @@ init_callproc ()
   else
     Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
 #endif
+
+#ifdef DOS_NT
+  Vshared_game_score_directory = Qnil;
+#else
+  Vshared_game_score_directory = build_string (PATH_GAME);
+  if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
+    Vshared_game_score_directory = Qnil;
+#endif
 }
 
 void
@@ -1611,6 +1645,15 @@ Emacs's info files; the default value for Info-default-directory-list
 includes this.  */);
   Vconfigure_info_directory = build_string (PATH_INFO);
 
+  DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory,
+              doc: /* Directory of score files for games which come with GNU Emacs.
+If this variable is nil, then Emacs is unable to use a shared directory.  */);
+#ifdef DOS_NT
+  Vshared_game_score_directory = Qnil;
+#else
+  Vshared_game_score_directory = build_string (PATH_GAME);
+#endif
+
   DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern,
               doc: /* Pattern for making names for temporary files.
 This is used by `call-process-region'.  */);