Mercurial > emacs
annotate src/callproc.c @ 942:c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
disappeared.
author | Joseph Arceneaux <jla@gnu.org> |
---|---|
date | Thu, 06 Aug 1992 03:24:07 +0000 |
parents | 1e2e41fd188b |
children | 928ed74adf4f |
rev | line source |
---|---|
296 | 1 /* Synchronous subprocess invocation for GNU Emacs. |
934 | 2 Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. |
296 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
8 the Free Software Foundation; either version 1, or (at your option) | |
9 any later version. | |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 | |
21 #include <signal.h> | |
22 | |
23 #include "config.h" | |
24 | |
25 /* Define SIGCHLD as an alias for SIGCLD. */ | |
26 | |
27 #if !defined (SIGCHLD) && defined (SIGCLD) | |
28 #define SIGCHLD SIGCLD | |
29 #endif /* SIGCLD */ | |
30 | |
31 #include <sys/types.h> | |
32 #define PRIO_PROCESS 0 | |
33 #include <sys/file.h> | |
34 #ifdef USG5 | |
35 #include <fcntl.h> | |
36 #endif | |
37 | |
38 #ifndef O_RDONLY | |
39 #define O_RDONLY 0 | |
40 #endif | |
41 | |
42 #ifndef O_WRONLY | |
43 #define O_WRONLY 1 | |
44 #endif | |
45 | |
46 #include "lisp.h" | |
47 #include "commands.h" | |
48 #include "buffer.h" | |
49 #include "paths.h" | |
50 #include "process.h" | |
51 | |
52 #ifdef VMS | |
53 extern noshare char **environ; | |
54 #else | |
55 extern char **environ; | |
56 #endif | |
57 | |
58 #define max(a, b) ((a) > (b) ? (a) : (b)) | |
59 | |
934 | 60 Lisp_Object Vexec_path, Vexec_directory; |
296 | 61 |
62 Lisp_Object Vshell_file_name; | |
63 | |
934 | 64 #ifndef MAINTAIN_ENVIRONMENT |
65 /* List of strings to append to front of environment of | |
66 all subprocesses when they are started. */ | |
67 | |
296 | 68 Lisp_Object Vprocess_environment; |
934 | 69 #endif |
296 | 70 |
71 /* True iff we are about to fork off a synchronous process or if we | |
72 are waiting for it. */ | |
73 int synch_process_alive; | |
74 | |
75 /* Nonzero => this is a string explaining death of synchronous subprocess. */ | |
76 char *synch_process_death; | |
77 | |
78 /* If synch_process_death is zero, | |
79 this is exit code of synchronous subprocess. */ | |
80 int synch_process_retcode; | |
81 | |
82 #ifndef VMS /* VMS version is in vmsproc.c. */ | |
83 | |
84 Lisp_Object | |
85 call_process_cleanup (fdpid) | |
86 Lisp_Object fdpid; | |
87 { | |
88 register Lisp_Object fd, pid; | |
89 fd = Fcar (fdpid); | |
90 pid = Fcdr (fdpid); | |
91 close (XFASTINT (fd)); | |
92 kill (XFASTINT (pid), SIGKILL); | |
93 synch_process_alive = 0; | |
94 return Qnil; | |
95 } | |
96 | |
97 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0, | |
98 "Call PROGRAM synchronously in separate process.\n\ | |
99 The program's input comes from file INFILE (nil means `/dev/null').\n\ | |
100 Insert output in BUFFER before point; t means current buffer;\n\ | |
101 nil for BUFFER means discard it; 0 means discard and don't wait.\n\ | |
102 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ | |
103 Remaining arguments are strings passed as command arguments to PROGRAM.\n\ | |
104 If BUFFER is nil or 0, returns immediately with value nil.\n\ | |
105 Otherwise waits for PROGRAM to terminate\n\ | |
934 | 106 and returns a numeric exit status or a signal name as a string.\n\ |
296 | 107 If you quit, the process is killed with SIGKILL.") |
108 (nargs, args) | |
109 int nargs; | |
110 register Lisp_Object *args; | |
111 { | |
934 | 112 Lisp_Object display, buffer, path; |
296 | 113 int fd[2]; |
114 int filefd; | |
115 register int pid; | |
116 char buf[1024]; | |
117 int count = specpdl_ptr - specpdl; | |
118 register unsigned char **new_argv | |
119 = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); | |
120 struct buffer *old = current_buffer; | |
121 #if 0 | |
122 int mask; | |
123 #endif | |
934 | 124 struct gcpro gcpro1; |
125 | |
126 GCPRO1 (*args); | |
127 gcpro1.nvars = nargs; | |
128 | |
296 | 129 CHECK_STRING (args[0], 0); |
130 | |
942
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
131 if (nargs <= 1 || NILP (args[1])) |
934 | 132 args[1] = build_string ("/dev/null"); |
296 | 133 else |
934 | 134 args[1] = Fexpand_file_name (args[1], current_buffer->directory); |
135 | |
136 CHECK_STRING (args[1], 1); | |
648 | 137 |
934 | 138 { |
139 register Lisp_Object tem; | |
140 buffer = tem = args[2]; | |
141 if (nargs <= 2) | |
142 buffer = Qnil; | |
143 else if (!(EQ (tem, Qnil) || EQ (tem, Qt) | |
144 || XFASTINT (tem) == 0)) | |
145 { | |
146 buffer = Fget_buffer (tem); | |
147 CHECK_BUFFER (buffer, 2); | |
148 } | |
149 } | |
296 | 150 |
934 | 151 display = nargs >= 3 ? args[3] : Qnil; |
296 | 152 |
153 { | |
154 register int i; | |
155 for (i = 4; i < nargs; i++) | |
156 { | |
157 CHECK_STRING (args[i], i); | |
158 new_argv[i - 3] = XSTRING (args[i])->data; | |
159 } | |
160 /* Program name is first command arg */ | |
161 new_argv[0] = XSTRING (args[0])->data; | |
162 new_argv[i - 3] = 0; | |
163 } | |
164 | |
934 | 165 filefd = open (XSTRING (args[1])->data, O_RDONLY, 0); |
296 | 166 if (filefd < 0) |
167 { | |
934 | 168 report_file_error ("Opening process input file", Fcons (args[1], Qnil)); |
296 | 169 } |
170 /* Search for program; barf if not found. */ | |
171 openp (Vexec_path, args[0], "", &path, 1); | |
942
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
172 if (NILP (path)) |
296 | 173 { |
174 close (filefd); | |
175 report_file_error ("Searching for program", Fcons (args[0], Qnil)); | |
176 } | |
177 new_argv[0] = XSTRING (path)->data; | |
178 | |
179 if (XTYPE (buffer) == Lisp_Int) | |
180 fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1; | |
181 else | |
182 { | |
183 pipe (fd); | |
184 #if 0 | |
185 /* Replaced by close_process_descs */ | |
186 set_exclusive_use (fd[0]); | |
187 #endif | |
188 } | |
189 | |
190 { | |
191 /* child_setup must clobber environ in systems with true vfork. | |
192 Protect it from permanent change. */ | |
193 register char **save_environ = environ; | |
194 register int fd1 = fd[1]; | |
934 | 195 char **env; |
196 | |
197 #ifdef MAINTAIN_ENVIRONMENT | |
198 env = (char **) alloca (size_of_current_environ ()); | |
199 get_current_environ (env); | |
200 #else | |
201 env = environ; | |
202 #endif /* MAINTAIN_ENVIRONMENT */ | |
296 | 203 |
204 #if 0 /* Some systems don't have sigblock. */ | |
638 | 205 mask = sigblock (sigmask (SIGCHLD)); |
296 | 206 #endif |
207 | |
208 /* Record that we're about to create a synchronous process. */ | |
209 synch_process_alive = 1; | |
210 | |
211 pid = vfork (); | |
212 | |
213 if (pid == 0) | |
214 { | |
215 if (fd[0] >= 0) | |
216 close (fd[0]); | |
217 #ifdef USG | |
218 setpgrp (); | |
219 #else | |
220 setpgrp (pid, pid); | |
221 #endif /* USG */ | |
934 | 222 child_setup (filefd, fd1, fd1, new_argv, env, 0); |
296 | 223 } |
224 | |
225 #if 0 | |
226 /* Tell SIGCHLD handler to look for this pid. */ | |
227 synch_process_pid = pid; | |
228 /* Now let SIGCHLD come through. */ | |
638 | 229 sigsetmask (mask); |
296 | 230 #endif |
231 | |
232 environ = save_environ; | |
233 | |
234 close (filefd); | |
235 close (fd1); | |
236 } | |
237 | |
238 if (pid < 0) | |
239 { | |
240 close (fd[0]); | |
241 report_file_error ("Doing vfork", Qnil); | |
242 } | |
243 | |
244 if (XTYPE (buffer) == Lisp_Int) | |
245 { | |
246 #ifndef subprocesses | |
247 wait_without_blocking (); | |
248 #endif /* subprocesses */ | |
934 | 249 |
250 UNGCPRO; | |
296 | 251 return Qnil; |
252 } | |
253 | |
254 record_unwind_protect (call_process_cleanup, | |
255 Fcons (make_number (fd[0]), make_number (pid))); | |
256 | |
257 | |
258 if (XTYPE (buffer) == Lisp_Buffer) | |
259 Fset_buffer (buffer); | |
260 | |
261 immediate_quit = 1; | |
262 QUIT; | |
263 | |
264 { | |
265 register int nread; | |
266 | |
267 while ((nread = read (fd[0], buf, sizeof buf)) > 0) | |
268 { | |
269 immediate_quit = 0; | |
942
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
270 if (!NILP (buffer)) |
296 | 271 insert (buf, nread); |
942
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
272 if (!NILP (display) && INTERACTIVE) |
296 | 273 redisplay_preserve_echo_area (); |
274 immediate_quit = 1; | |
275 QUIT; | |
276 } | |
277 } | |
278 | |
279 /* Wait for it to terminate, unless it already has. */ | |
280 wait_for_termination (pid); | |
281 | |
282 immediate_quit = 0; | |
283 | |
284 set_buffer_internal (old); | |
285 | |
286 unbind_to (count, Qnil); | |
287 | |
934 | 288 UNGCPRO; |
289 | |
296 | 290 if (synch_process_death) |
291 return build_string (synch_process_death); | |
292 return make_number (synch_process_retcode); | |
293 } | |
294 #endif | |
295 | |
296 static void | |
297 delete_temp_file (name) | |
298 Lisp_Object name; | |
299 { | |
300 unlink (XSTRING (name)->data); | |
301 } | |
302 | |
303 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, | |
304 3, MANY, 0, | |
305 "Send text from START to END to a synchronous process running PROGRAM.\n\ | |
306 Delete the text if fourth arg DELETE is non-nil.\n\ | |
307 Insert output in BUFFER before point; t means current buffer;\n\ | |
308 nil for BUFFER means discard it; 0 means discard and don't wait.\n\ | |
309 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ | |
310 Remaining args are passed to PROGRAM at startup as command args.\n\ | |
311 If BUFFER is nil, returns immediately with value nil.\n\ | |
312 Otherwise waits for PROGRAM to terminate\n\ | |
934 | 313 and returns a numeric exit status or a signal name as a string.\n\ |
296 | 314 If you quit, the process is killed with SIGKILL.") |
315 (nargs, args) | |
316 int nargs; | |
317 register Lisp_Object *args; | |
318 { | |
319 register Lisp_Object filename_string, start, end; | |
320 char tempfile[20]; | |
321 int count = specpdl_ptr - specpdl; | |
934 | 322 struct gcpro gcpro1; |
323 | |
324 GCPRO1 (*args); | |
325 gcpro1.nvars = 2; | |
296 | 326 |
327 #ifdef VMS | |
328 strcpy (tempfile, "tmp:emacsXXXXXX."); | |
329 #else | |
330 strcpy (tempfile, "/tmp/emacsXXXXXX"); | |
331 #endif | |
332 mktemp (tempfile); | |
333 | |
334 filename_string = build_string (tempfile); | |
335 start = args[0]; | |
336 end = args[1]; | |
337 Fwrite_region (start, end, filename_string, Qnil, Qlambda); | |
338 record_unwind_protect (delete_temp_file, filename_string); | |
339 | |
942
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
340 if (!NILP (args[3])) |
296 | 341 Fdelete_region (start, end); |
342 | |
343 args[3] = filename_string; | |
344 Fcall_process (nargs - 2, args + 2); | |
345 | |
934 | 346 UNGCPRO; |
296 | 347 return unbind_to (count, Qnil); |
348 } | |
349 | |
350 #ifndef VMS /* VMS version is in vmsproc.c. */ | |
351 | |
352 /* This is the last thing run in a newly forked inferior | |
353 either synchronous or asynchronous. | |
354 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2. | |
355 Initialize inferior's priority, pgrp, connected dir and environment. | |
356 then exec another program based on new_argv. | |
357 | |
358 This function may change environ for the superior process. | |
359 Therefore, the superior process must save and restore the value | |
360 of environ around the vfork and the call to this function. | |
361 | |
362 ENV is the environment for the subprocess. | |
363 | |
364 SET_PGRP is nonzero if we should put the subprocess into a separate | |
934 | 365 process group. */ |
296 | 366 |
934 | 367 child_setup (in, out, err, new_argv, env, set_pgrp) |
296 | 368 int in, out, err; |
369 register char **new_argv; | |
934 | 370 char **env; |
296 | 371 int set_pgrp; |
372 { | |
373 register int pid = getpid(); | |
374 | |
375 setpriority (PRIO_PROCESS, pid, 0); | |
376 | |
377 #ifdef subprocesses | |
378 /* Close Emacs's descriptors that this process should not have. */ | |
379 close_process_descs (); | |
380 #endif | |
381 | |
382 /* Note that use of alloca is always safe here. It's obvious for systems | |
383 that do not have true vfork or that have true (stack) alloca. | |
384 If using vfork and C_ALLOCA it is safe because that changes | |
385 the superior's static variables as if the superior had done alloca | |
386 and will be cleaned up in the usual way. */ | |
387 | |
934 | 388 if (XTYPE (current_buffer->directory) == Lisp_String) |
389 { | |
390 register unsigned char *temp; | |
391 register int i; | |
538 | 392 |
934 | 393 i = XSTRING (current_buffer->directory)->size; |
394 temp = (unsigned char *) alloca (i + 2); | |
395 bcopy (XSTRING (current_buffer->directory)->data, temp, i); | |
396 if (temp[i - 1] != '/') temp[i++] = '/'; | |
397 temp[i] = 0; | |
398 /* Switch to that directory, and report any error. */ | |
399 if (chdir (temp) < 0) | |
400 report_file_error ("In chdir", | |
401 Fcons (current_buffer->directory, Qnil)); | |
402 } | |
296 | 403 |
934 | 404 #ifndef MAINTAIN_ENVIRONMENT |
296 | 405 /* Set `env' to a vector of the strings in Vprocess_environment. */ |
406 { | |
407 register Lisp_Object tem; | |
408 register char **new_env; | |
409 register int new_length; | |
410 | |
411 new_length = 0; | |
412 for (tem = Vprocess_environment; | |
413 (XTYPE (tem) == Lisp_Cons | |
414 && XTYPE (XCONS (tem)->car) == Lisp_String); | |
415 tem = XCONS (tem)->cdr) | |
416 new_length++; | |
417 | |
418 /* new_length + 1 to include terminating 0 */ | |
419 env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *)); | |
420 | |
934 | 421 /* Copy the env strings into new_env. */ |
296 | 422 for (tem = Vprocess_environment; |
423 (XTYPE (tem) == Lisp_Cons | |
424 && XTYPE (XCONS (tem)->car) == Lisp_String); | |
425 tem = XCONS (tem)->cdr) | |
426 *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data; | |
427 *new_env = 0; | |
428 } | |
934 | 429 #endif /* Not MAINTAIN_ENVIRONMENT */ |
296 | 430 |
431 close (0); | |
432 close (1); | |
433 close (2); | |
434 | |
435 dup2 (in, 0); | |
436 dup2 (out, 1); | |
437 dup2 (err, 2); | |
438 close (in); | |
439 close (out); | |
440 close (err); | |
441 | |
442 setpgrp_of_tty (pid); | |
443 | |
444 #ifdef vipc | |
445 something missing here; | |
446 #endif /* vipc */ | |
447 | |
448 /* execvp does not accept an environment arg so the only way | |
449 to pass this environment is to set environ. Our caller | |
450 is responsible for restoring the ambient value of environ. */ | |
451 environ = env; | |
452 execvp (new_argv[0], new_argv); | |
453 | |
454 write (1, "Couldn't exec the program ", 26); | |
455 write (1, new_argv[0], strlen (new_argv[0])); | |
456 _exit (1); | |
457 } | |
458 | |
942
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
459 static int |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
460 getenv_internal (var, varlen, value, valuelen) |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
461 char *var; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
462 int varlen; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
463 char **value; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
464 int *valuelen; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
465 { |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
466 Lisp_Object scan; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
467 |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
468 for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr) |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
469 { |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
470 Lisp_Object entry = XCONS (scan)->car; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
471 |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
472 if (XTYPE (entry) == Lisp_String |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
473 && XSTRING (entry)->size > varlen |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
474 && XSTRING (entry)->data[varlen] == '=' |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
475 && ! bcmp (XSTRING (entry)->data, var, varlen)) |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
476 { |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
477 *value = (char *) XSTRING (entry)->data + (varlen + 1); |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
478 *valuelen = XSTRING (entry)->size - (varlen + 1); |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
479 return 1; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
480 } |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
481 } |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
482 |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
483 return 0; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
484 } |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
485 |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
486 DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0, |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
487 "Return the value of environment variable VAR, as a string.\n\ |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
488 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\ |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
489 This function consults the variable ``process-environment'' for its value.") |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
490 (var) |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
491 Lisp_Object var; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
492 { |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
493 char *value; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
494 int valuelen; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
495 |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
496 CHECK_STRING (var, 0); |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
497 if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size, |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
498 &value, &valuelen)) |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
499 return make_string (value, valuelen); |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
500 else |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
501 return Qnil; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
502 } |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
503 |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
504 /* A version of getenv that consults process_environment, easily |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
505 callable from C. */ |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
506 char * |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
507 egetenv (var) |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
508 char *var; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
509 { |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
510 char *value; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
511 int valuelen; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
512 |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
513 if (getenv_internal (var, strlen (var), &value, &valuelen)) |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
514 return value; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
515 else |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
516 return 0; |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
517 } |
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
518 |
296 | 519 #endif /* not VMS */ |
520 | |
521 init_callproc () | |
522 { | |
523 register char * sh; | |
524 register char **envp; | |
934 | 525 Lisp_Object execdir; |
439 | 526 |
934 | 527 /* Turn PATH_EXEC into a path. `==' is just a string which we know |
528 will not be the name of an environment variable. */ | |
529 Vexec_path = decode_env_path ("==", PATH_EXEC); | |
296 | 530 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); |
531 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); | |
532 | |
934 | 533 execdir = Fdirectory_file_name (Vexec_directory); |
534 if (access (XSTRING (execdir)->data, 0) < 0) | |
296 | 535 { |
934 | 536 printf ("Warning: executable/documentation dir (%s) does not exist.\n", |
296 | 537 XSTRING (Vexec_directory)->data); |
538 sleep (2); | |
539 } | |
540 | |
541 #ifdef VMS | |
542 Vshell_file_name = build_string ("*dcl*"); | |
543 #else | |
934 | 544 sh = (char *) egetenv ("SHELL"); |
296 | 545 Vshell_file_name = build_string (sh ? sh : "/bin/sh"); |
546 #endif | |
547 | |
934 | 548 #ifndef MAINTAIN_ENVIRONMENT |
549 /* The equivalent of this operation was done | |
550 in init_environ in environ.c if MAINTAIN_ENVIRONMENT */ | |
296 | 551 Vprocess_environment = Qnil; |
552 #ifndef CANNOT_DUMP | |
553 if (initialized) | |
554 #endif | |
555 for (envp = environ; *envp; envp++) | |
556 Vprocess_environment = Fcons (build_string (*envp), | |
557 Vprocess_environment); | |
934 | 558 #endif /* MAINTAIN_ENVIRONMENT */ |
296 | 559 } |
560 | |
561 syms_of_callproc () | |
562 { | |
563 DEFVAR_LISP ("shell-file-name", &Vshell_file_name, | |
564 "*File name to load inferior shells from.\n\ | |
565 Initialized from the SHELL environment variable."); | |
566 | |
567 DEFVAR_LISP ("exec-path", &Vexec_path, | |
568 "*List of directories to search programs to run in subprocesses.\n\ | |
569 Each element is a string (directory name) or nil (try default directory)."); | |
570 | |
571 DEFVAR_LISP ("exec-directory", &Vexec_directory, | |
934 | 572 "Directory that holds programs that come with GNU Emacs,\n\ |
573 intended for Emacs to invoke."); | |
439 | 574 |
934 | 575 #ifndef MAINTAIN_ENVIRONMENT |
296 | 576 DEFVAR_LISP ("process-environment", &Vprocess_environment, |
934 | 577 "List of strings to append to environment of subprocesses that are started.\n\ |
578 Each string should have the format ENVVARNAME=VALUE."); | |
579 #endif | |
296 | 580 |
581 #ifndef VMS | |
582 defsubr (&Scall_process); | |
583 #endif | |
584 defsubr (&Scall_process_region); | |
942
c519b70eb50b
Replaced fuctions egetenv, Fgetenv, getenv_internal, which had
Joseph Arceneaux <jla@gnu.org>
parents:
934
diff
changeset
|
585 defsubr (&Sgetenv); |
296 | 586 } |