#include <config.h>
#include <signal.h>
#ifdef subprocesses
#include <stdio.h>
#include <errno.h>
#include <setjmp.h>
#include <sys/types.h>
#include <sys/file.h>
#include <sys/stat.h>
#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#if defined(WINDOWSNT) || defined(UNIX98_PTYS)
#include <stdlib.h>
#include <fcntl.h>
#endif
#ifdef HAVE_SOCKETS
#include <sys/socket.h>
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#ifdef NEED_NET_ERRNO_H
#include <net/errno.h>
#endif
#if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
#if !defined (AF_LOCAL) && defined (AF_UNIX)
#define AF_LOCAL AF_UNIX
#endif
#ifdef AF_LOCAL
#define HAVE_LOCAL_SOCKETS
#include <sys/un.h>
#endif
#endif
#endif
#ifdef TERM
#include <client.h>
#endif
#ifdef HAVE_BROKEN_INET_ADDR
#define IN_ADDR struct in_addr
#define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
#else
#define IN_ADDR unsigned long
#define NUMERIC_ADDR_ERROR (numeric_addr == -1)
#endif
#if defined(BSD_SYSTEM) || defined(STRIDE)
#include <sys/ioctl.h>
#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
#include <fcntl.h>
#endif
#endif
#ifdef BROKEN_O_NONBLOCK
#undef O_NONBLOCK
#endif
#ifdef NEED_BSDTTY
#include <bsdtty.h>
#endif
#ifdef HAVE_SOCKETS
#if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
#ifndef SIOCGIFADDR
#include <sys/ioctl.h>
#endif
#include <net/if.h>
#endif
#endif
#ifdef IRIS
#include <sys/sysmacros.h>
#endif
#ifdef HAVE_SYS_WAIT
#include <sys/wait.h>
#endif
#ifdef WINDOWSNT
# ifdef AF_INET6
# undef AF_INET6
# endif
#endif
#include "lisp.h"
#include "systime.h"
#include "systty.h"
#include "window.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "process.h"
#include "termhooks.h"
#include "termopts.h"
#include "commands.h"
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
#include "dispextern.h"
#include "composite.h"
#include "atimer.h"
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
Lisp_Object Qlocal, Qipv4, Qdatagram;
#ifdef AF_INET6
Lisp_Object Qipv6;
#endif
Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
Lisp_Object QClocal, QCremote, QCcoding;
Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
Lisp_Object QCfilter_multibyte;
Lisp_Object Qlast_nonmenu_event;
extern Lisp_Object QCfamily, QCfilter;
extern Lisp_Object QCfamily;
extern Lisp_Object QCfilter;
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
#define NETCONN1_P(p) (GC_CONSP ((p)->childp))
#else
#define NETCONN_P(p) 0
#define NETCONN1_P(p) 0
#endif
#ifdef VMS
#define FIRST_PROC_DESC 1
#else
#define FIRST_PROC_DESC 3
#endif
#if !defined (SIGCHLD) && defined (SIGCLD)
#define SIGCHLD SIGCLD
#endif
#include "syssignal.h"
#include "syswait.h"
extern char *get_operating_system_release ();
#ifndef USE_CRT_DLL
extern int errno;
#endif
#ifdef VMS
extern char *sys_errlist[];
#endif
#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif
static Lisp_Object Vprocess_connection_type;
#ifdef SKTPAIR
#ifndef HAVE_SOCKETS
#include <sys/socket.h>
#endif
#endif
int process_tick;
int update_tick;
#ifdef BROKEN_NON_BLOCKING_CONNECT
#undef NON_BLOCKING_CONNECT
#else
#ifndef NON_BLOCKING_CONNECT
#ifdef HAVE_SOCKETS
#ifdef HAVE_SELECT
#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
#if defined (O_NONBLOCK) || defined (O_NDELAY)
#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
#define NON_BLOCKING_CONNECT
#endif
#endif
#endif
#endif
#endif
#endif
#endif
#ifdef BROKEN_DATAGRAM_SOCKETS
#undef DATAGRAM_SOCKETS
#else
#ifndef DATAGRAM_SOCKETS
#ifdef HAVE_SOCKETS
#if defined (HAVE_SELECT) || defined (FIONREAD)
#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
#define DATAGRAM_SOCKETS
#endif
#endif
#endif
#endif
#endif
#ifdef TERM
#undef NON_BLOCKING_CONNECT
#undef DATAGRAM_SOCKETS
#endif
#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
#ifdef EMACS_HAS_USECS
#define ADAPTIVE_READ_BUFFERING
#endif
#endif
#ifdef ADAPTIVE_READ_BUFFERING
#define READ_OUTPUT_DELAY_INCREMENT 10000
#define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
static int process_output_delay_count;
static int process_output_skip;
static Lisp_Object Vprocess_adaptive_read_buffering;
#else
#define process_output_delay_count 0
#endif
#include "sysselect.h"
static int keyboard_bit_set P_ ((SELECT_TYPE *));
static void deactivate_process P_ ((Lisp_Object));
static void status_notify P_ ((struct Lisp_Process *));
static int read_process_output P_ ((Lisp_Object, int));
#ifdef HAVE_WINDOW_SYSTEM
#define POLL_FOR_INPUT
#endif
static Lisp_Object get_process ();
static void exec_sentinel ();
extern EMACS_TIME timer_check ();
extern int timers_run;
static SELECT_TYPE input_wait_mask;
static SELECT_TYPE non_keyboard_wait_mask;
static SELECT_TYPE non_process_wait_mask;
#ifdef NON_BLOCKING_CONNECT
static SELECT_TYPE connect_wait_mask;
static int num_pending_connects;
#define IF_NON_BLOCKING_CONNECT(s) s
#else
#define IF_NON_BLOCKING_CONNECT(s)
#endif
static int max_process_desc;
static int max_keyboard_desc;
static int delete_exited_processes;
Lisp_Object chan_process[MAXDESC];
Lisp_Object Vprocess_alist;
int proc_buffered_char[MAXDESC];
static struct coding_system *proc_decode_coding_system[MAXDESC];
static struct coding_system *proc_encode_coding_system[MAXDESC];
#ifdef DATAGRAM_SOCKETS
struct sockaddr_and_len {
struct sockaddr *sa;
int len;
} datagram_address[MAXDESC];
#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
#else
#define DATAGRAM_CHAN_P(chan) (0)
#define DATAGRAM_CONN_P(proc) (0)
#endif
static int pty_max_bytes;
int inhibit_sentinels;
#ifdef HAVE_PTYS
#ifdef HAVE_PTY_H
#include <pty.h>
#endif
static char pty_name[24];
#endif
static Lisp_Object status_convert ();
static void
update_status (p)
struct Lisp_Process *p;
{
union { int i; WAITTYPE wt; } u;
eassert (p->raw_status_new);
u.i = p->raw_status;
p->status = status_convert (u.wt);
p->raw_status_new = 0;
}
static Lisp_Object
status_convert (w)
WAITTYPE w;
{
if (WIFSTOPPED (w))
return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
else if (WIFEXITED (w))
return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
WCOREDUMP (w) ? Qt : Qnil));
else if (WIFSIGNALED (w))
return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
WCOREDUMP (w) ? Qt : Qnil));
else
return Qrun;
}
static void
decode_status (l, symbol, code, coredump)
Lisp_Object l;
Lisp_Object *symbol;
int *code;
int *coredump;
{
Lisp_Object tem;
if (SYMBOLP (l))
{
*symbol = l;
*code = 0;
*coredump = 0;
}
else
{
*symbol = XCAR (l);
tem = XCDR (l);
*code = XFASTINT (XCAR (tem));
tem = XCDR (tem);
*coredump = !NILP (tem);
}
}
static Lisp_Object
status_message (p)
struct Lisp_Process *p;
{
Lisp_Object status = p->status;
Lisp_Object symbol;
int code, coredump;
Lisp_Object string, string2;
decode_status (status, &symbol, &code, &coredump);
if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
{
char *signame;
synchronize_system_messages_locale ();
signame = strsignal (code);
if (signame == 0)
signame = "unknown";
string = build_string (signame);
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
SSET (string, 0, DOWNCASE (SREF (string, 0)));
return concat2 (string, string2);
}
else if (EQ (symbol, Qexit))
{
if (NETCONN1_P (p))
return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
if (code == 0)
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
return concat3 (build_string ("exited abnormally with code "),
string, string2);
}
else if (EQ (symbol, Qfailed))
{
string = Fnumber_to_string (make_number (code));
string2 = build_string ("\n");
return concat3 (build_string ("failed with code "),
string, string2);
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
}
#ifdef HAVE_PTYS
static int
allocate_pty ()
{
register int c, i;
int fd;
#ifdef PTY_ITERATION
PTY_ITERATION
#else
for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
for (i = 0; i < 16; i++)
#endif
{
struct stat stb;
#ifdef PTY_NAME_SPRINTF
PTY_NAME_SPRINTF
#else
sprintf (pty_name, "/dev/pty%c%x", c, i);
#endif
#ifdef PTY_OPEN
PTY_OPEN;
#else
{
# ifdef IRIS
*ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
if (fd < 0)
return -1;
if (fstat (fd, &stb) < 0)
return -1;
# else
{
int failed_count = 0;
if (stat (pty_name, &stb) < 0)
{
failed_count++;
if (failed_count >= 3)
return -1;
}
else
failed_count = 0;
}
# ifdef O_NONBLOCK
fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
# else
fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
# endif
# endif
}
#endif
if (fd >= 0)
{
#ifdef PTY_TTY_NAME_SPRINTF
PTY_TTY_NAME_SPRINTF
#else
sprintf (pty_name, "/dev/tty%c%x", c, i);
#endif
#ifndef UNIPLUS
if (access (pty_name, 6) != 0)
{
emacs_close (fd);
# if !defined(IRIS) && !defined(__sgi)
continue;
# else
return -1;
# endif
}
#endif
setup_pty (fd);
return fd;
}
}
return -1;
}
#endif
static Lisp_Object
make_process (name)
Lisp_Object name;
{
register Lisp_Object val, tem, name1;
register struct Lisp_Process *p;
char suffix[10];
register int i;
p = allocate_process ();
XSETINT (p->infd, -1);
XSETINT (p->outfd, -1);
XSETFASTINT (p->tick, 0);
XSETFASTINT (p->update_tick, 0);
p->pid = 0;
p->raw_status_new = 0;
p->status = Qrun;
p->mark = Fmake_marker ();
#ifdef ADAPTIVE_READ_BUFFERING
p->adaptive_read_buffering = Qnil;
XSETFASTINT (p->read_output_delay, 0);
p->read_output_skip = Qnil;
#endif
name1 = name;
for (i = 1; ; i++)
{
tem = Fget_process (name1);
if (NILP (tem)) break;
sprintf (suffix, "<%d>", i);
name1 = concat2 (name, build_string (suffix));
}
name = name1;
p->name = name;
XSETPROCESS (val, p);
Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
return val;
}
static void
remove_process (proc)
register Lisp_Object proc;
{
register Lisp_Object pair;
pair = Frassq (proc, Vprocess_alist);
Vprocess_alist = Fdelq (pair, Vprocess_alist);
deactivate_process (proc);
}
void
setup_process_coding_systems (process)
Lisp_Object process;
{
struct Lisp_Process *p = XPROCESS (process);
int inch = XINT (p->infd);
int outch = XINT (p->outfd);
if (inch < 0 || outch < 0)
return;
if (!proc_decode_coding_system[inch])
proc_decode_coding_system[inch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
setup_coding_system (p->decode_coding_system,
proc_decode_coding_system[inch]);
if (! NILP (p->filter))
{
if (NILP (p->filter_multibyte))
setup_raw_text_coding_system (proc_decode_coding_system[inch]);
}
else if (BUFFERP (p->buffer))
{
if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
setup_raw_text_coding_system (proc_decode_coding_system[inch]);
}
if (!proc_encode_coding_system[outch])
proc_encode_coding_system[outch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[outch]);
if (proc_encode_coding_system[outch]->eol_type == CODING_EOL_UNDECIDED)
proc_encode_coding_system[outch]->eol_type = system_eol_type;
}
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
doc: )
(object)
Lisp_Object object;
{
return PROCESSP (object) ? Qt : Qnil;
}
DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
doc: )
(name)
register Lisp_Object name;
{
if (PROCESSP (name))
return name;
CHECK_STRING (name);
return Fcdr (Fassoc (name, Vprocess_alist));
}
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
doc: )
(buffer)
register Lisp_Object buffer;
{
register Lisp_Object buf, tail, proc;
if (NILP (buffer)) return Qnil;
buf = Fget_buffer (buffer);
if (NILP (buf)) return Qnil;
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
proc = Fcdr (Fcar (tail));
if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
return proc;
}
return Qnil;
}
static Lisp_Object
get_process (name)
register Lisp_Object name;
{
register Lisp_Object proc, obj;
if (STRINGP (name))
{
obj = Fget_process (name);
if (NILP (obj))
obj = Fget_buffer (name);
if (NILP (obj))
error ("Process %s does not exist", SDATA (name));
}
else if (NILP (name))
obj = Fcurrent_buffer ();
else
obj = name;
if (BUFFERP (obj))
{
proc = Fget_buffer_process (obj);
if (NILP (proc))
error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
}
else
{
CHECK_PROCESS (obj);
proc = obj;
}
return proc;
}
#ifdef SIGCHLD
static Lisp_Object deleted_pid_list;
#endif
DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
register struct Lisp_Process *p;
process = get_process (process);
p = XPROCESS (process);
p->raw_status_new = 0;
if (NETCONN1_P (p))
{
p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
XSETINT (p->tick, ++process_tick);
status_notify (p);
}
else if (XINT (p->infd) >= 0)
{
#ifdef SIGCHLD
Lisp_Object symbol;
EMACS_INT pid = p->pid;
deleted_pid_list = Fcons (make_fixnum_or_float (pid),
Fdelq (Qnil, deleted_pid_list));
if (p->raw_status_new)
update_status (p);
symbol = p->status;
if (CONSP (p->status))
symbol = XCAR (p->status);
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
deleted_pid_list
= Fdelete (make_fixnum_or_float (pid), deleted_pid_list);
else
#endif
{
Fkill_process (process, Qnil);
p->status
= Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
XSETINT (p->tick, ++process_tick);
status_notify (p);
}
}
remove_process (process);
return Qnil;
}
DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
register struct Lisp_Process *p;
register Lisp_Object status;
if (STRINGP (process))
process = Fget_process (process);
else
process = get_process (process);
if (NILP (process))
return process;
p = XPROCESS (process);
if (p->raw_status_new)
update_status (p);
status = p->status;
if (CONSP (status))
status = XCAR (status);
if (NETCONN1_P (p))
{
if (EQ (status, Qexit))
status = Qclosed;
else if (EQ (p->command, Qt))
status = Qstop;
else if (EQ (status, Qrun))
status = Qopen;
}
return status;
}
DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
if (XPROCESS (process)->raw_status_new)
update_status (XPROCESS (process));
if (CONSP (XPROCESS (process)->status))
return XCAR (XCDR (XPROCESS (process)->status));
return make_number (0);
}
DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
EMACS_INT pid;
CHECK_PROCESS (process);
pid = XPROCESS (process)->pid;
return (pid ? make_fixnum_or_float (pid) : Qnil);
}
DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->name;
}
DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->command;
}
DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->tty_name;
}
DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
2, 2, 0,
doc: )
(process, buffer)
register Lisp_Object process, buffer;
{
struct Lisp_Process *p;
CHECK_PROCESS (process);
if (!NILP (buffer))
CHECK_BUFFER (buffer);
p = XPROCESS (process);
p->buffer = buffer;
if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCbuffer, buffer);
setup_process_coding_systems (process);
return buffer;
}
DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->buffer;
}
DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->mark;
}
DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
2, 2, 0,
doc: )
(process, filter)
register Lisp_Object process, filter;
{
struct Lisp_Process *p;
CHECK_PROCESS (process);
p = XPROCESS (process);
if (XINT (p->infd) >= 0)
{
if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
{
FD_CLR (XINT (p->infd), &input_wait_mask);
FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
}
else if (EQ (p->filter, Qt)
&& !EQ (p->command, Qt))
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
}
}
p->filter = filter;
if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCfilter, filter);
setup_process_coding_systems (process);
return filter;
}
DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->filter;
}
DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
2, 2, 0,
doc: )
(process, sentinel)
register Lisp_Object process, sentinel;
{
struct Lisp_Process *p;
CHECK_PROCESS (process);
p = XPROCESS (process);
p->sentinel = sentinel;
if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
return sentinel;
}
DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->sentinel;
}
DEFUN ("set-process-window-size", Fset_process_window_size,
Sset_process_window_size, 3, 3, 0,
doc: )
(process, height, width)
register Lisp_Object process, height, width;
{
CHECK_PROCESS (process);
CHECK_NATNUM (height);
CHECK_NATNUM (width);
if (XINT (XPROCESS (process)->infd) < 0
|| set_window_size (XINT (XPROCESS (process)->infd),
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,
doc: )
(process, flag)
register Lisp_Object process, flag;
{
CHECK_PROCESS (process);
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,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->inherit_coding_system_flag;
}
DEFUN ("set-process-query-on-exit-flag",
Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
2, 2, 0,
doc: )
(process, flag)
register Lisp_Object process, flag;
{
CHECK_PROCESS (process);
XPROCESS (process)->kill_without_query = Fnull (flag);
return flag;
}
DEFUN ("process-query-on-exit-flag",
Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return Fnull (XPROCESS (process)->kill_without_query);
}
#ifdef DATAGRAM_SOCKETS
Lisp_Object Fprocess_datagram_address ();
#endif
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 2, 0,
doc: )
(process, key)
register Lisp_Object process, key;
{
Lisp_Object contact;
CHECK_PROCESS (process);
contact = XPROCESS (process)->childp;
#ifdef DATAGRAM_SOCKETS
if (DATAGRAM_CONN_P (process)
&& (EQ (key, Qt) || EQ (key, QCremote)))
contact = Fplist_put (contact, QCremote,
Fprocess_datagram_address (process));
#endif
if (!NETCONN_P (process) || EQ (key, Qt))
return contact;
if (NILP (key))
return Fcons (Fplist_get (contact, QChost),
Fcons (Fplist_get (contact, QCservice), Qnil));
return Fplist_get (contact, key);
}
DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return XPROCESS (process)->plist;
}
DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
2, 2, 0,
doc: )
(process, plist)
register Lisp_Object process, plist;
{
CHECK_PROCESS (process);
CHECK_LIST (plist);
XPROCESS (process)->plist = plist;
return plist;
}
#if 0
DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
doc: )
(process)
Lisp_Object process;
{
return XPROCESS (process)->type;
}
#endif
#ifdef HAVE_SOCKETS
DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1, 2, 0,
doc: )
(address, omit_port)
Lisp_Object address, omit_port;
{
if (NILP (address))
return Qnil;
if (STRINGP (address))
return address;
if (VECTORP (address))
{
register struct Lisp_Vector *p = XVECTOR (address);
Lisp_Object args[10];
int nargs, i;
if (p->size == 4 || (p->size == 5 && !NILP (omit_port)))
{
args[0] = build_string ("%d.%d.%d.%d");
nargs = 4;
}
else if (p->size == 5)
{
args[0] = build_string ("%d.%d.%d.%d:%d");
nargs = 5;
}
else if (p->size == 8 || (p->size == 9 && !NILP (omit_port)))
{
args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
nargs = 8;
}
else if (p->size == 9)
{
args[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
nargs = 9;
}
else
return Qnil;
for (i = 0; i < nargs; i++)
{
EMACS_INT element = XINT (p->contents[i]);
if (element < 0 || element > 65535)
return Qnil;
if (nargs <= 5
&& i < 4
&& element > 255)
return Qnil;
args[i+1] = p->contents[i];
}
return Fformat (nargs+1, args);
}
if (CONSP (address))
{
Lisp_Object args[2];
args[0] = build_string ("<Family %d>");
args[1] = Fcar (address);
return Fformat (2, args);
}
return Qnil;
}
#endif
static Lisp_Object
list_processes_1 (query_only)
Lisp_Object query_only;
{
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
register struct Lisp_Process *p;
char tembuf[300];
int w_proc, w_buffer, w_tty;
int exited = 0;
Lisp_Object i_status, i_buffer, i_tty, i_command;
w_proc = 4;
w_buffer = 6;
w_tty = 0;
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
int i;
proc = Fcdr (Fcar (tail));
p = XPROCESS (proc);
if (NILP (p->childp))
continue;
if (!NILP (query_only) && !NILP (p->kill_without_query))
continue;
if (STRINGP (p->name)
&& ( i = SCHARS (p->name), (i > w_proc)))
w_proc = i;
if (!NILP (p->buffer))
{
if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
w_buffer = 8;
else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
w_buffer = i;
}
if (STRINGP (p->tty_name)
&& (i = SCHARS (p->tty_name), (i > w_tty)))
w_tty = i;
}
XSETFASTINT (i_status, w_proc + 1);
XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
if (w_tty)
{
XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1);
} else {
i_tty = Qnil;
XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
}
XSETFASTINT (minspace, 1);
set_buffer_internal (XBUFFER (Vstandard_output));
current_buffer->undo_list = Qt;
current_buffer->truncate_lines = Qt;
write_string ("Proc", -1);
Findent_to (i_status, minspace); write_string ("Status", -1);
Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
if (!NILP (i_tty))
{
Findent_to (i_tty, minspace); write_string ("Tty", -1);
}
Findent_to (i_command, minspace); write_string ("Command", -1);
write_string ("\n", -1);
write_string ("----", -1);
Findent_to (i_status, minspace); write_string ("------", -1);
Findent_to (i_buffer, minspace); write_string ("------", -1);
if (!NILP (i_tty))
{
Findent_to (i_tty, minspace); write_string ("---", -1);
}
Findent_to (i_command, minspace); write_string ("-------", -1);
write_string ("\n", -1);
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
Lisp_Object symbol;
proc = Fcdr (Fcar (tail));
p = XPROCESS (proc);
if (NILP (p->childp))
continue;
if (!NILP (query_only) && !NILP (p->kill_without_query))
continue;
Finsert (1, &p->name);
Findent_to (i_status, minspace);
if (p->raw_status_new)
update_status (p);
symbol = p->status;
if (CONSP (p->status))
symbol = XCAR (p->status);
if (EQ (symbol, Qsignal))
{
Lisp_Object tem;
tem = Fcar (Fcdr (p->status));
#ifdef VMS
if (XINT (tem) < NSIG)
write_string (sys_errlist [XINT (tem)], -1);
else
#endif
Fprinc (symbol, Qnil);
}
else if (NETCONN1_P (p))
{
if (EQ (symbol, Qexit))
write_string ("closed", -1);
else if (EQ (p->command, Qt))
write_string ("stopped", -1);
else if (EQ (symbol, Qrun))
write_string ("open", -1);
else
Fprinc (symbol, Qnil);
}
else
Fprinc (symbol, Qnil);
if (EQ (symbol, Qexit))
{
Lisp_Object tem;
tem = Fcar (Fcdr (p->status));
if (XFASTINT (tem))
{
sprintf (tembuf, " %d", (int) XFASTINT (tem));
write_string (tembuf, -1);
}
}
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed))
exited++;
Findent_to (i_buffer, minspace);
if (NILP (p->buffer))
insert_string ("(none)");
else if (NILP (XBUFFER (p->buffer)->name))
insert_string ("(Killed)");
else
Finsert (1, &XBUFFER (p->buffer)->name);
if (!NILP (i_tty))
{
Findent_to (i_tty, minspace);
if (STRINGP (p->tty_name))
Finsert (1, &p->tty_name);
}
Findent_to (i_command, minspace);
if (EQ (p->status, Qlisten))
{
Lisp_Object port = Fplist_get (p->childp, QCservice);
if (INTEGERP (port))
port = Fnumber_to_string (port);
if (NILP (port))
port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
sprintf (tembuf, "(network %s server on %s)\n",
(DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
(STRINGP (port) ? (char *)SDATA (port) : "?"));
insert_string (tembuf);
}
else if (NETCONN1_P (p))
{
Lisp_Object host = Fplist_get (p->childp, QChost);
if (!STRINGP (host))
{
host = Fplist_get (p->childp, QCservice);
if (INTEGERP (host))
host = Fnumber_to_string (host);
}
if (NILP (host))
host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
sprintf (tembuf, "(network %s connection to %s)\n",
(DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
(STRINGP (host) ? (char *)SDATA (host) : "?"));
insert_string (tembuf);
}
else
{
tem = p->command;
while (1)
{
tem1 = Fcar (tem);
Finsert (1, &tem1);
tem = Fcdr (tem);
if (NILP (tem))
break;
insert_string (" ");
}
insert_string ("\n");
}
}
if (exited)
status_notify (NULL);
return Qnil;
}
DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
doc: )
(query_only)
Lisp_Object query_only;
{
internal_with_output_to_temp_buffer ("*Process List*",
list_processes_1, query_only);
return Qnil;
}
DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
doc: )
()
{
return Fmapcar (Qcdr, Vprocess_alist);
}
static Lisp_Object start_process_unwind ();
DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
Lisp_Object buffer, name, program, proc, current_dir, tem;
#ifdef VMS
register unsigned char *new_argv;
int len;
#else
register unsigned char **new_argv;
#endif
register int i;
int count = SPECPDL_INDEX ();
buffer = args[1];
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
{
struct gcpro gcpro1, gcpro2;
current_dir = current_buffer->directory;
GCPRO2 (buffer, current_dir);
current_dir
= expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
Fcons (current_buffer->directory, Qnil));
UNGCPRO;
}
name = args[0];
CHECK_STRING (name);
program = args[2];
CHECK_STRING (program);
proc = make_process (name);
record_unwind_protect (start_process_unwind, proc);
XPROCESS (proc)->childp = Qt;
XPROCESS (proc)->plist = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->filter_multibyte
= buffer_defaults.enable_multibyte_characters;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
#ifdef ADAPTIVE_READ_BUFFERING
XPROCESS (proc)->adaptive_read_buffering = Vprocess_adaptive_read_buffering;
#endif
if (BUFFERP (buffer))
set_marker_both (XPROCESS (proc)->mark, buffer,
BUF_ZV (XBUFFER (buffer)),
BUF_ZV_BYTE (XBUFFER (buffer)));
{
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
struct gcpro gcpro1, gcpro2;
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];
GCPRO2 (proc, current_dir);
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];
GCPRO2 (proc, current_dir);
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;
}
#ifdef VMS
len = SBYTES (program) + 2;
for (i = 3; i < nargs; i++)
{
tem = args[i];
CHECK_STRING (tem);
len += SBYTES (tem) + 1;
}
new_argv = (unsigned char *) alloca (len);
strcpy (new_argv, SDATA (program));
for (i = 3; i < nargs; i++)
{
tem = args[i];
CHECK_STRING (tem);
strcat (new_argv, " ");
strcat (new_argv, SDATA (tem));
}
#else
new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
if (!IS_DIRECTORY_SEP (SREF (program, 0))
&& !(SCHARS (program) > 1
&& IS_DEVICE_SEP (SREF (program, 1))))
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
tem = Qnil;
GCPRO4 (name, program, buffer, current_dir);
openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
UNGCPRO;
if (NILP (tem))
report_file_error ("Searching for program", Fcons (program, Qnil));
tem = Fexpand_file_name (tem, Qnil);
}
else
{
if (!NILP (Ffile_directory_p (program)))
error ("Specified program for new process is a directory");
tem = program;
}
if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
&& SREF (tem, 1) == ':')
tem = Fsubstring (tem, make_number (2), Qnil);
tem = ENCODE_FILE (tem);
new_argv[0] = SDATA (tem);
for (i = 3; i < nargs; i++)
{
tem = args[i];
CHECK_STRING (tem);
if (STRING_MULTIBYTE (tem))
tem = (code_convert_string_norecord
(tem, XPROCESS (proc)->encode_coding_system, 1));
new_argv[i - 2] = SDATA (tem);
}
new_argv[i - 2] = 0;
#endif
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);
}
static Lisp_Object
start_process_unwind (proc)
Lisp_Object proc;
{
if (!PROCESSP (proc))
abort ();
if (XPROCESS (proc)->pid <= 0)
remove_process (proc);
return Qnil;
}
static void
create_process_1 (timer)
struct atimer *timer;
{
}
#if 0
#ifdef USG
#ifdef SIGCHLD
int sigchld_deferred;
SIGTYPE
create_process_sigchld ()
{
signal (SIGCHLD, create_process_sigchld);
sigchld_deferred = 1;
}
#endif
#endif
#endif
#ifndef VMS
void
create_process (process, new_argv, current_dir)
Lisp_Object process;
char **new_argv;
Lisp_Object current_dir;
{
int inchannel, outchannel;
pid_t pid;
int sv[2];
#ifdef POSIX_SIGNALS
sigset_t procmask;
sigset_t blocked;
struct sigaction sigint_action;
struct sigaction sigquit_action;
#ifdef AIX
struct sigaction sighup_action;
#endif
#else
#if 0
#ifdef SIGCHLD
SIGTYPE (*sigchld)();
#endif
#endif
#endif
volatile int forkin, forkout;
volatile int pty_flag = 0;
#ifndef USE_CRT_DLL
extern char **environ;
#endif
inchannel = outchannel = -1;
#ifdef HAVE_PTYS
if (!NILP (Vprocess_connection_type))
outchannel = inchannel = allocate_pty ();
if (inchannel >= 0)
{
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
#ifdef O_NOCTTY
forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
#else
forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
#endif
if (forkin < 0)
report_file_error ("Opening pty", Qnil);
#if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
child_setup_tty (forkout);
#endif
#else
forkin = forkout = -1;
#endif
pty_flag = 1;
}
else
#endif
#ifdef SKTPAIR
{
if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
report_file_error ("Opening socketpair", Qnil);
outchannel = inchannel = sv[0];
forkout = forkin = sv[1];
}
#else
{
int tem;
tem = pipe (sv);
if (tem < 0)
report_file_error ("Creating pipe", Qnil);
inchannel = sv[0];
forkout = sv[1];
tem = pipe (sv);
if (tem < 0)
{
emacs_close (inchannel);
emacs_close (forkout);
report_file_error ("Creating pipe", Qnil);
}
outchannel = sv[1];
forkin = sv[0];
}
#endif
#if 0
set_exclusive_use (inchannel);
set_exclusive_use (outchannel);
#endif
#if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
{
int one = 1;
ioctl (inchannel, FIONBIO, &one);
}
#endif
#ifdef O_NONBLOCK
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
#else
#ifdef O_NDELAY
fcntl (inchannel, F_SETFL, O_NDELAY);
fcntl (outchannel, F_SETFL, O_NDELAY);
#endif
#endif
chan_process[inchannel] = process;
XSETINT (XPROCESS (process)->infd, inchannel);
XSETINT (XPROCESS (process)->outfd, outchannel);
XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
XPROCESS (process)->status = Qrun;
setup_process_coding_systems (process);
#ifdef POSIX_SIGNALS
sigemptyset (&blocked);
#ifdef SIGCHLD
sigaddset (&blocked, SIGCHLD);
#endif
#ifdef HAVE_WORKING_VFORK
sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
#ifdef AIX
sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
#endif
#endif
sigprocmask (SIG_BLOCK, &blocked, &procmask);
#else
#ifdef SIGCHLD
#ifdef BSD4_1
sighold (SIGCHLD);
#else
#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
sigsetmask (sigmask (SIGCHLD));
#else
#if 0
sigchld_deferred = 0;
sigchld = signal (SIGCHLD, create_process_sigchld);
#endif
#endif
#endif
#endif
#endif
FD_SET (inchannel, &input_wait_mask);
FD_SET (inchannel, &non_keyboard_wait_mask);
if (inchannel > max_process_desc)
max_process_desc = inchannel;
XPROCESS (process)->pid = -1;
BLOCK_INPUT;
{
char **save_environ = environ;
current_dir = ENCODE_FILE (current_dir);
#ifndef WINDOWSNT
pid = vfork ();
if (pid == 0)
#endif
{
int xforkin = forkin;
int xforkout = forkout;
#if 0
sigsetmask (SIGEMPTYMASK);
#endif
#ifdef HAVE_PTYS
#ifdef HAVE_SETSID
setsid ();
if (pty_flag)
{
#ifdef TIOCSCTTY
ioctl (xforkin, TIOCSCTTY, 0);
#endif
}
#else
#ifdef USG
setpgrp ();
#endif
#endif
#if defined (HAVE_TERMIOS) && defined (LDISC1)
if (pty_flag && xforkin >= 0)
{
struct termios t;
tcgetattr (xforkin, &t);
t.c_lflag = LDISC1;
if (tcsetattr (xforkin, TCSANOW, &t) < 0)
emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
}
#else
#if defined (NTTYDISC) && defined (TIOCSETD)
if (pty_flag && xforkin >= 0)
{
int ldisc = NTTYDISC;
ioctl (xforkin, TIOCSETD, &ldisc);
}
#endif
#endif
#ifdef TIOCNOTTY
if (pty_flag)
{
int j = emacs_open ("/dev/tty", O_RDWR, 0);
ioctl (j, TIOCNOTTY, 0);
emacs_close (j);
#ifndef USG
#ifdef HAVE_SETPGID
setpgid (0, 0);
#else
setpgrp (0, 0);
#endif
#endif
}
#endif
#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
if (pty_flag)
{
#ifdef SET_CHILD_PTY_PGRP
int pgrp = getpid ();
#endif
if (xforkin >= 0)
emacs_close (xforkin);
xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
if (xforkin < 0)
{
emacs_write (1, "Couldn't open the pty terminal ", 31);
emacs_write (1, pty_name, strlen (pty_name));
emacs_write (1, "\n", 1);
_exit (1);
}
#ifdef SET_CHILD_PTY_PGRP
ioctl (xforkin, TIOCSPGRP, &pgrp);
ioctl (xforkout, TIOCSPGRP, &pgrp);
#endif
}
#endif
#ifdef SETUP_SLAVE_PTY
if (pty_flag)
{
SETUP_SLAVE_PTY;
}
#endif
#ifdef AIX
if (pty_flag)
signal (SIGHUP, SIG_DFL);
#endif
#endif
signal (SIGINT, SIG_DFL);
signal (SIGQUIT, SIG_DFL);
#ifdef POSIX_SIGNALS
sigprocmask (SIG_SETMASK, &procmask, 0);
#else
#ifdef SIGCHLD
#ifdef BSD4_1
sigrelse (SIGCHLD);
#else
#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
sigsetmask (SIGEMPTYMASK);
#else
#if 0
signal (SIGCHLD, sigchld);
#endif
#endif
#endif
#endif
#endif
#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
if (pty_flag)
child_setup_tty (xforkout);
#endif
#ifdef WINDOWSNT
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
#else
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
#endif
}
environ = save_environ;
}
UNBLOCK_INPUT;
if (pid < 0)
{
if (forkin >= 0)
emacs_close (forkin);
if (forkin != forkout && forkout >= 0)
emacs_close (forkout);
}
else
{
XPROCESS (process)->pid = pid;
#ifdef WINDOWSNT
register_child (pid, inchannel);
#endif
{
struct atimer *timer;
EMACS_TIME offset;
stop_polling ();
EMACS_SET_SECS_USECS (offset, 1, 0);
timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
if (forkin >= 0)
emacs_close (forkin);
cancel_atimer (timer);
start_polling ();
}
if (forkin != forkout && forkout >= 0)
emacs_close (forkout);
#ifdef HAVE_PTYS
if (pty_flag)
XPROCESS (process)->tty_name = build_string (pty_name);
else
#endif
XPROCESS (process)->tty_name = Qnil;
}
#ifdef POSIX_SIGNALS
#ifdef HAVE_WORKING_VFORK
sigaction (SIGINT, &sigint_action, 0);
sigaction (SIGQUIT, &sigquit_action, 0);
#ifdef AIX
sigaction (SIGHUP, &sighup_action, 0);
#endif
#endif
sigprocmask (SIG_SETMASK, &procmask, 0);
#else
#ifdef SIGCHLD
#ifdef BSD4_1
sigrelse (SIGCHLD);
#else
#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
sigsetmask (SIGEMPTYMASK);
#else
#if 0
signal (SIGCHLD, sigchld);
if (sigchld_deferred)
kill (getpid (), SIGCHLD);
#endif
#endif
#endif
#endif
#endif
if (pid < 0)
report_file_error ("Doing vfork", Qnil);
}
#endif
#ifdef HAVE_SOCKETS
static Lisp_Object
conv_sockaddr_to_lisp (sa, len)
struct sockaddr *sa;
int len;
{
Lisp_Object address;
int i;
unsigned char *cp;
register struct Lisp_Vector *p;
switch (sa->sa_family)
{
case AF_INET:
{
struct sockaddr_in *sin = (struct sockaddr_in *) sa;
len = sizeof (sin->sin_addr) + 1;
address = Fmake_vector (make_number (len), Qnil);
p = XVECTOR (address);
p->contents[--len] = make_number (ntohs (sin->sin_port));
cp = (unsigned char *)&sin->sin_addr;
break;
}
#ifdef AF_INET6
case AF_INET6:
{
struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
len = sizeof (sin6->sin6_addr)/2 + 1;
address = Fmake_vector (make_number (len), Qnil);
p = XVECTOR (address);
p->contents[--len] = make_number (ntohs (sin6->sin6_port));
for (i = 0; i < len; i++)
p->contents[i] = make_number (ntohs (ip6[i]));
return address;
}
#endif
#ifdef HAVE_LOCAL_SOCKETS
case AF_LOCAL:
{
struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
for (i = 0; i < sizeof (sockun->sun_path); i++)
if (sockun->sun_path[i] == 0)
break;
return make_unibyte_string (sockun->sun_path, i);
}
#endif
default:
len -= sizeof (sa->sa_family);
address = Fcons (make_number (sa->sa_family),
Fmake_vector (make_number (len), Qnil));
p = XVECTOR (XCDR (address));
cp = (unsigned char *) sa + sizeof (sa->sa_family);
break;
}
i = 0;
while (i < len)
p->contents[i++] = make_number (*cp++);
return address;
}
static int
get_lisp_to_sockaddr_size (address, familyp)
Lisp_Object address;
int *familyp;
{
register struct Lisp_Vector *p;
if (VECTORP (address))
{
p = XVECTOR (address);
if (p->size == 5)
{
*familyp = AF_INET;
return sizeof (struct sockaddr_in);
}
#ifdef AF_INET6
else if (p->size == 9)
{
*familyp = AF_INET6;
return sizeof (struct sockaddr_in6);
}
#endif
}
#ifdef HAVE_LOCAL_SOCKETS
else if (STRINGP (address))
{
*familyp = AF_LOCAL;
return sizeof (struct sockaddr_un);
}
#endif
else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
{
struct sockaddr *sa;
*familyp = XINT (XCAR (address));
p = XVECTOR (XCDR (address));
return p->size + sizeof (sa->sa_family);
}
return 0;
}
static void
conv_lisp_to_sockaddr (family, address, sa, len)
int family;
Lisp_Object address;
struct sockaddr *sa;
int len;
{
register struct Lisp_Vector *p;
register unsigned char *cp = NULL;
register int i;
bzero (sa, len);
if (VECTORP (address))
{
p = XVECTOR (address);
if (family == AF_INET)
{
struct sockaddr_in *sin = (struct sockaddr_in *) sa;
len = sizeof (sin->sin_addr) + 1;
i = XINT (p->contents[--len]);
sin->sin_port = htons (i);
cp = (unsigned char *)&sin->sin_addr;
sa->sa_family = family;
}
#ifdef AF_INET6
else if (family == AF_INET6)
{
struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
len = sizeof (sin6->sin6_addr) + 1;
i = XINT (p->contents[--len]);
sin6->sin6_port = htons (i);
for (i = 0; i < len; i++)
if (INTEGERP (p->contents[i]))
{
int j = XFASTINT (p->contents[i]) & 0xffff;
ip6[i] = ntohs (j);
}
sa->sa_family = family;
}
#endif
return;
}
else if (STRINGP (address))
{
#ifdef HAVE_LOCAL_SOCKETS
if (family == AF_LOCAL)
{
struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
cp = SDATA (address);
for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
sockun->sun_path[i] = *cp++;
sa->sa_family = family;
}
#endif
return;
}
else
{
p = XVECTOR (XCDR (address));
cp = (unsigned char *)sa + sizeof (sa->sa_family);
}
for (i = 0; i < len; i++)
if (INTEGERP (p->contents[i]))
*cp++ = XFASTINT (p->contents[i]) & 0xff;
}
#ifdef DATAGRAM_SOCKETS
DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
1, 1, 0,
doc: )
(process)
Lisp_Object process;
{
int channel;
CHECK_PROCESS (process);
if (!DATAGRAM_CONN_P (process))
return Qnil;
channel = XINT (XPROCESS (process)->infd);
return conv_sockaddr_to_lisp (datagram_address[channel].sa,
datagram_address[channel].len);
}
DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2, 2, 0,
doc: )
(process, address)
Lisp_Object process, address;
{
int channel;
int family, len;
CHECK_PROCESS (process);
if (!DATAGRAM_CONN_P (process))
return Qnil;
channel = XINT (XPROCESS (process)->infd);
len = get_lisp_to_sockaddr_size (address, &family);
if (datagram_address[channel].len != len)
return Qnil;
conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
return address;
}
#endif
static struct socket_options {
char *name;
int optlevel;
int optnum;
enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
} socket_options[] =
{
#ifdef SO_BINDTODEVICE
{ ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
#endif
#ifdef SO_BROADCAST
{ ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_DONTROUTE
{ ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_KEEPALIVE
{ ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_LINGER
{ ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
#endif
#ifdef SO_OOBINLINE
{ ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_PRIORITY
{ ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
#endif
#ifdef SO_REUSEADDR
{ ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
#endif
{ 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
};
static int
set_socket_option (s, opt, val)
int s;
Lisp_Object opt, val;
{
char *name;
struct socket_options *sopt;
int ret = 0;
CHECK_SYMBOL (opt);
name = (char *) SDATA (SYMBOL_NAME (opt));
for (sopt = socket_options; sopt->name; sopt++)
if (strcmp (name, sopt->name) == 0)
break;
switch (sopt->opttype)
{
case SOPT_BOOL:
{
int optval;
optval = NILP (val) ? 0 : 1;
ret = setsockopt (s, sopt->optlevel, sopt->optnum,
&optval, sizeof (optval));
break;
}
case SOPT_INT:
{
int optval;
if (INTEGERP (val))
optval = XINT (val);
else
error ("Bad option value for %s", name);
ret = setsockopt (s, sopt->optlevel, sopt->optnum,
&optval, sizeof (optval));
break;
}
#ifdef SO_BINDTODEVICE
case SOPT_IFNAME:
{
char devname[IFNAMSIZ+1];
bzero (devname, sizeof devname);
if (STRINGP (val))
{
char *arg = (char *) SDATA (val);
int len = min (strlen (arg), IFNAMSIZ);
bcopy (arg, devname, len);
}
else if (!NILP (val))
error ("Bad option value for %s", name);
ret = setsockopt (s, sopt->optlevel, sopt->optnum,
devname, IFNAMSIZ);
break;
}
#endif
#ifdef SO_LINGER
case SOPT_LINGER:
{
struct linger linger;
linger.l_onoff = 1;
linger.l_linger = 0;
if (INTEGERP (val))
linger.l_linger = XINT (val);
else
linger.l_onoff = NILP (val) ? 0 : 1;
ret = setsockopt (s, sopt->optlevel, sopt->optnum,
&linger, sizeof (linger));
break;
}
#endif
default:
return 0;
}
if (ret < 0)
report_file_error ("Cannot set network option",
Fcons (opt, Fcons (val, Qnil)));
return (1 << sopt->optbit);
}
DEFUN ("set-network-process-option",
Fset_network_process_option, Sset_network_process_option,
3, 4, 0,
doc: )
(process, option, value, no_error)
Lisp_Object process, option, value;
Lisp_Object no_error;
{
int s;
struct Lisp_Process *p;
CHECK_PROCESS (process);
p = XPROCESS (process);
if (!NETCONN1_P (p))
error ("Process is not a network process");
s = XINT (p->infd);
if (s < 0)
error ("Process is not running");
if (set_socket_option (s, option, value))
{
p->childp = Fplist_put (p->childp, option, value);
return Qt;
}
if (NILP (no_error))
error ("Unknown or unsupported option");
return Qnil;
}
static Lisp_Object
unwind_request_sigio (dummy)
Lisp_Object dummy;
{
if (interrupt_input)
request_sigio ();
return Qnil;
}
DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
0, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
Lisp_Object proc;
Lisp_Object contact;
struct Lisp_Process *p;
#ifdef HAVE_GETADDRINFO
struct addrinfo ai, *res, *lres;
struct addrinfo hints;
char *portstring, portbuf[128];
#else
struct _emacs_addrinfo
{
int ai_family;
int ai_socktype;
int ai_protocol;
int ai_addrlen;
struct sockaddr *ai_addr;
struct _emacs_addrinfo *ai_next;
} ai, *res, *lres;
#endif
struct sockaddr_in address_in;
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un address_un;
#endif
int port;
int ret = 0;
int xerrno = 0;
int s = -1, outch, inch;
struct gcpro gcpro1;
int count = SPECPDL_INDEX ();
int count1;
Lisp_Object QCaddress;
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
Lisp_Object filter, sentinel;
int is_non_blocking_client = 0;
int is_server = 0, backlog = 5;
int socktype;
int family = -1;
if (nargs == 0)
return Qnil;
contact = Flist (nargs, args);
GCPRO1 (contact);
#ifdef WINDOWSNT
init_winsock (TRUE);
#endif
tem = Fplist_get (contact, QCtype);
if (NILP (tem))
socktype = SOCK_STREAM;
#ifdef DATAGRAM_SOCKETS
else if (EQ (tem, Qdatagram))
socktype = SOCK_DGRAM;
#endif
else
error ("Unsupported connection type");
tem = Fplist_get (contact, QCserver);
if (!NILP (tem))
{
#if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
error ("Network servers not supported");
#else
is_server = 1;
if (INTEGERP (tem))
backlog = XINT (tem);
#endif
}
QCaddress = is_server ? QClocal : QCremote;
if (!is_server && socktype == SOCK_STREAM
&& (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
{
#ifndef NON_BLOCKING_CONNECT
error ("Non-blocking connect not supported");
#else
is_non_blocking_client = 1;
#endif
}
name = Fplist_get (contact, QCname);
buffer = Fplist_get (contact, QCbuffer);
filter = Fplist_get (contact, QCfilter);
sentinel = Fplist_get (contact, QCsentinel);
CHECK_STRING (name);
#ifdef TERM
host = Fplist_get (contact, QChost);
CHECK_STRING (host);
service = Fplist_get (contact, QCservice);
if (INTEGERP (service))
port = htons ((unsigned short) XINT (service));
else
{
struct servent *svc_info;
CHECK_STRING (service);
svc_info = getservbyname (SDATA (service), "tcp");
if (svc_info == 0)
error ("Unknown service: %s", SDATA (service));
port = svc_info->s_port;
}
s = connect_server (0);
if (s < 0)
report_file_error ("error creating socket", Fcons (name, Qnil));
send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port));
send_command (s, C_DUMB, 1, 0);
#else
ai.ai_socktype = socktype;
ai.ai_protocol = 0;
ai.ai_next = NULL;
res = &ai;
address = Fplist_get (contact, QCaddress);
if (!NILP (address))
{
host = service = Qnil;
if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
error ("Malformed :address");
ai.ai_family = family;
ai.ai_addr = alloca (ai.ai_addrlen);
conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
goto open_socket;
}
tem = Fplist_get (contact, QCfamily);
if (NILP (tem))
{
#if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
family = AF_UNSPEC;
#else
family = AF_INET;
#endif
}
#ifdef HAVE_LOCAL_SOCKETS
else if (EQ (tem, Qlocal))
family = AF_LOCAL;
#endif
#ifdef AF_INET6
else if (EQ (tem, Qipv6))
family = AF_INET6;
#endif
else if (EQ (tem, Qipv4))
family = AF_INET;
else if (INTEGERP (tem))
family = XINT (tem);
else
error ("Unknown address family");
ai.ai_family = family;
service = Fplist_get (contact, QCservice);
#ifdef HAVE_LOCAL_SOCKETS
if (family == AF_LOCAL)
{
host = Qnil;
CHECK_STRING (service);
bzero (&address_un, sizeof address_un);
address_un.sun_family = AF_LOCAL;
strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path);
ai.ai_addr = (struct sockaddr *) &address_un;
ai.ai_addrlen = sizeof address_un;
goto open_socket;
}
#endif
host = Fplist_get (contact, QChost);
if (!NILP (host))
{
if (EQ (host, Qlocal))
host = build_string ("localhost");
CHECK_STRING (host);
}
#ifdef POLL_FOR_INPUT
if (socktype == SOCK_STREAM)
{
record_unwind_protect (unwind_stop_other_atimers, Qnil);
bind_polling_period (10);
}
#endif
#ifdef HAVE_GETADDRINFO
if (!NILP (host))
{
if (EQ (service, Qt))
portstring = "0";
else if (INTEGERP (service))
{
sprintf (portbuf, "%ld", (long) XINT (service));
portstring = portbuf;
}
else
{
CHECK_STRING (service);
portstring = SDATA (service);
}
immediate_quit = 1;
QUIT;
memset (&hints, 0, sizeof (hints));
hints.ai_flags = 0;
hints.ai_family = family;
hints.ai_socktype = socktype;
hints.ai_protocol = 0;
ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
if (ret)
#ifdef HAVE_GAI_STRERROR
error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
#else
error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
#endif
immediate_quit = 0;
goto open_socket;
}
#endif
if (EQ (service, Qt))
port = 0;
else if (INTEGERP (service))
port = htons ((unsigned short) XINT (service));
else
{
struct servent *svc_info;
CHECK_STRING (service);
svc_info = getservbyname (SDATA (service),
(socktype == SOCK_DGRAM ? "udp" : "tcp"));
if (svc_info == 0)
error ("Unknown service: %s", SDATA (service));
port = svc_info->s_port;
}
bzero (&address_in, sizeof address_in);
address_in.sin_family = family;
address_in.sin_addr.s_addr = INADDR_ANY;
address_in.sin_port = port;
#ifndef HAVE_GETADDRINFO
if (!NILP (host))
{
struct hostent *host_info_ptr;
immediate_quit = 1;
QUIT;
host_info_ptr = gethostbyname (SDATA (host));
immediate_quit = 0;
if (host_info_ptr)
{
bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
host_info_ptr->h_length);
family = host_info_ptr->h_addrtype;
address_in.sin_family = family;
}
else
{
IN_ADDR numeric_addr;
numeric_addr = inet_addr ((char *) SDATA (host));
if (NUMERIC_ADDR_ERROR)
error ("Unknown host \"%s\"", SDATA (host));
bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
sizeof (address_in.sin_addr));
}
}
#endif
ai.ai_family = family;
ai.ai_addr = (struct sockaddr *) &address_in;
ai.ai_addrlen = sizeof address_in;
open_socket:
if (interrupt_input
&& !is_server && socktype == SOCK_STREAM)
{
record_unwind_protect (unwind_request_sigio, Qnil);
unrequest_sigio ();
}
count1 = SPECPDL_INDEX ();
s = -1;
for (lres = res; lres; lres = lres->ai_next)
{
int optn, optbits;
retry_connect:
s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
if (s < 0)
{
xerrno = errno;
continue;
}
#ifdef DATAGRAM_SOCKETS
if (!is_server && socktype == SOCK_DGRAM)
break;
#endif
#ifdef NON_BLOCKING_CONNECT
if (is_non_blocking_client)
{
#ifdef O_NONBLOCK
ret = fcntl (s, F_SETFL, O_NONBLOCK);
#else
ret = fcntl (s, F_SETFL, O_NDELAY);
#endif
if (ret < 0)
{
xerrno = errno;
emacs_close (s);
s = -1;
continue;
}
}
#endif
record_unwind_protect (close_file_unwind, make_number (s));
for (optn = optbits = 0; optn < nargs-1; optn += 2)
optbits |= set_socket_option (s, args[optn], args[optn+1]);
if (is_server)
{
#ifdef HAVE_LOCAL_SOCKETS
if (family != AF_LOCAL)
#endif
if (!(optbits & (1 << OPIX_REUSEADDR)))
{
int optval = 1;
if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
report_file_error ("Cannot set reuse option on server socket", Qnil);
}
if (bind (s, lres->ai_addr, lres->ai_addrlen))
report_file_error ("Cannot bind server socket", Qnil);
#ifdef HAVE_GETSOCKNAME
if (EQ (service, Qt))
{
struct sockaddr_in sa1;
int len1 = sizeof (sa1);
if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
{
((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
service = make_number (ntohs (sa1.sin_port));
contact = Fplist_put (contact, QCservice, service);
}
}
#endif
if (socktype == SOCK_STREAM && listen (s, backlog))
report_file_error ("Cannot listen on server socket", Qnil);
break;
}
immediate_quit = 1;
QUIT;
turn_on_atimers (0);
ret = connect (s, lres->ai_addr, lres->ai_addrlen);
xerrno = errno;
turn_on_atimers (1);
if (ret == 0 || xerrno == EISCONN)
{
break;
}
#ifdef NON_BLOCKING_CONNECT
#ifdef EINPROGRESS
if (is_non_blocking_client && xerrno == EINPROGRESS)
break;
#else
#ifdef EWOULDBLOCK
if (is_non_blocking_client && xerrno == EWOULDBLOCK)
break;
#endif
#endif
#endif
immediate_quit = 0;
specpdl_ptr = specpdl + count1;
emacs_close (s);
s = -1;
if (xerrno == EINTR)
goto retry_connect;
}
if (s >= 0)
{
#ifdef DATAGRAM_SOCKETS
if (socktype == SOCK_DGRAM)
{
if (datagram_address[s].sa)
abort ();
datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
datagram_address[s].len = lres->ai_addrlen;
if (is_server)
{
Lisp_Object remote;
bzero (datagram_address[s].sa, lres->ai_addrlen);
if (remote = Fplist_get (contact, QCremote), !NILP (remote))
{
int rfamily, rlen;
rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
conv_lisp_to_sockaddr (rfamily, remote,
datagram_address[s].sa, rlen);
}
}
else
bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
}
#endif
contact = Fplist_put (contact, QCaddress,
conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
#ifdef HAVE_GETSOCKNAME
if (!is_server)
{
struct sockaddr_in sa1;
int len1 = sizeof (sa1);
if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
contact = Fplist_put (contact, QClocal,
conv_sockaddr_to_lisp (&sa1, len1));
}
#endif
}
immediate_quit = 0;
#ifdef HAVE_GETADDRINFO
if (res != &ai)
{
BLOCK_INPUT;
freeaddrinfo (res);
UNBLOCK_INPUT;
}
#endif
specpdl_ptr = specpdl + count1;
unbind_to (count, Qnil);
if (s < 0)
{
if (is_non_blocking_client)
return Qnil;
errno = xerrno;
if (is_server)
report_file_error ("make server process failed", contact);
else
report_file_error ("make client process failed", contact);
}
#endif
inch = s;
outch = s;
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
proc = make_process (name);
chan_process[inch] = proc;
#ifdef O_NONBLOCK
fcntl (inch, F_SETFL, O_NONBLOCK);
#else
#ifdef O_NDELAY
fcntl (inch, F_SETFL, O_NDELAY);
#endif
#endif
p = XPROCESS (proc);
p->childp = contact;
p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
p->buffer = buffer;
p->sentinel = sentinel;
p->filter = filter;
p->filter_multibyte = buffer_defaults.enable_multibyte_characters;
if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte);
p->log = Fplist_get (contact, QClog);
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = Qt;
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
p->command = Qt;
p->pid = 0;
XSETINT (p->infd, inch);
XSETINT (p->outfd, outch);
if (is_server && socktype == SOCK_STREAM)
p->status = Qlisten;
if (BUFFERP (buffer))
set_marker_both (p->mark, buffer,
BUF_ZV (XBUFFER (buffer)),
BUF_ZV_BYTE (XBUFFER (buffer)));
#ifdef NON_BLOCKING_CONNECT
if (is_non_blocking_client)
{
p->status = Qconnect;
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
num_pending_connects++;
}
}
else
#endif
if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
|| (EQ (p->status, Qlisten) && NILP (p->command)))
{
FD_SET (inch, &input_wait_mask);
FD_SET (inch, &non_keyboard_wait_mask);
}
if (inch > max_process_desc)
max_process_desc = inch;
tem = Fplist_member (contact, QCcoding);
if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
tem = Qnil;
{
struct gcpro gcpro1;
Lisp_Object coding_systems = Qt;
Lisp_Object args[5], val;
if (!NILP (tem))
{
val = XCAR (XCDR (tem));
if (CONSP (val))
val = XCAR (val);
}
else 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)))
val = Qnil;
else
{
if (NILP (host) || NILP (service))
coding_systems = 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;
}
p->decode_coding_system = val;
if (!NILP (tem))
{
val = XCAR (XCDR (tem));
if (CONSP (val))
val = XCDR (val);
}
else 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))
{
if (NILP (host) || NILP (service))
coding_systems = 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 = XCDR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
val = XCDR (Vdefault_process_coding_system);
else
val = Qnil;
}
p->encode_coding_system = val;
}
setup_process_coding_systems (proc);
p->decoding_buf = make_uninit_string (0);
p->decoding_carryover = make_number (0);
p->encoding_buf = make_uninit_string (0);
p->encoding_carryover = make_number (0);
p->inherit_coding_system_flag
= (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system
? Qnil : Qt);
UNGCPRO;
return proc;
}
#endif
#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
#ifdef SIOCGIFCONF
DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
doc: )
()
{
struct ifconf ifconf;
struct ifreq *ifreqs = NULL;
int ifaces = 0;
int buf_size, s;
Lisp_Object res;
s = socket (AF_INET, SOCK_STREAM, 0);
if (s < 0)
return Qnil;
again:
ifaces += 25;
buf_size = ifaces * sizeof(ifreqs[0]);
ifreqs = (struct ifreq *)xrealloc(ifreqs, buf_size);
if (!ifreqs)
{
close (s);
return Qnil;
}
ifconf.ifc_len = buf_size;
ifconf.ifc_req = ifreqs;
if (ioctl (s, SIOCGIFCONF, &ifconf))
{
close (s);
return Qnil;
}
if (ifconf.ifc_len == buf_size)
goto again;
close (s);
ifaces = ifconf.ifc_len / sizeof (ifreqs[0]);
res = Qnil;
while (--ifaces >= 0)
{
struct ifreq *ifq = &ifreqs[ifaces];
char namebuf[sizeof (ifq->ifr_name) + 1];
if (ifq->ifr_addr.sa_family != AF_INET)
continue;
bcopy (ifq->ifr_name, namebuf, sizeof (ifq->ifr_name));
namebuf[sizeof (ifq->ifr_name)] = 0;
res = Fcons (Fcons (build_string (namebuf),
conv_sockaddr_to_lisp (&ifq->ifr_addr,
sizeof (struct sockaddr))),
res);
}
return res;
}
#endif
#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
struct ifflag_def {
int flag_bit;
char *flag_sym;
};
static struct ifflag_def ifflag_table[] = {
#ifdef IFF_UP
{ IFF_UP, "up" },
#endif
#ifdef IFF_BROADCAST
{ IFF_BROADCAST, "broadcast" },
#endif
#ifdef IFF_DEBUG
{ IFF_DEBUG, "debug" },
#endif
#ifdef IFF_LOOPBACK
{ IFF_LOOPBACK, "loopback" },
#endif
#ifdef IFF_POINTOPOINT
{ IFF_POINTOPOINT, "pointopoint" },
#endif
#ifdef IFF_RUNNING
{ IFF_RUNNING, "running" },
#endif
#ifdef IFF_NOARP
{ IFF_NOARP, "noarp" },
#endif
#ifdef IFF_PROMISC
{ IFF_PROMISC, "promisc" },
#endif
#ifdef IFF_NOTRAILERS
{ IFF_NOTRAILERS, "notrailers" },
#endif
#ifdef IFF_ALLMULTI
{ IFF_ALLMULTI, "allmulti" },
#endif
#ifdef IFF_MASTER
{ IFF_MASTER, "master" },
#endif
#ifdef IFF_SLAVE
{ IFF_SLAVE, "slave" },
#endif
#ifdef IFF_MULTICAST
{ IFF_MULTICAST, "multicast" },
#endif
#ifdef IFF_PORTSEL
{ IFF_PORTSEL, "portsel" },
#endif
#ifdef IFF_AUTOMEDIA
{ IFF_AUTOMEDIA, "automedia" },
#endif
#ifdef IFF_DYNAMIC
{ IFF_DYNAMIC, "dynamic" },
#endif
#ifdef IFF_OACTIVE
{ IFF_OACTIVE, "oactive" },
#endif
#ifdef IFF_SIMPLEX
{ IFF_SIMPLEX, "simplex" },
#endif
#ifdef IFF_LINK0
{ IFF_LINK0, "link0" },
#endif
#ifdef IFF_LINK1
{ IFF_LINK1, "link1" },
#endif
#ifdef IFF_LINK2
{ IFF_LINK2, "link2" },
#endif
{ 0, 0 }
};
DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
doc: )
(ifname)
Lisp_Object ifname;
{
struct ifreq rq;
Lisp_Object res = Qnil;
Lisp_Object elt;
int s;
int any = 0;
CHECK_STRING (ifname);
bzero (rq.ifr_name, sizeof rq.ifr_name);
strncpy (rq.ifr_name, SDATA (ifname), sizeof (rq.ifr_name));
s = socket (AF_INET, SOCK_STREAM, 0);
if (s < 0)
return Qnil;
elt = Qnil;
#if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
{
int flags = rq.ifr_flags;
struct ifflag_def *fp;
int fnum;
any++;
for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
{
if (flags & fp->flag_bit)
{
elt = Fcons (intern (fp->flag_sym), elt);
flags -= fp->flag_bit;
}
}
for (fnum = 0; flags && fnum < 32; fnum++)
{
if (flags & (1 << fnum))
{
elt = Fcons (make_number (fnum), elt);
}
}
}
#endif
res = Fcons (elt, res);
elt = Qnil;
#if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
{
Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
register struct Lisp_Vector *p = XVECTOR (hwaddr);
int n;
any++;
for (n = 0; n < 6; n++)
p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
}
#endif
res = Fcons (elt, res);
elt = Qnil;
#if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
{
any++;
#ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
#else
elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
#endif
}
#endif
res = Fcons (elt, res);
elt = Qnil;
#if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
{
any++;
elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
}
#endif
res = Fcons (elt, res);
elt = Qnil;
#if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
if (ioctl (s, SIOCGIFADDR, &rq) == 0)
{
any++;
elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
}
#endif
res = Fcons (elt, res);
close (s);
return any ? res : Qnil;
}
#endif
#endif
void
deactivate_process (proc)
Lisp_Object proc;
{
register int inchannel, outchannel;
register struct Lisp_Process *p = XPROCESS (proc);
inchannel = XINT (p->infd);
outchannel = XINT (p->outfd);
#ifdef ADAPTIVE_READ_BUFFERING
if (XINT (p->read_output_delay) > 0)
{
if (--process_output_delay_count < 0)
process_output_delay_count = 0;
XSETINT (p->read_output_delay, 0);
p->read_output_skip = Qnil;
}
#endif
if (inchannel >= 0)
{
flush_pending_output (inchannel);
#ifdef VMS
{
VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
sys$dassgn (outchannel);
vs = get_vms_process_pointer (p->pid);
if (vs)
give_back_vms_process_stuff (vs);
}
#else
emacs_close (inchannel);
if (outchannel >= 0 && outchannel != inchannel)
emacs_close (outchannel);
#endif
XSETINT (p->infd, -1);
XSETINT (p->outfd, -1);
#ifdef DATAGRAM_SOCKETS
if (DATAGRAM_CHAN_P (inchannel))
{
xfree (datagram_address[inchannel].sa);
datagram_address[inchannel].sa = 0;
datagram_address[inchannel].len = 0;
}
#endif
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
#ifdef NON_BLOCKING_CONNECT
if (FD_ISSET (inchannel, &connect_wait_mask))
{
FD_CLR (inchannel, &connect_wait_mask);
if (--num_pending_connects < 0)
abort ();
}
#endif
if (inchannel == max_process_desc)
{
int i;
max_process_desc = 0;
for (i = 0; i < MAXDESC; i++)
if (!NILP (chan_process[i]))
max_process_desc = i;
}
}
}
void
close_process_descs ()
{
#ifndef WINDOWSNT
int i;
for (i = 0; i < MAXDESC; i++)
{
Lisp_Object process;
process = chan_process[i];
if (!NILP (process))
{
int in = XINT (XPROCESS (process)->infd);
int out = XINT (XPROCESS (process)->outfd);
if (in >= 0)
emacs_close (in);
if (out >= 0 && in != out)
emacs_close (out);
}
}
#endif
}
DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
0, 4, 0,
doc: )
(process, seconds, millisec, just_this_one)
register Lisp_Object process, seconds, millisec, just_this_one;
{
int secs, usecs = 0;
if (! NILP (process))
CHECK_PROCESS (process);
else
just_this_one = Qnil;
if (!NILP (seconds))
{
if (INTEGERP (seconds))
secs = XINT (seconds);
else if (FLOATP (seconds))
{
double timeout = XFLOAT_DATA (seconds);
secs = (int) timeout;
usecs = (int) ((timeout - (double) secs) * 1000000);
}
else
wrong_type_argument (Qnumberp, seconds);
if (INTEGERP (millisec))
{
int carry;
usecs += XINT (millisec) * 1000;
carry = usecs / 1000000;
secs += carry;
if ((usecs -= carry * 1000000) < 0)
{
secs--;
usecs += 1000000;
}
}
if (secs < 0 || (secs == 0 && usecs == 0))
secs = -1, usecs = 0;
}
else
secs = NILP (process) ? -1 : 0;
return
(wait_reading_process_output (secs, usecs, 0, 0,
Qnil,
!NILP (process) ? XPROCESS (process) : NULL,
NILP (just_this_one) ? 0 :
!INTEGERP (just_this_one) ? 1 : -1)
? Qt : Qnil);
}
static int connect_counter = 0;
static void
server_accept_connection (server, channel)
Lisp_Object server;
int channel;
{
Lisp_Object proc, caller, name, buffer;
Lisp_Object contact, host, service;
struct Lisp_Process *ps= XPROCESS (server);
struct Lisp_Process *p;
int s;
union u_sockaddr {
struct sockaddr sa;
struct sockaddr_in in;
#ifdef AF_INET6
struct sockaddr_in6 in6;
#endif
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un un;
#endif
} saddr;
int len = sizeof saddr;
s = accept (channel, &saddr.sa, &len);
if (s < 0)
{
int code = errno;
if (code == EAGAIN)
return;
#ifdef EWOULDBLOCK
if (code == EWOULDBLOCK)
return;
#endif
if (!NILP (ps->log))
call3 (ps->log, server, Qnil,
concat3 (build_string ("accept failed with code"),
Fnumber_to_string (make_number (code)),
build_string ("\n")));
return;
}
connect_counter++;
host = Qt;
service = Qnil;
switch (saddr.sa.sa_family)
{
case AF_INET:
{
Lisp_Object args[5];
unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
args[0] = build_string ("%d.%d.%d.%d");
args[1] = make_number (*ip++);
args[2] = make_number (*ip++);
args[3] = make_number (*ip++);
args[4] = make_number (*ip++);
host = Fformat (5, args);
service = make_number (ntohs (saddr.in.sin_port));
args[0] = build_string (" <%s:%d>");
args[1] = host;
args[2] = service;
caller = Fformat (3, args);
}
break;
#ifdef AF_INET6
case AF_INET6:
{
Lisp_Object args[9];
uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr;
int i;
args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
for (i = 0; i < 8; i++)
args[i+1] = make_number (ntohs(ip6[i]));
host = Fformat (9, args);
service = make_number (ntohs (saddr.in.sin_port));
args[0] = build_string (" <[%s]:%d>");
args[1] = host;
args[2] = service;
caller = Fformat (3, args);
}
break;
#endif
#ifdef HAVE_LOCAL_SOCKETS
case AF_LOCAL:
#endif
default:
caller = Fnumber_to_string (make_number (connect_counter));
caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
break;
}
if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
buffer = Qnil;
else
{
buffer = ps->buffer;
if (!NILP (buffer))
buffer = Fbuffer_name (buffer);
else
buffer = ps->name;
if (!NILP (buffer))
{
buffer = concat2 (buffer, caller);
buffer = Fget_buffer_create (buffer);
}
}
name = concat2 (ps->name, caller);
proc = make_process (name);
chan_process[s] = proc;
#ifdef O_NONBLOCK
fcntl (s, F_SETFL, O_NONBLOCK);
#else
#ifdef O_NDELAY
fcntl (s, F_SETFL, O_NDELAY);
#endif
#endif
p = XPROCESS (proc);
contact = Fcopy_sequence (ps->childp);
contact = Fplist_put (contact, QCserver, Qnil);
contact = Fplist_put (contact, QChost, host);
if (!NILP (service))
contact = Fplist_put (contact, QCservice, service);
contact = Fplist_put (contact, QCremote,
conv_sockaddr_to_lisp (&saddr.sa, len));
#ifdef HAVE_GETSOCKNAME
len = sizeof saddr;
if (getsockname (s, &saddr.sa, &len) == 0)
contact = Fplist_put (contact, QClocal,
conv_sockaddr_to_lisp (&saddr.sa, len));
#endif
p->childp = contact;
p->plist = Fcopy_sequence (ps->plist);
p->buffer = buffer;
p->sentinel = ps->sentinel;
p->filter = ps->filter;
p->command = Qnil;
p->pid = 0;
XSETINT (p->infd, s);
XSETINT (p->outfd, s);
p->status = Qrun;
if (!EQ (p->filter, Qt))
{
FD_SET (s, &input_wait_mask);
FD_SET (s, &non_keyboard_wait_mask);
}
if (s > max_process_desc)
max_process_desc = s;
p->decode_coding_system = ps->decode_coding_system;
p->encode_coding_system = ps->encode_coding_system;
setup_process_coding_systems (proc);
p->decoding_buf = make_uninit_string (0);
p->decoding_carryover = make_number (0);
p->encoding_buf = make_uninit_string (0);
p->encoding_carryover = make_number (0);
p->inherit_coding_system_flag
= (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
if (!NILP (ps->log))
call3 (ps->log, server, proc,
concat3 (build_string ("accept from "),
(STRINGP (host) ? host : build_string ("-")),
build_string ("\n")));
if (!NILP (p->sentinel))
exec_sentinel (proc,
concat3 (build_string ("open from "),
(STRINGP (host) ? host : build_string ("-")),
build_string ("\n")));
}
static int waiting_for_user_input_p;
static Lisp_Object
wait_reading_process_output_unwind (data)
Lisp_Object data;
{
waiting_for_user_input_p = XINT (data);
return Qnil;
}
static void
wait_reading_process_output_1 ()
{
}
#ifndef select
static INLINE int
select_wrapper (n, rfd, wfd, xfd, tmo)
int n;
SELECT_TYPE *rfd, *wfd, *xfd;
EMACS_TIME *tmo;
{
return select (n, rfd, wfd, xfd, tmo);
}
#define select select_wrapper
#endif
int
wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
wait_for_cell, wait_proc, just_wait_proc)
int time_limit, microsecs, read_kbd, do_display;
Lisp_Object wait_for_cell;
struct Lisp_Process *wait_proc;
int just_wait_proc;
{
register int channel, nfds;
SELECT_TYPE Available;
#ifdef NON_BLOCKING_CONNECT
SELECT_TYPE Connecting;
int check_connect;
#endif
int check_delay, no_avail;
int xerrno;
Lisp_Object proc;
EMACS_TIME timeout, end_time;
int wait_channel = -1;
int got_some_input = 0;
int count = SPECPDL_INDEX ();
FD_ZERO (&Available);
#ifdef NON_BLOCKING_CONNECT
FD_ZERO (&Connecting);
#endif
if (wait_proc != NULL)
wait_channel = XINT (wait_proc->infd);
record_unwind_protect (wait_reading_process_output_unwind,
make_number (waiting_for_user_input_p));
waiting_for_user_input_p = read_kbd;
if (time_limit || microsecs)
{
EMACS_GET_TIME (end_time);
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
#ifdef POLL_INTERRUPTED_SYS_CALL
stop_polling ();
turn_on_atimers (0);
#endif
while (1)
{
int timeout_reduced_for_timers = 0;
if (read_kbd >= 0)
QUIT;
#ifdef SYNC_INPUT
else if (interrupt_input_pending)
handle_async_input ();
#endif
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
if (time_limit == -1)
{
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 (NILP (wait_for_cell)
&& just_wait_proc >= 0)
{
EMACS_TIME timer_delay;
do
{
int old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
timer_delay = timer_check (1);
if (timers_run != old_timers_run
&& old_buffer != current_buffer
&& waiting_for_user_input_p == -1)
record_asynch_buffer_change ();
if (timers_run != old_timers_run && do_display)
redisplay_preserve_echo_area (9);
else
break;
}
while (!detect_input_pending ());
if (read_kbd != 0
&& requeued_events_pending_p ())
break;
if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
{
EMACS_TIME difference;
EMACS_SUB_TIME (difference, timer_delay, timeout);
if (EMACS_TIME_NEG_P (difference))
{
timeout = timer_delay;
timeout_reduced_for_timers = 1;
}
}
else if (time_limit != -1)
{
wait_reading_process_output_1 ();
}
}
if (read_kbd < 0)
set_waiting_for_input (&timeout);
if (update_tick != process_tick && do_display)
{
SELECT_TYPE Atemp;
#ifdef NON_BLOCKING_CONNECT
SELECT_TYPE Ctemp;
#endif
Atemp = input_wait_mask;
#if 0
FD_CLR (0, &Atemp);
#endif
IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask);
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
&Atemp,
#ifdef NON_BLOCKING_CONNECT
(num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
#else
(SELECT_TYPE *)0,
#endif
(SELECT_TYPE *)0, &timeout)
<= 0))
{
clear_waiting_for_input ();
status_notify (NULL);
}
}
if (wait_proc && wait_proc->raw_status_new)
update_status (wait_proc);
if (wait_proc
&& ! EQ (wait_proc->status, Qrun)
&& ! EQ (wait_proc->status, Qconnect))
{
int nread, total_nread = 0;
clear_waiting_for_input ();
XSETPROCESS (proc, wait_proc);
while (XINT (wait_proc->infd) >= 0)
{
nread = read_process_output (proc, XINT (wait_proc->infd));
if (nread == 0)
break;
if (0 < nread)
total_nread += nread;
#ifdef EIO
else if (nread == -1 && EIO == errno)
break;
#endif
#ifdef EAGAIN
else if (nread == -1 && EAGAIN == errno)
break;
#endif
#ifdef EWOULDBLOCK
else if (nread == -1 && EWOULDBLOCK == errno)
break;
#endif
}
if (total_nread > 0 && do_display)
redisplay_preserve_echo_area (10);
break;
}
if (wait_proc && just_wait_proc)
{
if (XINT (wait_proc->infd) < 0)
break;
FD_SET (XINT (wait_proc->infd), &Available);
check_delay = 0;
IF_NON_BLOCKING_CONNECT (check_connect = 0);
}
else if (!NILP (wait_for_cell))
{
Available = non_process_wait_mask;
check_delay = 0;
IF_NON_BLOCKING_CONNECT (check_connect = 0);
}
else
{
if (! read_kbd)
Available = non_keyboard_wait_mask;
else
Available = input_wait_mask;
IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0));
check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
}
if (frame_garbaged && do_display)
{
clear_waiting_for_input ();
redisplay_preserve_echo_area (11);
if (read_kbd < 0)
set_waiting_for_input (&timeout);
}
no_avail = 0;
if (read_kbd && detect_input_pending ())
{
nfds = 0;
no_avail = 1;
}
else
{
#ifdef NON_BLOCKING_CONNECT
if (check_connect)
Connecting = connect_wait_mask;
#endif
#ifdef ADAPTIVE_READ_BUFFERING
if (process_output_skip && check_delay > 0)
{
int usecs = EMACS_USECS (timeout);
if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX)
usecs = READ_OUTPUT_DELAY_MAX;
for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
{
proc = chan_process[channel];
if (NILP (proc))
continue;
if (XINT (XPROCESS (proc)->read_output_delay) > 0)
{
check_delay--;
if (NILP (XPROCESS (proc)->read_output_skip))
continue;
FD_CLR (channel, &Available);
XPROCESS (proc)->read_output_skip = Qnil;
if (XINT (XPROCESS (proc)->read_output_delay) < usecs)
usecs = XINT (XPROCESS (proc)->read_output_delay);
}
}
EMACS_SET_SECS_USECS (timeout, 0, usecs);
process_output_skip = 0;
}
#endif
nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
&Available,
#ifdef NON_BLOCKING_CONNECT
(check_connect ? &Connecting : (SELECT_TYPE *)0),
#else
(SELECT_TYPE *)0,
#endif
(SELECT_TYPE *)0, &timeout);
}
xerrno = errno;
clear_waiting_for_input ();
do_pending_window_change (0);
if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
break;
if (nfds < 0)
{
if (xerrno == EINTR)
no_avail = 1;
#ifdef ultrix
else if (xerrno == ENOMEM)
no_avail = 1;
#endif
#ifdef ALLIANT
else if (xerrno == EFAULT)
no_avail = 1;
#endif
else if (xerrno == EBADF)
{
#ifdef AIX
no_avail = 1;
#else
abort ();
#endif
}
else
error ("select error: %s", emacs_strerror (xerrno));
}
if (no_avail)
{
FD_ZERO (&Available);
IF_NON_BLOCKING_CONNECT (check_connect = 0);
}
#if defined(sun) && !defined(USG5_4)
if (nfds > 0 && keyboard_bit_set (&Available)
&& interrupt_input)
kill (getpid (), SIGIO);
#endif
#if 0
if (read_kbd && interrupt_input
&& keyboard_bit_set (&Available)
&& input_polling_used ())
kill (getpid (), SIGALRM);
#endif
if (read_kbd != 0)
{
int old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
int leave = 0;
if (detect_input_pending_run_timers (do_display))
{
swallow_events (do_display);
if (detect_input_pending_run_timers (do_display))
leave = 1;
}
if (timers_run != old_timers_run
&& waiting_for_user_input_p == -1
&& old_buffer != current_buffer)
record_asynch_buffer_change ();
if (leave)
break;
}
if (read_kbd != 0
&& requeued_events_pending_p ())
break;
if (read_kbd == 0 && detect_input_pending ())
{
swallow_events (do_display);
#if 0
if (detect_input_pending ())
break;
#endif
}
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
#ifdef SIGIO
if (read_kbd && interrupt_input
&& keyboard_bit_set (&Available) && ! noninteractive)
kill (getpid (), SIGIO);
#endif
if (! wait_proc)
got_some_input |= nfds > 0;
if (read_kbd || ! NILP (wait_for_cell))
do_pending_window_change (0);
if (no_avail || nfds == 0)
continue;
for (channel = 0; channel <= max_process_desc; channel++)
{
if (FD_ISSET (channel, &Available)
&& FD_ISSET (channel, &non_keyboard_wait_mask))
{
int nread;
if (wait_channel == channel)
{
wait_channel = -1;
time_limit = -1;
got_some_input = 1;
}
proc = chan_process[channel];
if (NILP (proc))
continue;
if (EQ (XPROCESS (proc)->status, Qlisten))
{
server_accept_connection (proc, channel);
continue;
}
nread = read_process_output (proc, channel);
if (nread > 0)
{
FD_ZERO (&Available);
if (do_display)
redisplay_preserve_echo_area (12);
}
#ifdef EWOULDBLOCK
else if (nread == -1 && errno == EWOULDBLOCK)
;
#endif
#ifdef O_NONBLOCK
else if (nread == -1 && errno == EAGAIN)
;
#else
#ifdef O_NDELAY
else if (nread == -1 && errno == EAGAIN)
;
else if (nread == 0 && !NETCONN_P (proc))
;
#endif
#endif
#ifdef HAVE_PTYS
else if (nread == -1 && errno == EIO)
{
FD_CLR (channel, &input_wait_mask);
FD_CLR (channel, &non_keyboard_wait_mask);
kill (getpid (), SIGCHLD);
}
#endif
#ifdef SIGCHLD
else if (nread == 0 && !NETCONN_P (proc))
;
#endif
else
{
XSETINT (XPROCESS (proc)->tick, ++process_tick);
deactivate_process (proc);
if (XPROCESS (proc)->raw_status_new)
update_status (XPROCESS (proc));
if (EQ (XPROCESS (proc)->status, Qrun))
XPROCESS (proc)->status
= Fcons (Qexit, Fcons (make_number (256), Qnil));
}
}
#ifdef NON_BLOCKING_CONNECT
if (check_connect && FD_ISSET (channel, &Connecting)
&& FD_ISSET (channel, &connect_wait_mask))
{
struct Lisp_Process *p;
FD_CLR (channel, &connect_wait_mask);
if (--num_pending_connects < 0)
abort ();
proc = chan_process[channel];
if (NILP (proc))
continue;
p = XPROCESS (proc);
#ifdef GNU_LINUX
{
int xlen = sizeof(xerrno);
if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
xerrno = errno;
}
#else
{
struct sockaddr pname;
int pnamelen = sizeof(pname);
xerrno = 0;
if (getpeername(channel, &pname, &pnamelen) < 0)
{
char dummy;
xerrno = errno;
if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
xerrno = errno;
}
}
#endif
if (xerrno)
{
XSETINT (p->tick, ++process_tick);
p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
deactivate_process (proc);
}
else
{
p->status = Qrun;
exec_sentinel (proc, build_string ("open\n"));
if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
}
}
}
#endif
}
}
unbind_to (count, Qnil);
if (read_kbd >= 0)
{
clear_input_pending ();
QUIT;
}
#ifdef POLL_INTERRUPTED_SYS_CALL
start_polling ();
#endif
return got_some_input;
}
static Lisp_Object
read_process_output_call (fun_and_args)
Lisp_Object fun_and_args;
{
return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
}
static Lisp_Object
read_process_output_error_handler (error)
Lisp_Object error;
{
cmd_error_internal (error, "error in process filter: ");
Vinhibit_quit = Qt;
update_echo_area ();
Fsleep_for (make_number (2), Qnil);
return Qt;
}
static int
read_process_output (proc, channel)
Lisp_Object proc;
register int channel;
{
register int nbytes;
char *chars;
register Lisp_Object outstream;
register struct buffer *old = current_buffer;
register struct Lisp_Process *p = XPROCESS (proc);
register int opoint;
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = XINT (p->decoding_carryover);
int readmax = 4096;
#ifdef VMS
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
vs = get_vms_process_pointer (p->pid);
if (vs)
{
if (!vs->iosb[0])
return (0);
if (!(vs->iosb[0] & 1))
return -1;
}
else
error ("Could not get VMS process pointer");
chars = vs->inputBuffer;
nbytes = clean_vms_buffer (chars, vs->iosb[1]);
if (nbytes <= 0)
{
start_vms_process_read (vs);
return 1;
}
if (carryover > 0)
{
chars = (char *) alloca (nbytes + carryover);
bcopy (SDATA (p->decoding_buf), buf, carryover);
bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else
chars = (char *) alloca (carryover + readmax);
if (carryover)
bcopy (SDATA (p->decoding_buf), chars, carryover);
#ifdef DATAGRAM_SOCKETS
if (DATAGRAM_CHAN_P (channel))
{
int len = datagram_address[channel].len;
nbytes = recvfrom (channel, chars + carryover, readmax,
0, datagram_address[channel].sa, &len);
}
else
#endif
if (proc_buffered_char[channel] < 0)
{
nbytes = emacs_read (channel, chars + carryover, readmax);
#ifdef ADAPTIVE_READ_BUFFERING
if (nbytes > 0 && !NILP (p->adaptive_read_buffering))
{
int delay = XINT (p->read_output_delay);
if (nbytes < 256)
{
if (delay < READ_OUTPUT_DELAY_MAX_MAX)
{
if (delay == 0)
process_output_delay_count++;
delay += READ_OUTPUT_DELAY_INCREMENT * 2;
}
}
else if (delay > 0 && (nbytes == readmax))
{
delay -= READ_OUTPUT_DELAY_INCREMENT;
if (delay == 0)
process_output_delay_count--;
}
XSETINT (p->read_output_delay, delay);
if (delay)
{
p->read_output_skip = Qt;
process_output_skip = 1;
}
}
#endif
}
else
{
chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1);
if (nbytes < 0)
nbytes = 1;
else
nbytes = nbytes + 1;
}
#endif
XSETINT (p->decoding_carryover, 0);
if (nbytes <= 0)
{
if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
return nbytes;
coding->mode |= CODING_MODE_LAST_BLOCK;
}
nbytes += carryover;
outstream = p->filter;
if (!NILP (outstream))
{
int count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
Lisp_Object obuffer, okeymap;
Lisp_Object text;
int outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
odeactivate = Vdeactivate_mark;
XSETBUFFER (obuffer, current_buffer);
okeymap = current_buffer->keymap;
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
if (outer_running_asynch_code)
{
Lisp_Object tem;
tem = Fmatch_data (Qnil, Qnil, Qnil);
restore_search_regs ();
record_unwind_save_match_data ();
Fset_match_data (tem, Qt);
}
running_asynch_code = 1;
text = decode_coding_string (make_unibyte_string (chars, nbytes),
coding, 0);
Vlast_coding_system_used = coding->symbol;
if (!EQ (p->decode_coding_system, coding->symbol))
{
p->decode_coding_system = coding->symbol;
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[XINT (p->outfd)])
{
p->encode_coding_system = coding->symbol;
setup_coding_system (coding->symbol,
proc_encode_coding_system[XINT (p->outfd)]);
if (proc_encode_coding_system[XINT (p->outfd)]->eol_type
== CODING_EOL_UNDECIDED)
proc_encode_coding_system[XINT (p->outfd)]->eol_type
= system_eol_type;
}
}
carryover = nbytes - coding->consumed;
if (carryover < 0)
abort ();
if (SCHARS (p->decoding_buf) < carryover)
p->decoding_buf = make_uninit_string (carryover);
bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
carryover);
XSETINT (p->decoding_carryover, carryover);
if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text))
text = (STRING_MULTIBYTE (text)
? Fstring_as_unibyte (text)
: Fstring_to_multibyte (text));
if (SBYTES (text) > 0)
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
Fcons (proc, Fcons (text, Qnil))),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
read_process_output_error_handler);
restore_search_regs ();
running_asynch_code = outer_running_asynch_code;
Vdeactivate_mark = odeactivate;
waiting_for_user_input_p = waiting;
#if 0
if (! EQ (Fcurrent_buffer (), obuffer)
|| ! EQ (current_buffer->keymap, okeymap))
#endif
if (waiting_for_user_input_p == -1)
record_asynch_buffer_change ();
#ifdef VMS
start_vms_process_read (vs);
#endif
unbind_to (count, Qnil);
return nbytes;
}
if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
{
Lisp_Object old_read_only;
int old_begv, old_zv;
int old_begv_byte, old_zv_byte;
Lisp_Object odeactivate;
int before, before_byte;
int opoint_byte;
Lisp_Object text;
struct buffer *b;
odeactivate = Vdeactivate_mark;
Fset_buffer (p->buffer);
opoint = PT;
opoint_byte = PT_BYTE;
old_read_only = current_buffer->read_only;
old_begv = BEGV;
old_zv = ZV;
old_begv_byte = BEGV_BYTE;
old_zv_byte = ZV_BYTE;
current_buffer->read_only = Qnil;
if (XMARKER (p->mark)->buffer)
SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
ZV_BYTE));
else
SET_PT_BOTH (ZV, ZV_BYTE);
before = PT;
before_byte = PT_BYTE;
if (! (BEGV <= PT && PT <= ZV))
Fwiden ();
text = decode_coding_string (make_unibyte_string (chars, nbytes),
coding, 0);
Vlast_coding_system_used = coding->symbol;
if (!EQ (p->decode_coding_system, coding->symbol))
{
p->decode_coding_system = coding->symbol;
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[XINT (p->outfd)])
{
p->encode_coding_system = coding->symbol;
setup_coding_system (coding->symbol,
proc_encode_coding_system[XINT (p->outfd)]);
if (proc_encode_coding_system[XINT (p->outfd)]->eol_type
== CODING_EOL_UNDECIDED)
proc_encode_coding_system[XINT (p->outfd)]->eol_type
= system_eol_type;
}
}
carryover = nbytes - coding->consumed;
if (carryover < 0)
abort ();
if (SCHARS (p->decoding_buf) < carryover)
p->decoding_buf = make_uninit_string (carryover);
bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
carryover);
XSETINT (p->decoding_carryover, carryover);
if (NILP (current_buffer->enable_multibyte_characters)
!= ! STRING_MULTIBYTE (text))
text = (STRING_MULTIBYTE (text)
? Fstring_as_unibyte (text)
: Fstring_to_multibyte (text));
insert_from_string_before_markers (text, 0, 0,
SCHARS (text), SBYTES (text), 0);
if (BUFFERP (p->buffer)
&& (b = XBUFFER (p->buffer), b != current_buffer))
set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
else
set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
update_mode_lines++;
if (opoint >= before)
{
opoint += PT - before;
opoint_byte += PT_BYTE - before_byte;
}
if (old_begv > before)
{
old_begv += PT - before;
old_begv_byte += PT_BYTE - before_byte;
}
if (old_zv >= before)
{
old_zv += PT - before;
old_zv_byte += PT_BYTE - before_byte;
}
if (old_begv != BEGV || old_zv != ZV)
Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
Vdeactivate_mark = odeactivate;
current_buffer->read_only = old_read_only;
SET_PT_BOTH (opoint, opoint_byte);
set_buffer_internal (old);
}
#ifdef VMS
start_vms_process_read (vs);
#endif
return nbytes;
}
DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
0, 0, 0,
doc: )
()
{
return (waiting_for_user_input_p ? Qt : Qnil);
}
jmp_buf send_process_frame;
Lisp_Object process_sent_to;
SIGTYPE
send_process_trap ()
{
SIGNAL_THREAD_CHECK (SIGPIPE);
#ifdef BSD4_1
sigrelse (SIGPIPE);
sigrelse (SIGALRM);
#endif
sigunblock (sigmask (SIGPIPE));
longjmp (send_process_frame, 1);
}
static void
send_process (proc, buf, len, object)
volatile Lisp_Object proc;
unsigned char *volatile buf;
volatile int len;
volatile Lisp_Object object;
{
struct Lisp_Process *p = XPROCESS (proc);
int rv;
struct coding_system *coding;
struct gcpro gcpro1;
SIGTYPE (*volatile old_sigpipe) ();
GCPRO1 (object);
#ifdef VMS
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
#endif
if (p->raw_status_new)
update_status (p);
if (! EQ (p->status, Qrun))
error ("Process %s not running", SDATA (p->name));
if (XINT (p->outfd) < 0)
error ("Output file descriptor of %s is closed", SDATA (p->name));
coding = proc_encode_coding_system[XINT (p->outfd)];
Vlast_coding_system_used = coding->symbol;
if ((STRINGP (object) && STRING_MULTIBYTE (object))
|| (BUFFERP (object)
&& !NILP (XBUFFER (object)->enable_multibyte_characters))
|| EQ (object, Qt))
{
if (!EQ (coding->symbol, p->encode_coding_system))
setup_coding_system (p->encode_coding_system, coding);
if (coding->eol_type == CODING_EOL_UNDECIDED)
coding->eol_type = system_eol_type;
coding->src_multibyte = 1;
}
else
{
if (coding->type != coding_type_raw_text)
{
if (CODING_REQUIRE_FLUSHING (coding))
{
coding->mode |= CODING_MODE_LAST_BLOCK;
send_process (proc, "", 0, Qt);
}
coding->src_multibyte = 0;
setup_raw_text_coding_system (coding);
}
}
coding->dst_multibyte = 0;
if (CODING_REQUIRE_ENCODING (coding))
{
int require = encoding_buffer_size (coding, len);
int from_byte = -1, from = -1, to = -1;
if (BUFFERP (object))
{
from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
from = buf_bytepos_to_charpos (XBUFFER (object), from_byte);
to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len);
}
else if (STRINGP (object))
{
from_byte = buf - SDATA (object);
from = string_byte_to_char (object, from_byte);
to = string_byte_to_char (object, from_byte + len);
}
if (coding->composing != COMPOSITION_DISABLED)
{
if (from_byte >= 0)
coding_save_composition (coding, from, to, object);
else
coding->composing = COMPOSITION_DISABLED;
}
if (SBYTES (p->encoding_buf) < require)
p->encoding_buf = make_uninit_string (require);
if (from_byte >= 0)
buf = (BUFFERP (object)
? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
: SDATA (object) + from_byte);
object = p->encoding_buf;
encode_coding (coding, (char *) buf, SDATA (object),
len, SBYTES (object));
coding_free_composition_data (coding);
len = coding->produced;
buf = SDATA (object);
}
#ifdef VMS
vs = get_vms_process_pointer (p->pid);
if (vs == 0)
error ("Could not find this process: %x", p->pid);
else if (write_to_vms_process (vs, buf, len))
;
#else
if (pty_max_bytes == 0)
{
#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
pty_max_bytes = fpathconf (XFASTINT (p->outfd), _PC_MAX_CANON);
if (pty_max_bytes < 0)
pty_max_bytes = 250;
#else
pty_max_bytes = 250;
#endif
pty_max_bytes--;
}
if (!setjmp (send_process_frame))
{
process_sent_to = proc;
while (len > 0)
{
int this = len;
if (!NILP (p->pty_flag))
{
int linepos = 0;
unsigned char *ptr = (unsigned char *) buf;
unsigned char *end = (unsigned char *) buf + len;
while (ptr != end && linepos < pty_max_bytes)
{
if (*ptr == '\n')
linepos = 0;
else
linepos++;
ptr++;
}
this = ptr - buf;
}
while (this > 0)
{
int outfd = XINT (p->outfd);
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
#ifdef DATAGRAM_SOCKETS
if (DATAGRAM_CHAN_P (outfd))
{
rv = sendto (outfd, (char *) buf, this,
0, datagram_address[outfd].sa,
datagram_address[outfd].len);
if (rv < 0 && errno == EMSGSIZE)
{
signal (SIGPIPE, old_sigpipe);
report_file_error ("sending datagram",
Fcons (proc, Qnil));
}
}
else
#endif
{
rv = emacs_write (outfd, (char *) buf, this);
#ifdef ADAPTIVE_READ_BUFFERING
if (XINT (p->read_output_delay) > 0
&& EQ (p->adaptive_read_buffering, Qt))
{
XSETFASTINT (p->read_output_delay, 0);
process_output_delay_count--;
p->read_output_skip = Qnil;
}
#endif
}
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
{
if (0
#ifdef EWOULDBLOCK
|| errno == EWOULDBLOCK
#endif
#ifdef EAGAIN
|| errno == EAGAIN
#endif
)
{
int offset = 0;
#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
if (errno == EAGAIN)
{
int flags = FWRITE;
ioctl (XINT (p->outfd), TIOCFLUSH, &flags);
}
#endif
if (BUFFERP (object))
offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
else if (STRINGP (object))
offset = buf - SDATA (object);
#ifdef EMACS_HAS_USECS
wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
#else
wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
#endif
if (BUFFERP (object))
buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
else if (STRINGP (object))
buf = offset + SDATA (object);
rv = 0;
}
else
report_file_error ("writing to process", Fcons (proc, Qnil));
}
buf += rv;
len -= rv;
this -= rv;
}
if (len > 0)
Fprocess_send_eof (proc);
}
}
#endif
else
{
signal (SIGPIPE, old_sigpipe);
#ifndef VMS
proc = process_sent_to;
p = XPROCESS (proc);
#endif
p->raw_status_new = 0;
p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
XSETINT (p->tick, ++process_tick);
deactivate_process (proc);
#ifdef VMS
error ("Error writing to process %s; closed it", SDATA (p->name));
#else
error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
#endif
}
UNGCPRO;
}
static Lisp_Object
send_process_object_unwind (buf)
Lisp_Object buf;
{
Lisp_Object tembuf;
if (XBUFFER (buf) == current_buffer)
return Qnil;
tembuf = Fcurrent_buffer ();
Fset_buffer (buf);
Fkill_buffer (tembuf);
return Qnil;
}
static void
send_process_object (proc, start, end)
Lisp_Object proc, start, end;
{
int count = SPECPDL_INDEX ();
Lisp_Object object = STRINGP (start) ? start : Fcurrent_buffer ();
struct buffer *given_buffer = current_buffer;
unsigned char *buf;
int len;
record_unwind_protect (send_process_object_unwind, Fcurrent_buffer ());
if (STRINGP (object) ? STRING_MULTIBYTE (object)
: ! NILP (XBUFFER (object)->enable_multibyte_characters))
{
struct Lisp_Process *p = XPROCESS (proc);
struct coding_system *coding;
if (p->raw_status_new)
update_status (p);
if (! EQ (p->status, Qrun))
error ("Process %s not running", SDATA (p->name));
if (XINT (p->outfd) < 0)
error ("Output file descriptor of %s is closed", SDATA (p->name));
coding = proc_encode_coding_system[XINT (p->outfd)];
if (! EQ (coding->symbol, p->encode_coding_system))
setup_coding_system (p->encode_coding_system, coding);
if (! NILP (coding->pre_write_conversion))
{
struct gcpro gcpro1, gcpro2;
GCPRO2 (proc, object);
call2 (coding->pre_write_conversion, start, end);
UNGCPRO;
if (given_buffer != current_buffer)
{
start = make_number (BEGV), end = make_number (ZV);
object = Fcurrent_buffer ();
}
}
}
if (BUFFERP (object))
{
EMACS_INT start_byte;
if (XINT (start) < GPT && XINT (end) > GPT)
move_gap (XINT (end));
start_byte = CHAR_TO_BYTE (XINT (start));
buf = BYTE_POS_ADDR (start_byte);
len = CHAR_TO_BYTE (XINT (end)) - start_byte;
}
else
{
buf = SDATA (object);
len = SBYTES (object);
}
send_process (proc, buf, len, object);
unbind_to (count, Qnil);
}
DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
3, 3, 0,
doc: )
(process, start, end)
Lisp_Object process, start, end;
{
Lisp_Object proc;
proc = get_process (process);
validate_region (&start, &end);
send_process_object (proc, start, end);
return Qnil;
}
DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
2, 2, 0,
doc: )
(process, string)
Lisp_Object process, string;
{
Lisp_Object proc;
CHECK_STRING (string);
proc = get_process (process);
send_process_object (proc, string, Qnil);
return Qnil;
}
static int
emacs_get_tty_pgrp (p)
struct Lisp_Process *p;
{
int gid = -1;
#ifdef TIOCGPGRP
if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
{
int fd;
fd = emacs_open (XSTRING (p->tty_name)->data, O_RDONLY, 0);
if (fd != -1)
{
ioctl (fd, TIOCGPGRP, &gid);
emacs_close (fd);
}
}
#endif
return gid;
}
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
doc: )
(process)
Lisp_Object process;
{
int gid;
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",
SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
SDATA (p->name));
gid = emacs_get_tty_pgrp (p);
if (gid == p->pid)
return Qnil;
return Qt;
}
static void
process_send_signal (process, signo, current_group, nomsg)
Lisp_Object process;
int signo;
Lisp_Object current_group;
int nomsg;
{
Lisp_Object proc;
register struct Lisp_Process *p;
int gid;
int no_pgrp = 0;
proc = get_process (process);
p = XPROCESS (proc);
if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
SDATA (p->name));
if (NILP (p->pty_flag))
current_group = Qnil;
if (NILP (current_group))
gid = p->pid;
else
{
#ifdef SIGNALS_VIA_CHARACTERS
#ifdef HAVE_TERMIOS
struct termios t;
cc_t *sig_char = NULL;
tcgetattr (XINT (p->infd), &t);
switch (signo)
{
case SIGINT:
sig_char = &t.c_cc[VINTR];
break;
case SIGQUIT:
sig_char = &t.c_cc[VQUIT];
break;
case SIGTSTP:
#if defined (VSWTCH) && !defined (PREFER_VSUSP)
sig_char = &t.c_cc[VSWTCH];
#else
sig_char = &t.c_cc[VSUSP];
#endif
break;
}
if (sig_char && *sig_char != CDISABLE)
{
send_process (proc, sig_char, 1, Qnil);
return;
}
#else
#if defined (TIOCGLTC) && defined (TIOCGETC)
struct tchars c;
struct ltchars lc;
switch (signo)
{
case SIGINT:
ioctl (XINT (p->infd), TIOCGETC, &c);
send_process (proc, &c.t_intrc, 1, Qnil);
return;
case SIGQUIT:
ioctl (XINT (p->infd), TIOCGETC, &c);
send_process (proc, &c.t_quitc, 1, Qnil);
return;
#ifdef SIGTSTP
case SIGTSTP:
ioctl (XINT (p->infd), TIOCGLTC, &lc);
send_process (proc, &lc.t_suspc, 1, Qnil);
return;
#endif
}
#else
#ifdef TCGETA
struct termio t;
switch (signo)
{
case SIGINT:
ioctl (XINT (p->infd), TCGETA, &t);
send_process (proc, &t.c_cc[VINTR], 1, Qnil);
return;
case SIGQUIT:
ioctl (XINT (p->infd), TCGETA, &t);
send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
return;
#ifdef SIGTSTP
case SIGTSTP:
ioctl (XINT (p->infd), TCGETA, &t);
send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
return;
#endif
}
#else
Your configuration files are messed up.
#endif
#endif
abort ();
#endif
#endif
#ifdef TIOCGPGRP
gid = emacs_get_tty_pgrp (p);
if (gid == -1)
gid = p->pid;
if (gid == -1)
no_pgrp = 1;
#else
gid = p->pid;
#endif
if (EQ (current_group, Qlambda) && gid == p->pid)
return;
}
switch (signo)
{
#ifdef SIGCONT
case SIGCONT:
p->raw_status_new = 0;
p->status = Qrun;
XSETINT (p->tick, ++process_tick);
if (!nomsg)
status_notify (NULL);
break;
#endif
case SIGINT:
#ifdef VMS
send_process (proc, "\003", 1, Qnil);
goto whoosh;
#endif
case SIGQUIT:
#ifdef VMS
send_process (proc, "\031", 1, Qnil);
goto whoosh;
#endif
case SIGKILL:
#ifdef VMS
sys$forcex (&(p->pid), 0, 1);
whoosh:
#endif
flush_pending_output (XINT (p->infd));
break;
}
if (no_pgrp)
{
kill (p->pid, signo);
return;
}
#ifdef TIOCSIGSEND
if (!NILP (current_group))
{
if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1)
EMACS_KILLPG (gid, signo);
}
else
{
gid = - p->pid;
kill (gid, signo);
}
#else
EMACS_KILLPG (gid, signo);
#endif
}
DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
doc: )
(process, current_group)
Lisp_Object process, current_group;
{
process_send_signal (process, SIGINT, current_group, 0);
return process;
}
DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
doc: )
(process, current_group)
Lisp_Object process, current_group;
{
process_send_signal (process, SIGKILL, current_group, 0);
return process;
}
DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
doc: )
(process, current_group)
Lisp_Object process, current_group;
{
process_send_signal (process, SIGQUIT, current_group, 0);
return process;
}
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
doc: )
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
if (PROCESSP (process) && NETCONN_P (process))
{
struct Lisp_Process *p;
p = XPROCESS (process);
if (NILP (p->command)
&& XINT (p->infd) >= 0)
{
FD_CLR (XINT (p->infd), &input_wait_mask);
FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
}
p->command = Qt;
return process;
}
#endif
#ifndef SIGTSTP
error ("No SIGTSTP support");
#else
process_send_signal (process, SIGTSTP, current_group, 0);
#endif
return process;
}
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
doc: )
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
if (PROCESSP (process) && NETCONN_P (process))
{
struct Lisp_Process *p;
p = XPROCESS (process);
if (EQ (p->command, Qt)
&& XINT (p->infd) >= 0
&& (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
}
p->command = Qnil;
return process;
}
#endif
#ifdef SIGCONT
process_send_signal (process, SIGCONT, current_group, 0);
#else
error ("No SIGCONT support");
#endif
return process;
}
DEFUN ("signal-process", Fsignal_process, Ssignal_process,
2, 2, "sProcess (name or number): \nnSignal code: ",
doc: )
(process, sigcode)
Lisp_Object process, sigcode;
{
pid_t pid;
if (INTEGERP (process))
{
pid = XINT (process);
goto got_it;
}
if (FLOATP (process))
{
pid = (pid_t) XFLOAT_DATA (process);
goto got_it;
}
if (STRINGP (process))
{
Lisp_Object tem;
if (tem = Fget_process (process), NILP (tem))
{
pid = XINT (Fstring_to_number (process, make_number (10)));
if (pid > 0)
goto got_it;
}
process = tem;
}
else
process = get_process (process);
if (NILP (process))
return process;
CHECK_PROCESS (process);
pid = XPROCESS (process)->pid;
if (pid <= 0)
error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
got_it:
#define parse_signal(NAME, VALUE) \
else if (!xstricmp (name, NAME)) \
XSETINT (sigcode, VALUE)
if (INTEGERP (sigcode))
;
else
{
unsigned char *name;
CHECK_SYMBOL (sigcode);
name = SDATA (SYMBOL_NAME (sigcode));
if (!strncmp(name, "SIG", 3) || !strncmp(name, "sig", 3))
name += 3;
if (0)
;
#ifdef SIGUSR1
parse_signal ("usr1", SIGUSR1);
#endif
#ifdef SIGUSR2
parse_signal ("usr2", SIGUSR2);
#endif
#ifdef SIGTERM
parse_signal ("term", SIGTERM);
#endif
#ifdef SIGHUP
parse_signal ("hup", SIGHUP);
#endif
#ifdef SIGINT
parse_signal ("int", SIGINT);
#endif
#ifdef SIGQUIT
parse_signal ("quit", SIGQUIT);
#endif
#ifdef SIGILL
parse_signal ("ill", SIGILL);
#endif
#ifdef SIGABRT
parse_signal ("abrt", SIGABRT);
#endif
#ifdef SIGEMT
parse_signal ("emt", SIGEMT);
#endif
#ifdef SIGKILL
parse_signal ("kill", SIGKILL);
#endif
#ifdef SIGFPE
parse_signal ("fpe", SIGFPE);
#endif
#ifdef SIGBUS
parse_signal ("bus", SIGBUS);
#endif
#ifdef SIGSEGV
parse_signal ("segv", SIGSEGV);
#endif
#ifdef SIGSYS
parse_signal ("sys", SIGSYS);
#endif
#ifdef SIGPIPE
parse_signal ("pipe", SIGPIPE);
#endif
#ifdef SIGALRM
parse_signal ("alrm", SIGALRM);
#endif
#ifdef SIGURG
parse_signal ("urg", SIGURG);
#endif
#ifdef SIGSTOP
parse_signal ("stop", SIGSTOP);
#endif
#ifdef SIGTSTP
parse_signal ("tstp", SIGTSTP);
#endif
#ifdef SIGCONT
parse_signal ("cont", SIGCONT);
#endif
#ifdef SIGCHLD
parse_signal ("chld", SIGCHLD);
#endif
#ifdef SIGTTIN
parse_signal ("ttin", SIGTTIN);
#endif
#ifdef SIGTTOU
parse_signal ("ttou", SIGTTOU);
#endif
#ifdef SIGIO
parse_signal ("io", SIGIO);
#endif
#ifdef SIGXCPU
parse_signal ("xcpu", SIGXCPU);
#endif
#ifdef SIGXFSZ
parse_signal ("xfsz", SIGXFSZ);
#endif
#ifdef SIGVTALRM
parse_signal ("vtalrm", SIGVTALRM);
#endif
#ifdef SIGPROF
parse_signal ("prof", SIGPROF);
#endif
#ifdef SIGWINCH
parse_signal ("winch", SIGWINCH);
#endif
#ifdef SIGINFO
parse_signal ("info", SIGINFO);
#endif
else
error ("Undefined signal name %s", name);
}
#undef parse_signal
return make_number (kill (pid, XINT (sigcode)));
}
DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
doc: )
(process)
Lisp_Object process;
{
Lisp_Object proc;
struct coding_system *coding;
if (DATAGRAM_CONN_P (process))
return process;
proc = get_process (process);
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
if (XPROCESS (proc)->raw_status_new)
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running", SDATA (XPROCESS (proc)->name));
if (CODING_REQUIRE_FLUSHING (coding))
{
coding->mode |= CODING_MODE_LAST_BLOCK;
send_process (proc, "", 0, Qnil);
}
#ifdef VMS
send_process (proc, "\032", 1, Qnil);
#else
if (!NILP (XPROCESS (proc)->pty_flag))
send_process (proc, "\004", 1, Qnil);
else
{
int old_outfd, new_outfd;
#ifdef HAVE_SHUTDOWN
if (XPROCESS (proc)->pid == 0
|| XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd))
shutdown (XINT (XPROCESS (proc)->outfd), 1);
if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd))
emacs_close (XINT (XPROCESS (proc)->outfd));
#else
emacs_close (XINT (XPROCESS (proc)->outfd));
#endif
new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
if (new_outfd < 0)
abort ();
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
return process;
}
void
kill_buffer_processes (buffer)
Lisp_Object buffer;
{
Lisp_Object tail, proc;
for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
if (GC_PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
if (NETCONN_P (proc))
Fdelete_process (proc);
else if (XINT (XPROCESS (proc)->infd) >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
}
}
}
#ifdef SIGCHLD
SIGTYPE
sigchld_handler (signo)
int signo;
{
int old_errno = errno;
Lisp_Object proc;
register struct Lisp_Process *p;
extern EMACS_TIME *input_available_clear_time;
SIGNAL_THREAD_CHECK (signo);
#ifdef BSD4_1
extern int sigheld;
sigheld |= sigbit (SIGCHLD);
#endif
while (1)
{
pid_t pid;
WAITTYPE w;
Lisp_Object tail;
#ifdef WNOHANG
#ifndef WUNTRACED
#define WUNTRACED 0
#endif
do
{
errno = 0;
pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
}
while (pid < 0 && errno == EINTR);
if (pid <= 0)
{
#if defined (USG) && !defined (POSIX_SIGNALS)
signal (signo, sigchld_handler);
#endif
#ifdef BSD4_1
sigheld &= ~sigbit (SIGCHLD);
sigrelse (SIGCHLD);
#endif
errno = old_errno;
return;
}
#else
pid = wait (&w);
#endif
for (tail = deleted_pid_list; GC_CONSP (tail); tail = XCDR (tail))
{
Lisp_Object xpid = XCAR (tail);
if ((GC_INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
|| (GC_FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
{
XSETCAR (tail, Qnil);
goto sigchld_end_of_loop;
}
}
p = 0;
for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
if (GC_EQ (p->childp, Qt) && p->pid == pid)
break;
p = 0;
}
if (p == 0)
for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
if (p->pid == -1)
break;
p = 0;
}
if (p != 0)
{
union { int i; WAITTYPE wt; } u;
int clear_desc_flag = 0;
XSETINT (p->tick, ++process_tick);
u.wt = w;
p->raw_status = u.i;
p->raw_status_new = 1;
if ((WIFSIGNALED (w) || WIFEXITED (w))
&& XINT (p->infd) >= 0)
clear_desc_flag = 1;
if (clear_desc_flag)
{
FD_CLR (XINT (p->infd), &input_wait_mask);
FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
}
if (input_available_clear_time)
EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
}
else
{
synch_process_alive = 0;
if (WIFEXITED (w))
synch_process_retcode = WRETCODE (w);
else if (WIFSIGNALED (w))
synch_process_termsig = WTERMSIG (w);
if (input_available_clear_time)
EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
}
sigchld_end_of_loop:
;
#if (defined WINDOWSNT \
|| (defined USG && !defined GNU_LINUX \
&& !(defined HPUX && defined WNOHANG)))
#if defined (USG) && ! defined (POSIX_SIGNALS)
signal (signo, sigchld_handler);
#endif
errno = old_errno;
return;
#endif
}
}
#endif
static Lisp_Object
exec_sentinel_unwind (data)
Lisp_Object data;
{
XPROCESS (XCAR (data))->sentinel = XCDR (data);
return Qnil;
}
static Lisp_Object
exec_sentinel_error_handler (error)
Lisp_Object error;
{
cmd_error_internal (error, "error in process sentinel: ");
Vinhibit_quit = Qt;
update_echo_area ();
Fsleep_for (make_number (2), Qnil);
return Qt;
}
static void
exec_sentinel (proc, reason)
Lisp_Object proc, reason;
{
Lisp_Object sentinel, obuffer, odeactivate, okeymap;
register struct Lisp_Process *p = XPROCESS (proc);
int count = SPECPDL_INDEX ();
int outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
if (inhibit_sentinels)
return;
odeactivate = Vdeactivate_mark;
XSETBUFFER (obuffer, current_buffer);
okeymap = current_buffer->keymap;
sentinel = p->sentinel;
if (NILP (sentinel))
return;
p->sentinel = Qnil;
record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
if (outer_running_asynch_code)
{
Lisp_Object tem;
tem = Fmatch_data (Qnil, Qnil, Qnil);
restore_search_regs ();
record_unwind_save_match_data ();
Fset_match_data (tem, Qt);
}
running_asynch_code = 1;
internal_condition_case_1 (read_process_output_call,
Fcons (sentinel,
Fcons (proc, Fcons (reason, Qnil))),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
exec_sentinel_error_handler);
restore_search_regs ();
running_asynch_code = outer_running_asynch_code;
Vdeactivate_mark = odeactivate;
waiting_for_user_input_p = waiting;
#if 0
if (! EQ (Fcurrent_buffer (), obuffer)
|| ! EQ (current_buffer->keymap, okeymap))
#endif
if (waiting_for_user_input_p == -1)
record_asynch_buffer_change ();
unbind_to (count, Qnil);
}
static void
status_notify (deleting_process)
struct Lisp_Process *deleting_process;
{
register Lisp_Object proc, buffer;
Lisp_Object tail, msg;
struct gcpro gcpro1, gcpro2;
tail = Qnil;
msg = Qnil;
GCPRO2 (tail, msg);
update_tick = process_tick;
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
Lisp_Object symbol;
register struct Lisp_Process *p;
proc = Fcdr (Fcar (tail));
p = XPROCESS (proc);
if (XINT (p->tick) != XINT (p->update_tick))
{
XSETINT (p->update_tick, XINT (p->tick));
while (! EQ (p->filter, Qt)
&& ! EQ (p->status, Qconnect)
&& ! EQ (p->status, Qlisten)
&& ! EQ (p->command, Qt)
&& XINT (p->infd) >= 0
&& p != deleting_process
&& read_process_output (proc, XINT (p->infd)) > 0);
buffer = p->buffer;
if (p->raw_status_new)
update_status (p);
msg = status_message (p);
symbol = p->status;
if (CONSP (p->status))
symbol = XCAR (p->status);
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
|| EQ (symbol, Qclosed))
{
if (delete_exited_processes)
remove_process (proc);
else
deactivate_process (proc);
}
XSETINT (p->update_tick, XINT (p->tick));
if (!NILP (p->sentinel))
exec_sentinel (proc, msg);
else if (!EQ (symbol, Qrun) && !NILP (buffer))
{
Lisp_Object ro, tem;
struct buffer *old = current_buffer;
int opoint, opoint_byte;
int before, before_byte;
ro = XBUFFER (buffer)->read_only;
if (NILP (XBUFFER (buffer)->name))
continue;
Fset_buffer (buffer);
opoint = PT;
opoint_byte = PT_BYTE;
if (XMARKER (p->mark)->buffer)
Fgoto_char (p->mark);
else
SET_PT_BOTH (ZV, ZV_BYTE);
before = PT;
before_byte = PT_BYTE;
tem = current_buffer->read_only;
current_buffer->read_only = Qnil;
insert_string ("\nProcess ");
Finsert (1, &p->name);
insert_string (" ");
Finsert (1, &msg);
current_buffer->read_only = tem;
set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
if (opoint >= before)
SET_PT_BOTH (opoint + (PT - before),
opoint_byte + (PT_BYTE - before_byte));
else
SET_PT_BOTH (opoint, opoint_byte);
set_buffer_internal (old);
}
}
}
update_mode_lines++;
redisplay_preserve_echo_area (13);
UNGCPRO;
}
DEFUN ("set-process-coding-system", Fset_process_coding_system,
Sset_process_coding_system, 1, 3, 0,
doc: )
(process, decoding, encoding)
register Lisp_Object process, decoding, encoding;
{
register struct Lisp_Process *p;
CHECK_PROCESS (process);
p = XPROCESS (process);
if (XINT (p->infd) < 0)
error ("Input file descriptor of %s closed", SDATA (p->name));
if (XINT (p->outfd) < 0)
error ("Output file descriptor of %s closed", SDATA (p->name));
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
p->decode_coding_system = decoding;
p->encode_coding_system = encoding;
setup_process_coding_systems (process);
return Qnil;
}
DEFUN ("process-coding-system",
Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
doc: )
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
return Fcons (XPROCESS (process)->decode_coding_system,
XPROCESS (process)->encode_coding_system);
}
DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
Sset_process_filter_multibyte, 2, 2, 0,
doc: )
(process, flag)
Lisp_Object process, flag;
{
register struct Lisp_Process *p;
CHECK_PROCESS (process);
p = XPROCESS (process);
p->filter_multibyte = flag;
setup_process_coding_systems (process);
return Qnil;
}
DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
Sprocess_filter_multibyte_p, 1, 1, 0,
doc: )
(process)
Lisp_Object process;
{
register struct Lisp_Process *p;
CHECK_PROCESS (process);
p = XPROCESS (process);
return (NILP (p->filter_multibyte) ? Qnil : Qt);
}
static int add_keyboard_wait_descriptor_called_flag;
void
add_keyboard_wait_descriptor (desc)
int desc;
{
if (! add_keyboard_wait_descriptor_called_flag)
FD_CLR (0, &input_wait_mask);
add_keyboard_wait_descriptor_called_flag = 1;
FD_SET (desc, &input_wait_mask);
FD_SET (desc, &non_process_wait_mask);
if (desc > max_keyboard_desc)
max_keyboard_desc = desc;
}
void
delete_keyboard_wait_descriptor (desc)
int desc;
{
int fd;
int lim = max_keyboard_desc;
FD_CLR (desc, &input_wait_mask);
FD_CLR (desc, &non_process_wait_mask);
if (desc == max_keyboard_desc)
for (fd = 0; fd < lim; fd++)
if (FD_ISSET (fd, &input_wait_mask)
&& !FD_ISSET (fd, &non_keyboard_wait_mask))
max_keyboard_desc = fd;
}
static int
keyboard_bit_set (mask)
SELECT_TYPE *mask;
{
int fd;
for (fd = 0; fd <= max_keyboard_desc; fd++)
if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
&& !FD_ISSET (fd, &non_keyboard_wait_mask))
return 1;
return 0;
}
void
init_process ()
{
register int i;
inhibit_sentinels = 0;
#ifdef SIGCHLD
#ifndef CANNOT_DUMP
if (! noninteractive || initialized)
#endif
signal (SIGCHLD, sigchld_handler);
#endif
FD_ZERO (&input_wait_mask);
FD_ZERO (&non_keyboard_wait_mask);
FD_ZERO (&non_process_wait_mask);
max_process_desc = 0;
#ifdef NON_BLOCKING_CONNECT
FD_ZERO (&connect_wait_mask);
num_pending_connects = 0;
#endif
#ifdef ADAPTIVE_READ_BUFFERING
process_output_delay_count = 0;
process_output_skip = 0;
#endif
FD_SET (0, &input_wait_mask);
Vprocess_alist = Qnil;
#ifdef SIGCHLD
deleted_pid_list = Qnil;
#endif
for (i = 0; i < MAXDESC; i++)
{
chan_process[i] = Qnil;
proc_buffered_char[i] = -1;
}
bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
#ifdef DATAGRAM_SOCKETS
bzero (datagram_address, sizeof datagram_address);
#endif
#ifdef HAVE_SOCKETS
{
Lisp_Object subfeatures = Qnil;
struct socket_options *sopt;
#define ADD_SUBFEATURE(key, val) \
subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
#ifdef NON_BLOCKING_CONNECT
ADD_SUBFEATURE (QCnowait, Qt);
#endif
#ifdef DATAGRAM_SOCKETS
ADD_SUBFEATURE (QCtype, Qdatagram);
#endif
#ifdef HAVE_LOCAL_SOCKETS
ADD_SUBFEATURE (QCfamily, Qlocal);
#endif
ADD_SUBFEATURE (QCfamily, Qipv4);
#ifdef AF_INET6
ADD_SUBFEATURE (QCfamily, Qipv6);
#endif
#ifdef HAVE_GETSOCKNAME
ADD_SUBFEATURE (QCservice, Qt);
#endif
#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
ADD_SUBFEATURE (QCserver, Qt);
#endif
for (sopt = socket_options; sopt->name; sopt++)
subfeatures = Fcons (intern (sopt->name), subfeatures);
Fprovide (intern ("make-network-process"), subfeatures);
}
#endif
#if defined (DARWIN) || defined (MAC_OSX)
if (initialized)
{
char *release = get_operating_system_release();
if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION
&& release[1] == '.')) {
Vprocess_connection_type = Qnil;
}
}
#endif
}
void
syms_of_process ()
{
Qprocessp = intern ("processp");
staticpro (&Qprocessp);
Qrun = intern ("run");
staticpro (&Qrun);
Qstop = intern ("stop");
staticpro (&Qstop);
Qsignal = intern ("signal");
staticpro (&Qsignal);
Qopen = intern ("open");
staticpro (&Qopen);
Qclosed = intern ("closed");
staticpro (&Qclosed);
Qconnect = intern ("connect");
staticpro (&Qconnect);
Qfailed = intern ("failed");
staticpro (&Qfailed);
Qlisten = intern ("listen");
staticpro (&Qlisten);
Qlocal = intern ("local");
staticpro (&Qlocal);
Qipv4 = intern ("ipv4");
staticpro (&Qipv4);
#ifdef AF_INET6
Qipv6 = intern ("ipv6");
staticpro (&Qipv6);
#endif
Qdatagram = intern ("datagram");
staticpro (&Qdatagram);
QCname = intern (":name");
staticpro (&QCname);
QCbuffer = intern (":buffer");
staticpro (&QCbuffer);
QChost = intern (":host");
staticpro (&QChost);
QCservice = intern (":service");
staticpro (&QCservice);
QCtype = intern (":type");
staticpro (&QCtype);
QClocal = intern (":local");
staticpro (&QClocal);
QCremote = intern (":remote");
staticpro (&QCremote);
QCcoding = intern (":coding");
staticpro (&QCcoding);
QCserver = intern (":server");
staticpro (&QCserver);
QCnowait = intern (":nowait");
staticpro (&QCnowait);
QCsentinel = intern (":sentinel");
staticpro (&QCsentinel);
QClog = intern (":log");
staticpro (&QClog);
QCnoquery = intern (":noquery");
staticpro (&QCnoquery);
QCstop = intern (":stop");
staticpro (&QCstop);
QCoptions = intern (":options");
staticpro (&QCoptions);
QCplist = intern (":plist");
staticpro (&QCplist);
QCfilter_multibyte = intern (":filter-multibyte");
staticpro (&QCfilter_multibyte);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
staticpro (&Vprocess_alist);
#ifdef SIGCHLD
staticpro (&deleted_pid_list);
#endif
DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
doc: );
delete_exited_processes = 1;
DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
doc: );
Vprocess_connection_type = Qt;
#ifdef ADAPTIVE_READ_BUFFERING
DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering,
doc: );
Vprocess_adaptive_read_buffering = Qt;
#endif
defsubr (&Sprocessp);
defsubr (&Sget_process);
defsubr (&Sget_buffer_process);
defsubr (&Sdelete_process);
defsubr (&Sprocess_status);
defsubr (&Sprocess_exit_status);
defsubr (&Sprocess_id);
defsubr (&Sprocess_name);
defsubr (&Sprocess_tty_name);
defsubr (&Sprocess_command);
defsubr (&Sset_process_buffer);
defsubr (&Sprocess_buffer);
defsubr (&Sprocess_mark);
defsubr (&Sset_process_filter);
defsubr (&Sprocess_filter);
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 (&Sset_process_query_on_exit_flag);
defsubr (&Sprocess_query_on_exit_flag);
defsubr (&Sprocess_contact);
defsubr (&Sprocess_plist);
defsubr (&Sset_process_plist);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
defsubr (&Sformat_network_address);
#endif
#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
#ifdef SIOCGIFCONF
defsubr (&Snetwork_interface_list);
#endif
#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
defsubr (&Snetwork_interface_info);
#endif
#endif
#ifdef DATAGRAM_SOCKETS
defsubr (&Sprocess_datagram_address);
defsubr (&Sset_process_datagram_address);
#endif
defsubr (&Saccept_process_output);
defsubr (&Sprocess_send_region);
defsubr (&Sprocess_send_string);
defsubr (&Sinterrupt_process);
defsubr (&Skill_process);
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);
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
defsubr (&Sset_process_filter_multibyte);
defsubr (&Sprocess_filter_multibyte_p);
}
#else
#include <sys/types.h>
#include <errno.h>
#include "lisp.h"
#include "systime.h"
#include "charset.h"
#include "coding.h"
#include "termopts.h"
#include "sysselect.h"
extern int frame_garbaged;
extern EMACS_TIME timer_check ();
extern int timers_run;
Lisp_Object QCtype;
int
wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
wait_for_cell, wait_proc, just_wait_proc)
int time_limit, microsecs, read_kbd, do_display;
Lisp_Object wait_for_cell;
struct Lisp_Process *wait_proc;
int just_wait_proc;
{
register int nfds;
EMACS_TIME end_time, timeout;
SELECT_TYPE waitchannels;
int xerrno;
if (time_limit || microsecs)
{
EMACS_GET_TIME (end_time);
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
stop_polling ();
turn_on_atimers (0);
while (1)
{
int timeout_reduced_for_timers = 0;
if (read_kbd >= 0)
QUIT;
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
if (time_limit == -1)
{
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 (NILP (wait_for_cell))
{
EMACS_TIME timer_delay;
do
{
int old_timers_run = timers_run;
timer_delay = timer_check (1);
if (timers_run != old_timers_run && do_display)
redisplay_preserve_echo_area (14);
else
break;
}
while (!detect_input_pending ());
if (read_kbd != 0
&& requeued_events_pending_p ())
break;
if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
{
EMACS_TIME difference;
EMACS_SUB_TIME (difference, timer_delay, timeout);
if (EMACS_TIME_NEG_P (difference))
{
timeout = timer_delay;
timeout_reduced_for_timers = 1;
}
}
}
if (read_kbd < 0)
set_waiting_for_input (&timeout);
if (! read_kbd && NILP (wait_for_cell))
FD_ZERO (&waitchannels);
else
FD_SET (0, &waitchannels);
if (frame_garbaged && do_display)
{
clear_waiting_for_input ();
redisplay_preserve_echo_area (15);
if (read_kbd < 0)
set_waiting_for_input (&timeout);
}
if (read_kbd && detect_input_pending ())
{
nfds = 0;
FD_ZERO (&waitchannels);
}
else
nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
&timeout);
xerrno = errno;
clear_waiting_for_input ();
do_pending_window_change (0);
if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
break;
if (nfds == -1)
{
if (xerrno == EINTR)
FD_ZERO (&waitchannels);
else
error ("select error: %s", emacs_strerror (xerrno));
}
#ifdef sun
else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
kill (getpid (), SIGIO);
#endif
#ifdef SIGIO
if (read_kbd && interrupt_input && (waitchannels & 1))
kill (getpid (), SIGIO);
#endif
if (read_kbd
&& detect_input_pending_run_timers (do_display))
{
swallow_events (do_display);
if (detect_input_pending_run_timers (do_display))
break;
}
if (read_kbd
&& requeued_events_pending_p ())
break;
if (! NILP (wait_for_cell)
&& detect_input_pending ())
{
swallow_events (do_display);
if (detect_input_pending ())
break;
}
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
}
start_polling ();
return 0;
}
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
0)
(name)
register Lisp_Object name;
{
return Qnil;
}
DEFUN ("process-inherit-coding-system-flag",
Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
1, 1, 0,
0)
(process)
register Lisp_Object process;
{
return inherit_process_coding_system ? Qt : Qnil;
}
void
kill_buffer_processes (buffer)
Lisp_Object buffer;
{
}
void
init_process ()
{
}
void
syms_of_process ()
{
QCtype = intern (":type");
staticpro (&QCtype);
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_inherit_coding_system_flag);
}
#endif