=== modified file 'src/callproc.c' *** src/callproc.c 2011-04-14 19:34:42 +0000 --- src/callproc.c 2011-04-21 15:41:49 +0000 *************** *** 96,101 **** --- 96,103 ---- /* Nonzero if this is termination due to exit. */ static int call_process_exited; + static Lisp_Object Qcallproc_file_symbol; + static Lisp_Object Fgetenv_internal (Lisp_Object, Lisp_Object); static Lisp_Object *************** *** 156,163 **** doc: /* Call PROGRAM synchronously in separate process. The remaining arguments are optional. The program's input comes from file INFILE (nil means `/dev/null'). ! Insert output in BUFFER before point; t means current buffer; ! nil for BUFFER means discard it; 0 means discard and don't wait. BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, REAL-BUFFER says what to do with standard output, as above, while STDERR-FILE says what to do with standard error in the child. --- 158,166 ---- doc: /* Call PROGRAM synchronously in separate process. The remaining arguments are optional. The program's input comes from file INFILE (nil means `/dev/null'). ! Insert output in BUFFER before point; t means current buffer; nil for BUFFER ! means discard it; 0 means discard and don't wait; and `(:file FILE)', where ! FILE is a file name string, means that it should be written to that file. BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, REAL-BUFFER says what to do with standard output, as above, while STDERR-FILE says what to do with standard error in the child. *************** *** 196,209 **** --- 199,215 ---- /* File to use for stderr in the child. t means use same as standard output. */ Lisp_Object error_file; + Lisp_Object output_file = Qnil; #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ char *outf, *tempfile; int outfilefd; #endif + int fd_output = -1; struct coding_system process_coding; /* coding-system of process output */ struct coding_system argument_coding; /* coding-system of arguments */ /* Set to the return value of Ffind_operation_coding_system. */ Lisp_Object coding_systems; + int output_to_buffer = 1; /* Qt denotes that Ffind_operation_coding_system is not yet called. */ coding_systems = Qt; *************** *** 273,281 **** { buffer = args[2]; ! /* If BUFFER is a list, its meaning is ! (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */ ! if (CONSP (buffer)) { if (CONSP (XCDR (buffer))) { --- 279,289 ---- { buffer = args[2]; ! /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT ! FILE-FOR-STDERR), unless the first element is :file, in which case see ! the next paragraph. */ ! if (CONSP (buffer) && ! !EQ (Qcallproc_file_symbol, XCAR (buffer))) { if (CONSP (XCDR (buffer))) { *************** *** 291,296 **** --- 299,315 ---- buffer = XCAR (buffer); } + /* If the buffer is (still) a list, it might be a (:file "file") spec. */ + if (CONSP (buffer) && + CONSP (XCDR (buffer)) && + EQ (Qcallproc_file_symbol, XCAR (buffer))) + { + output_file = Fexpand_file_name (XCAR (XCDR (buffer)), + BVAR (current_buffer, directory)); + CHECK_STRING (output_file); + buffer = Qnil; + } + if (!(EQ (buffer, Qnil) || EQ (buffer, Qt) || INTEGERP (buffer))) *************** *** 318,328 **** protected by the caller, so all we really have to worry about is buffer. */ { ! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; current_dir = BVAR (current_buffer, directory); ! GCPRO4 (infile, buffer, current_dir, error_file); current_dir = Funhandled_file_name_directory (current_dir); if (NILP (current_dir)) --- 337,347 ---- protected by the caller, so all we really have to worry about is buffer. */ { ! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; current_dir = BVAR (current_buffer, directory); ! GCPRO5 (infile, buffer, current_dir, error_file, output_file); current_dir = Funhandled_file_name_directory (current_dir); if (NILP (current_dir)) *************** *** 342,347 **** --- 361,368 ---- current_dir = ENCODE_FILE (current_dir); if (STRINGP (error_file) && STRING_MULTIBYTE (error_file)) error_file = ENCODE_FILE (error_file); + if (STRINGP (output_file) && STRING_MULTIBYTE (output_file)) + output_file = ENCODE_FILE (output_file); UNGCPRO; } *************** *** 353,358 **** --- 374,399 ---- infile = DECODE_FILE (infile); report_file_error ("Opening process input file", Fcons (infile, Qnil)); } + + if (STRINGP (output_file)) + { + #ifdef DOS_NT + fd_output = emacs_open (SSDATA (output_file), + O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, + S_IREAD | S_IWRITE); + #else /* not DOS_NT */ + fd_output = creat (SSDATA (output_file), 0666); + #endif /* not DOS_NT */ + if (fd_output < 0) + { + output_file = DECODE_FILE (output_file); + report_file_error ("Opening process output file", + Fcons (output_file, Qnil)); + } + if (STRINGP (error_file) || NILP (error_file)) + output_to_buffer = 0; + } + /* Search for program; barf if not found. */ { struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; *************** *** 413,429 **** strcat (tempfile, "detmp.XXX"); mktemp (tempfile); ! outfilefd = creat (tempfile, S_IREAD | S_IWRITE); ! if (outfilefd < 0) { ! emacs_close (filefd); ! report_file_error ("Opening process output file", ! Fcons (build_string (tempfile), Qnil)); } fd[0] = filefd; fd[1] = outfilefd; #endif /* MSDOS */ ! if (INTEGERP (buffer)) fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1; else --- 454,475 ---- strcat (tempfile, "detmp.XXX"); mktemp (tempfile); ! /* If we're redirecting STDOUT to a file, this is already opened. */ ! if (fd_output < 0) { ! outfilefd = creat (tempfile, S_IREAD | S_IWRITE); ! if (outfilefd < 0) { ! emacs_close (filefd); ! report_file_error ("Opening process output file", ! Fcons (build_string (tempfile), Qnil)); ! } } + else + outfilefd = fd_output; fd[0] = filefd; fd[1] = outfilefd; #endif /* MSDOS */ ! if (INTEGERP (buffer)) fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1; else *************** *** 450,455 **** --- 496,503 ---- struct sigaction sigpipe_action; #endif + if (fd_output >= 0) + fd1 = fd_output; #if 0 /* Some systems don't have sigblock. */ mask = sigblock (sigmask (SIGCHLD)); #endif *************** *** 572,578 **** } UNBLOCK_INPUT; ! #ifdef HAVE_WORKING_VFORK /* Restore the signal state. */ sigaction (SIGPIPE, &sigpipe_action, 0); --- 620,626 ---- } UNBLOCK_INPUT; ! #ifdef HAVE_WORKING_VFORK /* Restore the signal state. */ sigaction (SIGPIPE, &sigpipe_action, 0); *************** *** 591,596 **** --- 639,646 ---- /* Close most of our fd's, but not fd[0] since we will use that to read input from. */ emacs_close (filefd); + if (fd_output >= 0) + emacs_close (fd_output); if (fd1 >= 0 && fd1 != fd_error) emacs_close (fd1); } *************** *** 673,678 **** --- 723,729 ---- immediate_quit = 1; QUIT; + if (output_to_buffer) { register EMACS_INT nread; int first = 1; *************** *** 802,808 **** #ifndef MSDOS /* Wait for it to terminate, unless it already has. */ ! wait_for_termination (pid); #endif immediate_quit = 0; --- 853,862 ---- #ifndef MSDOS /* Wait for it to terminate, unless it already has. */ ! if (output_to_buffer) ! wait_for_termination (pid); ! else ! interruptible_wait_for_termination (pid); #endif immediate_quit = 0; *************** *** 1554,1559 **** --- 1608,1616 ---- #endif staticpro (&Vtemp_file_name_pattern); + Qcallproc_file_symbol = intern_c_string (":file"); + staticpro (&Qcallproc_file_symbol); + DEFVAR_LISP ("shell-file-name", Vshell_file_name, doc: /* *File name to load inferior shells from. Initialized from the SHELL environment variable, or to a system-dependent === modified file 'src/lisp.h' *** src/lisp.h 2011-04-15 08:22:34 +0000 --- src/lisp.h 2011-04-21 15:36:57 +0000 *************** *** 3309,3314 **** --- 3309,3315 ---- extern void init_all_sys_modes (void); extern void reset_all_sys_modes (void); extern void wait_for_termination (int); + extern void interruptible_wait_for_termination (int); extern void flush_pending_output (int); extern void child_setup_tty (int); extern void setup_pty (int); === modified file 'src/sysdep.c' *** src/sysdep.c 2011-04-16 21:26:33 +0000 --- src/sysdep.c 2011-04-21 15:35:27 +0000 *************** *** 302,307 **** --- 302,320 ---- void wait_for_termination (int pid) { + wait_for_termination_1 (pid, 0); + } + + /* Like the above, but allow keyboard interruption. */ + void + interruptible_wait_for_termination (int pid) + { + wait_for_termination_1 (pid, 1); + } + + void + wait_for_termination_1 (int pid, int interruptible) + { while (1) { #if defined (BSD_SYSTEM) || defined (HPUX) *************** *** 339,344 **** --- 352,359 ---- sigsuspend (&empty_mask); #endif /* not WINDOWSNT */ #endif /* not BSD_SYSTEM, and not HPUX version >= 6 */ + if (interruptible) + QUIT; } }