Mercurial > hg > xemacs-beta
diff src/callproc.c @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | de805c49cfc1 |
children |
line wrap: on
line diff
--- a/src/callproc.c Mon Aug 13 11:19:22 2007 +0200 +++ b/src/callproc.c Mon Aug 13 11:20:41 2007 +0200 @@ -41,19 +41,20 @@ #include "syssignal.h" /* Always include before systty.h */ #include "systty.h" -#ifdef WIN32_NATIVE +#ifdef WINDOWSNT #define _P_NOWAIT 1 /* from process.h */ +#include <windows.h> #include "nt.h" #endif -#ifdef WIN32_NATIVE +#ifdef DOS_NT /* When we are starting external processes we need to know whether they take binary input (no conversion) or text input (\n is converted to \r\n). Similarly for output: if newlines are written as \r\n then it's text process output, otherwise it's binary. */ Lisp_Object Vbinary_process_input; Lisp_Object Vbinary_process_output; -#endif /* WIN32_NATIVE */ +#endif /* DOS_NT */ Lisp_Object Vshell_file_name; @@ -67,14 +68,14 @@ volatile int synch_process_alive; /* Nonzero => this is a string explaining death of synchronous subprocess. */ -const char *synch_process_death; +CONST char *synch_process_death; /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ int synch_process_retcode; /* Clean up when exiting Fcall_process_internal. - On Windows, delete the temporary file on any kind of termination. + 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. */ @@ -101,7 +102,7 @@ static Lisp_Object call_process_cleanup (Lisp_Object fdpid) { - int fd = XINT (Fcar (fdpid)); + int fd = XINT (Fcar (fdpid)); int pid = XINT (Fcdr (fdpid)); if (!call_process_exited && @@ -113,18 +114,7 @@ /* #### "c-G" -- need non-consing Single-key-description */ message ("Waiting for process to die...(type C-g again to kill it instantly)"); -#ifdef WIN32_NATIVE - { - HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); - if (pHandle == NULL) - warn_when_safe (Qprocess, Qwarning, - "cannot open process (PID %d) for cleanup", pid); - else - wait_for_termination (pHandle); - } -#else wait_for_termination (pid); -#endif /* "Discard" the unwind protect. */ XCAR (fdpid) = Qnil; @@ -152,7 +142,7 @@ } #endif /* unused */ -DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /* +DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /* Call PROGRAM synchronously in separate process, with coding-system specified. Arguments are (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS). @@ -180,15 +170,12 @@ Lisp_Object infile, buffer, current_dir, display, path; int fd[2]; int filefd; -#ifdef WIN32_NATIVE - HANDLE pHandle; -#endif int pid; char buf[16384]; char *bufptr = buf; int bufsize = 16384; int speccount = specpdl_depth (); - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2; char **new_argv = alloca_array (char *, max (2, nargs - 2)); /* File to use for stderr in the child. @@ -235,7 +222,7 @@ NUNGCPRO; } - GCPRO2 (current_dir, path); + GCPRO1 (current_dir); if (nargs >= 2 && ! NILP (args[1])) { @@ -250,7 +237,7 @@ UNGCPRO; - GCPRO3 (infile, current_dir, path); /* Fexpand_file_name might trash it */ + GCPRO2 (infile, current_dir); /* Fexpand_file_name might trash it */ if (nargs >= 3) { @@ -300,8 +287,8 @@ CHECK_STRING (args[i]); new_argv[i - 3] = (char *) XSTRING_DATA (args[i]); } + new_argv[nargs - 3] = 0; } - new_argv[max(nargs - 3,1)] = 0; if (NILP (path)) report_file_error ("Searching for program", Fcons (args[0], Qnil)); @@ -348,14 +335,14 @@ fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); else if (STRINGP (error_file)) { - fd_error = open ((const char *) XSTRING_DATA (error_file), -#ifdef WIN32_NATIVE + fd_error = open ((CONST char *) XSTRING_DATA (error_file), +#ifdef DOS_NT O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, S_IREAD | S_IWRITE -#else /* not WIN32_NATIVE */ +#else /* not DOS_NT */ O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, CREAT_MODE -#endif /* not WIN32_NATIVE */ +#endif /* not DOS_NT */ ); } @@ -369,27 +356,10 @@ } fork_error = Qnil; -#ifdef WIN32_NATIVE +#ifdef WINDOWSNT pid = child_setup (filefd, fd1, fd_error, new_argv, (char *) XSTRING_DATA (current_dir)); - if (!INTP (buffer)) - { - /* OpenProcess() as soon after child_setup as possible. It's too - late once the process terminated. */ - pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid); -#if 0 - if (pHandle == NULL) - { - /* #### seems to cause crash in unbind_to(...) below. APA */ - warn_when_safe (Qprocess, Qwarning, - "cannot open process to wait for"); - } -#endif - } - /* Close STDERR into the parent process. We no longer need it. */ - if (fd_error >= 0) - close (fd_error); -#else /* not WIN32_NATIVE */ +#else /* not WINDOWSNT */ pid = fork (); if (pid == 0) @@ -410,7 +380,7 @@ if (fd_error >= 0) close (fd_error); -#endif /* not WIN32_NATIVE */ +#endif /* not WINDOWSNT */ environ = save_environ; @@ -424,14 +394,12 @@ if (!NILP (fork_error)) signal_error (Qfile_error, fork_error); -#ifndef WIN32_NATIVE if (pid < 0) { if (fd[0] >= 0) close (fd[0]); report_file_error ("Doing fork", Qnil); } -#endif if (INTP (buffer)) { @@ -482,7 +450,7 @@ nread = 0; while (nread < bufsize - 1024) { - ssize_t this_read + int this_read = Lstream_read (XLSTREAM (instream), bufptr + nread, bufsize - nread); @@ -501,12 +469,10 @@ if (nread == 0) break; -#if 0 -#ifdef WIN32_NATIVE +#ifdef DOS_NT /* Until we pull out of MULE things like make_decoding_input_stream(), we do the following which is less elegant. --marcpa */ - /* We did. -- kkm */ { int lf_count = 0; if (NILP (Vbinary_process_output)) { @@ -514,7 +480,6 @@ } } #endif -#endif total_read += nread; @@ -542,11 +507,7 @@ QUIT; /* Wait for it to terminate, unless it already has. */ -#ifdef WIN32_NATIVE - wait_for_termination (pHandle); -#else wait_for_termination (pid); -#endif /* Don't kill any children that the subprocess may have left behind when exiting. */ @@ -602,48 +563,31 @@ a decent error from within the child, this should be verified as an executable directory by the parent. */ -#ifdef WIN32_NATIVE +#ifdef WINDOWSNT int #else void #endif child_setup (int in, int out, int err, char **new_argv, - const char *current_dir) + CONST char *current_dir) { char **env; char *pwd; -#ifdef WIN32_NATIVE +#ifdef WINDOWSNT int cpid; HANDLE handles[4]; -#endif /* WIN32_NATIVE */ +#endif /* WINDOWSNT */ #ifdef SET_EMACS_PRIORITY if (emacs_priority != 0) nice (- emacs_priority); #endif - /* Under Windows, we are not in a child process at all, so we should - not close handles inherited from the parent -- we are the parent - and doing so will screw up all manner of things! Similarly, most - of the rest of the cleanup done in this function is not done - under Windows. - - #### This entire child_setup() function is an utter and complete - piece of shit. I would rewrite it, at the very least splitting - out the Windows and non-Windows stuff into two completely - different functions; but instead I'm trying to make it go away - entirely, using the Lisp definition in process.el. What's left - is to fix up the routines in event-msw.c (and in event-Xt.c and - event-tty.c) to allow for stream devices to be handled correctly. - There isn't much to do, in fact, and I'll fix it shortly. That - way, the Lisp definition can be used non-interactively too. */ -#if !defined (NO_SUBPROCESSES) && !defined (WIN32_NATIVE) +#if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT) /* Close Emacs's descriptors that this process should not have. */ close_process_descs (); #endif /* not NO_SUBPROCESSES */ -#ifndef WIN32_NATIVE close_load_descs (); -#endif /* Note that use of alloca is always safe here. It's obvious for systems that do not have true vfork or that have true (stack) alloca. @@ -701,10 +645,9 @@ { char **ep = env; char *envvar_external; + Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail)); - TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (tail), - C_STRING_ALLOCA, envvar_external, - Qfile_name); + GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external); /* See if envvar_external duplicates any string already in the env. If so, don't put it in. @@ -738,10 +681,10 @@ *new_env = 0; } -#ifdef WIN32_NATIVE +#ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); set_process_dir (current_dir); -#else /* not WIN32_NATIVE */ +#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 started with its standard in, out, or error closed, as might @@ -772,22 +715,22 @@ for (fd=3; fd<=64; fd++) close (fd); } -#endif /* not WIN32_NATIVE */ +#endif /* not WINDOWSNT */ #ifdef vipc something missing here; #endif /* vipc */ -#ifdef WIN32_NATIVE +#ifdef WINDOWSNT /* Spawn the child. (See ntproc.c:Spawnve). */ - cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv, - (const char* const*)env); + cpid = spawnve (_P_NOWAIT, new_argv[0], (CONST char* CONST*)new_argv, + (CONST char* CONST*)env); if (cpid == -1) /* An error occurred while trying to spawn the process. */ report_file_error ("Spawning child process", Qnil); reset_standard_handles (in, out, err, handles); return cpid; -#else /* not WIN32_NATIVE */ +#else /* not WINDOWSNT */ /* execvp does not accept an environment arg so the only way to pass this environment is to set environ. Our caller is responsible for restoring the ambient value of environ. */ @@ -796,11 +739,11 @@ stdout_out ("Can't exec program %s\n", new_argv[0]); _exit (1); -#endif /* not WIN32_NATIVE */ +#endif /* not WINDOWSNT */ } static int -getenv_internal (const Bufbyte *var, +getenv_internal (CONST Bufbyte *var, Bytecount varlen, Bufbyte **value, Bytecount *valuelen) @@ -814,12 +757,12 @@ if (STRINGP (entry) && XSTRING_LENGTH (entry) > varlen && XSTRING_BYTE (entry, varlen) == '=' -#ifdef WIN32_NATIVE +#ifdef WINDOWSNT /* NT environment variables are case insensitive. */ && ! memicmp (XSTRING_DATA (entry), var, varlen) -#else /* not WIN32_NATIVE */ +#else /* not WINDOWSNT */ && ! memcmp (XSTRING_DATA (entry), var, varlen) -#endif /* not WIN32_NATIVE */ +#endif /* not WINDOWSNT */ ) { *value = XSTRING_DATA (entry) + (varlen + 1); @@ -863,12 +806,12 @@ /* A version of getenv that consults process_environment, easily callable from C. */ char * -egetenv (const char *var) +egetenv (CONST char *var) { Bufbyte *value; Bytecount valuelen; - if (getenv_internal ((const Bufbyte *) var, strlen (var), &value, &valuelen)) + if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen)) return (char *) value; else return 0; @@ -886,17 +829,19 @@ char **envp; Vprocess_environment = Qnil; for (envp = environ; envp && *envp; envp++) - Vprocess_environment = - Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment); + { + Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS), + Vprocess_environment); + } } { /* Initialize shell-file-name from environment variables or best guess. */ -#ifdef WIN32_NATIVE - const char *shell = egetenv ("COMSPEC"); +#ifdef WINDOWSNT + CONST char *shell = egetenv ("COMSPEC"); if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; -#else /* not WIN32_NATIVE */ - const char *shell = egetenv ("SHELL"); +#else /* not WINDOWSNT */ + CONST char *shell = egetenv ("SHELL"); if (!shell) shell = "/bin/sh"; #endif @@ -923,7 +868,7 @@ void syms_of_callproc (void) { - DEFSUBR (Fold_call_process_internal); + DEFSUBR (Fcall_process_internal); DEFSUBR (Fgetenv); } @@ -931,7 +876,7 @@ vars_of_callproc (void) { /* This function can GC */ -#ifdef WIN32_NATIVE +#ifdef DOS_NT DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /* *If non-nil then new subprocesses are assumed to take binary input. */ ); @@ -941,7 +886,7 @@ *If non-nil then new subprocesses are assumed to produce binary output. */ ); Vbinary_process_output = Qnil; -#endif /* WIN32_NATIVE */ +#endif /* DOS_NT */ DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* *File name to load inferior shells from.