Mercurial > hg > xemacs-beta
comparison src/callproc.c @ 185:3d6bfa290dbd r20-3b19
Import from CVS: tag r20-3b19
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:55:28 +0200 |
parents | 9ad43877534d |
children | a2f645c6b9f8 |
comparison
equal
deleted
inserted
replaced
184:bcd2674570bf | 185:3d6bfa290dbd |
---|---|
97 if (!NILP (fd)) | 97 if (!NILP (fd)) |
98 close (XINT (fd)); | 98 close (XINT (fd)); |
99 | 99 |
100 if (!NILP (pid)) | 100 if (!NILP (pid)) |
101 EMACS_KILLPG (XINT (pid), SIGKILL); | 101 EMACS_KILLPG (XINT (pid), SIGKILL); |
102 | 102 |
103 synch_process_alive = 0; | 103 synch_process_alive = 0; |
104 return Qnil; | 104 return Qnil; |
105 } | 105 } |
106 | 106 |
107 static Lisp_Object | 107 static Lisp_Object |
185 char buf[16384]; | 185 char buf[16384]; |
186 char *bufptr = buf; | 186 char *bufptr = buf; |
187 int bufsize = 16384; | 187 int bufsize = 16384; |
188 int speccount = specpdl_depth (); | 188 int speccount = specpdl_depth (); |
189 struct gcpro gcpro1; | 189 struct gcpro gcpro1; |
190 char **new_argv = (char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); | 190 char **new_argv = alloca_array (char *, max (2, nargs - 2)); |
191 | 191 |
192 /* File to use for stderr in the child. | 192 /* File to use for stderr in the child. |
193 t means use same as standard output. */ | 193 t means use same as standard output. */ |
194 Lisp_Object error_file; | 194 Lisp_Object error_file; |
195 #ifdef MSDOS | 195 #ifdef MSDOS |
196 char *outf, *tempfile; | 196 char *outf, *tempfile; |
197 int outfilefd; | 197 int outfilefd; |
198 #endif /* MSDOS */ | 198 #endif /* MSDOS */ |
199 | 199 |
200 CHECK_STRING (args[0]); | 200 CHECK_STRING (args[0]); |
201 | 201 |
202 error_file = Qt; | 202 error_file = Qt; |
203 | 203 |
204 #if defined (NO_SUBPROCESSES) | 204 #if defined (NO_SUBPROCESSES) |
215 buffer's current directory, or its unhandled equivalent. We | 215 buffer's current directory, or its unhandled equivalent. We |
216 can't just have the child check for an error when it does the | 216 can't just have the child check for an error when it does the |
217 chdir, since it's in a vfork. */ | 217 chdir, since it's in a vfork. */ |
218 { | 218 { |
219 struct gcpro ngcpro1, ngcpro2; | 219 struct gcpro ngcpro1, ngcpro2; |
220 /* Do this test before building new_argv because GC in Lisp code | 220 /* Do this test before building new_argv because GC in Lisp code |
221 * called by various filename-hacking routines might relocate strings */ | 221 * called by various filename-hacking routines might relocate strings */ |
222 /* Make sure that the child will be able to chdir to the current | 222 /* Make sure that the child will be able to chdir to the current |
223 buffer's current directory. We can't just have the child check | 223 buffer's current directory. We can't just have the child check |
224 for an error when it does the chdir, since it's in a vfork. */ | 224 for an error when it does the chdir, since it's in a vfork. */ |
225 | 225 |
283 if (NILP (buffer)) | 283 if (NILP (buffer)) |
284 CHECK_BUFFER (spec_buffer); | 284 CHECK_BUFFER (spec_buffer); |
285 CHECK_BUFFER (buffer); | 285 CHECK_BUFFER (buffer); |
286 } | 286 } |
287 } | 287 } |
288 else | 288 else |
289 buffer = Qnil; | 289 buffer = Qnil; |
290 | 290 |
291 UNGCPRO; | 291 UNGCPRO; |
292 | 292 |
293 display = ((nargs >= 4) ? args[3] : Qnil); | 293 display = ((nargs >= 4) ? args[3] : Qnil); |
304 } | 304 } |
305 | 305 |
306 if (NILP (path)) | 306 if (NILP (path)) |
307 report_file_error ("Searching for program", Fcons (args[0], Qnil)); | 307 report_file_error ("Searching for program", Fcons (args[0], Qnil)); |
308 new_argv[0] = (char *) XSTRING_DATA (path); | 308 new_argv[0] = (char *) XSTRING_DATA (path); |
309 | 309 |
310 filefd = open ((char *) XSTRING_DATA (infile), O_RDONLY, 0); | 310 filefd = open ((char *) XSTRING_DATA (infile), O_RDONLY, 0); |
311 if (filefd < 0) | 311 if (filefd < 0) |
312 report_file_error ("Opening process input file", Fcons (infile, Qnil)); | 312 report_file_error ("Opening process input file", Fcons (infile, Qnil)); |
313 | 313 |
314 #ifdef MSDOS | 314 #ifdef MSDOS |
324 { | 324 { |
325 tempfile = alloca (20); | 325 tempfile = alloca (20); |
326 *tempfile = '\0'; | 326 *tempfile = '\0'; |
327 } | 327 } |
328 dostounix_filename (tempfile); | 328 dostounix_filename (tempfile); |
329 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/') | 329 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/') |
330 strcat (tempfile, "/"); | 330 strcat (tempfile, "/"); |
331 strcat (tempfile, "detmp.XXX"); | 331 strcat (tempfile, "detmp.XXX"); |
332 mktemp (tempfile); | 332 mktemp (tempfile); |
333 | 333 |
334 outfilefd = creat (tempfile, S_IREAD | S_IWRITE); | 334 outfilefd = creat (tempfile, S_IREAD | S_IWRITE); |
358 { | 358 { |
359 char *outf; | 359 char *outf; |
360 | 360 |
361 if (INTP (buffer)) | 361 if (INTP (buffer)) |
362 outf = NULL_DEVICE; | 362 outf = NULL_DEVICE; |
363 else | 363 else |
364 { | 364 { |
365 /* DOS can't create pipe for interprocess communication, | 365 /* DOS can't create pipe for interprocess communication, |
366 so redirect child process's standard output to temporary file | 366 so redirect child process's standard output to temporary file |
367 and later read the file. */ | 367 and later read the file. */ |
368 | 368 |
369 if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP"))) | 369 if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP"))) |
370 { | 370 { |
371 strcpy (tempfile, outf); | 371 strcpy (tempfile, outf); |
372 dostounix_filename (tempfile); | 372 dostounix_filename (tempfile); |
373 } | 373 } |
451 report_file_error ("Cannot open", Fcons(error_file, Qnil)); | 451 report_file_error ("Cannot open", Fcons(error_file, Qnil)); |
452 } | 452 } |
453 | 453 |
454 fork_error = Qnil; | 454 fork_error = Qnil; |
455 #ifdef WINDOWSNT | 455 #ifdef WINDOWSNT |
456 pid = child_setup (filefd, fd1, fd_error, new_argv, | 456 pid = child_setup (filefd, fd1, fd_error, new_argv, |
457 (char *) XSTRING_DATA (current_dir)); | 457 (char *) XSTRING_DATA (current_dir)); |
458 #else /* not WINDOWSNT */ | 458 #else /* not WINDOWSNT */ |
459 pid = fork (); | 459 pid = fork (); |
460 | 460 |
461 if (pid == 0) | 461 if (pid == 0) |
574 /* Now NREAD is the total amount of data in the buffer. */ | 574 /* Now NREAD is the total amount of data in the buffer. */ |
575 if (nread == 0) | 575 if (nread == 0) |
576 break; | 576 break; |
577 | 577 |
578 total_read += nread; | 578 total_read += nread; |
579 | 579 |
580 if (!NILP (buffer)) | 580 if (!NILP (buffer)) |
581 buffer_insert_raw_string (XBUFFER (buffer), (Bufbyte *) bufptr, | 581 buffer_insert_raw_string (XBUFFER (buffer), (Bufbyte *) bufptr, |
582 nread); | 582 nread); |
583 | 583 |
584 /* Make the buffer bigger as we continue to read more data, | 584 /* Make the buffer bigger as we continue to read more data, |
679 and will be cleaned up in the usual way. */ | 679 and will be cleaned up in the usual way. */ |
680 { | 680 { |
681 REGISTER int i; | 681 REGISTER int i; |
682 | 682 |
683 i = strlen (current_dir); | 683 i = strlen (current_dir); |
684 pwd = (char *) alloca (i + 6); | 684 pwd = alloca_array (char, i + 6); |
685 memcpy (pwd, "PWD=", 4); | 685 memcpy (pwd, "PWD=", 4); |
686 memcpy (pwd + 4, current_dir, i); | 686 memcpy (pwd + 4, current_dir, i); |
687 i += 4; | 687 i += 4; |
688 if (!IS_DIRECTORY_SEP (pwd[i - 1])) | 688 if (!IS_DIRECTORY_SEP (pwd[i - 1])) |
689 pwd[i++] = DIRECTORY_SEP; | 689 pwd[i++] = DIRECTORY_SEP; |
721 && STRINGP (XCAR (tem))); | 721 && STRINGP (XCAR (tem))); |
722 tem = XCDR (tem)) | 722 tem = XCDR (tem)) |
723 new_length++; | 723 new_length++; |
724 | 724 |
725 /* new_length + 2 to include PWD and terminating 0. */ | 725 /* new_length + 2 to include PWD and terminating 0. */ |
726 env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *)); | 726 env = new_env = alloca_array (char *, new_length + 2); |
727 | 727 |
728 /* If we have a PWD envvar and we know the real current directory, | 728 /* If we have a PWD envvar and we know the real current directory, |
729 pass one down, but with corrected value. */ | 729 pass one down, but with corrected value. */ |
730 if (pwd && getenv ("PWD")) | 730 if (pwd && getenv ("PWD")) |
731 *new_env++ = pwd; | 731 *new_env++ = pwd; |
795 close (2); | 795 close (2); |
796 | 796 |
797 dup2 (in, 0); | 797 dup2 (in, 0); |
798 dup2 (out, 1); | 798 dup2 (out, 1); |
799 dup2 (err, 2); | 799 dup2 (err, 2); |
800 | 800 |
801 close (in); | 801 close (in); |
802 close (out); | 802 close (out); |
803 close (err); | 803 close (err); |
804 | 804 |
805 /* I can't think of any reason why child processes need any more | 805 /* I can't think of any reason why child processes need any more |
873 Lisp_Object scan; | 873 Lisp_Object scan; |
874 | 874 |
875 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | 875 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) |
876 { | 876 { |
877 Lisp_Object entry = XCAR (scan); | 877 Lisp_Object entry = XCAR (scan); |
878 | 878 |
879 if (STRINGP (entry) | 879 if (STRINGP (entry) |
880 && XSTRING_LENGTH (entry) > varlen | 880 && XSTRING_LENGTH (entry) > varlen |
881 && XSTRING_BYTE (entry, varlen) == '=' | 881 && XSTRING_BYTE (entry, varlen) == '=' |
882 #ifdef WINDOWSNT | 882 #ifdef WINDOWSNT |
883 /* NT environment variables are case insensitive. */ | 883 /* NT environment variables are case insensitive. */ |
971 #endif | 971 #endif |
972 { | 972 { |
973 char *data_dir = egetenv ("EMACSDATA"); | 973 char *data_dir = egetenv ("EMACSDATA"); |
974 char *site_dir = egetenv ("EMACSSITE"); | 974 char *site_dir = egetenv ("EMACSSITE"); |
975 char *doc_dir = egetenv ("EMACSDOC"); | 975 char *doc_dir = egetenv ("EMACSDOC"); |
976 | 976 |
977 #ifdef PATH_DATA | 977 #ifdef PATH_DATA |
978 if (!data_dir) | 978 if (!data_dir) |
979 data_dir = (char *) PATH_DATA; | 979 data_dir = (char *) PATH_DATA; |
980 #endif | 980 #endif |
981 #ifdef PATH_DOC | 981 #ifdef PATH_DOC |
984 #endif | 984 #endif |
985 #ifdef PATH_SITE | 985 #ifdef PATH_SITE |
986 if (!site_dir) | 986 if (!site_dir) |
987 site_dir = (char *) PATH_SITE; | 987 site_dir = (char *) PATH_SITE; |
988 #endif | 988 #endif |
989 | 989 |
990 if (data_dir) | 990 if (data_dir) |
991 Vdata_directory = Ffile_name_as_directory | 991 Vdata_directory = Ffile_name_as_directory |
992 (build_string (data_dir)); | 992 (build_string (data_dir)); |
993 else | 993 else |
994 Vdata_directory = Qnil; | 994 Vdata_directory = Qnil; |
1057 #else | 1057 #else |
1058 Vdata_directory = Qnil; | 1058 Vdata_directory = Qnil; |
1059 #endif | 1059 #endif |
1060 } | 1060 } |
1061 } | 1061 } |
1062 | 1062 |
1063 if (!NILP (Vsite_directory)) | 1063 if (!NILP (Vsite_directory)) |
1064 { | 1064 { |
1065 tempdir = Fdirectory_file_name (Vsite_directory); | 1065 tempdir = Fdirectory_file_name (Vsite_directory); |
1066 if (access ((char *) XSTRING_DATA (tempdir), 0) < 0) | 1066 if (access ((char *) XSTRING_DATA (tempdir), 0) < 0) |
1067 { | 1067 { |
1075 #else | 1075 #else |
1076 Vsite_directory = Qnil; | 1076 Vsite_directory = Qnil; |
1077 #endif | 1077 #endif |
1078 } | 1078 } |
1079 } | 1079 } |
1080 | 1080 |
1081 #ifdef PATH_PREFIX | 1081 #ifdef PATH_PREFIX |
1082 Vprefix_directory = build_string ((char *) PATH_PREFIX); | 1082 Vprefix_directory = build_string ((char *) PATH_PREFIX); |
1083 #else | 1083 #else |
1084 Vprefix_directory = Qnil; | 1084 Vprefix_directory = Qnil; |
1085 #endif | 1085 #endif |
1093 sh = egetenv ("COMSPEC"); | 1093 sh = egetenv ("COMSPEC"); |
1094 { | 1094 { |
1095 char *tem; | 1095 char *tem; |
1096 /* | 1096 /* |
1097 ** If COMSPEC has been set, then convert the | 1097 ** If COMSPEC has been set, then convert the |
1098 ** DOS formatted name into a UNIX format. Then | 1098 ** DOS formatted name into a UNIX format. Then |
1099 ** create a LISP object. | 1099 ** create a LISP object. |
1100 */ | 1100 */ |
1101 if (sh) | 1101 if (sh) |
1102 { | 1102 { |
1103 tem = (char *) alloca (strlen (sh) + 1); | 1103 tem = (char *) alloca (strlen (sh) + 1); |
1114 } | 1114 } |
1115 } | 1115 } |
1116 #else /* not VMS or WINDOWSNT */ | 1116 #else /* not VMS or WINDOWSNT */ |
1117 sh = (char *) egetenv ("SHELL"); | 1117 sh = (char *) egetenv ("SHELL"); |
1118 Vshell_file_name = build_string (sh ? sh : "/bin/sh"); | 1118 Vshell_file_name = build_string (sh ? sh : "/bin/sh"); |
1119 #endif | 1119 #endif |
1120 } | 1120 } |
1121 | 1121 |
1122 #if 0 | 1122 #if 0 |
1123 void | 1123 void |
1124 set_process_environment (void) | 1124 set_process_environment (void) |