Mercurial > hg > xemacs-beta

comparison src/callproc.c @ 14:9ee227acff29 r19-15b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents 376386a54a3c
children 859a2309aef8
comparison
equal deleted inserted replaced
13:13c6d0aaafe5 14:9ee227acff29
102 { 102 {
103 #ifdef MSDOS 103 #ifdef MSDOS
104 /* for MSDOS fdpid is really (fd . tempfile) */ 104 /* for MSDOS fdpid is really (fd . tempfile) */
105 Lisp_Object file = Fcdr (fdpid); 105 Lisp_Object file = Fcdr (fdpid);
106 close (XINT (Fcar (fdpid))); 106 close (XINT (Fcar (fdpid)));
107 if (strcmp (string_data (XSTRING (file)), NULL_DEVICE) != 0) 107 if (strcmp (XSTRING_DATA (file), NULL_DEVICE) != 0)
108 unlink (string_data (XSTRING (file))); 108 unlink (XSTRING_DATA (file));
109 #else /* not MSDOS */ 109 #else /* not MSDOS */
110 int fd = XINT (Fcar (fdpid)); 110 int fd = XINT (Fcar (fdpid));
111 int pid = XINT (Fcdr (fdpid)); 111 int pid = XINT (Fcdr (fdpid));
112 112
113 if (!call_process_exited && 113 if (!call_process_exited &&
194 t means use same as standard output. */ 194 t means use same as standard output. */
195 Lisp_Object error_file; 195 Lisp_Object error_file;
196 #ifdef MSDOS 196 #ifdef MSDOS
197 char *outf, *tempfile; 197 char *outf, *tempfile;
198 int outfilefd; 198 int outfilefd;
199 #endif 199 #endif /* MSDOS */
200 200
201 CHECK_STRING (args[0]); 201 CHECK_STRING (args[0]);
202 202
203 error_file = Qt; 203 error_file = Qt;
204 204
205 #if defined (NO_SUBPROCESSES) 205 #if defined (NO_SUBPROCESSES)
206 /* Without asynchronous processes we cannot have BUFFER == 0. */ 206 /* Without asynchronous processes we cannot have BUFFER == 0. */
207 if (nargs >= 3 && !INTP (args[2])) 207 if (nargs >= 3 && !INTP (args[2]))
208 error ("Operating system cannot handle asynchronous subprocesses"); 208 error ("Operating system cannot handle asynchronous subprocesses");
209 #endif 209 #endif /* NO_SUBPROCESSES */
210 210
211 /* Do this before building new_argv because GC in Lisp code 211 /* Do this before building new_argv because GC in Lisp code
212 * called by various filename-hacking routines might relocate strings */ 212 * called by various filename-hacking routines might relocate strings */
213 locate_file (Vexec_path, args[0], EXEC_SUFFIXES, &path, X_OK); 213 locate_file (Vexec_path, args[0], EXEC_SUFFIXES, &path, X_OK);
214 214
239 UNGCPRO; 239 UNGCPRO;
240 } 240 }
241 241
242 if (nargs >= 2 && ! NILP (args[1])) 242 if (nargs >= 2 && ! NILP (args[1]))
243 { 243 {
244 infile = Fexpand_file_name (args[1], 244 infile = Fexpand_file_name (args[1], current_buffer->directory);
245 current_buffer->directory);
246 CHECK_STRING (infile); 245 CHECK_STRING (infile);
247 } 246 }
248 else 247 else
249 infile = build_string (NULL_DEVICE); 248 infile = build_string (NULL_DEVICE);
250 249
285 else 284 else
286 buffer = Qnil; 285 buffer = Qnil;
287 286
288 display = ((nargs >= 4) ? args[3] : Qnil); 287 display = ((nargs >= 4) ? args[3] : Qnil);
289 288
290 /* From here we assume we won't GC (unless an error is signalled). */ 289 /* From here we assume we won't GC (unless an error is signaled). */
291 { 290 {
292 REGISTER int i; 291 REGISTER int i;
293 for (i = 4; i < nargs; i++) 292 for (i = 4; i < nargs; i++)
294 { 293 {
295 CHECK_STRING (args[i]); 294 CHECK_STRING (args[i]);
296 new_argv[i - 3] = (char *) string_data (XSTRING (args[i])); 295 new_argv[i - 3] = (char *) XSTRING_DATA (args[i]);
297 } 296 }
298 /* Program name is first command arg */ 297 /* Program name is first command arg */
299 new_argv[0] = (char *) string_data (XSTRING (args[0])); 298 new_argv[0] = (char *) XSTRING_DATA (args[0]);
300 new_argv[i - 3] = 0; 299 new_argv[i - 3] = 0;
301 } 300 }
302 301
303 filefd = open ((char *) string_data (XSTRING (infile)), O_RDONLY, 0); 302 filefd = open ((char *) XSTRING_DATA (infile), O_RDONLY, 0);
304 if (filefd < 0) 303 if (filefd < 0)
305 { 304 {
306 report_file_error ("Opening process input file", 305 report_file_error ("Opening process input file",
307 Fcons (infile, Qnil)); 306 Fcons (infile, Qnil));
308 } 307 }
311 { 310 {
312 close (filefd); 311 close (filefd);
313 report_file_error ("Searching for program", 312 report_file_error ("Searching for program",
314 Fcons (args[0], Qnil)); 313 Fcons (args[0], Qnil));
315 } 314 }
316 new_argv[0] = (char *) string_data (XSTRING (path)); 315 new_argv[0] = (char *) XSTRING_DATA (path);
317 316
318 #ifdef MSDOS 317 #ifdef MSDOS
319 /* These vars record information from process termination. 318 /* These vars record information from process termination.
320 Clear them now before process can possibly terminate, 319 Clear them now before process can possibly terminate,
321 to avoid timing error if process terminates soon. */ 320 to avoid timing error if process terminates soon. */
340 { 339 {
341 close (filefd); 340 close (filefd);
342 report_file_error ("Opening process output file", 341 report_file_error ("Opening process output file",
343 Fcons (tempfile, Qnil)); 342 Fcons (tempfile, Qnil));
344 } 343 }
345 #endif 344 #endif /* MSDOS */
346 345
347 #ifndef MSDOS 346 #ifndef MSDOS
348 if (INTP (buffer)) 347 if (INTP (buffer))
349 { 348 {
350 fd[1] = open (NULL_DEVICE, O_WRONLY, 0); 349 fd[1] = open (NULL_DEVICE, O_WRONLY, 0);
406 /* when performance monitoring is on, turn it off before the vfork(), 405 /* when performance monitoring is on, turn it off before the vfork(),
407 as the child has no handler for the signal -- when back in the 406 as the child has no handler for the signal -- when back in the
408 parent process, turn it back on if it was really on when you "turned 407 parent process, turn it back on if it was really on when you "turned
409 it off" */ 408 it off" */
410 int logging_on = cadillac_stop_logging (); 409 int logging_on = cadillac_stop_logging ();
411 #endif 410 #endif /* EMACS_BTL */
412 411
413 env = environ; 412 env = environ;
414 413
415 /* Record that we're about to create a synchronous process. */ 414 /* Record that we're about to create a synchronous process. */
416 synch_process_alive = 1; 415 synch_process_alive = 1;
439 if (NILP (error_file)) 438 if (NILP (error_file))
440 fd_error = open (NULL_DEVICE, O_WRONLY); 439 fd_error = open (NULL_DEVICE, O_WRONLY);
441 else if (STRINGP (error_file)) 440 else if (STRINGP (error_file))
442 { 441 {
443 #ifdef DOS_NT 442 #ifdef DOS_NT
444 fd_error = open (string_data (XSTRING (error_file)), 443 fd_error = open (XSTRING_DATA (error_file),
445 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, 444 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
446 S_IREAD | S_IWRITE); 445 S_IREAD | S_IWRITE);
447 #else /* not DOS_NT */ 446 #else /* not DOS_NT */
448 fd_error = 447 fd_error =
449 creat ((CONST char *) string_data (XSTRING (error_file)), 0666); 448 creat ((CONST char *) XSTRING_DATA (error_file), 0666);
450 #endif /* not DOS_NT */ 449 #endif /* not DOS_NT */
451 } 450 }
452 451
453 if (fd_error < 0) 452 if (fd_error < 0)
454 { 453 {
476 Buchholz observed this problem running a subprocess 475 Buchholz observed this problem running a subprocess
477 that used zsh to call gzip to uncompress an info 476 that used zsh to call gzip to uncompress an info
478 file. */ 477 file. */
479 disconnect_controlling_terminal (); 478 disconnect_controlling_terminal ();
480 child_setup (filefd, fd1, fd_error, new_argv, 479 child_setup (filefd, fd1, fd_error, new_argv,
481 (char *) string_data (XSTRING (current_dir))); 480 (char *) XSTRING_DATA (current_dir));
482 } 481 }
483 #ifdef EMACS_BTL 482 #ifdef EMACS_BTL
484 else if (logging_on) 483 else if (logging_on)
485 cadillac_start_logging (); 484 cadillac_start_logging ();
486 #endif 485 #endif
514 #if defined (NO_SUBPROCESSES) 513 #if defined (NO_SUBPROCESSES)
515 /* If Emacs has been built with asynchronous subprocess support, 514 /* If Emacs has been built with asynchronous subprocess support,
516 we don't need to do this, I think because it will then have 515 we don't need to do this, I think because it will then have
517 the facilities for handling SIGCHLD. */ 516 the facilities for handling SIGCHLD. */
518 wait_without_blocking (); 517 wait_without_blocking ();
519 #endif 518 #endif /* NO_SUBPROCESSES */
520 return Qnil; 519 return Qnil;
521 } 520 }
522 521
523 { 522 {
524 int nread; 523 int nread;
533 #ifdef MSDOS 532 #ifdef MSDOS
534 /* MSDOS needs different cleanup information. */ 533 /* MSDOS needs different cleanup information. */
535 record_unwind_protect (call_process_cleanup, 534 record_unwind_protect (call_process_cleanup,
536 Fcons (make_int (fd[0]), 535 Fcons (make_int (fd[0]),
537 build_string (tempfile))); 536 build_string (tempfile)));
538 #else 537 #else /* not MSDOS */
539 record_unwind_protect (call_process_cleanup, 538 record_unwind_protect (call_process_cleanup,
540 Fcons (make_int (fd[0]), make_int (pid))); 539 Fcons (make_int (fd[0]), make_int (pid)));
541 #endif /* not MSDOS */ 540 #endif /* not MSDOS */
542 541
543 /* FSFmacs calls Fset_buffer() here. We don't have to because 542 /* FSFmacs calls Fset_buffer() here. We don't have to because
731 (CONSP (tem) 730 (CONSP (tem)
732 && STRINGP (XCAR (tem))); 731 && STRINGP (XCAR (tem)));
733 tem = XCDR (tem)) 732 tem = XCDR (tem))
734 { 733 {
735 char **ep = env; 734 char **ep = env;
736 char *string = (char *) string_data (XSTRING (XCAR (tem))); 735 char *string = (char *) XSTRING_DATA (XCAR (tem));
737 /* See if this string duplicates any string already in the env. 736 /* See if this string duplicates any string already in the env.
738 If so, don't put it in. 737 If so, don't put it in.
739 When an env var has multiple definitions, 738 When an env var has multiple definitions,
740 we keep the definition that comes first in process-environment. */ 739 we keep the definition that comes first in process-environment. */
741 for (; ep != new_env; ep++) 740 for (; ep != new_env; ep++)
871 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) 870 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
872 { 871 {
873 Lisp_Object entry = XCAR (scan); 872 Lisp_Object entry = XCAR (scan);
874 873
875 if (STRINGP (entry) 874 if (STRINGP (entry)
876 && string_length (XSTRING (entry)) > varlen 875 && XSTRING_LENGTH (entry) > varlen
877 && string_byte (XSTRING (entry), varlen) == '=' 876 && XSTRING_BYTE (entry, varlen) == '='
878 #ifdef WINDOWSNT 877 #ifdef WINDOWSNT
879 /* NT environment variables are case insensitive. */ 878 /* NT environment variables are case insensitive. */
880 && ! memicmp (string_data (XSTRING (entry)), var, varlen) 879 && ! memicmp (XSTRING_DATA (entry), var, varlen)
881 #else /* not WINDOWSNT */ 880 #else /* not WINDOWSNT */
882 && ! memcmp (string_data (XSTRING (entry)), var, varlen) 881 && ! memcmp (XSTRING_DATA (entry), var, varlen)
883 #endif /* not WINDOWSNT */ 882 #endif /* not WINDOWSNT */
884 ) 883 )
885 { 884 {
886 *value = string_data (XSTRING (entry)) + (varlen + 1); 885 *value = XSTRING_DATA (entry) + (varlen + 1);
887 *valuelen = string_length (XSTRING (entry)) - (varlen + 1); 886 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1);
888 return 1; 887 return 1;
889 } 888 }
890 } 889 }
891 890
892 return 0; 891 return 0;
905 Lisp_Object v = Qnil; 904 Lisp_Object v = Qnil;
906 struct gcpro gcpro1; 905 struct gcpro gcpro1;
907 906
908 CHECK_STRING (var); 907 CHECK_STRING (var);
909 GCPRO1 (v); 908 GCPRO1 (v);
910 if (getenv_internal (string_data (XSTRING (var)), 909 if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var),
911 string_length (XSTRING (var)),
912 &value, &valuelen)) 910 &value, &valuelen))
913 v = make_string (value, valuelen); 911 v = make_string (value, valuelen);
914 if (!NILP (interactivep)) 912 if (!NILP (interactivep))
915 { 913 {
916 if (NILP (v)) 914 if (NILP (v))
917 message ("%s not defined in environment", 915 message ("%s not defined in environment", XSTRING_DATA (var));
918 string_data (XSTRING (var)));
919 else 916 else
920 message ("\"%s\"", value); 917 message ("\"%s\"", value);
921 } 918 }
922 RETURN_UNGCPRO (v); 919 RETURN_UNGCPRO (v);
923 } 920 }
960 */ 957 */
961 #ifndef CANNOT_DUMP 958 #ifndef CANNOT_DUMP
962 if (!initialized) 959 if (!initialized)
963 { 960 {
964 Vdata_directory = Qnil; 961 Vdata_directory = Qnil;
965 Vdoc_directory = Qnil; 962 Vdoc_directory = Qnil;
966 Vexec_path = Qnil; 963 Vexec_path = Qnil;
967 } 964 }
968 else 965 else
969 #endif 966 #endif
970 { 967 {
971 char *data_dir = egetenv ("EMACSDATA"); 968 char *data_dir = egetenv ("EMACSDATA");
972 char *doc_dir = egetenv ("EMACSDOC"); 969 char *doc_dir = egetenv ("EMACSDOC");
973 970
974 #ifdef PATH_DATA 971 #ifdef PATH_DATA
975 if (!data_dir) 972 if (!data_dir)
976 data_dir = (char *) PATH_DATA; 973 data_dir = (char *) PATH_DATA;
977 #endif 974 #endif
1013 Vexec_path); 1010 Vexec_path);
1014 1011
1015 if (!NILP (Vexec_directory)) 1012 if (!NILP (Vexec_directory))
1016 { 1013 {
1017 tempdir = Fdirectory_file_name (Vexec_directory); 1014 tempdir = Fdirectory_file_name (Vexec_directory);
1018 if (access ((char *) string_data (XSTRING (tempdir)), 0) < 0) 1015 if (access ((char *) XSTRING_DATA (tempdir), 0) < 0)
1019 { 1016 {
1020 /* If the hard-coded path is bogus, fail silently. 1017 /* If the hard-coded path is bogus, fail silently.
1021 This will allow the normal heuristics to make an attempt. */ 1018 This will allow the normal heuristics to make an attempt. */
1022 #if 0 1019 #if 0
1023 warn_when_safe 1020 warn_when_safe
1024 (Qpath, Qwarning, 1021 (Qpath, Qwarning,
1025 "Warning: machine-dependent data dir (%s) does not exist.\n", 1022 "Warning: machine-dependent data dir (%s) does not exist.\n",
1026 string_data (XSTRING (Vexec_directory))); 1023 XSTRING_DATA (Vexec_directory));
1027 #else 1024 #else
1028 Vexec_directory = Qnil; 1025 Vexec_directory = Qnil;
1029 #endif 1026 #endif
1030 } 1027 }
1031 } 1028 }
1032 1029
1033 if (!NILP (Vdata_directory)) 1030 if (!NILP (Vdata_directory))
1034 { 1031 {
1035 tempdir = Fdirectory_file_name (Vdata_directory); 1032 tempdir = Fdirectory_file_name (Vdata_directory);
1036 if (access ((char *) string_data (XSTRING (tempdir)), 0) < 0) 1033 if (access ((char *) XSTRING_DATA (tempdir), 0) < 0)
1037 { 1034 {
1038 /* If the hard-coded path is bogus, fail silently. 1035 /* If the hard-coded path is bogus, fail silently.
1039 This will allow the normal heuristics to make an attempt. */ 1036 This will allow the normal heuristics to make an attempt. */
1040 #if 0 1037 #if 0
1041 warn_when_safe 1038 warn_when_safe
1042 (Qpath, Qwarning, 1039 (Qpath, Qwarning,
1043 "Warning: machine-independent data dir (%s) does not exist.\n", 1040 "Warning: machine-independent data dir (%s) does not exist.\n",
1044 string_data (XSTRING (Vdata_directory))); 1041 XSTRING_DATA (Vdata_directory));
1045 #else 1042 #else
1046 Vdata_directory = Qnil; 1043 Vdata_directory = Qnil;
1047 #endif 1044 #endif
1048 } 1045 }
1049 } 1046 }