/* Asynchronous subprocess control for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
- 1996, 1998, 1999, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+ 1996, 1998, 1999, 2001, 2002, 2003, 2004,
+ 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
+
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
-
-#if defined(WINDOWSNT) || defined(UNIX98_PTYS)
-#include <stdlib.h>
#include <fcntl.h>
-#endif /* not WINDOWSNT */
#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
#include <sys/socket.h>
#endif
#endif /* HAVE_SOCKETS */
-/* TERM is a poor-man's SLIP, used on GNU/Linux. */
-#ifdef TERM
-#include <client.h>
-#endif
-
#if defined(BSD_SYSTEM)
#include <sys/ioctl.h>
#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
#endif /* HAVE_PTYS and no O_NDELAY */
#endif /* BSD_SYSTEM */
-#ifdef BROKEN_O_NONBLOCK
-#undef O_NONBLOCK
-#endif /* BROKEN_O_NONBLOCK */
-
#ifdef NEED_BSDTTY
#include <bsdtty.h>
#endif
#endif
#endif
-#ifdef IRIS
-#include <sys/sysmacros.h> /* for "minor" */
-#endif /* not IRIS */
-
#ifdef HAVE_SYS_WAIT
#include <sys/wait.h>
#endif
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
Lisp_Object Qlocal, Qipv4, Qdatagram;
+Lisp_Object Qreal, Qnetwork, Qserial;
#ifdef AF_INET6
Lisp_Object Qipv6;
#endif
+Lisp_Object QCport, QCspeed, QCprocess;
+Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
+Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
Lisp_Object QClocal, QCremote, QCcoding;
Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
/* 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 property list (KEY VAL ...). */
+Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
+Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
+Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
+Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
#ifdef HAVE_SOCKETS
-#define NETCONN_P(p) (CONSP (XPROCESS (p)->childp))
-#define NETCONN1_P(p) (CONSP ((p)->childp))
+#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
+#define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
+#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
+#define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
#else
#define NETCONN_P(p) 0
#define NETCONN1_P(p) 0
+#define SERIALCONN_P(p) 0
+#define SERIALCONN1_P(p) 0
#endif /* HAVE_SOCKETS */
/* Define first descriptor number available for subprocesses. */
-#ifdef VMS
-#define FIRST_PROC_DESC 1
-#else /* Not VMS */
#define FIRST_PROC_DESC 3
-#endif
/* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
testing SIGCHLD. */
extern char *get_operating_system_release ();
+/* Serial processes require termios or Windows. */
+#if defined (HAVE_TERMIOS) || defined (WINDOWSNT)
+#define HAVE_SERIAL
+#endif
+
+#ifdef HAVE_SERIAL
+/* From sysdep.c or w32.c */
+extern int serial_open (char *port);
+extern void serial_configure (struct Lisp_Process *p, Lisp_Object contact);
+#endif
+
#ifndef USE_CRT_DLL
extern int errno;
#endif
-#ifdef VMS
-extern char *sys_errlist[];
-#endif
#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif /* DATAGRAM_SOCKETS */
#endif /* BROKEN_DATAGRAM_SOCKETS */
-#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
/* Compute the Lisp form of the process status, p->status, from
the numeric status that was returned by `wait'. */
-static Lisp_Object status_convert ();
+static Lisp_Object status_convert (int);
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->status = status_convert (p->raw_status);
p->raw_status_new = 0;
}
the list that we use internally. */
static Lisp_Object
-status_convert (w)
- WAITTYPE w;
+status_convert (int w)
{
if (WIFSTOPPED (w))
return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
PTY_OPEN;
#else /* no PTY_OPEN */
{
-# ifdef IRIS
- /* Unusual IRIS code */
- *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
- if (fd < 0)
- return -1;
- if (fstat (fd, &stb) < 0)
- return -1;
-# else /* not IRIS */
{ /* Some systems name their pseudoterminals so that there are gaps in
the usual sequence - for example, on HP9000/S700 systems, there
are no pseudoterminals with names ending in 'f'. So we wait for
# else
fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
# endif
-# endif /* not IRIS */
}
#endif /* no PTY_OPEN */
#ifdef PTY_TTY_NAME_SPRINTF
PTY_TTY_NAME_SPRINTF
#else
- sprintf (pty_name, "/dev/tty%c%x", c, i);
+ sprintf (pty_name, "/dev/tty%c%x", c, i);
#endif /* no PTY_TTY_NAME_SPRINTF */
if (access (pty_name, 6) != 0)
{
emacs_close (fd);
-# if !defined(IRIS) && !defined(__sgi)
+# ifndef __sgi
continue;
# else
return -1;
-# endif /* IRIS */
+# endif /* __sgi */
}
setup_pty (fd);
return fd;
p->raw_status_new = 0;
p->status = Qrun;
p->mark = Fmake_marker ();
+ p->kill_without_query = 0;
#ifdef ADAPTIVE_READ_BUFFERING
p->adaptive_read_buffering = 0;
p = XPROCESS (process);
p->raw_status_new = 0;
- if (NETCONN1_P (p))
+ if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
p->tick = ++process_tick;
status = p->status;
if (CONSP (status))
status = XCAR (status);
- if (NETCONN1_P (p))
+ if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
if (EQ (status, Qexit))
status = Qclosed;
doc: /* Return the command that was executed to start PROCESS.
This is a list of strings, the first string being the program executed
and the rest of the strings being the arguments given to it.
-For a non-child channel, this is nil. */)
+For a network or serial process, this is nil (process is running) or t
+\(process is stopped). */)
(process)
register Lisp_Object process;
{
CHECK_BUFFER (buffer);
p = XPROCESS (process);
p->buffer = buffer;
- if (NETCONN1_P (p))
+ if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCbuffer, buffer);
setup_process_coding_systems (process);
return buffer;
FD_CLR (p->infd, &non_keyboard_wait_mask);
}
else if (EQ (p->filter, Qt)
- && !EQ (p->command, Qt)) /* Network process not stopped. */
+ /* Network or serial process not stopped: */
+ && !EQ (p->command, Qt))
{
FD_SET (p->infd, &input_wait_mask);
FD_SET (p->infd, &non_keyboard_wait_mask);
}
p->filter = filter;
- if (NETCONN1_P (p))
+ if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCfilter, filter);
setup_process_coding_systems (process);
return filter;
p = XPROCESS (process);
p->sentinel = sentinel;
- if (NETCONN1_P (p))
+ if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
return sentinel;
}
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 2, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
-For a net connection, the value depends on the optional KEY arg.
-If KEY is nil, value is a cons cell of the form (HOST SERVICE),
-if KEY is t, the complete contact information for the connection is
-returned, else the specific value for the keyword KEY is returned.
-See `make-network-process' for a list of keywords. */)
+For a network or serial connection, the value depends on the optional
+KEY arg. If KEY is nil, value is a cons cell of the form (HOST
+SERVICE) for a network connection or (PORT SPEED) for a serial
+connection. If KEY is t, the complete contact information for the
+connection is returned, else the specific value for the keyword KEY is
+returned. See `make-network-process' or `make-serial-process' for a
+list of keywords. */)
(process, key)
register Lisp_Object process, key;
{
Fprocess_datagram_address (process));
#endif
- if (!NETCONN_P (process) || EQ (key, Qt))
+ if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
return contact;
- if (NILP (key))
+ if (NILP (key) && NETCONN_P (process))
return Fcons (Fplist_get (contact, QChost),
Fcons (Fplist_get (contact, QCservice), Qnil));
+ if (NILP (key) && SERIALCONN_P (process))
+ return Fcons (Fplist_get (contact, QCport),
+ Fcons (Fplist_get (contact, QCspeed), Qnil));
return Fplist_get (contact, key);
}
}
#endif
+DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
+ doc: /* Return the connection type of PROCESS.
+The value is either the symbol `real', `network', or `serial'.
+PROCESS may be a process, a buffer, the name of a process or buffer, or
+nil, indicating the current buffer's process. */)
+ (process)
+ Lisp_Object process;
+{
+ Lisp_Object proc;
+ proc = get_process (process);
+ return XPROCESS (proc)->type;
+}
+
#ifdef HAVE_SOCKETS
DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1, 2, 0,
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
- if (NILP (p->childp))
+ if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
- if (NILP (p->childp))
+ if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
{
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);
+ Fprinc (symbol, Qnil);
}
- else if (NETCONN1_P (p))
+ else if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
if (EQ (symbol, Qexit))
write_string ("closed", -1);
else
Fprinc (symbol, Qnil);
}
+ else if (SERIALCONN1_P (p))
+ {
+ write_string ("running", -1);
+ }
else
Fprinc (symbol, Qnil);
insert_string (tembuf);
}
else if (NETCONN1_P (p))
- {
+ {
/* For a local socket, there is no host name,
so display service instead. */
Lisp_Object host = Fplist_get (p->childp, QChost);
(DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
(STRINGP (host) ? (char *)SDATA (host) : "?"));
insert_string (tembuf);
- }
+ }
+ else if (SERIALCONN1_P (p))
+ {
+ Lisp_Object port = Fplist_get (p->childp, QCport);
+ Lisp_Object speed = Fplist_get (p->childp, QCspeed);
+ insert_string ("(serial port ");
+ if (STRINGP (port))
+ insert_string (SDATA (port));
+ else
+ insert_string ("?");
+ if (INTEGERP (speed))
+ {
+ sprintf (tembuf, " at %d b/s", XINT (speed));
+ insert_string (tembuf);
+ }
+ insert_string (")\n");
+ }
else
{
tem = p->command;
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 ();
XPROCESS (proc)->childp = Qt;
XPROCESS (proc)->plist = Qnil;
+ XPROCESS (proc)->type = Qreal;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->encode_coding_system = val;
}
-#ifdef VMS
- /* Make a one member argv with all args concatenated
- together separated by a blank. */
- len = SBYTES (program) + 2;
- for (i = 3; i < nargs; i++)
- {
- tem = args[i];
- CHECK_STRING (tem);
- len += SBYTES (tem) + 1; /* count the blank */
- }
- 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));
- }
- /* 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.
new_argv[i - 2] = SDATA (tem);
}
new_argv[i - 2] = 0;
-#endif /* not VMS */
XPROCESS (proc)->decoding_buf = make_uninit_string (0);
XPROCESS (proc)->decoding_carryover = 0;
#endif
#endif
-#ifndef VMS /* VMS version of this function is in vmsproc.c. */
void
create_process (process, new_argv, current_dir)
Lisp_Object process;
int inchannel, outchannel;
pid_t pid;
int sv[2];
+#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+ int wait_child_setup[2];
+#endif
#ifdef POSIX_SIGNALS
sigset_t procmask;
sigset_t blocked;
forkin = sv[0];
}
+#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+ {
+ int tem;
+
+ tem = pipe (wait_child_setup);
+ if (tem < 0)
+ report_file_error ("Creating pipe", Qnil);
+ tem = fcntl (wait_child_setup[1], F_GETFD, 0);
+ if (tem >= 0)
+ tem = fcntl (wait_child_setup[1], F_SETFD, tem | FD_CLOEXEC);
+ if (tem < 0)
+ {
+ emacs_close (wait_child_setup[0]);
+ emacs_close (wait_child_setup[1]);
+ report_file_error ("Setting file descriptor flags", Qnil);
+ }
+ }
+#endif
+
#if 0
/* Replaced by close_process_descs */
set_exclusive_use (inchannel);
sigprocmask (SIG_BLOCK, &blocked, &procmask);
#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
-#ifdef BSD4_1
- sighold (SIGCHLD);
-#else /* not BSD4_1 */
#if defined (BSD_SYSTEM) || defined (HPUX)
sigsetmask (sigmask (SIGCHLD));
#else /* ordinary USG */
sigchld = signal (SIGCHLD, create_process_sigchld);
#endif
#endif /* ordinary USG */
-#endif /* not BSD4_1 */
#endif /* SIGCHLD */
#endif /* !POSIX_SIGNALS */
This makes the pty the controlling terminal of the subprocess. */
if (pty_flag)
{
-#ifdef SET_CHILD_PTY_PGRP
- int pgrp = getpid ();
-#endif
/* I wonder if emacs_close (emacs_open (pty_name, ...))
would work? */
_exit (1);
}
-#ifdef SET_CHILD_PTY_PGRP
- ioctl (xforkin, TIOCSPGRP, &pgrp);
- ioctl (xforkout, TIOCSPGRP, &pgrp);
-#endif
}
#endif /* not DONT_REOPEN_PTY */
sigprocmask (SIG_SETMASK, &procmask, 0);
#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
-#ifdef BSD4_1
- sigrelse (SIGCHLD);
-#else /* not BSD4_1 */
#if defined (BSD_SYSTEM) || defined (HPUX)
sigsetmask (SIGEMPTYMASK);
#else /* ordinary USG */
signal (SIGCHLD, sigchld);
#endif
#endif /* ordinary USG */
-#endif /* not BSD4_1 */
#endif /* SIGCHLD */
#endif /* !POSIX_SIGNALS */
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
#else /* not WINDOWSNT */
+#ifdef FD_CLOEXEC
+ emacs_close (wait_child_setup[0]);
+#endif
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
#endif /* not WINDOWSNT */
else
#endif
XPROCESS (process)->tty_name = Qnil;
+
+#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+ /* Wait for child_setup to complete in case that vfork is
+ actually defined as fork. The descriptor wait_child_setup[1]
+ of a pipe is closed at the child side either by close-on-exec
+ on successful execvp or the _exit call in child_setup. */
+ {
+ char dummy;
+
+ emacs_close (wait_child_setup[1]);
+ emacs_read (wait_child_setup[0], &dummy, 1);
+ emacs_close (wait_child_setup[0]);
+ }
+#endif
}
/* Restore the signal state whether vfork succeeded or not.
sigprocmask (SIG_SETMASK, &procmask, 0);
#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
-#ifdef BSD4_1
- sigrelse (SIGCHLD);
-#else /* not BSD4_1 */
#if defined (BSD_SYSTEM) || defined (HPUX)
sigsetmask (SIGEMPTYMASK);
#else /* ordinary USG */
kill (getpid (), SIGCHLD);
#endif
#endif /* ordinary USG */
-#endif /* not BSD4_1 */
#endif /* SIGCHLD */
#endif /* !POSIX_SIGNALS */
if (pid < 0)
report_file_error ("Doing vfork", Qnil);
}
-#endif /* not VMS */
\f
#ifdef HAVE_SOCKETS
unsigned char *cp;
register struct Lisp_Vector *p;
+ /* Workaround for a bug in getsockname on BSD: Names bound to
+ sockets in the UNIX domain are inaccessible; getsockname returns
+ a zero length name. */
+ if (len < OFFSETOF (struct sockaddr, sa_family) + sizeof (sa->sa_family))
+ return build_string ("");
+
switch (sa->sa_family)
{
case AF_INET:
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;
+ 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;
+ 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);
}
#endif
default:
- len -= sizeof (sa->sa_family);
+ len -= OFFSETOF (struct sockaddr, sa_family) + 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);
+ cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
break;
}
}
\f
-/* A version of request_sigio suitable for a record_unwind_protect. */
+#ifdef HAVE_SERIAL
+DEFUN ("serial-process-configure",
+ Fserial_process_configure,
+ Sserial_process_configure,
+ 0, MANY, 0,
+ doc: /* Configure speed, bytesize, etc. of a serial process.
-#ifdef __ultrix__
-static Lisp_Object
-unwind_request_sigio (dummy)
- Lisp_Object dummy;
+Arguments are specified as keyword/argument pairs. Attributes that
+are not given are re-initialized from the process's current
+configuration (available via the function `process-contact') or set to
+reasonable default values. The following arguments are defined:
+
+:process PROCESS
+:name NAME
+:buffer BUFFER
+:port PORT
+-- Any of these arguments can be given to identify the process that is
+to be configured. If none of these arguments is given, the current
+buffer's process is used.
+
+:speed SPEED -- SPEED is the speed of the serial port in bits per
+second, also called baud rate. Any value can be given for SPEED, but
+most serial ports work only at a few defined values between 1200 and
+115200, with 9600 being the most common value. If SPEED is nil, the
+serial port is not configured any further, i.e., all other arguments
+are ignored. This may be useful for special serial ports such as
+Bluetooth-to-serial converters which can only be configured through AT
+commands. A value of nil for SPEED can be used only when passed
+through `make-serial-process' or `serial-term'.
+
+:bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
+can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
+
+:parity PARITY -- PARITY can be nil (don't use parity), the symbol
+`odd' (use odd parity), or the symbol `even' (use even parity). If
+PARITY is not given, no parity is used.
+
+:stopbits STOPBITS -- STOPBITS is the number of stopbits used to
+terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
+is not given or nil, 1 stopbit is used.
+
+:flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
+flowcontrol to be used, which is either nil (don't use flowcontrol),
+the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
+\(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
+flowcontrol is used.
+
+`serial-process-configure' is called by `make-serial-process' for the
+initial configuration of the serial port.
+
+Examples:
+
+\(serial-process-configure :process "/dev/ttyS0" :speed 1200)
+
+\(serial-process-configure
+ :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
+
+\(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
+
+usage: (serial-process-configure &rest ARGS) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ struct Lisp_Process *p;
+ Lisp_Object contact = Qnil;
+ Lisp_Object proc = Qnil;
+ struct gcpro gcpro1;
+
+ contact = Flist (nargs, args);
+ GCPRO1 (contact);
+
+ proc = Fplist_get (contact, QCprocess);
+ if (NILP (proc))
+ proc = Fplist_get (contact, QCname);
+ if (NILP (proc))
+ proc = Fplist_get (contact, QCbuffer);
+ if (NILP (proc))
+ proc = Fplist_get (contact, QCport);
+ proc = get_process (proc);
+ p = XPROCESS (proc);
+ if (!EQ (p->type, Qserial))
+ error ("Not a serial process");
+
+ if (NILP (Fplist_get (p->childp, QCspeed)))
+ {
+ UNGCPRO;
+ return Qnil;
+ }
+
+ serial_configure (p, contact);
+
+ UNGCPRO;
+ return Qnil;
+}
+
+/* Used by make-serial-process to recover from errors. */
+Lisp_Object make_serial_process_unwind (Lisp_Object proc)
{
- if (interrupt_input)
- request_sigio ();
+ if (!PROCESSP (proc))
+ abort ();
+ remove_process (proc);
return Qnil;
}
-#endif
+
+DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
+ 0, MANY, 0,
+ doc: /* Create and return a serial port process.
+
+In Emacs, serial port connections are represented by process objects,
+so input and output work as for subprocesses, and `delete-process'
+closes a serial port connection. However, a serial process has no
+process id, it cannot be signaled, and the status codes are different
+from normal processes.
+
+`make-serial-process' creates a process and a buffer, on which you
+probably want to use `process-send-string'. Try \\[serial-term] for
+an interactive terminal. See below for examples.
+
+Arguments are specified as keyword/argument pairs. The following
+arguments are defined:
+
+:port PORT -- (mandatory) PORT is the path or name of the serial port.
+For example, this could be "/dev/ttyS0" on Unix. On Windows, this
+could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
+the backslashes in strings).
+
+:speed SPEED -- (mandatory) is handled by `serial-process-configure',
+which is called by `make-serial-process'.
+
+:name NAME -- NAME is the name of the process. If NAME is not given,
+the value of PORT is used.
+
+:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
+with the process. Process output goes at the end of that buffer,
+unless you specify an output stream or filter function to handle the
+output. If BUFFER is not given, the value of NAME is used.
+
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process. If CODING
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
+ENCODING is used for writing.
+
+:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
+the process is running. If BOOL is not given, query before exiting.
+
+:stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
+In the stopped state, a serial process does not accept incoming data,
+but you can send outgoing data. The stopped state is cleared by
+`continue-process' and set by `stop-process'.
+
+:filter FILTER -- Install FILTER as the process filter.
+
+:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+
+:plist PLIST -- Install PLIST as the initial plist of the process.
+
+:speed
+:bytesize
+:parity
+:stopbits
+:flowcontrol
+-- These arguments are handled by `serial-process-configure', which is
+called by `make-serial-process'.
+
+The original argument list, possibly modified by later configuration,
+is available via the function `process-contact'.
+
+Examples:
+
+\(make-serial-process :port "/dev/ttyS0" :speed 9600)
+
+\(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
+
+\(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
+
+\(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
+
+usage: (make-serial-process &rest ARGS) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ int fd = -1;
+ Lisp_Object proc, contact, port;
+ struct Lisp_Process *p;
+ struct gcpro gcpro1;
+ Lisp_Object name, buffer;
+ Lisp_Object tem, val;
+ int specpdl_count = -1;
+
+ if (nargs == 0)
+ return Qnil;
+
+ contact = Flist (nargs, args);
+ GCPRO1 (contact);
+
+ port = Fplist_get (contact, QCport);
+ if (NILP (port))
+ error ("No port specified");
+ CHECK_STRING (port);
+
+ if (NILP (Fplist_member (contact, QCspeed)))
+ error (":speed not specified");
+ if (!NILP (Fplist_get (contact, QCspeed)))
+ CHECK_NUMBER (Fplist_get (contact, QCspeed));
+
+ name = Fplist_get (contact, QCname);
+ if (NILP (name))
+ name = port;
+ CHECK_STRING (name);
+ proc = make_process (name);
+ specpdl_count = SPECPDL_INDEX ();
+ record_unwind_protect (make_serial_process_unwind, proc);
+ p = XPROCESS (proc);
+
+ fd = serial_open ((char*) SDATA (port));
+ p->infd = fd;
+ p->outfd = fd;
+ if (fd > max_process_desc)
+ max_process_desc = fd;
+ chan_process[fd] = proc;
+
+ buffer = Fplist_get (contact, QCbuffer);
+ if (NILP (buffer))
+ buffer = name;
+ buffer = Fget_buffer_create (buffer);
+ p->buffer = buffer;
+
+ p->childp = contact;
+ p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
+ p->type = Qserial;
+ p->sentinel = Fplist_get (contact, QCsentinel);
+ p->filter = Fplist_get (contact, QCfilter);
+ p->log = Qnil;
+ if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
+ p->kill_without_query = 1;
+ if (tem = Fplist_get (contact, QCstop), !NILP (tem))
+ p->command = Qt;
+ p->pty_flag = 0;
+
+ if (!EQ (p->command, Qt))
+ {
+ FD_SET (fd, &input_wait_mask);
+ FD_SET (fd, &non_keyboard_wait_mask);
+ }
+
+ if (BUFFERP (buffer))
+ {
+ set_marker_both (p->mark, buffer,
+ BUF_ZV (XBUFFER (buffer)),
+ BUF_ZV_BYTE (XBUFFER (buffer)));
+ }
+
+ tem = Fplist_member (contact, QCcoding);
+ if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
+ tem = Qnil;
+
+ val = Qnil;
+ 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;
+ p->decode_coding_system = val;
+
+ val = Qnil;
+ 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 (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
+ || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
+ val = Qnil;
+ p->encode_coding_system = val;
+
+ setup_process_coding_systems (proc);
+ p->decoding_buf = make_uninit_string (0);
+ p->decoding_carryover = 0;
+ p->encoding_buf = make_uninit_string (0);
+ p->inherit_coding_system_flag
+ = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
+
+ Fserial_process_configure(nargs, args);
+
+ specpdl_ptr = specpdl + specpdl_count;
+
+ UNGCPRO;
+ return proc;
+}
+#endif /* HAVE_SERIAL */
/* Create a network stream/datagram client/server process. Treated
exactly like a normal process when reading and writing. Primary
{
/* 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))
+#if !defined(O_NONBLOCK) && !defined(O_NDELAY)
error ("Network servers not supported");
#else
is_server = 1;
CHECK_STRING (name);
-#ifdef TERM
- /* Let's handle TERM before things get complicated ... */
- 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 /* not TERM */
-
/* Initialize addrinfo structure in case we don't use getaddrinfo. */
ai.ai_socktype = socktype;
ai.ai_protocol = 0;
#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);
+ error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
#endif
immediate_quit = 0;
open_socket:
-#ifdef __ultrix__
- /* Previously this was compiled unconditionally, but that seems
- unnecessary on modern systems, and `unrequest_sigio' was a noop
- under X anyway. --lorentey */
- /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
- when connect is interrupted. So let's not let it get interrupted.
- Note we do not turn off polling, because polling is only used
- when not interrupt_input, and thus not normally used on the systems
- which have this bug. On systems which use polling, there's no way
- to quit if polling is turned off. */
- if (interrupt_input
- && !is_server && socktype == SOCK_STREAM)
- {
- /* Comment from KFS: The original open-network-stream code
- didn't unwind protect this, but it seems like the proper
- thing to do. In any case, I don't see how it could harm to
- do this -- and it makes cleanup (using unbind_to) easier. */
- record_unwind_protect (unwind_request_sigio, Qnil);
- unrequest_sigio ();
- }
-#endif
-
/* Do this in case we never enter the for-loop below. */
count1 = SPECPDL_INDEX ();
s = -1;
/* Parse network options in the arg list.
We simply ignore anything which isn't a known option (including other keywords).
- An error is signalled if setting a known option fails. */
+ An error is signaled if setting a known option fails. */
for (optn = optbits = 0; optn < nargs-1; optn += 2)
optbits |= set_socket_option (s, args[optn], args[optn+1]);
report_file_error ("make client process failed", contact);
}
-#endif /* not TERM */
-
inch = s;
outch = s;
p->childp = contact;
p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
+ p->type = Qnetwork;
p->buffer = buffer;
p->sentinel = sentinel;
{
/* Beware SIGCHLD hereabouts. */
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
p->infd = -1;
p->outfd = -1;
Non-nil arg PROCESS means do not return until some output has been received
from PROCESS.
-Non-nil second arg SECONDS and third arg MILLISEC are number of
-seconds and milliseconds to wait; return after that much time whether
-or not there is input. If SECONDS is a floating point number,
+Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
+and milliseconds to wait; return after that much time whether or not
+there is any subprocess output. If SECONDS is a floating point number,
it specifies a fractional number of seconds to wait.
+The MILLISEC argument is obsolete and should be avoided.
If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
from PROCESS, suspending reading output from other processes.
else
just_this_one = Qnil;
+ if (!NILP (millisec))
+ { /* Obsolete calling convention using integers rather than floats. */
+ CHECK_NUMBER (millisec);
+ if (NILP (seconds))
+ seconds = make_float (XINT (millisec) / 1000.0);
+ else
+ {
+ CHECK_NUMBER (seconds);
+ seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
+ }
+ }
+
if (!NILP (seconds))
{
if (INTEGERP (seconds))
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;
}
p->childp = contact;
p->plist = Fcopy_sequence (ps->plist);
+ p->type = Qnetwork;
p->buffer = buffer;
p->sentinel = ps->sentinel;
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
-#ifdef POLL_INTERRUPTED_SYS_CALL
- /* 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),
- and then turn off any other atimers. */
- stop_polling ();
- turn_on_atimers (0);
-#endif /* POLL_INTERRUPTED_SYS_CALL */
while (1)
{
QUIT;
#ifdef SYNC_INPUT
else
- {
- if (interrupt_input_pending)
- handle_async_input ();
- if (pending_atimers)
- do_pending_atimers ();
- }
+ {
+ if (interrupt_input_pending)
+ handle_async_input ();
+ if (pending_atimers)
+ do_pending_atimers ();
+ }
#endif
/* Exit now if the cell we're waiting for became non-nil. */
/* If status of something has changed, and no input is
available, notify the user of the change right away. After
this explicit check, we'll let the SIGCHLD handler zap
- timeout to get our attention. */
- if (update_tick != process_tick && do_display)
+ timeout to get our attention. When Emacs is run
+ interactively, only do this with a nonzero DO_DISPLAY
+ argument, because status_notify triggers redisplay. */
+ if (update_tick != process_tick
+ && (do_display || noninteractive))
{
SELECT_TYPE Atemp;
#ifdef NON_BLOCKING_CONNECT
#endif
Atemp = input_wait_mask;
-#if 0
- /* On Mac OS X 10.0, 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
IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask);
EMACS_SET_SECS_USECS (timeout, 0, 0);
}
/* Don't wait for output from a non-running process. Just
- read whatever data has already been received. */
+ read whatever data has already been received. */
if (wait_proc && wait_proc->raw_status_new)
update_status (wait_proc);
if (wait_proc
if (nread == 0)
break;
- if (0 < nread)
- total_nread += nread;
+ if (0 < nread)
+ {
+ total_nread += nread;
+ got_some_input = 1;
+ }
#ifdef EIO
else if (nread == -1 && EIO == errno)
- break;
+ break;
#endif
#ifdef EAGAIN
else if (nread == -1 && EAGAIN == errno)
- break;
+ break;
#endif
#ifdef EWOULDBLOCK
else if (nread == -1 && EWOULDBLOCK == errno)
- break;
+ break;
#endif
}
if (total_nread > 0 && do_display)
process_output_skip = 0;
}
#endif
-
- nfds = select (max (max (max_process_desc, max_keyboard_desc),
+#ifdef HAVE_NS
+ nfds = ns_select
+#else
+ nfds = select
+#endif
+ (max (max (max_process_desc, max_keyboard_desc),
max_gpm_desc) + 1,
&Available,
#ifdef NON_BLOCKING_CONNECT
{
if (xerrno == EINTR)
no_avail = 1;
-#ifdef ultrix
- /* Ultrix select seems to return ENOMEM when it is
- interrupted. Treat it just like EINTR. Bleah. Note
- that we want to test for the "ultrix" CPP symbol, not
- "__ultrix__"; the latter is only defined under GCC, but
- not by DEC's bundled CC. -JimB */
- else if (xerrno == ENOMEM)
- no_avail = 1;
-#endif
else if (xerrno == EBADF)
{
#ifdef AIX
IF_NON_BLOCKING_CONNECT (check_connect = 0);
}
-#if defined(sun) && !defined(USG5_4)
- if (nfds > 0 && keyboard_bit_set (&Available)
- && interrupt_input)
- /* System sometimes fails to deliver SIGIO.
-
- David J. Mackenzie says that Emacs doesn't compile under
- Solaris if this code is enabled, thus the USG5_4 in the CPP
- conditional. "I haven't noticed any ill effects so far.
- If you find a Solaris expert somewhere, they might know
- better." */
- kill (getpid (), SIGIO);
-#endif
-
#if 0 /* When polling is used, interrupt_input is 0,
so get_input_pending should read the input.
So this should not be needed. */
available now and a closed pipe.
With luck, a closed pipe will be accompanied by
subprocess termination and SIGCHLD. */
- else if (nread == 0 && !NETCONN_P (proc))
+ else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
;
#endif /* O_NDELAY */
#endif /* O_NONBLOCK */
/* If we can detect process termination, don't consider the process
gone just because its pipe is closed. */
#ifdef SIGCHLD
- else if (nread == 0 && !NETCONN_P (proc))
+ else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
;
#endif
else
#ifdef GNU_LINUX
/* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
- So only use it on systems where it is known to work. */
+ So only use it on systems where it is known to work. */
{
int xlen = sizeof(xerrno);
if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
clear_input_pending ();
QUIT;
}
-#ifdef POLL_INTERRUPTED_SYS_CALL
- /* AlainF 5-Jul-1996
- HP-UX 10.10 seems to have problems with signals coming in
- Causes "poll: interrupted system call" messages when Emacs is run
- in an X window
- Turn periodic alarms back on */
- start_polling ();
-#endif /* POLL_INTERRUPTED_SYS_CALL */
return got_some_input;
}
int carryover = 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); /* Really weird if it does this */
- if (!(vs->iosb[0] & 1))
- return -1; /* I/O error */
- }
- 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); /* Crank up the next read on the process */
- return 1; /* Nothing worth printing, say we got 1 */
- }
- if (carryover > 0)
- {
- /* The data carried over in the previous decoding (which are at
- the tail of decoding buffer) should be prepended to the new
- data read to decode all together. */
- chars = (char *) alloca (nbytes + 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. */
else
nbytes = nbytes + 1;
}
-#endif /* not VMS */
p->decoding_carryover = 0;
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;
}
SET_PT_BOTH (opoint, opoint_byte);
set_buffer_internal (old);
}
-#ifdef VMS
- start_vms_process_read (vs);
-#endif
return nbytes;
}
send_process_trap ()
{
SIGNAL_THREAD_CHECK (SIGPIPE);
-#ifdef BSD4_1
- sigrelse (SIGPIPE);
- sigrelse (SIGALRM);
-#endif /* BSD4_1 */
sigunblock (sigmask (SIGPIPE));
longjmp (send_process_frame, 1);
}
GCPRO1 (object);
-#ifdef VMS
- VMS_PROC_STUFF *vs, *get_vms_process_pointer();
-#endif /* VMS */
-
if (p->raw_status_new)
update_status (p);
if (! EQ (p->status, Qrun))
buf = SDATA (coding->dst_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 /* not VMS */
-
if (pty_max_bytes == 0)
{
#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
if (p->pty_flag)
{
/* Starting this at zero is always correct when not the first
- iteration because the previous iteration ended by sending C-d.
+ iteration because the previous iteration ended by sending C-d.
It may not be correct for the first iteration
if a partial line was sent in a separate send_process call.
If that proves worth handling, we need to save linepos
this -= rv;
}
- /* If we sent just part of the string, put in an EOF
+ /* If we sent just part of the string, put in an EOF (C-d)
to force it through, before we send the rest. */
if (len > 0)
Fprocess_send_eof (proc);
}
}
-#endif /* not VMS */
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));
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;
proc = get_process (process);
p = XPROCESS (proc);
- if (!EQ (p->childp, Qt))
+ if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
proc = get_process (process);
p = XPROCESS (proc);
- if (!EQ (p->childp, Qt))
+ if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
by sending an input character to it. */
/* TERMIOS is the latest and bestest, and seems most likely to
- work. If the system has it, use it. */
+ work. If the system has it, use it. */
#ifdef HAVE_TERMIOS
struct termios t;
cc_t *sig_char = NULL;
break;
#endif /* ! defined (SIGCONT) */
case SIGINT:
-#ifdef VMS
- send_process (proc, "\003", 1, Qnil); /* ^C */
- goto whoosh;
-#endif
case SIGQUIT:
-#ifdef VMS
- send_process (proc, "\031", 1, Qnil); /* ^Y */
- goto whoosh;
-#endif
case SIGKILL:
-#ifdef VMS
- sys$forcex (&(p->pid), 0, 1);
- whoosh:
-#endif
flush_pending_output (p->infd);
break;
}
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
doc: /* Stop process PROCESS. May be process or name of one.
See function `interrupt-process' for more details on usage.
-If PROCESS is a network process, inhibit handling of incoming traffic. */)
+If PROCESS is a network or serial process, inhibit handling of incoming
+traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
- if (PROCESSP (process) && NETCONN_P (process))
+ if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
{
struct Lisp_Process *p;
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
doc: /* Continue process PROCESS. May be process or name of one.
See function `interrupt-process' for more details on usage.
-If PROCESS is a network process, resume handling of incoming traffic. */)
+If PROCESS is a network or serial process, resume handling of incoming
+traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
- if (PROCESSP (process) && NETCONN_P (process))
+ if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
{
struct Lisp_Process *p;
{
FD_SET (p->infd, &input_wait_mask);
FD_SET (p->infd, &non_keyboard_wait_mask);
+#ifdef WINDOWSNT
+ if (fd_info[ p->infd ].flags & FILE_SERIAL)
+ PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
+#endif
+#ifdef HAVE_TERMIOS
+ tcflush (p->infd, TCIFLUSH);
+#endif
}
p->command = Qnil;
return process;
got_it:
#define parse_signal(NAME, VALUE) \
- else if (!xstricmp (name, NAME)) \
+ else if (!xstrcasecmp (name, NAME)) \
XSETINT (sigcode, VALUE)
if (INTEGERP (sigcode))
nil, indicating the current buffer's process.
If PROCESS is a network connection, or is a process communicating
through a pipe (as opposed to a pty), then you cannot send any more
-text to PROCESS after you call this function. */)
+text to PROCESS after you call this function.
+If PROCESS is a serial process, wait until all output written to the
+process has been transmitted to the serial port. */)
(process)
Lisp_Object process;
{
send_process (proc, "", 0, Qnil);
}
-#ifdef VMS
- send_process (proc, "\032", 1, Qnil); /* ^z */
-#else
if (XPROCESS (proc)->pty_flag)
send_process (proc, "\004", 1, Qnil);
+ else if (EQ (XPROCESS (proc)->type, Qserial))
+ {
+#ifdef HAVE_TERMIOS
+ if (tcdrain (XPROCESS (proc)->outfd) != 0)
+ error ("tcdrain() failed: %s", emacs_strerror (errno));
+#endif
+ /* Do nothing on Windows because writes are blocking. */
+ }
else
{
int old_outfd, new_outfd;
for communication with the subprocess, call shutdown to cause EOF.
(In some old system, shutdown to socketpair doesn't work.
Then we just can't win.) */
- if (XPROCESS (proc)->pid == 0
+ if (EQ (XPROCESS (proc)->type, Qnetwork)
|| XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
shutdown (XPROCESS (proc)->outfd, 1);
/* In case of socketpair, outfd == infd, so don't close it. */
XPROCESS (proc)->outfd = new_outfd;
}
-#endif /* VMS */
return process;
}
if (PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
- if (NETCONN_P (proc))
+ if (NETCONN_P (proc) || SERIALCONN_P (proc))
Fdelete_process (proc);
else if (XPROCESS (proc)->infd >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
SIGNAL_THREAD_CHECK (signo);
-#ifdef BSD4_1
- extern int sigheld;
- sigheld |= sigbit (SIGCHLD);
-#endif
-
while (1)
{
pid_t pid;
- WAITTYPE w;
+ int w;
Lisp_Object tail;
#ifdef WNOHANG
#endif /* no WUNTRACED */
/* Keep trying to get a status until we get a definitive result. */
do
- {
+ {
errno = 0;
pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
}
must reestablish each time */
#if defined (USG) && !defined (POSIX_SIGNALS)
signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
-#endif
-#ifdef BSD4_1
- sigheld &= ~sigbit (SIGCHLD);
- sigrelse (SIGCHLD);
#endif
errno = old_errno;
return;
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
- if (EQ (p->childp, Qt) && p->pid == pid)
+ if (EQ (p->type, Qreal) && p->pid == pid)
break;
p = 0;
}
/* Change the status of the process that was found. */
if (p != 0)
{
- union { int i; WAITTYPE wt; } u;
int clear_desc_flag = 0;
p->tick = ++process_tick;
- u.wt = w;
- p->raw_status = u.i;
+ p->raw_status = w;
p->raw_status_new = 1;
/* If process has terminated, stop waiting for its output. */
if (WIFEXITED (w))
synch_process_retcode = WRETCODE (w);
else if (WIFSIGNALED (w))
- synch_process_termsig = WTERMSIG (w);
+ synch_process_termsig = WTERMSIG (w);
/* Tell wait_reading_process_output that it needs to wake up and
look around. */
to use up all the processes that have something to tell us. */
#if (defined WINDOWSNT \
|| (defined USG && !defined GNU_LINUX \
- && !(defined HPUX && defined WNOHANG)))
+ && !(defined HPUX && defined WNOHANG)))
#if defined (USG) && ! defined (POSIX_SIGNALS)
signal (signo, sigchld_handler);
#endif
while (! EQ (p->filter, Qt)
&& ! EQ (p->status, Qconnect)
&& ! EQ (p->status, Qlisten)
- && ! EQ (p->command, Qt) /* Network process not stopped. */
+ /* Network or serial process not stopped: */
+ && ! EQ (p->command, Qt)
&& p->infd >= 0
&& p != deleting_process
&& read_process_output (proc, p->infd) > 0);
return 0;
}
\f
+/* Enumeration of and access to system processes a-la ps(1). */
+
+DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
+ 0, 0, 0,
+ doc: /* Return a list of numerical process IDs of all running processes.
+If this functionality is unsupported, return nil.
+
+See `system-process-attributes' for getting attributes of a process
+given its ID. */)
+ ()
+{
+ return list_system_processes ();
+}
+
+DEFUN ("system-process-attributes", Fsystem_process_attributes,
+ Ssystem_process_attributes, 1, 1, 0,
+ doc: /* Return attributes of the process given by its PID, a number.
+
+Value is an alist where each element is a cons cell of the form
+
+ \(KEY . VALUE)
+
+If this functionality is unsupported, the value is nil.
+
+See `list-system-processes' for getting a list of all process IDs.
+
+The KEYs of the attributes that this function may return are listed
+below, together with the type of the associated VALUE (in parentheses).
+Not all platforms support all of these attributes; unsupported
+attributes will not appear in the returned alist.
+Unless explicitly indicated otherwise, numbers can have either
+integer or floating point values.
+
+ euid -- Effective user User ID of the process (number)
+ user -- User name corresponding to euid (string)
+ egid -- Effective user Group ID of the process (number)
+ group -- Group name corresponding to egid (string)
+ comm -- Command name (executable name only) (string)
+ state -- Process state code, such as "S", "R", or "T" (string)
+ ppid -- Parent process ID (number)
+ pgrp -- Process group ID (number)
+ sess -- Session ID, i.e. process ID of session leader (number)
+ ttname -- Controlling tty name (string)
+ tpgid -- ID of foreground process group on the process's tty (number)
+ minflt -- number of minor page faults (number)
+ majflt -- number of major page faults (number)
+ cminflt -- cumulative number of minor page faults (number)
+ cmajflt -- cumulative number of major page faults (number)
+ utime -- user time used by the process, in the (HIGH LOW USEC) format
+ stime -- system time used by the process, in the (HIGH LOW USEC) format
+ time -- sum of utime and stime, in the (HIGH LOW USEC) format
+ cutime -- user time used by the process and its children, (HIGH LOW USEC)
+ cstime -- system time used by the process and its children, (HIGH LOW USEC)
+ ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
+ pri -- priority of the process (number)
+ nice -- nice value of the process (number)
+ thcount -- process thread count (number)
+ start -- time the process started, in the (HIGH LOW USEC) format
+ vsize -- virtual memory size of the process in KB's (number)
+ rss -- resident set size of the process in KB's (number)
+ etime -- elapsed time the process is running, in (HIGH LOW USEC) format
+ pcpu -- percents of CPU time used by the process (floating-point number)
+ pmem -- percents of total physical memory used by process's resident set
+ (floating-point number)
+ args -- command line which invoked the process (string). */)
+ (pid)
+
+ Lisp_Object pid;
+{
+ return system_process_attributes (pid);
+}
+\f
void
init_process ()
{
#ifdef HAVE_GETSOCKNAME
ADD_SUBFEATURE (QCservice, Qt);
#endif
-#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
+#if defined(O_NONBLOCK) || defined(O_NDELAY)
ADD_SUBFEATURE (QCserver, Qt);
#endif
}
#endif /* HAVE_SOCKETS */
-#if defined (DARWIN) || defined (MAC_OSX)
+#if defined (DARWIN_OS)
/* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
processes. As such, we only change the default value. */
if (initialized)
Qdatagram = intern ("datagram");
staticpro (&Qdatagram);
+ QCport = intern (":port");
+ staticpro (&QCport);
+ QCspeed = intern (":speed");
+ staticpro (&QCspeed);
+ QCprocess = intern (":process");
+ staticpro (&QCprocess);
+
+ QCbytesize = intern (":bytesize");
+ staticpro (&QCbytesize);
+ QCstopbits = intern (":stopbits");
+ staticpro (&QCstopbits);
+ QCparity = intern (":parity");
+ staticpro (&QCparity);
+ Qodd = intern ("odd");
+ staticpro (&Qodd);
+ Qeven = intern ("even");
+ staticpro (&Qeven);
+ QCflowcontrol = intern (":flowcontrol");
+ staticpro (&QCflowcontrol);
+ Qhw = intern ("hw");
+ staticpro (&Qhw);
+ Qsw = intern ("sw");
+ staticpro (&Qsw);
+ QCsummary = intern (":summary");
+ staticpro (&QCsummary);
+
+ Qreal = intern ("real");
+ staticpro (&Qreal);
+ Qnetwork = intern ("network");
+ staticpro (&Qnetwork);
+ Qserial = intern ("serial");
+ staticpro (&Qserial);
+
QCname = intern (":name");
staticpro (&QCname);
QCbuffer = intern (":buffer");
staticpro (&deleted_pid_list);
#endif
+ Qeuid = intern ("euid");
+ staticpro (&Qeuid);
+ Qegid = intern ("egid");
+ staticpro (&Qegid);
+ Quser = intern ("user");
+ staticpro (&Quser);
+ Qgroup = intern ("group");
+ staticpro (&Qgroup);
+ Qcomm = intern ("comm");
+ staticpro (&Qcomm);
+ Qstate = intern ("state");
+ staticpro (&Qstate);
+ Qppid = intern ("ppid");
+ staticpro (&Qppid);
+ Qpgrp = intern ("pgrp");
+ staticpro (&Qpgrp);
+ Qsess = intern ("sess");
+ staticpro (&Qsess);
+ Qttname = intern ("ttname");
+ staticpro (&Qttname);
+ Qtpgid = intern ("tpgid");
+ staticpro (&Qtpgid);
+ Qminflt = intern ("minflt");
+ staticpro (&Qminflt);
+ Qmajflt = intern ("majflt");
+ staticpro (&Qmajflt);
+ Qcminflt = intern ("cminflt");
+ staticpro (&Qcminflt);
+ Qcmajflt = intern ("cmajflt");
+ staticpro (&Qcmajflt);
+ Qutime = intern ("utime");
+ staticpro (&Qutime);
+ Qstime = intern ("stime");
+ staticpro (&Qstime);
+ Qtime = intern ("time");
+ staticpro (&Qtime);
+ Qcutime = intern ("cutime");
+ staticpro (&Qcutime);
+ Qcstime = intern ("cstime");
+ staticpro (&Qcstime);
+ Qctime = intern ("ctime");
+ staticpro (&Qctime);
+ Qpri = intern ("pri");
+ staticpro (&Qpri);
+ Qnice = intern ("nice");
+ staticpro (&Qnice);
+ Qthcount = intern ("thcount");
+ staticpro (&Qthcount);
+ Qstart = intern ("start");
+ staticpro (&Qstart);
+ Qvsize = intern ("vsize");
+ staticpro (&Qvsize);
+ Qrss = intern ("rss");
+ staticpro (&Qrss);
+ Qetime = intern ("etime");
+ staticpro (&Qetime);
+ Qpcpu = intern ("pcpu");
+ staticpro (&Qpcpu);
+ Qpmem = intern ("pmem");
+ staticpro (&Qpmem);
+ Qargs = intern ("args");
+ staticpro (&Qargs);
+
DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
doc: /* *Non-nil means delete processes immediately when they exit.
A value of nil means don't delete them until `list-processes' is run. */);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
+#ifdef HAVE_SERIAL
+ defsubr (&Sserial_process_configure);
+ defsubr (&Smake_serial_process);
+#endif /* HAVE_SERIAL */
#ifdef HAVE_SOCKETS
defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
defsubr (&Sprocess_send_eof);
defsubr (&Ssignal_process);
defsubr (&Swaiting_for_user_input_p);
-/* defsubr (&Sprocess_connection); */
+ defsubr (&Sprocess_type);
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
defsubr (&Sset_process_filter_multibyte);
defsubr (&Sprocess_filter_multibyte_p);
+ defsubr (&Slist_system_processes);
+ defsubr (&Ssystem_process_attributes);
}
\f
#include <sys/types.h>
#include <errno.h>
+#include <sys/stat.h>
+#include <stdlib.h>
+#include <fcntl.h>
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
#include "lisp.h"
#include "systime.h"
extern EMACS_TIME timer_check ();
extern int timers_run;
-Lisp_Object QCtype;
+Lisp_Object QCtype, QCname;
+
+Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
+Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
+Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
+Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
/* As described above, except assuming that there are no subprocesses:
else
error ("select error: %s", emacs_strerror (xerrno));
}
-#ifdef sun
+#ifdef SOLARIS2
else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
/* System sometimes fails to deliver SIGIO. */
kill (getpid (), SIGIO);
{
}
+DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
+ 0, 0, 0,
+ doc: /* Return a list of numerical process IDs of all running processes.
+If this functionality is unsupported, return nil.
+
+See `system-process-attributes' for getting attributes of a process
+given its ID. */)
+ ()
+{
+ return list_system_processes ();
+}
+
+DEFUN ("system-process-attributes", Fsystem_process_attributes,
+ Ssystem_process_attributes, 1, 1, 0,
+ doc: /* Return attributes of the process given by its PID, a number.
+
+Value is an alist where each element is a cons cell of the form
+
+ \(KEY . VALUE)
+
+If this functionality is unsupported, the value is nil.
+
+See `list-system-processes' for getting a list of all process IDs.
+
+The KEYs of the attributes that this function may return are listed
+below, together with the type of the associated VALUE (in parentheses).
+Not all platforms support all of these attributes; unsupported
+attributes will not appear in the returned alist.
+Unless explicitly indicated otherwise, numbers can have either
+integer or floating point values.
+
+ euid -- Effective user User ID of the process (number)
+ user -- User name corresponding to euid (string)
+ egid -- Effective user Group ID of the process (number)
+ group -- Group name corresponding to egid (string)
+ comm -- Command name (executable name only) (string)
+ state -- Process state code, such as "S", "R", or "T" (string)
+ ppid -- Parent process ID (number)
+ pgrp -- Process group ID (number)
+ sess -- Session ID, i.e. process ID of session leader (number)
+ ttname -- Controlling tty name (string)
+ tpgid -- ID of foreground process group on the process's tty (number)
+ minflt -- number of minor page faults (number)
+ majflt -- number of major page faults (number)
+ cminflt -- cumulative number of minor page faults (number)
+ cmajflt -- cumulative number of major page faults (number)
+ utime -- user time used by the process, in the (HIGH LOW USEC) format
+ stime -- system time used by the process, in the (HIGH LOW USEC) format
+ time -- sum of utime and stime, in the (HIGH LOW USEC) format
+ cutime -- user time used by the process and its children, (HIGH LOW USEC)
+ cstime -- system time used by the process and its children, (HIGH LOW USEC)
+ ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
+ pri -- priority of the process (number)
+ nice -- nice value of the process (number)
+ thcount -- process thread count (number)
+ start -- time the process started, in the (HIGH LOW USEC) format
+ vsize -- virtual memory size of the process in KB's (number)
+ rss -- resident set size of the process in KB's (number)
+ etime -- elapsed time the process is running, in (HIGH LOW USEC) format
+ pcpu -- percents of CPU time used by the process (floating-point number)
+ pmem -- percents of total physical memory used by process's resident set
+ (floating-point number)
+ args -- command line which invoked the process (string). */)
+ (pid)
+
+ Lisp_Object pid;
+{
+ return system_process_attributes (pid);
+}
+
void
init_process ()
{
{
QCtype = intern (":type");
staticpro (&QCtype);
+ QCname = intern (":name");
+ staticpro (&QCname);
+ QCtype = intern (":type");
+ staticpro (&QCtype);
+ QCname = intern (":name");
+ staticpro (&QCname);
+ Qeuid = intern ("euid");
+ staticpro (&Qeuid);
+ Qegid = intern ("egid");
+ staticpro (&Qegid);
+ Quser = intern ("user");
+ staticpro (&Quser);
+ Qgroup = intern ("group");
+ staticpro (&Qgroup);
+ Qcomm = intern ("comm");
+ staticpro (&Qcomm);
+ Qstate = intern ("state");
+ staticpro (&Qstate);
+ Qppid = intern ("ppid");
+ staticpro (&Qppid);
+ Qpgrp = intern ("pgrp");
+ staticpro (&Qpgrp);
+ Qsess = intern ("sess");
+ staticpro (&Qsess);
+ Qttname = intern ("ttname");
+ staticpro (&Qttname);
+ Qtpgid = intern ("tpgid");
+ staticpro (&Qtpgid);
+ Qminflt = intern ("minflt");
+ staticpro (&Qminflt);
+ Qmajflt = intern ("majflt");
+ staticpro (&Qmajflt);
+ Qcminflt = intern ("cminflt");
+ staticpro (&Qcminflt);
+ Qcmajflt = intern ("cmajflt");
+ staticpro (&Qcmajflt);
+ Qutime = intern ("utime");
+ staticpro (&Qutime);
+ Qstime = intern ("stime");
+ staticpro (&Qstime);
+ Qtime = intern ("time");
+ staticpro (&Qtime);
+ Qcutime = intern ("cutime");
+ staticpro (&Qcutime);
+ Qcstime = intern ("cstime");
+ staticpro (&Qcstime);
+ Qctime = intern ("ctime");
+ staticpro (&Qctime);
+ Qpri = intern ("pri");
+ staticpro (&Qpri);
+ Qnice = intern ("nice");
+ staticpro (&Qnice);
+ Qthcount = intern ("thcount");
+ staticpro (&Qthcount);
+ Qstart = intern ("start");
+ staticpro (&Qstart);
+ Qvsize = intern ("vsize");
+ staticpro (&Qvsize);
+ Qrss = intern ("rss");
+ staticpro (&Qrss);
+ Qetime = intern ("etime");
+ staticpro (&Qetime);
+ Qpcpu = intern ("pcpu");
+ staticpro (&Qpcpu);
+ Qpmem = intern ("pmem");
+ staticpro (&Qpmem);
+ Qargs = intern ("args");
+ staticpro (&Qargs);
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_inherit_coding_system_flag);
+ defsubr (&Slist_system_processes);
+ defsubr (&Ssystem_process_attributes);
}
\f
HCoop / bpt / emacs.git / blobdiff