annotate src/callproc.c @ 814:a634e3b7acc8

[xemacs-hg @ 2002-04-14 12:41:59 by ben] latest changes TODO.ben-mule-21-5: Update. make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse the basic charset designation sequences so we know whether we're in ASCII and have to pay attention to end quotes and such. Reformat code according to coding standards. abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if non-nil, defining an abbrev through an interactive function will automatically turn on abbrev-mode, either globally or locally depending on the command. This is the "what you'd expect" behavior. indent.el: general function for indenting a balanced expression in a mode-correct way. Works similar to indent-region in that a mode can specify a specific command to do the whole operation; if not, figure out the region using forward-sexp and indent each line using indent-according-to-mode. keydefs.el: Removed. Modify M-C-backslash to do indent-region-or-balanced-expression. Make S-Tab just insert a TAB char, like it's meant to do. make-docfile.el: Now that we're using the call-process-in-lisp, we need to load an extra file win32-native.el because we're running a bare temacs. menubar-items.el: Totally redo the Cmds menu so that most used commands appear directly on the menu and less used commands appear in submenus. The old way may have been very pretty, but rather impractical. process.el: Under Windows, don't ever use old-call-process-internal, even in batch mode. We can do processes in batch mode. subr.el: Someone recoded truncate-string-to-width, saying "the FSF version is too complicated and does lots of hard-to-understand stuff" but the resulting recoded version was *totally* wrong! it misunderstood the basic point of this function, which is work in *columns* not chars. i dumped ours and copied the version from FSF 21.1. Also added truncate-string-with-continuation-dots, since this idiom is used often. config.inc.samp, xemacs.mak: Separate out debug and optimize flags. Remove all vestiges of USE_MINIMAL_TAGBITS, USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those ifdefs have long been removed. Make error-checking support actually work. Some rearrangement of config.inc.samp to make it more logical. Remove callproc.c and ntproc.c from xemacs.mak, no longer used. Make pdump the default. lisp.h: Add support for strong type-checking of Bytecount, Bytebpos, Charcount, Charbpos, and others, by making them classes, overloading the operators to provide integer-like operation and carefully controlling what operations are allowed. Not currently enabled in C++ builds because there are still a number of compile errors, and it won't really work till we merge in my "8-bit-Mule" workspace, in which I make use of the new types Charxpos, Bytexpos, Memxpos, representing a "position" either in a buffer or a string. (This is especially important in the extent code.) abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type checking of Bytecount, Charbpos, etc. dired.c: Caught an actual error due to strong type checking -- char len being passed when should be byte len. alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall: -- process arg list at compiled-function creation time, converting into an array for extra-quick access at funcall time. -- rewrite funcall_compiled_function to use it, and inline this function. -- change the order of check for magic stuff in SPECBIND_FAST_UNSAFE to be faster. -- move the check for need to garbage collect into the allocation code, so only a single flag needs to be checked in funcall. buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and strings. eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under pdump. Redo a bit some of the init routines; convert some complex_vars_of() into simple vars_of(), because they didn't need complex processing. callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god but Allah!!! fix so that processes can be invoked in bare temacs -- thereby eliminating any need for callproc.c. (currently only eliminated under NT.) remove all crufty and unnecessary old process code in ntproc.c and elsewhere. move non-callproc-specific stuff (mostly environment) into process.c, so callproc.c can be left out under NT. console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs. change handling of "character mode" so callers don't have to manually set it (quite error-prone). event-msw.c: spacing fixes. lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code. lrecord.h: improve pdump description docs. buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized before by simply always calling the ...A versions of functions, but that won't cut it -- eventually we want to be able to run properly even if XEmacs has been installed in a Japanese directory. (The current problem is the timing of the loading of the Unicode tables; this will eventually be fixed.) Go through and fix various other places where the code was not Mule-clean. Provide a function mswindows_get_module_file_name() to get our own name without resort to PATH_MAX and such. Add a big comment in main() about the problem with Unicode table load timing that I just alluded to. emacs.c: When error-checking is enabled (interpreted as "user is developing XEmacs"), don't ask user to "pause to read messages" when a fatal error has occurred, because it will wedge if we are in an inner modal loop (typically when a menu is popped up) and make us unable to get a useful stack trace in the debugger. text.c: Correct update_entirely_ascii_p_flag to actually work. lisp.h, symsinit.h: declarations for above changes.
author ben
date Sun, 14 Apr 2002 12:43:31 +0000
parents a5954632b187
children 0490271de7d8
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 563
diff changeset
1 /* Old synchronous subprocess invocation for XEmacs.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3 Copyright (C) 2000, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Partly sync'ed with 19.36.4 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 563
diff changeset
25
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
26 /* #### Everything in this file should go. As soon as I merge my
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
27 stderr-proc WS, it will.
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 563
diff changeset
28 */
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 563
diff changeset
29
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "commands.h"
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
35 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "process.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "sysdep.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
42 #include "sysdir.h"
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
43 #include "sysfile.h"
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
44 #include "sysproc.h"
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
45 #include "syssignal.h"
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
46 #include "systime.h"
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
47 #include "systty.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 /* True iff we are about to fork off a synchronous process or if we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 are waiting for it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 volatile int synch_process_alive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 /* Nonzero => this is a string explaining death of synchronous subprocess. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
54 const char *synch_process_death;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 /* If synch_process_death is zero,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 this is exit code of synchronous subprocess. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 int synch_process_retcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 /* Clean up when exiting Fcall_process_internal.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
61 On Windows, delete the temporary file on any kind of termination.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 On Unix, kill the process and any children on termination by signal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 /* Nonzero if this is termination due to exit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 static int call_process_exited;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 call_process_kill (Lisp_Object fdpid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Lisp_Object fd = Fcar (fdpid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Lisp_Object pid = Fcdr (fdpid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 if (!NILP (fd))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
74 retry_close (XINT (fd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 if (!NILP (pid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 EMACS_KILLPG (XINT (pid), SIGKILL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 synch_process_alive = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 call_process_cleanup (Lisp_Object fdpid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
86 int fd = XINT (Fcar (fdpid));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 int pid = XINT (Fcdr (fdpid));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 if (!call_process_exited &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 EMACS_KILLPG (pid, SIGINT) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 record_unwind_protect (call_process_kill, fdpid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 /* #### "c-G" -- need non-consing Single-key-description */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 message ("Waiting for process to die...(type C-g again to kill it instantly)");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 wait_for_termination (pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 /* "Discard" the unwind protect. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 XCAR (fdpid) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 XCDR (fdpid) = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
103 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 message ("Waiting for process to die... done");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 synch_process_alive = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
108 retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
112 DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 Call PROGRAM synchronously in separate process, with coding-system specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Arguments are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 The program's input comes from file INFILE (nil means `/dev/null').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 Insert output in BUFFER before point; t means current buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 nil for BUFFER means discard it; 0 means discard and don't wait.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 REAL-BUFFER says what to do with standard output, as above,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 while STDERR-FILE says what to do with standard error in the child.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 STDERR-FILE may be nil (discard standard error output),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 t (mix it with ordinary output), or a file name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 Remaining arguments are strings passed as command arguments to PROGRAM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 If BUFFER is 0, `call-process' returns immediately with value nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 or a signal description string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 If you quit, the process is killed with SIGINT, or SIGKILL if you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 quit again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 Lisp_Object infile, buffer, current_dir, display, path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 int fd[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 int filefd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 int pid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 char buf[16384];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 char *bufptr = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 int bufsize = 16384;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 int speccount = specpdl_depth ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
145 struct gcpro gcpro1, gcpro2, gcpro3;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
146 Intbyte **new_argv = alloca_array (Intbyte *, max (2, nargs - 2));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 /* File to use for stderr in the child.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 t means use same as standard output. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Lisp_Object error_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 CHECK_STRING (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 error_file = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 #if defined (NO_SUBPROCESSES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* Without asynchronous processes we cannot have BUFFER == 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if (nargs >= 3 && !INTP (args[2]))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
159 signal_error (Qunimplemented, "Operating system cannot handle asynchronous subprocesses", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 #endif /* NO_SUBPROCESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
162 /* Do all filename munging before building new_argv because GC in
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
163 * Lisp code called by various filename-hacking routines might
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
164 * relocate strings */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 /* Make sure that the child will be able to chdir to the current
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
168 buffer's current directory, or its unhandled equivalent. [[ We
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 can't just have the child check for an error when it does the
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
170 chdir, since it's in a vfork. ]] -- not any more, we don't use
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
171 vfork. -ben
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
172
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
173 Note: These calls are spread out to insure that the return values
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
174 of the calls (which may be newly-created strings) are properly
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
175 GC-protected. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 struct gcpro ngcpro1, ngcpro2;
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
178 NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
179 current_dir = current_buffer->directory;
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
180 /* If the current dir has no terminating slash, we'll get undesirable
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
181 results, so put the slash back. */
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
182 current_dir = Ffile_name_as_directory (current_dir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 current_dir = Funhandled_file_name_directory (current_dir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 current_dir = expand_and_dir_to_file (current_dir, Qnil);
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
185
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 /* This is in FSF, but it breaks everything in the presence of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 ange-ftp-visited files, so away with it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 if (NILP (Ffile_accessible_directory_p (current_dir)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
190 signal_error (Qprocess_error, "Setting current directory",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
191 current_buffer->directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
196 GCPRO2 (current_dir, path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 if (nargs >= 2 && ! NILP (args[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 NGCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 infile = Fexpand_file_name (args[1], current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 CHECK_STRING (infile);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 infile = build_string (NULL_DEVICE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
211 GCPRO3 (infile, current_dir, path); /* Fexpand_file_name might trash it */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 if (nargs >= 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 buffer = args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 /* If BUFFER is a list, its meaning is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 if (CONSP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 if (CONSP (XCDR (buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Lisp_Object file_for_stderr = XCAR (XCDR (buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 if (NILP (file_for_stderr) || EQ (Qt, file_for_stderr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 error_file = file_for_stderr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 error_file = Fexpand_file_name (file_for_stderr, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 buffer = XCAR (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 if (!(EQ (buffer, Qnil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 || EQ (buffer, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 || ZEROP (buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 Lisp_Object spec_buffer = buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 buffer = Fget_buffer (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 /* Mention the buffer name for a better error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 if (NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 CHECK_BUFFER (spec_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 CHECK_BUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 buffer = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 display = ((nargs >= 4) ? args[3] : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 /* From here we assume we won't GC (unless an error is signaled). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 REGISTER int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 for (i = 4; i < nargs; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 CHECK_STRING (args[i]);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
259 new_argv[i - 3] = XSTRING_DATA (args[i]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 }
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
262 new_argv[max(nargs - 3,1)] = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 if (NILP (path))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
265 signal_error (Qprocess_error, "Searching for program",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
266 Fcons (args[0], Qnil));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
267 new_argv[0] = XSTRING_DATA (path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
269 filefd = qxe_open (XSTRING_DATA (infile), O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 if (filefd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
271 report_process_error ("Opening process input file", infile);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 if (INTP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
275 fd[1] = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 fd[0] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 pipe (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 /* Replaced by close_process_descs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 set_exclusive_use (fd[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 REGISTER int fd1 = fd[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 int fd_error = fd1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 /* Record that we're about to create a synchronous process. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 synch_process_alive = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 /* These vars record information from process termination.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 Clear them now before process can possibly terminate,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 to avoid timing error if process terminates soon. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 synch_process_death = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 synch_process_retcode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 if (NILP (error_file))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
301 fd_error = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 else if (STRINGP (error_file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
304 fd_error = qxe_open (XSTRING_DATA (error_file),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
305 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
306 CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 if (fd_error < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
311 int save_errno = errno;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
312 retry_close (filefd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
313 retry_close (fd[0]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 if (fd1 >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
315 retry_close (fd1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
316 errno = save_errno;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
317 report_process_error ("Cannot open", Fcons (error_file, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 pid = fork ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 if (pid == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 if (fd[0] >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
325 retry_close (fd[0]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 /* This is necessary because some shells may attempt to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 access the current controlling terminal and will hang
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 if they are run in the background, as will be the case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 when XEmacs is started in the background. Martin
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Buchholz observed this problem running a subprocess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 that used zsh to call gzip to uncompress an info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 disconnect_controlling_terminal ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
334 child_setup (filefd, fd1, fd_error, new_argv, current_dir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 if (fd_error >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
337 retry_close (fd_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 /* Close most of our fd's, but not fd[0]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 since we will use that to read input from. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
341 retry_close (filefd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 if (fd1 >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
343 retry_close (fd1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 if (pid < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
348 int save_errno = errno;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 if (fd[0] >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
350 retry_close (fd[0]);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
351 errno = save_errno;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
352 report_process_error ("Doing fork", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 if (INTP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 if (fd[0] >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
358 retry_close (fd[0]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 #if defined (NO_SUBPROCESSES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 /* If Emacs has been built with asynchronous subprocess support,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 we don't need to do this, I think because it will then have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 the facilities for handling SIGCHLD. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 wait_without_blocking ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 #endif /* NO_SUBPROCESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 int nread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 int total_read = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 Lisp_Object instream;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 /* Enable sending signal if user quits below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 call_process_exited = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 record_unwind_protect (call_process_cleanup,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 Fcons (make_int (fd[0]), make_int (pid)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 /* FSFmacs calls Fset_buffer() here. We don't have to because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 we can insert into buffers other than the current one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 if (EQ (buffer, Qt))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
383 buffer = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 instream =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
386 make_coding_input_stream
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (XLSTREAM (instream),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
388 get_coding_system_for_text_file (Vcoding_system_for_read, 1),
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
389 CODING_DECODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 NGCPRO1 (instream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 /* Repeatedly read until we've filled as much as possible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 of the buffer size we have. But don't read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 less than 1024--save that for the next bufferfull. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 nread = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 while (nread < bufsize - 1024)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
401 Bytecount this_read
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 = Lstream_read (XLSTREAM (instream), bufptr + nread,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 bufsize - nread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 if (this_read < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 goto give_up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 if (this_read == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 goto give_up_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 nread += this_read;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 give_up_1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 /* Now NREAD is the total amount of data in the buffer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 if (nread == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
420 #if 0
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
421 /* [[check Vbinary_process_output]] */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
422 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 total_read += nread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 if (!NILP (buffer))
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
427 buffer_insert_raw_string (XBUFFER (buffer), (Intbyte *) bufptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 nread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 /* Make the buffer bigger as we continue to read more data,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 but not past 64k. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 bufsize *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 bufptr = (char *) alloca (bufsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 if (!NILP (display) && INTERACTIVE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 give_up:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 Lstream_close (XLSTREAM (instream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 /* Wait for it to terminate, unless it already has. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 wait_for_termination (pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 /* Don't kill any children that the subprocess may have left behind
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 when exiting. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 call_process_exited = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
454 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 if (synch_process_death)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
457 return build_msg_string (synch_process_death);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 return make_int (synch_process_retcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 /* Move the file descriptor FD so that its number is not less than MIN. *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 The original file descriptor remains open. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 relocate_fd (int fd, int min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 if (fd >= min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 return fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 int newfd = dup (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 if (newfd == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
476 Intbyte *errmess;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
477 GET_STRERROR (errmess, errno);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
478 stderr_out ("Error while setting up child: %s\n", errmess);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 _exit (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 return relocate_fd (newfd, min);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 /* This is the last thing run in a newly forked inferior
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 either synchronous or asynchronous.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 Copy descriptors IN, OUT and ERR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 Initialize inferior's priority, pgrp, connected dir and environment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 then exec another program based on new_argv.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 XEmacs: We've removed the SET_PGRP argument because it's already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 done by the callers of child_setup.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 CURRENT_DIR is an elisp string giving the path of the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 directory the subprocess should have. Since we can't really signal
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
497 a decent error from within the child (not quite correct in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
498 XEmacs?), this should be verified as an executable directory by the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
499 parent. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
502 child_setup (int in, int out, int err, Intbyte **new_argv,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
503 Lisp_Object current_dir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
505 Intbyte **env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
506 Intbyte *pwd;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 #ifdef SET_EMACS_PRIORITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 if (emacs_priority != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 nice (- emacs_priority);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
513 /* Under Windows, we are not in a child process at all, so we should
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
514 not close handles inherited from the parent -- we are the parent
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
515 and doing so will screw up all manner of things! Similarly, most
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
516 of the rest of the cleanup done in this function is not done
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
517 under Windows.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
518
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
519 #### This entire child_setup() function is an utter and complete
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
520 piece of shit. I would rewrite it, at the very least splitting
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
521 out the Windows and non-Windows stuff into two completely
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
522 different functions; but instead I'm trying to make it go away
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
523 entirely, using the Lisp definition in process.el. What's left
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
524 is to fix up the routines in event-msw.c (and in event-Xt.c and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
525 event-tty.c) to allow for stream devices to be handled correctly.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
526 There isn't much to do, in fact, and I'll fix it shortly. That
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
527 way, the Lisp definition can be used non-interactively too. */
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
528 #if !defined (NO_SUBPROCESSES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 /* Close Emacs's descriptors that this process should not have. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 close_process_descs ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 #endif /* not NO_SUBPROCESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 close_load_descs ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
534 /* [[Note that use of alloca is always safe here. It's obvious for systems
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 that do not have true vfork or that have true (stack) alloca.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 If using vfork and C_ALLOCA it is safe because that changes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 the superior's static variables as if the superior had done alloca
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
538 and will be cleaned up in the usual way.]] -- irrelevant because
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
539 XEmacs does not use vfork. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
541 REGISTER Bytecount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
543 i = XSTRING_LENGTH (current_dir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
544 pwd = alloca_array (Intbyte, i + 6);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 memcpy (pwd, "PWD=", 4);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
546 memcpy (pwd + 4, XSTRING_DATA (current_dir), i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 i += 4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 if (!IS_DIRECTORY_SEP (pwd[i - 1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 pwd[i++] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 pwd[i] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
552 /* [[We can't signal an Elisp error here; we're in a vfork. Since
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 the callers check the current directory before forking, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 should only return an error if the directory's permissions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 are changed between the check and this chdir, but we should
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
556 at least check.]] -- irrelevant because XEmacs does not use vfork. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
557 if (qxe_chdir (pwd + 4) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 /* Don't report the chdir error, or ange-ftp.el doesn't work. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 /* (FSFmacs does _exit (errno) here.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 pwd = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 /* Strip trailing "/". Cretinous *[]&@$#^%@#$% Un*x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 /* leave "//" (from FSF) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 while (i > 6 && IS_DIRECTORY_SEP (pwd[i - 1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 pwd[--i] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 /* Set `env' to a vector of the strings in Vprocess_environment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 /* + 2 to include PWD and terminating 0. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
574 env = alloca_array (Intbyte *, XINT (Flength (Vprocess_environment)) + 2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 REGISTER Lisp_Object tail;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
577 Intbyte **new_env = env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 /* If we have a PWD envvar and we know the real current directory,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 pass one down, but with corrected value. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
581 if (pwd && egetenv ("PWD"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 *new_env++ = pwd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 /* Copy the Vprocess_environment strings into new_env. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 for (tail = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 CONSP (tail) && STRINGP (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 tail = XCDR (tail))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
588 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
589 Intbyte **ep = env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
590 Intbyte *envvar = XSTRING_DATA (XCAR (tail));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
592 /* See if envvar duplicates any string already in the env.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 If so, don't put it in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 When an env var has multiple definitions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 we keep the definition that comes first in process-environment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 for (; ep != new_env; ep++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
598 Intbyte *p = *ep, *q = envvar;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 if (*q == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 /* The string is malformed; might as well drop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 if (*q != *p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 if (*q == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 p++, q++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
611 if (pwd && !qxestrncmp ((Intbyte *) "PWD=", envvar, 4))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 *new_env++ = pwd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 pwd = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
617 *new_env++ = envvar;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 duplicate: ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
621
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 *new_env = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 /* Make sure that in, out, and err are not actually already in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 descriptors zero, one, or two; this could happen if Emacs is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 started with its standard in, out, or error closed, as might
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 happen under X. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 in = relocate_fd (in, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 out = relocate_fd (out, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 err = relocate_fd (err, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 /* Set the standard input/output channels of the new process. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
634 retry_close (STDIN_FILENO);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
635 retry_close (STDOUT_FILENO);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
636 retry_close (STDERR_FILENO);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 dup2 (in, STDIN_FILENO);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 dup2 (out, STDOUT_FILENO);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 dup2 (err, STDERR_FILENO);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
642 retry_close (in);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
643 retry_close (out);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
644 retry_close (err);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 /* I can't think of any reason why child processes need any more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 than the standard 3 file descriptors. It would be cleaner to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 close just the ones that need to be, but the following brute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 force approach is certainly effective, and not too slow. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 for (fd=3; fd<=64; fd++)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
653 retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 #ifdef vipc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 something missing here;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 #endif /* vipc */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
660 /* we've wrapped execve; it translates its arguments */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
661 qxe_execve (new_argv[0], new_argv, env);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 stdout_out ("Can't exec program %s\n", new_argv[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 _exit (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 syms_of_callproc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
670 DEFSUBR (Fold_call_process_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 }