From: Lars Magne Ingebrigtsen <larsi@gnus.org>
To: emacs-devel@gnu.org
Subject: Re: Redirecting standard output
Date: Thu, 21 Apr 2011 17:46:17 +0200 [thread overview]
Message-ID: <m3liz34ng6.fsf@quimbies.gnus.org> (raw)
In-Reply-To: m3tydr4ouy.fsf@quimbies.gnus.org
[-- Attachment #1: Type: text/plain, Size: 276 bytes --]
I added a interruptible_wait_for_termination function, which will
probably not work on NT, since I have no idea how to do that.
But otherwise, I think it's usable. Comments and style tips are
welcome. :-) I'm cargo-culting somewhat when it comes to Emacs C
internals...
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: callproc2.patch --]
[-- Type: text/x-diff, Size: 9703 bytes --]
=== 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;
}
}
[-- Attachment #3: Type: text/plain, Size: 103 bytes --]
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog http://lars.ingebrigtsen.no/
next prev parent reply other threads:[~2011-04-21 15:46 UTC|newest]
Thread overview: 37+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-04-20 21:19 Redirecting standard output Lars Magne Ingebrigtsen
2011-04-20 22:54 ` Stefan Monnier
2011-04-21 1:54 ` Lars Magne Ingebrigtsen
2011-04-21 6:10 ` Eli Zaretskii
2011-04-21 11:45 ` Lars Magne Ingebrigtsen
2011-04-21 13:25 ` Lars Magne Ingebrigtsen
2011-04-21 14:10 ` Eli Zaretskii
2011-04-21 15:15 ` Lars Magne Ingebrigtsen
2011-04-21 15:46 ` Lars Magne Ingebrigtsen [this message]
2011-04-21 16:15 ` Eli Zaretskii
2011-04-21 16:22 ` Lars Magne Ingebrigtsen
2011-04-21 16:24 ` Lars Magne Ingebrigtsen
2011-04-21 16:55 ` Eli Zaretskii
2011-04-21 17:05 ` Jan Djärv
2011-04-21 19:15 ` Eli Zaretskii
2011-04-21 19:19 ` Davis Herring
2011-04-21 19:31 ` Lars Magne Ingebrigtsen
2011-04-22 5:50 ` Eli Zaretskii
2011-04-23 18:46 ` Lars Magne Ingebrigtsen
2011-04-23 20:10 ` Eli Zaretskii
2011-04-24 8:30 ` Jan Djärv
2011-04-30 23:58 ` Lars Magne Ingebrigtsen
2011-05-01 0:06 ` Lars Magne Ingebrigtsen
2011-05-01 17:56 ` Andy Moreton
2011-05-07 11:34 ` Eli Zaretskii
2011-05-07 12:10 ` Eli Zaretskii
2011-05-30 17:39 ` Lars Magne Ingebrigtsen
2011-04-21 16:29 ` Glenn Morris
2011-04-21 8:27 ` Michael Albinus
2011-04-21 5:57 ` Eli Zaretskii
2011-04-21 6:28 ` Thierry Volpiatto
2011-04-21 6:41 ` Eli Zaretskii
2011-04-21 7:33 ` Thierry Volpiatto
2011-04-21 11:40 ` Lars Magne Ingebrigtsen
2011-04-21 11:58 ` Eli Zaretskii
2011-04-21 12:24 ` Lars Magne Ingebrigtsen
2011-04-21 14:25 ` Lars Magne Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m3liz34ng6.fsf@quimbies.gnus.org \
--to=larsi@gnus.org \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).