}
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
- "Return the (or, a) process associated with BUFFER.\n\
+ "Return the (or a) process associated with BUFFER.\n\
BUFFER may be a buffer or the name of one.")
(buffer)
register Lisp_Object buffer;
}
\f
DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
- "Return the status of PROCESS: a symbol, one of these:\n\
+ "Return the status of PROCESS.\n\
+The returned value is one of the following symbols:\n\
run -- for a process that is running.\n\
stop -- for a process stopped but continuable.\n\
exit -- for a process that has exited.\n\
open -- for a network stream connection that is open.\n\
closed -- for a network stream connection that is closed.\n\
nil -- if arg is a process name and no such process exists.\n\
-PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
+PROCESS may be a process, a buffer, the name of a process, or\n\
nil, indicating the current buffer's process.")
(process)
register Lisp_Object process;
DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
1, 1, 0,
"Return the buffer PROCESS is associated with.\n\
-Output from PROCESS is inserted in this buffer\n\
-unless PROCESS has a filter.")
+Output from PROCESS is inserted in this buffer unless PROCESS has a filter.")
(process)
register Lisp_Object process;
{
#if 0 /* Turned off because we don't currently record this info
in the process. Perhaps add it. */
DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
- "Return the connection type of `PROCESS'.\n\
-The value is `nil' for a pipe,\n\
-`t' or `pty' for a pty, or `stream' for a socket connection.")
+ "Return the connection type of PROCESS.\n\
+The value is nil for a pipe, t or `pty' for a pty, or `stream' for\n\
+a socket connection.")
(process)
Lisp_Object process;
{
DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
"Display a list of all processes.\n\
-\(Any processes listed as Exited or Signaled are actually eliminated\n\
-after the listing is made.)")
+Any process listed as exited or signaled is actually eliminated\n\
+after the listing is made.")
()
{
internal_with_output_to_temp_buffer ("*Process List*",
BUF_ZV_BYTE (XBUFFER (buffer)));
{
- /* Setup coding systems for communicating with the process. */
+ /* Decide coding systems for communicating with the process. Here
+ we don't setup the structure coding_system nor pay attention to
+ unibyte mode. They are done in create_process. */
+
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
struct gcpro gcpro1;
- if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
- else if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)
- || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
- /* The user will normally expect EOL conversion to take place, so
- specify `raw-text' as the decoding system; when that is not
- desired, the process coding system should be set explicitly to
- `no-conversion'. The encoding system will be updated to match
- when the EOL convention has been established, which seems
- reasonable. */
- val = Qraw_text;
- else
+ val = Vcoding_system_for_read;
+ if (NILP (val))
{
args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qstart_process;
val = XCONS (coding_systems)->car;
else if (CONSP (Vdefault_process_coding_system))
val = XCONS (Vdefault_process_coding_system)->car;
- else
- val = Qnil;
}
XPROCESS (proc)->decode_coding_system = val;
- if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
- else if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)
- || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
- val = Qnil;
- else
+ val = Vcoding_system_for_write;
+ if (NILP (val))
{
if (EQ (coding_systems, Qt))
{
val = XCONS (coding_systems)->cdr;
else if (CONSP (Vdefault_process_coding_system))
val = XCONS (Vdefault_process_coding_system)->cdr;
- else
- val = Qnil;
}
XPROCESS (proc)->encode_coding_system = val;
}
volatile int forkin, forkout;
volatile int pty_flag = 0;
extern char **environ;
+ Lisp_Object buffer = XPROCESS (process)->buffer;
inchannel = outchannel = -1;
setup_coding_system (XPROCESS (process)->decode_coding_system,
proc_decode_coding_system[inchannel]);
if (!proc_encode_coding_system[outchannel])
- proc_encode_coding_system[outchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ proc_encode_coding_system[outchannel]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
setup_coding_system (XPROCESS (process)->encode_coding_system,
proc_encode_coding_system[outchannel]);
+ if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)
+ || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
+ {
+ /* In unibyte mode, character code conversion should not take
+ place but EOL conversion should. So, setup raw-text or one
+ of the subsidiary according to the information just setup. */
+ if (!NILP (XPROCESS (process)->decode_coding_system))
+ setup_raw_text_coding_system (proc_decode_coding_system[inchannel]);
+ if (!NILP (XPROCESS (process)->encode_coding_system))
+ setup_raw_text_coding_system (proc_encode_coding_system[outchannel]);
+ }
+
if (CODING_REQUIRE_ENCODING (proc_encode_coding_system[outchannel]))
{
/* Here we encode arguments by the coding system used for
int seconds;
int useconds;
+ if (! NILP (process))
+ CHECK_PROCESS (process, 0);
+
if (! NILP (timeout_msecs))
{
CHECK_NUMBER (timeout_msecs, 2);
{
int timeout_reduced_for_timers = 0;
+#ifdef HAVE_X_WINDOWS
+ if (display_busy_cursor_p)
+ Fx_hide_busy_cursor (Qnil);
+#endif
+
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
Otherwise, do pending quit if requested. */
Therefore, if we get an error reading and errno =
EIO, just continue, because the child process has
exited and should clean itself up soon (e.g. when we
- get a SIGCHLD). */
+ get a SIGCHLD).
+
+ However, it has been known to happen that the SIGCHLD
+ got lost. So raise the signl again just in case.
+ It can't hurt. */
else if (nread == -1 && errno == EIO)
- ;
+ kill (getpid (), SIGCHLD);
#endif /* HAVE_PTYS */
/* If we can detect process termination, don't consider the process
gone just because its pipe is closed. */
Turn periodic alarms back on */
start_polling ();
#endif
+
+#ifdef HAVE_X_WINDOWS
+ if (display_busy_cursor_p)
+ if (!inhibit_busy_cursor)
+ Fx_show_busy_cursor ();
+#endif
return got_some_input;
}
/* At this point, NBYTES holds number of characters just received
(including the one in proc_buffered_char[channel]). */
- if (nbytes <= 0) return nbytes;
+ if (nbytes <= 0)
+ {
+ if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
+ return nbytes;
+ coding->mode |= CODING_MODE_LAST_BLOCK;
+ }
/* Now set NBYTES how many bytes we must decode. */
nbytes += carryover;
carryover = nbytes - coding->consumed;
if (carryover > 0)
{
- /* We must move the data carried over to the tail of
- decoding buffer. We are sure that the size of decoding
- buffer (decided by decoding_buffer_size) is large enough
- to contain them. */
- bcopy (chars + nbytes - carryover,
- (XSTRING (p->decoding_buf)->data
- + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover),
+ /* Copy the carryover bytes to the end of p->decoding_buf, to
+ be processed on the next read. Since decoding_buffer_size
+ asks for an extra amount of space beyond the maximum
+ expected for the output, there should always be sufficient
+ space for the carryover (which is by definition a sequence
+ of bytes that was not long enough to be decoded, and thus
+ has a bounded length). */
+ if (STRING_BYTES (XSTRING (p->decoding_buf))
+ < coding->produced + carryover)
+ abort ();
+ bcopy (chars + coding->consumed,
+ XSTRING (p->decoding_buf)->data
+ + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover,
carryover);
XSETINT (p->decoding_carryover, carryover);
}
: coding->produced_char);
chars_in_decoding_buf = 1;
}
-#ifdef VMS
- else if (chars_allocated)
+ else
{
- /* Although we don't have to decode the received data, we must
- move it to an area which we don't have to free. */
- if (! STRINGP (p->decoding_buf)
- || STRING_BYTES (XSTRING (p->decoding_buf)) < nbytes)
- p->decoding_buf = make_uninit_string (nbytes);
- bcopy (chars, XSTRING (p->decoding_buf)->data, nbytes);
- free (chars);
- chars = XSTRING (p->decoding_buf)->data;
+#ifdef VMS
+ if (chars_allocated)
+ {
+ /* Although we don't have to decode the received data, we
+ must move it to an area which we don't have to free. */
+ if (! STRINGP (p->decoding_buf)
+ || STRING_BYTES (XSTRING (p->decoding_buf)) < nbytes)
+ p->decoding_buf = make_uninit_string (nbytes);
+ bcopy (chars, XSTRING (p->decoding_buf)->data, nbytes);
+ free (chars);
+ chars = XSTRING (p->decoding_buf)->data;
+ chars_in_decoding_buf = 1;
+ }
+#endif
nchars = multibyte_chars_in_text (chars, nbytes);
- chars_in_decoding_buf = 1;
}
-#endif
Vlast_coding_system_used = coding->symbol;
Lisp_Object obuffer, okeymap;
Lisp_Object text;
int outer_running_asynch_code = running_asynch_code;
+ int waiting = waiting_for_user_input_p;
/* No need to gcpro these, because all we do with them later
is test them for EQness, and none of them should be a string. */
save the match data in a special nonrecursive fashion. */
running_asynch_code = 1;
- text = make_string_from_bytes (chars, nchars, nbytes);
+ /* The multibyteness of a string given to the filter is decided
+ by which coding system we used for decoding. */
+ if (coding->type == coding_type_no_conversion
+ || coding->type == coding_type_raw_text)
+ text = make_unibyte_string (chars, nbytes);
+ else
+ text = make_multibyte_string (chars, nchars, nbytes);
+
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
Fcons (proc, Fcons (text, Qnil))),
/* Handling the process output should not deactivate the mark. */
Vdeactivate_mark = odeactivate;
+ /* Restore waiting_for_user_input_p as it was
+ when we were called, in case the filter clobbered it. */
+ waiting_for_user_input_p = waiting;
+
#if 0 /* Call record_asynch_buffer_change unconditionally,
because we might have changed minor modes or other things
that affect key bindings. */
if (! (BEGV <= PT && PT <= ZV))
Fwiden ();
+ if (NILP (current_buffer->enable_multibyte_characters))
+ nchars = nbytes;
+
/* Insert before markers in case we are inserting where
the buffer's mark is, and the user's next command is Meta-y. */
if (chars_in_decoding_buf)
insert_before_markers (temp_buf, nbytes);
}
else
- insert_1_both (chars, nchars, nbytes, 0, 1, 1);
+ {
+ insert_1_both (chars, nchars, nbytes, 0, 1, 1);
+ signal_after_change (opoint, 0, PT - opoint);
+ }
set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
update_mode_lines++;
/* Remember the offset of data because a string or a buffer may
be relocated. Setting OFFSET to -1 means we don't have to
- care relocation. */
+ care about relocation. */
offset = (BUFFERP (object)
? BUF_PTR_BYTE_POS (XBUFFER (object), buf)
: (STRINGP (object)
- ? offset = buf - XSTRING (object)->data
+ ? buf - XSTRING (object)->data
: -1));
if (carryover > 0)
buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
else if (STRINGP (object))
buf = offset + XSTRING (object)->data;
- /* Now we don't have to care relocation. */
+ /* Now we don't have to care about relocation. */
offset = -1;
}
bcopy ((XSTRING (XPROCESS (proc)->encoding_buf)->data
return Qnil;
}
\f
+DEFUN ("process-running-child-p", Fprocess_running_child_p,
+ Sprocess_running_child_p, 0, 1, 0,
+ "Return t if PROCESS has given the terminal to a child.\n\
+If the operating system does not make it possible to find out,\n\
+return t unconditionally.")
+ (process)
+ Lisp_Object process;
+{
+ /* Initialize in case ioctl doesn't exist or gives an error,
+ in a way that will cause returning t. */
+ int gid = 0;
+ Lisp_Object proc;
+ struct Lisp_Process *p;
+
+ proc = get_process (process);
+ p = XPROCESS (proc);
+
+ if (!EQ (p->childp, Qt))
+ error ("Process %s is not a subprocess",
+ XSTRING (p->name)->data);
+ if (XINT (p->infd) < 0)
+ error ("Process %s is not active",
+ XSTRING (p->name)->data);
+
+#ifdef TIOCGPGRP
+ if (!NILP (p->subtty))
+ ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
+ else
+ ioctl (XINT (p->infd), TIOCGPGRP, &gid);
+#endif /* defined (TIOCGPGRP ) */
+
+ if (gid == XFASTINT (p->pid))
+ return Qnil;
+ return Qt;
+}
+\f
/* send a signal number SIGNO to PROCESS.
- CURRENT_GROUP means send to the process group that currently owns
- the terminal being used to communicate with PROCESS.
+ If CURRENT_GROUP is t, that means send to the process group
+ that currently owns the terminal being used to communicate with PROCESS.
This is used for various commands in shell mode.
+ If CURRENT_GROUP is lambda, that means send to the process group
+ that currently owns the terminal, but only if it is NOT the shell itself.
+
If NOMSG is zero, insert signal-announcements into process's buffers
right away.
the child itself heads the pgrp. */
gid = - XFASTINT (p->pid);
#endif /* ! defined (TIOCGPGRP ) */
+
+ /* If current_group is lambda, and the shell owns the terminal,
+ don't send any signal. */
+ if (EQ (current_group, Qlambda) && gid == - XFASTINT (p->pid))
+ return;
}
else
gid = - XFASTINT (p->pid);
}
DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
- "Interrupt process PROCESS. May be process or name of one.\n\
+ "Interrupt process PROCESS.\n\
PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
nil or no arg means current buffer's process.\n\
Second arg CURRENT-GROUP non-nil means send signal to\n\
the current process-group of the process's controlling terminal\n\
rather than to the process's own process group.\n\
If the process is a shell, this means interrupt current subjob\n\
-rather than the shell.")
+rather than the shell.\n\
+\n\
+If CURRENT-GROUP is `lambda', and if the shell owns the terminal,\n\
+don't send the signal.")
(process, current_group)
Lisp_Object process, current_group;
{
DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
"Make PROCESS see end-of-file in its input.\n\
-Eof comes after any text already sent to it.\n\
+EOF comes after any text already sent to it.\n\
PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
nil, indicating the current buffer's process.\n\
If PROCESS is a network connection, or is a process communicating\n\
Lisp_Object process;
{
Lisp_Object proc;
+ struct coding_system *coding;
proc = get_process (process);
+ coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
/* Make sure the process is really alive. */
if (! NILP (XPROCESS (proc)->raw_status_low))
if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+ if (CODING_REQUIRE_FLUSHING (coding))
+ {
+ coding->mode |= CODING_MODE_LAST_BLOCK;
+ send_process (proc, "", 0, Qnil);
+ }
+
#ifdef VMS
send_process (proc, "\032", 1, Qnil); /* ^z */
#else
send_process (proc, "\004", 1, Qnil);
else
{
+ int old_outfd, new_outfd;
+
#ifdef HAVE_SHUTDOWN
/* If this is a network connection, or socketpair is used
for communication with the subprocess, call shutdown to cause EOF.
#else /* not HAVE_SHUTDOWN */
close (XINT (XPROCESS (proc)->outfd));
#endif /* not HAVE_SHUTDOWN */
- XSETINT (XPROCESS (proc)->outfd, open (NULL_DEVICE, O_WRONLY));
+ new_outfd = open (NULL_DEVICE, O_WRONLY);
+ old_outfd = XINT (XPROCESS (proc)->outfd);
+
+ if (!proc_encode_coding_system[new_outfd])
+ proc_encode_coding_system[new_outfd]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ bcopy (proc_encode_coding_system[old_outfd],
+ proc_encode_coding_system[new_outfd],
+ sizeof (struct coding_system));
+ bzero (proc_encode_coding_system[old_outfd],
+ sizeof (struct coding_system));
+
+ XSETINT (XPROCESS (proc)->outfd, new_outfd);
}
#endif /* VMS */
return process;
register struct Lisp_Process *p = XPROCESS (proc);
int count = specpdl_ptr - specpdl;
int outer_running_asynch_code = running_asynch_code;
+ int waiting = waiting_for_user_input_p;
/* No need to gcpro these, because all we do with them later
is test them for EQness, and none of them should be a string. */
running_asynch_code = outer_running_asynch_code;
Vdeactivate_mark = odeactivate;
+
+ /* Restore waiting_for_user_input_p as it was
+ when we were called, in case the filter clobbered it. */
+ waiting_for_user_input_p = waiting;
+
#if 0
if (! EQ (Fcurrent_buffer (), obuffer)
|| ! EQ (current_buffer->keymap, okeymap))
\f
DEFUN ("set-process-coding-system", Fset_process_coding_system,
Sset_process_coding_system, 1, 3, 0,
- "Set coding systems of PROCESS to DECODING (input from the process) and\n\
-ENCODING (output to the process).")
+ "Set coding systems of PROCESS to DECODING and ENCODING.\n\
+DECODING will be used to decode subprocess output and ENCODING to\n\
+encode subprocess input.")
(proc, decoding, encoding)
register Lisp_Object proc, decoding, encoding;
{
}
bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+
+ Vdefault_process_coding_system
+ = (NILP (buffer_defaults.enable_multibyte_characters)
+ ? Fcons (Qraw_text, Qnil)
+ : Fcons (Qemacs_mule, Qnil));
}
void
defsubr (&Squit_process);
defsubr (&Sstop_process);
defsubr (&Scontinue_process);
+ defsubr (&Sprocess_running_child_p);
defsubr (&Sprocess_send_eof);
defsubr (&Ssignal_process);
defsubr (&Swaiting_for_user_input_p);
Lisp_Object read_kbd;
int do_display;
{
+ register int nfds;
EMACS_TIME end_time, timeout;
SELECT_TYPE waitchannels;
int xerrno;
/* What does time_limit really mean? */
if (time_limit || microsecs)
{
- if (time_limit == -1)
- /* In fact, it's zero. */
- EMACS_SET_SECS_USECS (timeout, 0, 0);
- else
- EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
-
- /* How far in the future is that? */
EMACS_GET_TIME (end_time);
+ EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
- else
- /* It's infinite. */
- EMACS_SET_SECS_USECS (timeout, 100000, 0);
/* Turn off periodic alarms (in case they are in use)
because the select emulator uses alarms. */
stop_polling ();
- for (;;)
+ while (1)
{
- int nfds;
int timeout_reduced_for_timers = 0;
/* If calling from keyboard input, do not quit
/* Compute time from now till when time limit is up */
/* Exit if already run out */
- if (time_limit > 0 || microsecs)
+ if (time_limit == -1)
+ {
+ /* -1 specified for timeout means
+ gobble output available now
+ but don't wait at all. */
+
+ EMACS_SET_SECS_USECS (timeout, 0, 0);
+ }
+ else if (time_limit || microsecs)
{
EMACS_GET_TIME (timeout);
EMACS_SUB_TIME (timeout, end_time, timeout);
if (EMACS_TIME_NEG_P (timeout))
break;
}
+ else
+ {
+ EMACS_SET_SECS_USECS (timeout, 100000, 0);
+ }
/* If our caller will not immediately handle keyboard events,
run timer events directly.
goto retry;
}
+ /* If there is unread keyboard input, also return. */
+ if (XINT (read_kbd) != 0
+ && requeued_events_pending_p ())
+ break;
+
if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
{
EMACS_TIME difference;
break;
}
+ /* If there is unread keyboard input, also return. */
+ if (XINT (read_kbd) != 0
+ && requeued_events_pending_p ())
+ break;
+
/* If wait_for_cell. check for keyboard input
but don't run any timers.
??? (It seems wrong to me to check for keyboard
HCoop / bpt / emacs.git / blobdiff