annotate src/callproc.c @ 844:047d37eb70d7

[xemacs-hg @ 2002-05-16 13:30:23 by ben] ui fixes for things that were bothering me bytecode.c, editfns.c, lisp.h, lread.c: Fix save-restriction to use markers rather than pseudo-markers (integers representing the amount of text on either side of the region). That way, all inserts are handled correctly, not just those inside old restriction. Add buffer argument to save_restriction_save(). process.c: Clean up very dirty and kludgy code that outputs into a buffer -- use proper unwind protects, etc. font-lock.c: Do save-restriction/widen around the function -- otherwise, incorrect results will ensue when a buffer has been narrowed before a call to e.g. `buffer-syntactic-context' -- something that happens quite often. fileio.c: Look for a handler for make-temp-name. window.c, winslots.h: Try to solve this annoying problem: have two frames displaying the buffer, in different places; in one, temporarily switch away to another buffer and then back -- and you've lost your position; it's reset to the other one in the other frame. My current solution involves window-level caches of buffers and points (also a cache for window-start); when set-window-buffer is called, it looks to see if the buffer was previously visited in the window, and if so, uses the most recent point at that time. (It's a marker, so it handles changes.) #### Note: It could be argued that doing it on the frame level would be better -- e.g. if you visit a buffer temporarily through a grep, and then go back to that buffer, you presumably want the grep's position rather than some previous position provided everything was in the same frame, even though the grep was in another window in the frame. However, doing it on the frame level fails when you have two windows on the same frame. Perhaps we keep both a window and a frame cache, and use the frame cache if there are no other windows on the frame showing the buffer, else the window's cache? This is probably something to be configurable using a specifier. Suggestions please please please? window.c: Clean up a bit code that deals with the annoyance of window-point vs. point. dialog.el: Function to ask a multiple-choice question, automatically choosing a dialog box or minibuffer representation as necessary. Generalized version of yes-or-no-p, y-or-n-p. files.el: Use get-user-response to ask "yes/no/diff" question when recovering. "diff" means that a diff is displayed between the current file and the autosave. (Converts/deconverts escape-quoted as necessary. No more complaints from you, Mr. Turnbull!) One known problem: when a dialog is used, it's modal, so you can't scroll the diff. Will fix soon. lisp-mode.el: If we're filling a string, don't treat semicolon as a comment, which would give very unfriendly results. Uses `buffer-syntactic-context'. simple.el: all changes back to the beginning. (Useful if you've saved the file in the middle of the changes.) simple.el: Add option kill-word-into-kill-ring, which controls whether words deleted with kill-word, backward-kill-word, etc. are "cut" into the kill ring, or "cleared" into nothingness. (My preference is the latter, by far. I'd almost go so far as suggesting we make it the default, as you can always select a word and then cut it if you want it cut.) menubar-items.el: Add option corresponding to kill-word-into-kill-ring.
author ben
date Thu, 16 May 2002 13:30:58 +0000
parents 1e4e42de23d5
children e7ee5f8bde58
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.
837
0490271de7d8 [xemacs-hg @ 2002-05-14 05:30:30 by adrian]
adrian
parents: 814
diff changeset
119 If BUFFER is a string, then find or create a buffer with that name,
0490271de7d8 [xemacs-hg @ 2002-05-14 05:30:30 by adrian]
adrian
parents: 814
diff changeset
120 then insert the output in that buffer, before point.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 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
122 REAL-BUFFER says what to do with standard output, as above,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 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
124 STDERR-FILE may be nil (discard standard error output),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 t (mix it with ordinary output), or a file name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Remaining arguments are strings passed as command arguments to PROGRAM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 If BUFFER is 0, `call-process' returns immediately with value nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 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
132 or a signal description string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 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
134 quit again.
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 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 Lisp_Object infile, buffer, current_dir, display, path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 int fd[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 int filefd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 int pid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 char buf[16384];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 char *bufptr = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 int bufsize = 16384;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 int speccount = specpdl_depth ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
147 struct gcpro gcpro1, gcpro2, gcpro3;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
148 Intbyte **new_argv = alloca_array (Intbyte *, max (2, nargs - 2));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 /* File to use for stderr in the child.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 t means use same as standard output. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Lisp_Object error_file;
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 CHECK_STRING (args[0]);
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 error_file = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 #if defined (NO_SUBPROCESSES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 /* Without asynchronous processes we cannot have BUFFER == 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 if (nargs >= 3 && !INTP (args[2]))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
161 signal_error (Qunimplemented, "Operating system cannot handle asynchronous subprocesses", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 #endif /* NO_SUBPROCESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
164 /* 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
165 * 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
166 * relocate strings */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 /* 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
170 buffer's current directory, or its unhandled equivalent. [[ We
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 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
172 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
173 vfork. -ben
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
174
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
175 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
176 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
177 GC-protected. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 struct gcpro ngcpro1, ngcpro2;
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
180 NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
181 current_dir = current_buffer->directory;
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
182 /* 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
183 results, so put the slash back. */
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
184 current_dir = Ffile_name_as_directory (current_dir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 current_dir = Funhandled_file_name_directory (current_dir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 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
187
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 /* This is in FSF, but it breaks everything in the presence of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 ange-ftp-visited files, so away with it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 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
192 signal_error (Qprocess_error, "Setting current directory",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
193 current_buffer->directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
198 GCPRO2 (current_dir, path);
428
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 if (nargs >= 2 && ! NILP (args[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 NGCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 infile = Fexpand_file_name (args[1], current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 CHECK_STRING (infile);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 infile = build_string (NULL_DEVICE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
213 GCPRO3 (infile, current_dir, path); /* Fexpand_file_name might trash it */
428
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 if (nargs >= 3)
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 buffer = args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 /* If BUFFER is a list, its meaning is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 if (CONSP (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 if (CONSP (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 Lisp_Object file_for_stderr = XCAR (XCDR (buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 if (NILP (file_for_stderr) || EQ (Qt, file_for_stderr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 error_file = file_for_stderr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 error_file = Fexpand_file_name (file_for_stderr, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 }
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 buffer = XCAR (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 if (!(EQ (buffer, Qnil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 || EQ (buffer, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 || ZEROP (buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 Lisp_Object spec_buffer = buffer;
840
1e4e42de23d5 [xemacs-hg @ 2002-05-14 13:03:54 by ben]
ben
parents: 837
diff changeset
241 buffer = Fget_buffer_create (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 /* Mention the buffer name for a better error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 if (NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 CHECK_BUFFER (spec_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 CHECK_BUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 buffer = Qnil;
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 UNGCPRO;
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 display = ((nargs >= 4) ? args[3] : Qnil);
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 /* 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
256 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 REGISTER int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 for (i = 4; i < nargs; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 CHECK_STRING (args[i]);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
261 new_argv[i - 3] = XSTRING_DATA (args[i]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 }
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
264 new_argv[max(nargs - 3,1)] = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 if (NILP (path))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
267 signal_error (Qprocess_error, "Searching for program",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
268 Fcons (args[0], Qnil));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
269 new_argv[0] = XSTRING_DATA (path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
271 filefd = qxe_open (XSTRING_DATA (infile), O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 if (filefd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
273 report_process_error ("Opening process input file", infile);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 if (INTP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
277 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
278 fd[0] = -1;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 pipe (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 /* Replaced by close_process_descs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 set_exclusive_use (fd[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 #endif
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 REGISTER int fd1 = fd[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 int fd_error = fd1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 /* Record that we're about to create a synchronous process. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 synch_process_alive = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 /* These vars record information from process termination.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 Clear them now before process can possibly terminate,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 to avoid timing error if process terminates soon. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 synch_process_death = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 synch_process_retcode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 if (NILP (error_file))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
303 fd_error = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 else if (STRINGP (error_file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
306 fd_error = qxe_open (XSTRING_DATA (error_file),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
307 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
308 CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 if (fd_error < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
313 int save_errno = errno;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
314 retry_close (filefd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
315 retry_close (fd[0]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 if (fd1 >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
317 retry_close (fd1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
318 errno = save_errno;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
319 report_process_error ("Cannot open", Fcons (error_file, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 }
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 pid = fork ();
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 (pid == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 if (fd[0] >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
327 retry_close (fd[0]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 /* This is necessary because some shells may attempt to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 access the current controlling terminal and will hang
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 if they are run in the background, as will be the case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 when XEmacs is started in the background. Martin
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 Buchholz observed this problem running a subprocess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 that used zsh to call gzip to uncompress an info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 disconnect_controlling_terminal ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
336 child_setup (filefd, fd1, fd_error, new_argv, current_dir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 if (fd_error >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
339 retry_close (fd_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 /* Close most of our fd's, but not fd[0]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 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
343 retry_close (filefd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 if (fd1 >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
345 retry_close (fd1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 if (pid < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
350 int save_errno = errno;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 if (fd[0] >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
352 retry_close (fd[0]);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
353 errno = save_errno;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
354 report_process_error ("Doing fork", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 }
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 (INTP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 if (fd[0] >= 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
360 retry_close (fd[0]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 #if defined (NO_SUBPROCESSES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 /* If Emacs has been built with asynchronous subprocess support,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 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
364 the facilities for handling SIGCHLD. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 wait_without_blocking ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 #endif /* NO_SUBPROCESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 int nread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 int total_read = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 Lisp_Object instream;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 /* Enable sending signal if user quits below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 call_process_exited = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 record_unwind_protect (call_process_cleanup,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 Fcons (make_int (fd[0]), make_int (pid)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 /* FSFmacs calls Fset_buffer() here. We don't have to because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 we can insert into buffers other than the current one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 if (EQ (buffer, Qt))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
385 buffer = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 instream =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
388 make_coding_input_stream
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (XLSTREAM (instream),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
390 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
391 CODING_DECODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 NGCPRO1 (instream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 /* Repeatedly read until we've filled as much as possible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 of the buffer size we have. But don't read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 less than 1024--save that for the next bufferfull. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 nread = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 while (nread < bufsize - 1024)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
403 Bytecount this_read
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 = Lstream_read (XLSTREAM (instream), bufptr + nread,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 bufsize - nread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 if (this_read < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 goto give_up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (this_read == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 goto give_up_1;
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 nread += this_read;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 }
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 give_up_1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 /* Now NREAD is the total amount of data in the buffer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 if (nread == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
422 #if 0
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
423 /* [[check Vbinary_process_output]] */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
424 #endif
428
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 total_read += nread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 if (!NILP (buffer))
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
429 buffer_insert_raw_string (XBUFFER (buffer), (Intbyte *) bufptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 nread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 /* Make the buffer bigger as we continue to read more data,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 but not past 64k. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 bufsize *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 bufptr = (char *) alloca (bufsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 }
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 if (!NILP (display) && INTERACTIVE)
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 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 give_up:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 Lstream_close (XLSTREAM (instream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 /* Wait for it to terminate, unless it already has. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 wait_for_termination (pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 /* Don't kill any children that the subprocess may have left behind
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 when exiting. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 call_process_exited = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
456 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 if (synch_process_death)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
459 return build_msg_string (synch_process_death);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 return make_int (synch_process_retcode);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 /* 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
467 The original file descriptor remains open. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 relocate_fd (int fd, int min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 if (fd >= min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 return fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 int newfd = dup (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 if (newfd == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
478 Intbyte *errmess;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
479 GET_STRERROR (errmess, errno);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
480 stderr_out ("Error while setting up child: %s\n", errmess);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 _exit (1);
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 return relocate_fd (newfd, min);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 /* This is the last thing run in a newly forked inferior
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 either synchronous or asynchronous.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 Copy descriptors IN, OUT and ERR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 Initialize inferior's priority, pgrp, connected dir and environment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 then exec another program based on new_argv.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 XEmacs: We've removed the SET_PGRP argument because it's already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 done by the callers of child_setup.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 CURRENT_DIR is an elisp string giving the path of the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 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
499 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
500 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
501 parent. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
504 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
505 Lisp_Object current_dir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
507 Intbyte **env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
508 Intbyte *pwd;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 #ifdef SET_EMACS_PRIORITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 if (emacs_priority != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 nice (- emacs_priority);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
515 /* 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
516 not close handles inherited from the parent -- we are the parent
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
517 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
518 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
519 under Windows.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
520
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
521 #### This entire child_setup() function is an utter and complete
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
522 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
523 out the Windows and non-Windows stuff into two completely
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
524 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
525 entirely, using the Lisp definition in process.el. What's left
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
526 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
527 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
528 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
529 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
530 #if !defined (NO_SUBPROCESSES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 /* Close Emacs's descriptors that this process should not have. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 close_process_descs ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 #endif /* not NO_SUBPROCESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 close_load_descs ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
536 /* [[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
537 that do not have true vfork or that have true (stack) alloca.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 If using vfork and C_ALLOCA it is safe because that changes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 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
540 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
541 XEmacs does not use vfork. */
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 REGISTER Bytecount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
545 i = XSTRING_LENGTH (current_dir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
546 pwd = alloca_array (Intbyte, i + 6);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 memcpy (pwd, "PWD=", 4);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
548 memcpy (pwd + 4, XSTRING_DATA (current_dir), i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 i += 4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 if (!IS_DIRECTORY_SEP (pwd[i - 1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 pwd[i++] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 pwd[i] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
554 /* [[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
555 the callers check the current directory before forking, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 should only return an error if the directory's permissions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 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
558 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
559 if (qxe_chdir (pwd + 4) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 /* 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
562 /* (FSFmacs does _exit (errno) here.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 pwd = 0;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 /* Strip trailing "/". Cretinous *[]&@$#^%@#$% Un*x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 /* leave "//" (from FSF) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 while (i > 6 && IS_DIRECTORY_SEP (pwd[i - 1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 pwd[--i] = 0;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 /* Set `env' to a vector of the strings in Vprocess_environment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 /* + 2 to include PWD and terminating 0. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
576 env = alloca_array (Intbyte *, XINT (Flength (Vprocess_environment)) + 2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 REGISTER Lisp_Object tail;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
579 Intbyte **new_env = env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 /* 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
582 pass one down, but with corrected value. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
583 if (pwd && egetenv ("PWD"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 *new_env++ = pwd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 /* Copy the Vprocess_environment strings into new_env. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 for (tail = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 CONSP (tail) && STRINGP (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 tail = XCDR (tail))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
590 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
591 Intbyte **ep = env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
592 Intbyte *envvar = XSTRING_DATA (XCAR (tail));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
594 /* See if envvar duplicates any string already in the env.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 If so, don't put it in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 When an env var has multiple definitions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 we keep the definition that comes first in process-environment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 for (; ep != new_env; ep++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
600 Intbyte *p = *ep, *q = envvar;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 if (*q == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 /* The string is malformed; might as well drop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 if (*q != *p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 if (*q == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 p++, q++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
613 if (pwd && !qxestrncmp ((Intbyte *) "PWD=", envvar, 4))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 *new_env++ = pwd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 pwd = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
619 *new_env++ = envvar;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 duplicate: ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
623
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 *new_env = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 /* Make sure that in, out, and err are not actually already in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 descriptors zero, one, or two; this could happen if Emacs is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 started with its standard in, out, or error closed, as might
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 happen under X. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 in = relocate_fd (in, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 out = relocate_fd (out, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 err = relocate_fd (err, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 /* 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
636 retry_close (STDIN_FILENO);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
637 retry_close (STDOUT_FILENO);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
638 retry_close (STDERR_FILENO);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 dup2 (in, STDIN_FILENO);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 dup2 (out, STDOUT_FILENO);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 dup2 (err, STDERR_FILENO);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
644 retry_close (in);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
645 retry_close (out);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
646 retry_close (err);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 /* 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
649 than the standard 3 file descriptors. It would be cleaner to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 close just the ones that need to be, but the following brute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 force approach is certainly effective, and not too slow. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 for (fd=3; fd<=64; fd++)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
655 retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 #ifdef vipc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 something missing here;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 #endif /* vipc */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
662 /* we've wrapped execve; it translates its arguments */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
663 qxe_execve (new_argv[0], new_argv, env);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 stdout_out ("Can't exec program %s\n", new_argv[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 _exit (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 syms_of_callproc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
672 DEFSUBR (Fold_call_process_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 }