Mercurial > hg > xemacs-beta

comparison src/callproc.c @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
29 #include "lstream.h" 29 #include "lstream.h"
30 #include "paths.h" 30 #include "paths.h"
31 #include "process.h" 31 #include "process.h"
32 #include "sysdep.h" 32 #include "sysdep.h"
33 #include "window.h" 33 #include "window.h"
34 #ifdef MULE
35 #include "mule-coding.h"
36 #endif
34 37
35 #include "sysfile.h" 38 #include "sysfile.h"
36 #include "systime.h" 39 #include "systime.h"
37 #include "sysproc.h" 40 #include "sysproc.h"
38 #include "syssignal.h" /* Always include before systty.h */ 41 #include "syssignal.h" /* Always include before systty.h */
47 Lisp_Object Vbinary_process_input; 50 Lisp_Object Vbinary_process_input;
48 Lisp_Object Vbinary_process_output; 51 Lisp_Object Vbinary_process_output;
49 #endif /* DOS_NT */ 52 #endif /* DOS_NT */
50 53
51 Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory; 54 Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
52 Lisp_Object Vconfigure_info_directory, Vsite_directory; 55 Lisp_Object Vconfigure_info_directory;
53 56
54 /* The default base directory XEmacs is installed under. */ 57 /* The default base directory XEmacs is installed under. */
55 Lisp_Object Vprefix_directory; 58 Lisp_Object Vprefix_directory;
56 59
57 Lisp_Object Vshell_file_name; 60 Lisp_Object Vshell_file_name;
182 int pid; 185 int pid;
183 char buf[16384]; 186 char buf[16384];
184 char *bufptr = buf; 187 char *bufptr = buf;
185 int bufsize = 16384; 188 int bufsize = 16384;
186 int speccount = specpdl_depth (); 189 int speccount = specpdl_depth ();
187 struct gcpro gcpro1;
188 char **new_argv 190 char **new_argv
189 = (char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); 191 = (char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
190 192
191 /* File to use for stderr in the child. 193 /* File to use for stderr in the child.
192 t means use same as standard output. */ 194 t means use same as standard output. */
198 200
199 CHECK_STRING (args[0]); 201 CHECK_STRING (args[0]);
200 202
201 error_file = Qt; 203 error_file = Qt;
202 204
203 #if defined (NO_SUBPROCESSES) 205 #ifdef NO_SUBPROCESSES
204 /* Without asynchronous processes we cannot have BUFFER == 0. */ 206 /* Without asynchronous processes we cannot have BUFFER == 0. */
205 if (nargs >= 3 && !INTP (args[2])) 207 if (nargs >= 3 && !INTP (args[2]))
206 error ("Operating system cannot handle asynchronous subprocesses"); 208 error ("Operating system cannot handle asynchronous subprocesses");
207 #endif /* NO_SUBPROCESSES */ 209 #endif /* NO_SUBPROCESSES */
208 210
222 buffer's current directory. We can't just have the child check 224 buffer's current directory. We can't just have the child check
223 for an error when it does the chdir, since it's in a vfork. */ 225 for an error when it does the chdir, since it's in a vfork. */
224 226
225 GCPRO2 (current_dir, path); /* Caller gcprotects args[] */ 227 GCPRO2 (current_dir, path); /* Caller gcprotects args[] */
226 current_dir = current_buffer->directory; 228 current_dir = current_buffer->directory;
227 current_dir = Funhandled_file_name_directory (current_dir); 229 current_dir = expand_and_dir_to_file
228 current_dir = expand_and_dir_to_file (current_dir, Qnil); 230 (Funhandled_file_name_directory (current_dir), Qnil);
229 #if 0 231 #if 0
230 /* I don't know how RMS intends this crock of shit to work, but it 232 /* I don't know how RMS intends this crock of shit to work, but it
231 breaks everything in the presence of ange-ftp-visited files, so 233 breaks everything in the presence of ange-ftp-visited files, so
232 fuck it. */ 234 fuck it. */
233 if (NILP (Ffile_accessible_directory_p (current_dir))) 235 if (NILP (Ffile_accessible_directory_p (current_dir)))
237 UNGCPRO; 239 UNGCPRO;
238 } 240 }
239 241
240 if (nargs >= 2 && ! NILP (args[1])) 242 if (nargs >= 2 && ! NILP (args[1]))
241 { 243 {
242 struct gcpro gcpro1;
243 GCPRO1 (current_buffer->directory);
244 infile = Fexpand_file_name (args[1], current_buffer->directory); 244 infile = Fexpand_file_name (args[1], current_buffer->directory);
245 UNGCPRO;
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
251 GCPRO1 (infile); /* Fexpand_file_name might trash it */
252 249
253 if (nargs >= 3) 250 if (nargs >= 3)
254 { 251 {
255 buffer = args[2]; 252 buffer = args[2];
256 253
284 CHECK_BUFFER (buffer); 281 CHECK_BUFFER (buffer);
285 } 282 }
286 } 283 }
287 else 284 else
288 buffer = Qnil; 285 buffer = Qnil;
289
290 UNGCPRO;
291 286
292 display = ((nargs >= 4) ? args[3] : Qnil); 287 display = ((nargs >= 4) ? args[3] : Qnil);
293 288
294 /* From here we assume we won't GC (unless an error is signaled). */ 289 /* From here we assume we won't GC (unless an error is signaled). */
295 { 290 {
449 { 444 {
450 close (filefd); 445 close (filefd);
451 close (fd[0]); 446 close (fd[0]);
452 if (fd1 >= 0) 447 if (fd1 >= 0)
453 close (fd1); 448 close (fd1);
454 report_file_error ("Cannot open", Fcons(error_file, Qnil)); 449 report_file_error ("Cannot open", error_file);
455 } 450 }
456 451
457 fork_error = Qnil; 452 fork_error = Qnil;
458 #ifdef WINDOWSNT 453 #ifdef WINDOWSNT
459 pid = child_setup (filefd, fd1, fd_error, new_argv, current_dir); 454 pid = child_setup (filefd, fd1, fd_error, new_argv, current_dir);
504 499
505 if (INTP (buffer)) 500 if (INTP (buffer))
506 { 501 {
507 if (fd[0] >= 0) 502 if (fd[0] >= 0)
508 close (fd[0]); 503 close (fd[0]);
509 #if defined (NO_SUBPROCESSES) 504 #ifdef NO_SUBPROCESSES
510 /* If Emacs has been built with asynchronous subprocess support, 505 /* If Emacs has been built with asynchronous subprocess support,
511 we don't need to do this, I think because it will then have 506 we don't need to do this, I think because it will then have
512 the facilities for handling SIGCHLD. */ 507 the facilities for handling SIGCHLD. */
513 wait_without_blocking (); 508 wait_without_blocking ();
514 #endif /* NO_SUBPROCESSES */ 509 #endif /* NO_SUBPROCESSES */
538 /* FSFmacs calls Fset_buffer() here. We don't have to because 533 /* FSFmacs calls Fset_buffer() here. We don't have to because
539 we can insert into buffers other than the current one. */ 534 we can insert into buffers other than the current one. */
540 if (EQ (buffer, Qt)) 535 if (EQ (buffer, Qt))
541 XSETBUFFER (buffer, current_buffer); 536 XSETBUFFER (buffer, current_buffer);
542 instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT); 537 instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT);
538 #ifdef MULE
539 instream =
540 make_decoding_input_stream
541 (XLSTREAM (instream),
542 Fget_coding_system (Vprocess_input_coding_system));
543 Lstream_set_character_mode (XLSTREAM (instream));
544 #endif /* MULE */
543 GCPRO1 (instream); 545 GCPRO1 (instream);
544 while (1) 546 while (1)
545 { 547 {
546 QUIT; 548 QUIT;
547 /* Repeatedly read until we've filled as much as possible 549 /* Repeatedly read until we've filled as much as possible
655 #ifdef SET_EMACS_PRIORITY 657 #ifdef SET_EMACS_PRIORITY
656 if (emacs_priority != 0) 658 if (emacs_priority != 0)
657 nice (- emacs_priority); 659 nice (- emacs_priority);
658 #endif 660 #endif
659 661
660 #if !defined (NO_SUBPROCESSES) 662 #ifndef NO_SUBPROCESSES
661 /* Close Emacs's descriptors that this process should not have. */ 663 /* Close Emacs's descriptors that this process should not have. */
662 close_process_descs (); 664 close_process_descs ();
663 #endif /* not NO_SUBPROCESSES */ 665 #endif /* not NO_SUBPROCESSES */
664 close_load_descs (); 666 close_load_descs ();
665 667
867 { 869 {
868 Lisp_Object entry = XCAR (scan); 870 Lisp_Object entry = XCAR (scan);
869 871
870 if (STRINGP (entry) 872 if (STRINGP (entry)
871 && XSTRING_LENGTH (entry) > varlen 873 && XSTRING_LENGTH (entry) > varlen
872 && XSTRING_BYTE (entry, varlen) == '=' 874 && string_byte (XSTRING (entry), varlen) == '='
873 #ifdef WINDOWSNT 875 #ifdef WINDOWSNT
874 /* NT environment variables are case insensitive. */ 876 /* NT environment variables are case insensitive. */
875 && ! memicmp (XSTRING_DATA (entry), var, varlen) 877 && ! memicmp (XSTRING_DATA (entry), var, varlen)
876 #else /* not WINDOWSNT */ 878 #else /* not WINDOWSNT */
877 && ! memcmp (XSTRING_DATA (entry), var, varlen) 879 && ! memcmp (XSTRING_DATA (entry), var, varlen)
952 */ 954 */
953 #ifndef CANNOT_DUMP 955 #ifndef CANNOT_DUMP
954 if (!initialized) 956 if (!initialized)
955 { 957 {
956 Vdata_directory = Qnil; 958 Vdata_directory = Qnil;
957 Vsite_directory = Qnil;
958 Vdoc_directory = Qnil; 959 Vdoc_directory = Qnil;
959 Vexec_path = Qnil; 960 Vexec_path = Qnil;
960 } 961 }
961 else 962 else
962 #endif 963 #endif
963 { 964 {
964 char *data_dir = egetenv ("EMACSDATA"); 965 char *data_dir = egetenv ("EMACSDATA");
965 char *site_dir = egetenv ("EMACSSITE");
966 char *doc_dir = egetenv ("EMACSDOC"); 966 char *doc_dir = egetenv ("EMACSDOC");
967 967
968 #ifdef PATH_DATA 968 #ifdef PATH_DATA
969 if (!data_dir) 969 if (!data_dir)
970 data_dir = (char *) PATH_DATA; 970 data_dir = (char *) PATH_DATA;
971 #endif 971 #endif
972 #ifdef PATH_DOC 972 #ifdef PATH_DOC
973 if (!doc_dir) 973 if (!doc_dir)
974 doc_dir = (char *) PATH_DOC; 974 doc_dir = (char *) PATH_DOC;
975 #endif
976 #ifdef PATH_SITE
977 if (!site_dir)
978 site_dir = (char *) PATH_SITE;
979 #endif 975 #endif
980 976
981 if (data_dir) 977 if (data_dir)
982 Vdata_directory = Ffile_name_as_directory 978 Vdata_directory = Ffile_name_as_directory
983 (build_string (data_dir)); 979 (build_string (data_dir));
986 if (doc_dir) 982 if (doc_dir)
987 Vdoc_directory = Ffile_name_as_directory 983 Vdoc_directory = Ffile_name_as_directory
988 (build_string (doc_dir)); 984 (build_string (doc_dir));
989 else 985 else
990 Vdoc_directory = Qnil; 986 Vdoc_directory = Qnil;
991 if (site_dir)
992 Vsite_directory = Ffile_name_as_directory
993 (build_string (site_dir));
994 else
995 Vsite_directory = Qnil;
996 987
997 /* Check the EMACSPATH environment variable, defaulting to the 988 /* Check the EMACSPATH environment variable, defaulting to the
998 PATH_EXEC path from paths.h. */ 989 PATH_EXEC path from paths.h. */
999 Vexec_path = decode_env_path ("EMACSPATH", 990 Vexec_path = decode_env_path ("EMACSPATH",
1000 #ifdef PATH_EXEC 991 #ifdef PATH_EXEC
1045 (Qpath, Qwarning, 1036 (Qpath, Qwarning,
1046 "Warning: machine-independent data dir (%s) does not exist.\n", 1037 "Warning: machine-independent data dir (%s) does not exist.\n",
1047 XSTRING_DATA (Vdata_directory)); 1038 XSTRING_DATA (Vdata_directory));
1048 #else 1039 #else
1049 Vdata_directory = Qnil; 1040 Vdata_directory = Qnil;
1050 #endif
1051 }
1052 }
1053
1054 if (!NILP (Vsite_directory))
1055 {
1056 tempdir = Fdirectory_file_name (Vsite_directory);
1057 if (access ((char *) XSTRING_DATA (tempdir), 0) < 0)
1058 {
1059 /* If the hard-coded path is bogus, fail silently.
1060 This will allow the normal heuristics to make an attempt. */
1061 #if 0
1062 warn_when_safe
1063 (Qpath, Qwarning,
1064 "Warning: machine-independent site dir (%s) does not exist.\n",
1065 XSTRING_DATA (Vsite_directory));
1066 #else
1067 Vsite_directory = Qnil;
1068 #endif 1041 #endif
1069 } 1042 }
1070 } 1043 }
1071 1044
1072 #ifdef PATH_PREFIX 1045 #ifdef PATH_PREFIX
1155 DEFVAR_LISP ("data-directory", &Vdata_directory /* 1128 DEFVAR_LISP ("data-directory", &Vdata_directory /*
1156 Directory of architecture-independent files that come with XEmacs, 1129 Directory of architecture-independent files that come with XEmacs,
1157 intended for Emacs to use. 1130 intended for Emacs to use.
1158 */ ); 1131 */ );
1159 1132
1160 DEFVAR_LISP ("site-directory", &Vsite_directory /*
1161 Directory of architecture-independent files that do not come with XEmacs,
1162 intended for Emacs to use.
1163 */ );
1164
1165 /* FSF puts the DOC file into data-directory. They do a bunch of 1133 /* FSF puts the DOC file into data-directory. They do a bunch of
1166 contortions to attempt to put everything into the DOC file 1134 contortions to attempt to put everything into the DOC file
1167 whether the support is there or not. */ 1135 whether the support is there or not. */
1168 DEFVAR_LISP ("doc-directory", &Vdoc_directory /* 1136 DEFVAR_LISP ("doc-directory", &Vdoc_directory /*
1169 Directory containing the DOC file that comes with XEmacs. 1137 Directory containing the DOC file that comes with XEmacs.