#include "commands.h"
#include "frame.h"
#include "blockinput.h"
+#include "keyboard.h"
+#include "dispextern.h"
#define max(a, b) ((a) > (b) ? (a) : (b))
#include "syswait.h"
+extern void set_waiting_for_input P_ ((EMACS_TIME *));
+
extern int errno;
extern char *strerror ();
#ifdef VMS
#include "sysselect.h"
+extern int keyboard_bit_set P_ ((SELECT_TYPE *));
+
/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object status_convert ();
+void
update_status (p)
struct Lisp_Process *p;
{
}
else
{
- *symbol = XCONS (l)->car;
- tem = XCONS (l)->cdr;
- *code = XFASTINT (XCONS (tem)->car);
- tem = XCONS (tem)->cdr;
+ *symbol = XCAR (l);
+ tem = XCDR (l);
+ *code = XFASTINT (XCAR (tem));
+ tem = XCDR (tem);
*coredump = !NILP (tem);
}
}
allocate_pty ()
{
struct stat stb;
- register c, i;
+ register int c, i;
int fd;
/* Some systems name their pseudoterminals so that there are gaps in
return val;
}
+void
remove_process (proc)
register Lisp_Object proc;
{
}
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;
update_status (p);
status = p->status;
if (CONSP (status))
- status = XCONS (status)->car;
+ status = XCAR (status);
if (NETCONN_P (process))
{
if (EQ (status, Qrun))
if (!NILP (XPROCESS (process)->raw_status_low))
update_status (XPROCESS (process));
if (CONSP (XPROCESS (process)->status))
- return XCONS (XCONS (XPROCESS (process)->status)->cdr)->car;
+ return XCAR (XCDR (XPROCESS (process)->status));
return make_number (0);
}
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;
{
CHECK_NATNUM (height, 0);
CHECK_NATNUM (width, 0);
if (set_window_size (XINT (XPROCESS (process)->infd),
- XINT (height), XINT(width)) <= 0)
+ XINT (height), XINT (width)) <= 0)
return Qnil;
else
return Qt;
}
+DEFUN ("set-process-inherit-coding-system-flag",
+ Fset_process_inherit_coding_system_flag,
+ Sset_process_inherit_coding_system_flag, 2, 2, 0,
+ "Determine whether buffer of PROCESS will inherit coding-system.\n\
+If the second argument FLAG is non-nil, then the variable\n\
+`buffer-file-coding-system' of the buffer associated with PROCESS\n\
+will be bound to the value of the coding system used to decode\n\
+the process output.\n\
+\n\
+This is useful when the coding system specified for the process buffer\n\
+leaves either the character code conversion or the end-of-line conversion\n\
+unspecified, or if the coding system used to decode the process output\n\
+is more appropriate for saving the process buffer.\n\
+\n\
+Binding the variable `inherit-process-coding-system' to non-nil before\n\
+starting the process is an alternative way of setting the inherit flag\n\
+for the process which will run.")
+ (process, flag)
+ register Lisp_Object process, flag;
+{
+ CHECK_PROCESS (process, 0);
+ XPROCESS (process)->inherit_coding_system_flag = flag;
+ return flag;
+}
+
+DEFUN ("process-inherit-coding-system-flag",
+ Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
+ 1, 1, 0,
+ "Return the value of inherit-coding-system flag for PROCESS.\n\
+If this flag is t, `buffer-file-coding-system' of the buffer\n\
+associated with PROCESS will inherit the coding system used to decode\n\
+the process output.")
+ (process)
+ register Lisp_Object process;
+{
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->inherit_coding_system_flag;
+}
+
DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
Sprocess_kill_without_query, 1, 2, 0,
"Say no query needed if PROCESS is running when Emacs is exited.\n\
#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;
{
{
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
- register struct buffer *old = current_buffer;
register struct Lisp_Process *p;
- register int state;
char tembuf[80];
XSETFASTINT (minspace, 1);
update_status (p);
symbol = p->status;
if (CONSP (p->status))
- symbol = XCONS (p->status)->car;
+ symbol = XCAR (p->status);
if (EQ (symbol, Qsignal))
if (NETCONN_P (proc))
{
sprintf (tembuf, "(network stream connection to %s)\n",
- XSTRING (XCONS (p->childp)->car)->data);
+ XSTRING (XCAR (p->childp))->data);
insert_string (tembuf);
}
else
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 (XBUFFER (buffer)),
BUF_ZV_BYTE (XBUFFER (buffer)));
- if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)
- || NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))
- {
- XPROCESS (proc)->decode_coding_system = Qnil;
- XPROCESS (proc)->encode_coding_system = Qnil;
- }
- else
- {
- /* Setup coding systems for communicating with the process. */
- /* Qt denotes we have not yet called Ffind_operation_coding_system. */
- Lisp_Object coding_systems = Qt;
- Lisp_Object val, *args2;
- struct gcpro gcpro1;
+ {
+ /* 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. */
- if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
- else if (NILP (current_buffer->enable_multibyte_characters))
- val = Qraw_text;
- else
- {
- args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
- args2[0] = Qstart_process;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
- UNGCPRO;
- if (CONSP (coding_systems))
- 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;
+ /* 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_write))
- val = Vcoding_system_for_write;
- else if (NILP (current_buffer->enable_multibyte_characters))
- val = Qnil;
- else
- {
- if (EQ (coding_systems, Qt))
- {
- args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
- args2[0] = Qstart_process;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
- GCPRO1 (proc);
- coding_systems =
- Ffind_operation_coding_system (nargs + 1, args2);
- UNGCPRO;
- }
- if (CONSP (coding_systems))
- 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;
- }
+ val = Vcoding_system_for_read;
+ if (NILP (val))
+ {
+ args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
+ args2[0] = Qstart_process;
+ for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ UNGCPRO;
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCAR (Vdefault_process_coding_system);
+ }
+ XPROCESS (proc)->decode_coding_system = val;
+
+ val = Vcoding_system_for_write;
+ if (NILP (val))
+ {
+ if (EQ (coding_systems, Qt))
+ {
+ args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
+ args2[0] = Qstart_process;
+ for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ UNGCPRO;
+ }
+ if (CONSP (coding_systems))
+ val = XCDR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCDR (Vdefault_process_coding_system);
+ }
+ XPROCESS (proc)->encode_coding_system = val;
+ }
XPROCESS (proc)->decoding_buf = make_uninit_string (0);
XPROCESS (proc)->decoding_carryover = make_number (0);
XPROCESS (proc)->encoding_buf = make_uninit_string (0);
XPROCESS (proc)->encoding_carryover = make_number (0);
+ XPROCESS (proc)->inherit_coding_system_flag
+ = (NILP (buffer) || !inherit_process_coding_system
+ ? Qnil : Qt);
+
create_process (proc, (char **) new_argv, current_dir);
return unbind_to (count, proc);
struct sigaction sighup_action;
#endif
#else /* !POSIX_SIGNALS */
+#if 0
#ifdef SIGCHLD
SIGTYPE (*sigchld)();
#endif
+#endif /* 0 */
#endif /* !POSIX_SIGNALS */
/* Use volatile to protect variables from being clobbered by longjmp. */
volatile int forkin, forkout;
volatile int pty_flag = 0;
extern char **environ;
+ Lisp_Object buffer = XPROCESS (process)->buffer;
inchannel = outchannel = -1;
}
#else /* not SKTPAIR */
{
- pipe (sv);
+ int tem;
+ tem = pipe (sv);
+ if (tem < 0)
+ report_file_error ("Creating pipe", Qnil);
inchannel = sv[0];
forkout = sv[1];
- pipe (sv);
+ tem = pipe (sv);
+ if (tem < 0)
+ {
+ close (inchannel);
+ close (forkout);
+ report_file_error ("Creating pipe", Qnil);
+ }
outchannel = sv[1];
forkin = sv[0];
}
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 size = encoding_buffer_size (coding, len);
unsigned char *buf = (unsigned char *) alloca (size);
- encode_coding (coding, new_argv[i], buf, len, size);
+ encode_coding (coding, (unsigned char *)new_argv[i], buf, len, size);
buf[coding->produced] = 0;
/* We don't have to free new_argv[i] because it points to a
Lisp string given as an argument to `start-process'. */
- new_argv[i++] = buf;
+ new_argv[i++] = (char *) buf;
}
UNGCPRO;
coding->mode &= ~CODING_MODE_LAST_BLOCK;
Lisp_Object name, buffer, host, service;
{
Lisp_Object proc;
- register int i;
+#ifndef HAVE_GETADDRINFO
struct sockaddr_in address;
struct servent *svc_info;
struct hostent *host_info_ptr, host_info;
char *(addr_list[2]);
IN_ADDR numeric_addr;
- int s, outch, inch;
- char errstring[80];
int port;
- struct hostent host_info_fixed;
+#else /* HAVE_GETADDRINFO */
+ struct addrinfo hints, *res, *lres;
+ int ret = 0;
+ int xerrno = 0;
+ char *portstring, portbuf[128];
+#endif /* HAVE_GETADDRINFO */
+ int s = -1, outch, inch;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int retry = 0;
int count = specpdl_ptr - specpdl;
+ int count1;
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
GCPRO4 (name, buffer, host, service);
CHECK_STRING (name, 0);
CHECK_STRING (host, 0);
+
+#ifdef HAVE_GETADDRINFO
+ /*
+ * SERVICE can either be a string or int.
+ * Convert to a C string for later use by getaddrinfo.
+ */
+ if (INTEGERP (service))
+ {
+ sprintf (portbuf, "%d", XINT (service));
+ portstring = portbuf;
+ }
+ else
+ {
+ CHECK_STRING (service, 0);
+ portstring = XSTRING (service)->data;
+ }
+#else /* ! HAVE_GETADDRINFO */
if (INTEGERP (service))
port = htons ((unsigned short) XINT (service));
else
error ("Unknown service \"%s\"", XSTRING (service)->data);
port = svc_info->s_port;
}
+#endif /* ! HAVE_GETADDRINFO */
+
/* Slow down polling to every ten seconds.
Some kernels have a bug which causes retrying connect to fail
#endif
#ifndef TERM
+#ifdef HAVE_GETADDRINFO
+ {
+ immediate_quit = 1;
+ QUIT;
+ memset (&hints, 0, sizeof (hints));
+ hints.ai_flags = 0;
+ hints.ai_family = AF_UNSPEC;
+ hints.ai_socktype = SOCK_STREAM;
+ hints.ai_protocol = 0;
+ ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
+ if (ret)
+ {
+ error ("%s/%s %s", XSTRING (host)->data, portstring,
+ strerror (ret));
+ }
+ immediate_quit = 0;
+ }
+
+ s = -1;
+ count1 = specpdl_ptr - specpdl;
+ record_unwind_protect (close_file_unwind, make_number (s));
+
+ for (lres = res; lres; lres = lres->ai_next)
+ {
+ s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
+ if (s < 0)
+ continue;
+
+ /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
+ when connect is interrupted. So let's not let it get interrupted.
+ Note we do not turn off polling, because polling is only used
+ when not interrupt_input, and thus not normally used on the systems
+ which have this bug. On systems which use polling, there's no way
+ to quit if polling is turned off. */
+ if (interrupt_input)
+ unrequest_sigio ();
+
+ immediate_quit = 1;
+ QUIT;
+
+ ret = connect (s, lres->ai_addr, lres->ai_addrlen);
+ if (ret == 0)
+ break;
+ close (s);
+ s = -1;
+ }
+
+ freeaddrinfo (res);
+ if (s < 0)
+ {
+ if (interrupt_input)
+ request_sigio ();
+
+ errno = xerrno;
+ report_file_error ("connection failed",
+ Fcons (host, Fcons (name, Qnil)));
+ }
+#else /* ! HAVE_GETADDRINFO */
+
while (1)
{
#ifdef TRY_AGAIN
if (s < 0)
report_file_error ("error creating socket", Fcons (name, Qnil));
+ count1 = specpdl_ptr - specpdl;
+ record_unwind_protect (close_file_unwind, make_number (s));
+
/* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
when connect is interrupted. So let's not let it get interrupted.
Note we do not turn off polling, because polling is only used
goto loop;
}
+ /* Discard the unwind protect. */
+ specpdl_ptr = specpdl + count1;
+
close (s);
if (interrupt_input)
report_file_error ("connection failed",
Fcons (host, Fcons (name, Qnil)));
}
+#endif /* ! HAVE_GETADDRINFO */
immediate_quit = 0;
+ /* Discard the unwind protect. */
+ specpdl_ptr = specpdl + count1;
+
#ifdef POLL_FOR_INPUT
unbind_to (count, Qnil);
#endif
if (inch > max_process_desc)
max_process_desc = inch;
- if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)
- || NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))
- {
- XPROCESS (proc)->decode_coding_system = Qnil;
- XPROCESS (proc)->encode_coding_system = Qnil;
- }
- else
- {
- /* Setup coding systems for communicating with the network stream. */
- struct gcpro gcpro1;
- /* Qt denotes we have not yet called Ffind_operation_coding_system. */
- Lisp_Object coding_systems = Qt;
- Lisp_Object args[5], val;
-
- if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
- else if (NILP (current_buffer->enable_multibyte_characters))
- /* We dare not decode end-of-line format by setting VAL to
- Qraw_text, because the existing Emacs Lisp libraries
- assume that they receive bare code including a sequene of
- CR LF. */
- val = Qnil;
- else
- {
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
- if (CONSP (coding_systems))
- 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;
+ {
+ /* Setup coding systems for communicating with the network stream. */
+ struct gcpro gcpro1;
+ /* Qt denotes we have not yet called Ffind_operation_coding_system. */
+ Lisp_Object coding_systems = Qt;
+ Lisp_Object args[5], val;
+
+ 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)))
+ /* We dare not decode end-of-line format by setting VAL to
+ Qraw_text, because the existing Emacs Lisp libraries
+ assume that they receive bare code including a sequene of
+ CR LF. */
+ val = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCAR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ XPROCESS (proc)->decode_coding_system = val;
- if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
- else if (NILP (current_buffer->enable_multibyte_characters))
- val = Qnil;
- else
- {
- if (EQ (coding_systems, Qt))
- {
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
- }
- if (CONSP (coding_systems))
- 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;
- }
+ if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (NILP (current_buffer->enable_multibyte_characters))
+ val = Qnil;
+ else
+ {
+ if (EQ (coding_systems, Qt))
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
+ if (CONSP (coding_systems))
+ val = XCDR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCDR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ XPROCESS (proc)->encode_coding_system = val;
+ }
if (!proc_decode_coding_system[inch])
proc_decode_coding_system[inch]
XPROCESS (proc)->encoding_buf = make_uninit_string (0);
XPROCESS (proc)->encoding_carryover = make_number (0);
+ XPROCESS (proc)->inherit_coding_system_flag
+ = (NILP (buffer) || !inherit_process_coding_system
+ ? Qnil : Qt);
+
UNGCPRO;
return proc;
}
int seconds;
int useconds;
+ if (! NILP (process))
+ CHECK_PROCESS (process, 0);
+
if (! NILP (timeout_msecs))
{
CHECK_NUMBER (timeout_msecs, 2);
static int waiting_for_user_input_p;
/* This is here so breakpoints can be put on it. */
-static
+static void
wait_reading_process_input_1 ()
{
}
before the timeout elapsed.
Otherwise, return true iff we received input from any process. */
+int
wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
int time_limit, microsecs;
Lisp_Object read_kbd;
int do_display;
{
- register int channel, nfds, m;
+ register int channel, nfds;
static SELECT_TYPE Available;
int xerrno;
Lisp_Object proc;
- EMACS_TIME timeout, end_time, garbage;
+ EMACS_TIME timeout, end_time;
SELECT_TYPE Atemp;
int wait_channel = -1;
struct Lisp_Process *wait_proc = 0;
/* If waiting for non-nil in a cell, record where. */
if (CONSP (read_kbd))
{
- wait_for_cell = &XCONS (read_kbd)->car;
+ wait_for_cell = &XCAR (read_kbd);
XSETFASTINT (read_kbd, 0);
}
{
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. */
clear_waiting_for_input ();
/* If we woke up due to SIGWINCH, actually change size now. */
- do_pending_window_change ();
+ do_pending_window_change (0);
if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
/* We wanted the full specified time, so return now. */
/* If checking input just got us a size-change event from X,
obey it now if we should. */
if (XINT (read_kbd) || wait_for_cell)
- do_pending_window_change ();
+ do_pending_window_change (0);
/* Check for data from a process. */
/* Really FIRST_PROC_DESC should be 0 on Unix,
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;
}
read_process_output_call (fun_and_args)
Lisp_Object fun_and_args;
{
- return apply1 (XCONS (fun_and_args)->car, XCONS (fun_and_args)->cdr);
+ return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
}
static Lisp_Object
The characters read are decoded according to PROC's coding-system
for decoding. */
+int
read_process_output (proc, channel)
Lisp_Object proc;
register int channel;
if (vs)
{
if (!vs->iosb[0])
- return(0); /* Really weird if it does this */
+ return (0); /* Really weird if it does this */
if (!(vs->iosb[0] & 1))
return -1; /* I/O error */
}
chars = buf;
#endif /* not VMS */
+ XSETINT (p->decoding_carryover, 0);
+
/* 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;
result = decode_coding (coding, chars, XSTRING (p->decoding_buf)->data,
nbytes, STRING_BYTES (XSTRING (p->decoding_buf)));
carryover = nbytes - coding->consumed;
+ if (carryover > 0)
+ {
+ /* 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);
+ }
/* A new coding system might be found by `decode_coding'. */
if (!EQ (p->decode_coding_system, coding->symbol))
valid memory because p->outfd will be changed once EOF is
sent to the process. */
if (NILP (p->encode_coding_system)
- && proc_encode_coding_system[p->outfd])
+ && proc_encode_coding_system[XINT (p->outfd)])
{
p->encode_coding_system = coding->symbol;
setup_coding_system (coding->symbol,
- proc_encode_coding_system[p->outfd]);
+ proc_encode_coding_system[XINT (p->outfd)]);
}
}
: 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;
- carryover = 0;
}
-#endif
- XSETINT (p->decoding_carryover, carryover);
Vlast_coding_system_used = coding->symbol;
+ /* If the caller required, let the process associated buffer
+ inherit the coding-system used to decode the process output. */
+ if (! NILP (p->inherit_coding_system_flag)
+ && !NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
+ {
+ struct buffer *prev_buf = current_buffer;
+
+ Fset_buffer (p->buffer);
+ call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
+ make_number (nbytes));
+ set_buffer_internal (prev_buf);
+ }
+
/* Read and dispose of the process output. */
outstream = p->filter;
if (!NILP (outstream))
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++;
being encoded. Should we store them in a buffer to prepend them to
the data send later? */
+void
send_process (proc, buf, len, object)
volatile Lisp_Object proc;
unsigned char *buf;
if (CODING_REQUIRE_ENCODING (coding))
{
int require = encoding_buffer_size (coding, len);
- int offset, dummy;
+ int offset;
unsigned char *temp_buf = NULL;
/* 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
{
int this = len;
SIGTYPE (*old_sigpipe)();
- int flush_pty = 0;
/* Decide how much data we can send in one batch.
Long lines need to be split into multiple batches. */
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;
{
Lisp_Object tail, proc;
- for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
{
- proc = XCONS (XCONS (tail)->car)->cdr;
+ proc = XCDR (XCAR (tail));
if (GC_PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
/* Find the process that signaled us, and record its status. */
p = 0;
- for (tail = Vprocess_alist; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
- proc = XCONS (XCONS (tail)->car)->cdr;
+ proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
break;
/* Look for an asynchronous process whose pid hasn't been filled
in yet. */
if (p == 0)
- for (tail = Vprocess_alist; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
- proc = XCONS (XCONS (tail)->car)->cdr;
+ proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
if (INTEGERP (p->pid) && XINT (p->pid) == -1)
break;
exec_sentinel_unwind (data)
Lisp_Object data;
{
- XPROCESS (XCONS (data)->car)->sentinel = XCONS (data)->cdr;
+ XPROCESS (XCAR (data))->sentinel = XCDR (data);
return Qnil;
}
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))
/* If process is terminated, deactivate it or delete it. */
symbol = p->status;
if (CONSP (p->status))
- symbol = XCONS (p->status)->car;
+ symbol = XCAR (p->status);
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
|| EQ (symbol, Qclosed))
\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;
{
return 0;
}
\f
+void
init_process ()
{
register int i;
}
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
syms_of_process ()
{
Qprocessp = intern ("processp");
defsubr (&Sset_process_sentinel);
defsubr (&Sprocess_sentinel);
defsubr (&Sset_process_window_size);
+ defsubr (&Sset_process_inherit_coding_system_flag);
+ defsubr (&Sprocess_inherit_coding_system_flag);
defsubr (&Sprocess_kill_without_query);
defsubr (&Sprocess_contact);
defsubr (&Slist_processes);
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);
#include "lisp.h"
#include "systime.h"
+#include "charset.h"
+#include "coding.h"
#include "termopts.h"
#include "sysselect.h"
Lisp_Object read_kbd;
int do_display;
{
+ register int nfds;
EMACS_TIME end_time, timeout;
SELECT_TYPE waitchannels;
int xerrno;
/* If waiting for non-nil in a cell, record where. */
if (CONSP (read_kbd))
{
- wait_for_cell = &XCONS (read_kbd)->car;
+ wait_for_cell = &XCAR (read_kbd);
XSETFASTINT (read_kbd, 0);
}
/* 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;
clear_waiting_for_input ();
/* If we woke up due to SIGWINCH, actually change size now. */
- do_pending_window_change ();
+ do_pending_window_change (0);
if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
/* We waited the full specified time, so return now. */
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
return Qnil;
}
+DEFUN ("process-inherit-coding-system-flag",
+ Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
+ 1, 1, 0,
+ /* Don't confuse make-docfile by having two doc strings for this function.
+ make-docfile does not pay attention to #if, for good reason! */
+ 0)
+ (process)
+ register Lisp_Object process;
+{
+ /* Ignore the argument and return the value of
+ inherit-process-coding-system. */
+ return inherit_process_coding_system ? Qt : Qnil;
+}
+
/* Kill all processes associated with `buffer'.
If `buffer' is nil, kill all processes.
Since we have no subprocesses, this does nothing. */
+void
kill_buffer_processes (buffer)
Lisp_Object buffer;
{
}
+void
init_process ()
{
}
+void
syms_of_process ()
{
defsubr (&Sget_buffer_process);
+ defsubr (&Sprocess_inherit_coding_system_flag);
}
\f
HCoop / bpt / emacs.git / blobdiff