Boston, MA 02111-1307, USA. */
-#define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
#include <config.h>
#include <signal.h>
#ifdef IRIS
#include <sys/sysmacros.h> /* for "minor" */
#endif /* not IRIS */
+
+#ifdef HAVE_SYS_WAIT
+#include <sys/wait.h>
+#endif
#include "systime.h"
#include "systty.h"
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
-Lisp_Object Qlocal;
-Lisp_Object QCname, QCbuffer, QChost, QCservice;
+Lisp_Object Qlocal, Qdatagram;
+Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
Lisp_Object QClocal, QCremote, QCcoding;
-Lisp_Object QCserver, QCdatagram, QCnowait, QCnoquery, QCstop;
-Lisp_Object QCsentinel, QClog, QCoptions, QCfeature;
+Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
+Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
Lisp_Object Qlast_nonmenu_event;
/* QCfamily is declared and initialized in xfaces.c,
QCfilter in keyboard.c. */
/* Qexit is declared and initialized in eval.c. */
+/* QCfamily is defined in xfaces.c. */
+extern Lisp_Object QCfamily;
+/* QCfilter is defined in keyboard.c. */
+extern Lisp_Object QCfilter;
+
/* a process object is a network connection when its childp field is neither
- Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
+ Qt nor Qnil but is instead a property list (KEY VAL ...). */
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
int len;
} datagram_address[MAXDESC];
#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
-#define DATAGRAM_CONN_P(proc) (datagram_address[XPROCESS (proc)->infd].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)
extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
#ifdef HAVE_PTYS
+#ifdef HAVE_PTY_H
+#include <pty.h>
+#endif
/* The file name of the pty opened by allocate_pty. */
static char pty_name[24];
signame = "unknown";
string = build_string (signame);
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
- XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
+ SSET (string, 0, DOWNCASE (SREF (string, 0)));
return concat2 (string, string2);
}
else if (EQ (symbol, Qexit))
if (NILP (obj))
obj = Fget_buffer (name);
if (NILP (obj))
- error ("Process %s does not exist", XSTRING (name)->data);
+ error ("Process %s does not exist", SDATA (name));
}
else if (NILP (name))
obj = Fcurrent_buffer ();
{
proc = Fget_buffer_process (obj);
if (NILP (proc))
- error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data);
+ error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
}
else
{
2, 2, 0,
doc: /* Give PROCESS the filter function FILTER; nil means no filter.
t means stop accepting output from the process.
-When a process has a filter, each time it does output
-the entire string of output is passed to the filter.
+
+When a process has a filter, its buffer is not used for output.
+Instead, each time it does output, the entire string of output is
+passed to the filter.
+
The filter gets two arguments: the process and the string of output.
-If the process has a filter, its buffer is not used for output. */)
+The string argument is normally a multibyte string, except:
+- if the process' input coding system is no-conversion or raw-text,
+ it is a unibyte string (the non-converted input), or else
+- if `default-enable-multibyte-characters' is nil, it is a unibyte
+ string (the result of converting the decoded input multibyte
+ string to unibyte with `string-make-unibyte'). */)
(process, filter)
register Lisp_Object process, filter;
{
return Fplist_get (contact, key);
}
+DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
+ 1, 1, 0,
+ doc: /* Return the plist of PROCESS. */)
+ (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: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
+ (process, plist)
+ register Lisp_Object process, plist;
+{
+ CHECK_PROCESS (process);
+ CHECK_LIST (plist);
+
+ XPROCESS (process)->plist = plist;
+ return plist;
+}
+
#if 0 /* Turned off because we don't currently record this info
in the process. Perhaps add it. */
DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
return XPROCESS (process)->type;
}
#endif
+
+#ifdef HAVE_SOCKETS
+DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
+ 1, 2, 0,
+ doc: /* Convert network ADDRESS from internal format to a string.
+If optional second argument OMIT-PORT is non-nil, don't include a port
+number in the string; in this case, interpret a 4 element vector as an
+IP address. Returns nil if format of ADDRESS is invalid. */)
+ (address, omit_port)
+ Lisp_Object address, omit_port;
+{
+ if (NILP (address))
+ return Qnil;
+
+ if (STRINGP (address)) /* AF_LOCAL */
+ return address;
+
+ if (VECTORP (address)) /* AF_INET */
+ {
+ register struct Lisp_Vector *p = XVECTOR (address);
+ Lisp_Object args[6];
+ int nargs, i;
+
+ if (!NILP (omit_port) && (p->size == 4 || p->size == 5))
+ {
+ 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
+ return Qnil;
+
+ for (i = 0; i < nargs; i++)
+ 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
\f
Lisp_Object
list_processes_1 (query_only)
if (!NILP (query_only) && !NILP (p->kill_without_query))
continue;
if (STRINGP (p->name)
- && ( i = XSTRING (p->name)->size, (i > w_proc)))
+ && ( 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; /* (Killed) */
- else if ((i = XSTRING (XBUFFER (p->buffer)->name)->size, (i > w_buffer)))
+ else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
w_buffer = i;
}
if (STRINGP (p->tty_name)
- && (i = XSTRING (p->tty_name)->size, (i > w_tty)))
+ && (i = SCHARS (p->tty_name), (i > w_tty)))
w_tty = i;
}
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 (p->infd) ? "datagram" : "stream"),
- XSTRING (port)->data);
+ (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
+ (STRINGP (port) ? (char *)SDATA (port) : "?"));
insert_string (tembuf);
}
else if (NETCONN1_P (p))
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 (p->infd) ? "datagram" : "stream"),
- XSTRING (host)->data);
+ (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
+ (STRINGP (host) ? (char *)SDATA (host) : "?"));
insert_string (tembuf);
}
else
with any buffer.
Third arg is program file name. It is searched for in PATH.
Remaining arguments are strings to give program as arguments.
+
usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
(nargs, args)
int nargs;
register unsigned char **new_argv;
#endif
register int i;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
buffer = args[1];
if (!NILP (buffer))
record_unwind_protect (start_process_unwind, proc);
XPROCESS (proc)->childp = Qt;
+ XPROCESS (proc)->plist = Qnil;
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
#ifdef VMS
/* Make a one member argv with all args concatenated
together separated by a blank. */
- len = STRING_BYTES (XSTRING (program)) + 2;
+ len = SBYTES (program) + 2;
for (i = 3; i < nargs; i++)
{
tem = args[i];
CHECK_STRING (tem);
- len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */
+ len += SBYTES (tem) + 1; /* count the blank */
}
new_argv = (unsigned char *) alloca (len);
- strcpy (new_argv, XSTRING (program)->data);
+ strcpy (new_argv, SDATA (program));
for (i = 3; i < nargs; i++)
{
tem = args[i];
CHECK_STRING (tem);
strcat (new_argv, " ");
- strcat (new_argv, XSTRING (tem)->data);
+ strcat (new_argv, SDATA (tem));
}
/* Need to add code here to check for program existence on VMS */
#else /* not VMS */
new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
- /* If program file name is not absolute, search our path for it */
- if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0])
- && !(XSTRING (program)->size > 1
- && IS_DEVICE_SEP (XSTRING (program)->data[1])))
+ /* If program file name is not absolute, search our path for it.
+ Put the name we will really use in TEM. */
+ 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, 1);
+ 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);
- tem = ENCODE_FILE (tem);
- new_argv[0] = XSTRING (tem)->data;
}
else
{
if (!NILP (Ffile_directory_p (program)))
error ("Specified program for new process is a directory");
-
- tem = ENCODE_FILE (program);
- new_argv[0] = XSTRING (tem)->data;
+ tem = program;
}
+ /* If program file name starts with /: for quoting a magic name,
+ discard that. */
+ if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
+ && SREF (tem, 1) == ':')
+ tem = Fsubstring (tem, make_number (2), Qnil);
+
+ /* Encode the file name and put it in NEW_ARGV.
+ That's where the child will use it to execute the program. */
+ tem = ENCODE_FILE (tem);
+ new_argv[0] = SDATA (tem);
+
/* Here we encode arguments by the coding system used for sending
data to the process. We don't support using different coding
systems for encoding arguments and for encoding data sent to the
if (STRING_MULTIBYTE (tem))
tem = (code_convert_string_norecord
(tem, XPROCESS (proc)->encode_coding_system, 1));
- new_argv[i - 2] = XSTRING (tem)->data;
+ new_argv[i - 2] = SDATA (tem);
}
new_argv[i - 2] = 0;
#endif /* not VMS */
if (inchannel >= 0)
{
-#ifndef USG
- /* On USG systems it does not work to open the pty's tty here
- and then close and reopen it in the child. */
+#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
+ /* On most USG systems it does not work to open the pty's tty here,
+ then close it and reopen it in the child. */
#ifdef O_NOCTTY
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
report_file_error ("Opening pty", Qnil);
#else
forkin = forkout = -1;
-#endif /* not USG */
+#endif /* not USG, or USG_SUBTTY_WORKS */
pty_flag = 1;
}
else
if (family == AF_LOCAL)
{
struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
- cp = XSTRING (address)->data;
+ cp = SDATA (address);
for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
sockun->sun_path[i] = *cp++;
}
if (!DATAGRAM_CONN_P (process))
return Qnil;
- channel = XPROCESS (process)->infd;
+ channel = XINT (XPROCESS (process)->infd);
return conv_sockaddr_to_lisp (datagram_address[channel].sa,
datagram_address[channel].len);
}
if (!DATAGRAM_CONN_P (process))
return Qnil;
- channel = XPROCESS (process)->infd;
+ channel = XINT (XPROCESS (process)->infd);
len = get_lisp_to_sockaddr_size (address, &family);
if (datagram_address[channel].len != len)
opt = XCAR (opt);
}
if (STRINGP (opt))
- name = (char *) XSTRING (opt)->data;
+ name = (char *) SDATA (opt);
else if (SYMBOLP (opt))
- name = (char *) XSYMBOL (opt)->name->data;
+ name = (char *) SDATA (SYMBOL_NAME (opt));
else {
error ("Mal-formed option list");
return 0;
if (NILP (val))
arg = "";
else if (STRINGP (val))
- arg = (char *) XSTRING (val)->data;
+ arg = (char *) SDATA (val);
else if (XSYMBOL (val))
- arg = (char *) XSYMBOL (val)->name->data;
+ arg = (char *) SDATA (SYMBOL_NAME (val));
else
error ("Invalid argument to %s option", name);
}
Fset_network_process_options, Sset_network_process_options,
1, MANY, 0,
doc: /* Set one or more options for network process PROCESS.
-Arguments are PROCESS &rest OPTIONS.
Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
A boolean value is false if it either zero or nil, true otherwise.
linger=BOOL or TIMEOUT -- Send queued messages before closing.
oobinline=BOOL -- Place out-of-band data in receive data stream.
priority=INT -- Set protocol defined priority for sent packets.
-reuseaddr=BOOL -- Allow reusing a recently used address. */)
+reuseaddr=BOOL -- Allow reusing a recently used address.
+
+usage: (set-network-process-options PROCESS &rest OPTIONS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
process = args[0];
CHECK_PROCESS (process);
- if (nargs > 1 && XPROCESS (process)->infd >= 0)
+ if (nargs > 1 && XINT (XPROCESS (process)->infd) >= 0)
{
opts = Flist (nargs, args);
- set_socket_options (XPROCESS (process)->infd, opts, 0);
+ set_socket_options (XINT (XPROCESS (process)->infd), opts, 0);
}
return process;
}
\f
-/* Check whether a given KEY VALUE pair is supported on this system. */
-
-static int
-network_process_featurep (key, value)
- Lisp_Object key, value;
-{
-
- if (EQ (key, QCnowait))
- {
-#ifdef NON_BLOCKING_CONNECT
- return 1;
-#else
- return NILP (value);
-#endif
- }
-
- if (EQ (key, QCdatagram))
- {
-#ifdef DATAGRAM_SOCKETS
- return 1;
-#else
- return NILP (value);
-#endif
- }
-
- if (EQ (key, QCfamily))
- {
- if (NILP (value))
- return 1;
-#ifdef HAVE_LOCAL_SOCKETS
- if (EQ (key, Qlocal))
- return 1;
-#endif
- return 0;
- }
-
- if (EQ (key, QCname))
- return STRINGP (value);
-
- if (EQ (key, QCbuffer))
- return (NILP (value) || STRINGP (value) || BUFFERP (value));
-
- if (EQ (key, QClocal) || EQ (key, QCremote))
- {
- int family;
- return get_lisp_to_sockaddr_size (value, &family);
- }
-
- if (EQ (key, QChost))
- return (NILP (value) || STRINGP (value));
-
- if (EQ (key, QCservice))
- {
-#ifdef HAVE_GETSOCKNAME
- if (EQ (value, Qt))
- return 1;
-#endif
- return (INTEGERP (value) || STRINGP (value));
- }
-
- if (EQ (key, QCserver))
- {
-#ifndef TERM
- return 1;
-#else
- return NILP (value);
-#endif
- }
-
- if (EQ (key, QCoptions))
- return set_socket_options (-1, value, 0);
-
- if (EQ (key, QCcoding))
- return 1;
- if (EQ (key, QCsentinel))
- return 1;
- if (EQ (key, QCfilter))
- return 1;
- if (EQ (key, QClog))
- return 1;
- if (EQ (key, QCnoquery))
- return 1;
- if (EQ (key, QCstop))
- return 1;
-
- return 0;
-}
-
/* A version of request_sigio suitable for a record_unwind_protect. */
Lisp_Object
integer specifying a port number to connect to. If SERVICE is t,
a random port number is selected for the server.
+:type TYPE -- TYPE is the type of connection. The default (nil) is a
+stream type connection, `datagram' creates a datagram type connection.
+
:family FAMILY -- FAMILY is the address (and protocol) family for the
service specified by HOST and SERVICE. The default address family is
Inet (or IPv4) for the host and port number specified by HOST and
:coding CODING -- CODING is coding system for this process.
-:datagram BOOL -- Create a datagram type connection if BOOL is
-non-nil. Default is a stream type connection.
-
:options OPTIONS -- Set the specified options for the network process.
-See `set-process-options' for details.
+See `set-network-process-options' for details.
:nowait BOOL -- If BOOL is non-nil for a stream type client process,
return without waiting for the connection to complete; instead, the
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
:log LOG -- Install LOG as the server process log function. This
-function is called as when the server accepts a network connection from a
+function is called when the server accepts a network connection from a
client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
is the server process, CLIENT is the new process for the connection,
and MESSAGE is a string.
+:plist PLIST -- Install PLIST as the new process' initial plist.
+
:server BOOL -- if BOOL is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
Default is a client process.
inherited from the server process' TYPE, FILTER and SENTINEL.
- The client process' contact info is set according to the client's
addressing information (typically an IP address and a port number).
+- The client process' plist is initialized from the server's plist.
Notice that the FILTER and SENTINEL args are never used directly by
the server process. Also, the BUFFER argument is not used directly by
-the server process, but via `network-server-log-function' hook, a log
-of the accepted (and failed) connections may be recorded in the server
-process' buffer.
+the server process, but via the optional :log function, accepted (and
+failed) connections may be logged in the server process' buffer.
-The following special call returns t iff a given KEY VALUE
-pair is supported on this system:
- (make-network-process :feature KEY VALUE)
+The original argument list, modified with the actual connection
+information, is available via the `process-contact' function.
usage: (make-network-process &rest ARGS) */)
(nargs, args)
int s = -1, outch, inch;
struct gcpro gcpro1;
int retry = 0;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int count1;
Lisp_Object QCaddress; /* one of QClocal or QCremote */
Lisp_Object tem;
Lisp_Object filter, sentinel;
int is_non_blocking_client = 0;
int is_server = 0;
- int socktype = SOCK_STREAM;
+ int socktype;
int family = -1;
if (nargs == 0)
return Qnil;
- /* Handle :feature KEY VALUE query. */
- if (EQ (args[0], QCfeature))
- {
- if (nargs != 3)
- return Qnil;
- return network_process_featurep (args[1], args[2]) ? Qt : Qnil;
- }
-
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
GCPRO1 (contact);
init_winsock (TRUE);
#endif
- /* :datagram BOOL */
- tem = Fplist_get (contact, QCdatagram);
- if (!NILP (tem))
- {
-#ifndef DATAGRAM_SOCKETS
- error ("Datagram connections not supported");
-#else
- socktype = SOCK_DGRAM;
+ /* :type TYPE (nil: stream, datagram */
+ 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");
/* :server BOOL */
tem = Fplist_get (contact, QCserver);
if (!NILP (tem))
{
-#ifdef TERM
+ /* Don't support network sockets when non-blocking mode is
+ not available, since a blocked Emacs is not useful. */
+#if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
error ("Network servers not supported");
#else
is_server = 1;
{
struct servent *svc_info;
CHECK_STRING (service);
- svc_info = getservbyname (XSTRING (service)->data, "tcp");
+ svc_info = getservbyname (SDATA (service), "tcp");
if (svc_info == 0)
- error ("Unknown service: %s", XSTRING (service)->data);
+ 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", XSTRING (host)->data, ntohs (port));
+ send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port));
send_command (s, C_DUMB, 1, 0);
#else /* not TERM */
CHECK_STRING (service);
bzero (&address_un, sizeof address_un);
address_un.sun_family = AF_LOCAL;
- strncpy (address_un.sun_path, XSTRING (service)->data, sizeof address_un.sun_path);
+ 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;
else
{
CHECK_STRING (service);
- portstring = XSTRING (service)->data;
+ portstring = SDATA (service);
}
immediate_quit = 1;
hints.ai_family = NILP (Fplist_member (contact, QCfamily)) ? AF_UNSPEC : family;
hints.ai_socktype = socktype;
hints.ai_protocol = 0;
- ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
+ ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
if (ret)
#ifdef HAVE_GAI_STRERROR
- error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
+ error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
#else
- error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ret);
+ error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
#endif
immediate_quit = 0;
{
struct servent *svc_info;
CHECK_STRING (service);
- svc_info = getservbyname (XSTRING (service)->data,
+ svc_info = getservbyname (SDATA (service),
(socktype == SOCK_DGRAM ? "udp" : "tcp"));
if (svc_info == 0)
- error ("Unknown service: %s", XSTRING (service)->data);
+ error ("Unknown service: %s", SDATA (service));
port = svc_info->s_port;
}
as it may `hang' emacs for a very long time. */
immediate_quit = 1;
QUIT;
- host_info_ptr = gethostbyname (XSTRING (host)->data);
+ host_info_ptr = gethostbyname (SDATA (host));
immediate_quit = 0;
if (host_info_ptr)
/* Attempt to interpret host as numeric inet address */
{
IN_ADDR numeric_addr;
- numeric_addr = inet_addr ((char *) XSTRING (host)->data);
+ numeric_addr = inet_addr ((char *) SDATA (host));
if (NUMERIC_ADDR_ERROR)
- error ("Unknown host \"%s\"", XSTRING (host)->data);
+ error ("Unknown host \"%s\"", SDATA (host));
bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
sizeof (address_in.sin_addr));
}
/* Do this in case we never enter the for-loop below. */
- count1 = specpdl_ptr - specpdl;
+ count1 = SPECPDL_INDEX ();
s = -1;
for (lres = res; lres; lres = lres->ai_next)
if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
{
((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
- service = make_number (sa1.sin_port);
+ service = make_number (ntohs (sa1.sin_port));
contact = Fplist_put (contact, QCservice, service);
}
}
#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
}
#ifdef HAVE_GETADDRINFO
p = XPROCESS (proc);
p->childp = contact;
+ p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
+
p->buffer = buffer;
p->sentinel = sentinel;
p->filter = filter;
val = Qnil;
else
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (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))
{
if (EQ (coding_systems, Qt))
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (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);
conv_sockaddr_to_lisp (&saddr.sa, len));
#ifdef HAVE_GETSOCKNAME
len = sizeof saddr;
- if (getsockname (channel, &saddr.sa, &len) == 0)
+ 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;
(STRINGP (host) ? host : build_string ("-")),
build_string ("\n")));
- if (p->sentinel)
+ if (!NILP (p->sentinel))
exec_sentinel (proc,
concat3 (build_string ("open from "),
(STRINGP (host) ? host : build_string ("-")),
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
-#ifdef hpux
+#ifdef POLLING_PROBLEM_IN_SELECT
/* AlainF 5-Jul-1996
HP-UX 10.10 seem to have problems with signals coming in
Causes "poll: interrupted system call" messages when Emacs is run
in an X window
- Turn off periodic alarms (in case they are in use) */
+ Turn off periodic alarms (in case they are in use),
+ and then turn off any other atimers. */
+ stop_polling ();
turn_on_atimers (0);
#endif
SELECT_TYPE Atemp, Ctemp;
Atemp = input_wait_mask;
+#ifdef MAC_OSX
+ /* On Mac OS X, the SELECT system call always says input is
+ present (for reading) at stdin, even when none is. This
+ causes the call to SELECT below to return 1 and
+ status_notify not to be called. As a result output of
+ subprocesses are incorrectly discarded. */
+ FD_CLR (0, &Atemp);
+#endif
Ctemp = connect_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
the tail of decoding buffer) should be prepended to the new
data read to decode all together. */
chars = (char *) alloca (nbytes + carryover);
- bcopy (XSTRING (p->decoding_buf)->data, buf, carryover);
+ bcopy (SDATA (p->decoding_buf), buf, carryover);
bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else /* not VMS */
chars = (char *) alloca (carryover + readmax);
if (carryover)
/* See the comment above. */
- bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
+ bcopy (SDATA (p->decoding_buf), chars, carryover);
#ifdef DATAGRAM_SOCKETS
/* We have a working select, so proc_buffered_char is always -1. */
/* We inhibit quit here instead of just catching it so that
hitting ^G when a filter happens to be running won't screw
it up. */
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
Lisp_Object obuffer, okeymap;
Lisp_Object text;
}
carryover = nbytes - coding->consumed;
- bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
+ bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
carryover);
XSETINT (p->decoding_carryover, carryover);
- nbytes = STRING_BYTES (XSTRING (text));
- nchars = XSTRING (text)->size;
+ nbytes = SBYTES (text);
+ nchars = SCHARS (text);
if (nbytes > 0)
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
}
}
carryover = nbytes - coding->consumed;
- bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
+ bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
carryover);
XSETINT (p->decoding_carryover, carryover);
/* Adjust the multibyteness of TEXT to that of the buffer. */
text = (STRING_MULTIBYTE (text)
? Fstring_as_unibyte (text)
: Fstring_as_multibyte (text));
- nbytes = STRING_BYTES (XSTRING (text));
- nchars = XSTRING (text)->size;
+ nbytes = SBYTES (text);
+ nchars = SCHARS (text);
/* Insert before markers in case we are inserting where
the buffer's mark is, and the user's next command is Meta-y. */
insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running",
- XSTRING (XPROCESS (proc)->name)->data);
+ SDATA (XPROCESS (proc)->name));
if (XINT (XPROCESS (proc)->outfd) < 0)
error ("Output file descriptor of %s is closed",
- XSTRING (XPROCESS (proc)->name)->data);
+ SDATA (XPROCESS (proc)->name));
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
Vlast_coding_system_used = coding->symbol;
}
else if (STRINGP (object))
{
- from_byte = buf - XSTRING (object)->data;
+ from_byte = buf - SDATA (object);
from = string_byte_to_char (object, from_byte);
to = string_byte_to_char (object, from_byte + len);
}
coding->composing = COMPOSITION_DISABLED;
}
- if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require)
+ if (SBYTES (XPROCESS (proc)->encoding_buf) < require)
XPROCESS (proc)->encoding_buf = make_uninit_string (require);
if (from_byte >= 0)
buf = (BUFFERP (object)
? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
- : XSTRING (object)->data + from_byte);
+ : SDATA (object) + from_byte);
object = XPROCESS (proc)->encoding_buf;
- encode_coding (coding, (char *) buf, XSTRING (object)->data,
- len, STRING_BYTES (XSTRING (object)));
+ encode_coding (coding, (char *) buf, SDATA (object),
+ len, SBYTES (object));
len = coding->produced;
- buf = XSTRING (object)->data;
+ buf = SDATA (object);
if (temp_buf)
xfree (temp_buf);
}
if (BUFFERP (object))
offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
else if (STRINGP (object))
- offset = buf - XSTRING (object)->data;
+ offset = buf - SDATA (object);
XSETFASTINT (zero, 0);
#ifdef EMACS_HAS_USECS
if (BUFFERP (object))
buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
else if (STRINGP (object))
- buf = offset + XSTRING (object)->data;
+ buf = offset + SDATA (object);
rv = 0;
}
deactivate_process (proc);
#ifdef VMS
error ("Error writing to process %s; closed it",
- XSTRING (XPROCESS (proc)->name)->data);
+ SDATA (XPROCESS (proc)->name));
#else
error ("SIGPIPE raised on process %s; closed it",
- XSTRING (XPROCESS (proc)->name)->data);
+ SDATA (XPROCESS (proc)->name));
#endif
}
Lisp_Object proc;
CHECK_STRING (string);
proc = get_process (process);
- send_process (proc, XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)), string);
+ send_process (proc, SDATA (string),
+ SBYTES (string), string);
return Qnil;
}
\f
if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
- XSTRING (p->name)->data);
+ SDATA (p->name));
#ifdef TIOCGPGRP
if (!NILP (p->subtty))
if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (NILP (p->pty_flag))
current_group = Qnil;
/* If we are using pgrps, get a pgrp number and make it negative. */
- if (!NILP (current_group))
+ if (NILP (current_group))
+ /* Send the signal to the shell's process group. */
+ gid = XFASTINT (p->pid);
+ else
{
#ifdef SIGNALS_VIA_CHARACTERS
/* If possible, send signals to the entire pgrp
#endif /* ! defined (TCGETA) */
#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
#endif /* ! defined HAVE_TERMIOS */
-#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
+ abort ();
+ /* The code above always returns from the function. */
+#endif /* defined (SIGNALS_VIA_CHARACTERS) */
#ifdef TIOCGPGRP
- /* Get the pgrp using the tty itself, if we have that.
+ /* Get the current pgrp using the tty itself, if we have that.
Otherwise, use the pty to get the pgrp.
On pfa systems, saka@pfu.fujitsu.co.JP writes:
"TIOCGPGRP symbol defined in sys/ioctl.h at E50.
else
err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
-#ifdef pfa
if (err == -1)
- gid = - XFASTINT (p->pid);
-#endif /* ! defined (pfa) */
+ /* If we can't get the information, assume
+ the shell owns the tty. */
+ gid = XFASTINT (p->pid);
}
+
+ /* It is not clear whether anything really can set GID to -1.
+ Perhaps on some system one of those ioctls can or could do so.
+ Or perhaps this is vestigial. */
if (gid == -1)
no_pgrp = 1;
- else
- gid = - gid;
#else /* ! defined (TIOCGPGRP ) */
/* Can't select pgrps on this system, so we know that
the child itself heads the pgrp. */
- gid = - XFASTINT (p->pid);
+ gid = XFASTINT (p->pid);
#endif /* ! defined (TIOCGPGRP ) */
/* If current_group is lambda, and the shell owns the terminal,
don't send any signal. */
- if (EQ (current_group, Qlambda) && gid == - XFASTINT (p->pid))
+ if (EQ (current_group, Qlambda) && gid == XFASTINT (p->pid))
return;
}
- else
- gid = - XFASTINT (p->pid);
switch (signo)
{
kill (gid, signo);
}
#else /* ! defined (TIOCSIGSEND) */
- EMACS_KILLPG (-gid, signo);
+ EMACS_KILLPG (gid, signo);
#endif /* ! defined (TIOCSIGSEND) */
}
}
DEFUN ("signal-process", Fsignal_process, Ssignal_process,
- 2, 2, "nProcess number: \nnSignal code: ",
- doc: /* Send the process with process id PID the signal with code SIGCODE.
-PID must be an integer. The process need not be a child of this Emacs.
+ 2, 2, "sProcess (name or number): \nnSignal code: ",
+ doc: /* Send PROCESS the signal with code SIGCODE.
+PROCESS may also be an integer specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
SIGCODE may be an integer, or a symbol whose name is a signal name. */)
- (pid, sigcode)
- Lisp_Object pid, sigcode;
+ (process, sigcode)
+ Lisp_Object process, sigcode;
{
- CHECK_NUMBER (pid);
+ Lisp_Object pid;
+
+ if (INTEGERP (process))
+ {
+ pid = process;
+ goto got_it;
+ }
+
+ if (STRINGP (process))
+ {
+ Lisp_Object tem;
+ if (tem = Fget_process (process), NILP (tem))
+ {
+ pid = Fstring_to_number (process, make_number (10));
+ if (XINT (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 (!INTEGERP (pid) || XINT (pid) <= 0)
+ error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
+
+ got_it:
#define handle_signal(NAME, VALUE) \
else if (!strcmp (name, NAME)) \
unsigned char *name;
CHECK_SYMBOL (sigcode);
- name = XSYMBOL (sigcode)->name->data;
+ name = SDATA (SYMBOL_NAME (sigcode));
if (0)
;
if (! NILP (XPROCESS (proc)->raw_status_low))
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
- error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+ error ("Process %s not running", SDATA (XPROCESS (proc)->name));
if (CODING_REQUIRE_FLUSHING (coding))
{
{
Lisp_Object sentinel, obuffer, odeactivate, okeymap;
register struct Lisp_Process *p = XPROCESS (proc);
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
/* Report all recent events of a change in process status
(either run the sentinel or output a message).
- This is done while Emacs is waiting for keyboard input. */
+ This is usually done while Emacs is waiting for keyboard input
+ but can be done at other times. */
void
status_notify ()
CHECK_PROCESS (proc);
p = XPROCESS (proc);
if (XINT (p->infd) < 0)
- error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
+ error ("Input file descriptor of %s closed", SDATA (p->name));
if (XINT (p->outfd) < 0)
- error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
+ error ("Output file descriptor of %s closed", SDATA (p->name));
p->decode_coding_system = Fcheck_coding_system (decoding);
p->encode_coding_system = Fcheck_coding_system (encoding);
#ifdef DATAGRAM_SOCKETS
bzero (datagram_address, sizeof datagram_address);
#endif
+
+#ifdef HAVE_SOCKETS
+ {
+ Lisp_Object subfeatures = Qnil;
+#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
+#ifdef HAVE_GETSOCKNAME
+ ADD_SUBFEATURE (QCservice, Qt);
+#endif
+#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
+ ADD_SUBFEATURE (QCserver, Qt);
+#endif
+#ifdef SO_BINDTODEVICE
+ ADD_SUBFEATURE (QCoptions, intern ("bindtodevice"));
+#endif
+#ifdef SO_BROADCAST
+ ADD_SUBFEATURE (QCoptions, intern ("broadcast"));
+#endif
+#ifdef SO_DONTROUTE
+ ADD_SUBFEATURE (QCoptions, intern ("dontroute"));
+#endif
+#ifdef SO_KEEPALIVE
+ ADD_SUBFEATURE (QCoptions, intern ("keepalive"));
+#endif
+#ifdef SO_LINGER
+ ADD_SUBFEATURE (QCoptions, intern ("linger"));
+#endif
+#ifdef SO_OOBINLINE
+ ADD_SUBFEATURE (QCoptions, intern ("oobinline"));
+#endif
+#ifdef SO_PRIORITY
+ ADD_SUBFEATURE (QCoptions, intern ("priority"));
+#endif
+#ifdef SO_REUSEADDR
+ ADD_SUBFEATURE (QCoptions, intern ("reuseaddr"));
+#endif
+ Fprovide (intern ("make-network-process"), subfeatures);
+ }
+#endif /* HAVE_SOCKETS */
}
void
staticpro (&Qlisten);
Qlocal = intern ("local");
staticpro (&Qlocal);
+ Qdatagram = intern ("datagram");
+ staticpro (&Qdatagram);
QCname = intern (":name");
staticpro (&QCname);
staticpro (&QChost);
QCservice = intern (":service");
staticpro (&QCservice);
+ QCtype = intern (":type");
+ staticpro (&QCtype);
QClocal = intern (":local");
staticpro (&QClocal);
QCremote = intern (":remote");
staticpro (&QCcoding);
QCserver = intern (":server");
staticpro (&QCserver);
- QCdatagram = intern (":datagram");
- staticpro (&QCdatagram);
QCnowait = intern (":nowait");
staticpro (&QCnowait);
QCsentinel = intern (":sentinel");
staticpro (&QCstop);
QCoptions = intern (":options");
staticpro (&QCoptions);
- QCfeature = intern (":feature");
- staticpro (&QCfeature);
+ QCplist = intern (":plist");
+ staticpro (&QCplist);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
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_options);
defsubr (&Smake_network_process);
+ defsubr (&Sformat_network_address);
#endif /* HAVE_SOCKETS */
#ifdef DATAGRAM_SOCKETS
defsubr (&Sprocess_datagram_address);
extern EMACS_TIME timer_check ();
extern int timers_run;
+Lisp_Object QCtype;
+
/* As described above, except assuming that there are no subprocesses:
Wait for timeout to elapse and/or keyboard input to be available.
int xerrno;
/* Either nil or a cons cell, the car of which is of interest and
may be changed outside of this routine. */
- Lisp_Object wait_for_cell = Qnil;
+ Lisp_Object wait_for_cell;
+
+ wait_for_cell = Qnil;
/* If waiting for non-nil in a cell, record where. */
if (CONSP (read_kbd))
}
/* Turn off periodic alarms (in case they are in use)
+ and then turn off any other atimers,
because the select emulator uses alarms. */
+ stop_polling ();
turn_on_atimers (0);
while (1)
void
syms_of_process ()
{
+ QCtype = intern (":type");
+ staticpro (&QCtype);
+
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_inherit_coding_system_flag);
}