/* 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, 2010 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#ifdef subprocesses
#include <stdio.h>
-#include <stdlib.h>
-#include <ctype.h>
#include <errno.h>
#include <setjmp.h>
#include <sys/types.h> /* some typedefs are used in sys/file.h */
#include <sys/file.h>
#include <sys/stat.h>
+#include <setjmp.h>
#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif
-
-#ifdef HAVE_PWD_H
-#include <pwd.h>
-#include <grp.h>
+#ifdef STDC_HEADERS
+#include <stdlib.h>
#endif
#ifdef HAVE_UNISTD_H
#endif
#endif /* HAVE_SOCKETS */
-#if defined(BSD_SYSTEM)
+#if defined(HAVE_SYS_IOCTL_H)
#include <sys/ioctl.h>
#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
#include <fcntl.h>
#endif /* HAVE_PTYS and no O_NDELAY */
-#endif /* BSD_SYSTEM */
+#endif /* HAVE_SYS_IOCTL_H */
#ifdef NEED_BSDTTY
#include <bsdtty.h>
#include "composite.h"
#include "atimer.h"
+#if defined (USE_GTK) || defined (HAVE_GCONF)
+#include "xgselect.h"
+#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
+
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
-Lisp_Object Qlocal, Qipv4, Qdatagram;
+Lisp_Object Qlocal, Qipv4, Qdatagram, Qseqpacket;
Lisp_Object Qreal, Qnetwork, Qserial;
#ifdef AF_INET6
Lisp_Object Qipv6;
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;
+Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
extern void serial_configure (struct Lisp_Process *p, Lisp_Object contact);
#endif
-#ifndef USE_CRT_DLL
-extern int errno;
-#endif
-
#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif
#endif /* DATAGRAM_SOCKETS */
#endif /* BROKEN_DATAGRAM_SOCKETS */
+#if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
+# define HAVE_SEQPACKET
+#endif
+
#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
#ifdef EMACS_HAS_USECS
#define ADAPTIVE_READ_BUFFERING
static void deactivate_process P_ ((Lisp_Object));
static void status_notify P_ ((struct Lisp_Process *));
static int read_process_output P_ ((Lisp_Object, int));
+static void create_pty P_ ((Lisp_Object));
/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
static Lisp_Object get_process ();
static void exec_sentinel ();
-extern EMACS_TIME timer_check ();
extern int timers_run;
\f
/* Mask of bits indicating the descriptors that we wait for input on. */
synchronize_system_messages_locale ();
signame = strsignal (code);
if (signame == 0)
- signame = "unknown";
- string = build_string (signame);
+ string = build_string ("unknown");
+ else
+ {
+ int c1, c2;
+
+ string = make_unibyte_string (signame, strlen (signame));
+ if (! NILP (Vlocale_coding_system))
+ string = (code_convert_string_norecord
+ (string, Vlocale_coding_system, 0));
+ c1 = STRING_CHAR ((char *) SDATA (string));
+ c2 = DOWNCASE (c1);
+ if (c1 != c2)
+ Faset (string, make_number (0), make_number (c2));
+ }
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
- SSET (string, 0, DOWNCASE (SREF (string, 0)));
return concat2 (string, string2);
}
else if (EQ (symbol, Qexit))
#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)
{
p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
p->tick = ++process_tick;
status_notify (p);
+ redisplay_preserve_echo_area (13);
}
else if (p->infd >= 0)
{
= Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
p->tick = ++process_tick;
status_notify (p);
+ redisplay_preserve_echo_area (13);
}
}
remove_process (process);
2, 2, 0,
doc: /* Specify if query is needed for PROCESS when Emacs is exited.
If the second argument FLAG is non-nil, Emacs will query the user before
-exiting if PROCESS is running. */)
+exiting or killing a buffer if PROCESS is running. */)
(process, flag)
register Lisp_Object process, flag;
{
return XPROCESS (process)->type;
}
#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'.
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);
insert_string ("?");
if (INTEGERP (speed))
{
- sprintf (tembuf, " at %d b/s", XINT (speed));
+ sprintf (tembuf, " at %ld b/s", (long) XINT (speed));
insert_string (tembuf);
}
insert_string (")\n");
while (1)
{
tem1 = Fcar (tem);
+ if (NILP (tem1))
+ break;
Finsert (1, &tem1);
tem = Fcdr (tem);
if (NILP (tem))
}
}
if (exited)
- status_notify (NULL);
+ {
+ status_notify (NULL);
+ redisplay_preserve_echo_area (13);
+ }
return Qnil;
}
function to handle the output. BUFFER may also be nil, meaning that
this process is not associated with any buffer.
-PROGRAM is the program file name. It is searched for in PATH.
-Remaining arguments are strings to give program as arguments.
+PROGRAM is the program file name. It is searched for in PATH. If
+nil, just associate a pty with the buffer. Remaining arguments are
+strings to give program as arguments.
If you want to separate standard output from standard error, invoke
the command through a shell and redirect one of them using the shell
program = args[2];
- CHECK_STRING (program);
+ if (!NILP (program))
+ CHECK_STRING (program);
proc = make_process (name);
/* If an error occurs and we can't start the process, we want to
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
GCPRO2 (proc, current_dir);
- coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ if (!NILP (program))
+ coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
UNGCPRO;
if (CONSP (coding_systems))
val = XCAR (coding_systems);
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
GCPRO2 (proc, current_dir);
- coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ if (!NILP (program))
+ coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
UNGCPRO;
}
if (CONSP (coding_systems))
XPROCESS (proc)->encode_coding_system = val;
}
- new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
- /* 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;
+ XPROCESS (proc)->decoding_buf = make_uninit_string (0);
+ XPROCESS (proc)->decoding_carryover = 0;
+ XPROCESS (proc)->encoding_buf = make_uninit_string (0);
- tem = Qnil;
- GCPRO4 (name, program, buffer, current_dir);
- openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
- UNGCPRO;
- if (NILP (tem))
- report_file_error ("Searching for program", Fcons (program, Qnil));
- tem = Fexpand_file_name (tem, Qnil);
- }
- else
+ XPROCESS (proc)->inherit_coding_system_flag
+ = !(NILP (buffer) || !inherit_process_coding_system);
+
+ if (!NILP (program))
{
- if (!NILP (Ffile_directory_p (program)))
- error ("Specified program for new process is a directory");
- tem = program;
- }
+ /* 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, make_number (X_OK));
+ UNGCPRO;
+ if (NILP (tem))
+ report_file_error ("Searching for program", Fcons (program, Qnil));
+ tem = Fexpand_file_name (tem, Qnil);
+ }
+ else
+ {
+ if (!NILP (Ffile_directory_p (program)))
+ error ("Specified program for new process is a directory");
+ tem = program;
+ }
- /* If 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);
+ /* 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);
+ {
+ struct gcpro gcpro1;
+ GCPRO1 (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
- process. */
+ /* Encode the file name and put it in NEW_ARGV.
+ That's where the child will use it to execute the program. */
+ tem = Fcons (ENCODE_FILE (tem), Qnil);
- for (i = 3; i < nargs; i++)
- {
- tem = args[i];
- CHECK_STRING (tem);
- if (STRING_MULTIBYTE (tem))
- tem = (code_convert_string_norecord
- (tem, XPROCESS (proc)->encode_coding_system, 1));
- new_argv[i - 2] = SDATA (tem);
- }
- new_argv[i - 2] = 0;
+ /* 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
+ process. */
- XPROCESS (proc)->decoding_buf = make_uninit_string (0);
- XPROCESS (proc)->decoding_carryover = 0;
- XPROCESS (proc)->encoding_buf = make_uninit_string (0);
+ for (i = 3; i < nargs; i++)
+ {
+ tem = Fcons (args[i], tem);
+ CHECK_STRING (XCAR (tem));
+ if (STRING_MULTIBYTE (XCAR (tem)))
+ XSETCAR (tem,
+ code_convert_string_norecord
+ (XCAR (tem), XPROCESS (proc)->encode_coding_system, 1));
+ }
- XPROCESS (proc)->inherit_coding_system_flag
- = !(NILP (buffer) || !inherit_process_coding_system);
+ UNGCPRO;
+ }
+
+ /* Now that everything is encoded we can collect the strings into
+ NEW_ARGV. */
+ new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
+ new_argv[nargs - 2] = 0;
+
+ for (i = nargs - 3; i >= 0; i--)
+ {
+ new_argv[i] = SDATA (XCAR (tem));
+ tem = XCDR (tem);
+ }
- create_process (proc, (char **) new_argv, current_dir);
+ create_process (proc, (char **) new_argv, current_dir);
+ }
+ else
+ create_pty (proc);
return unbind_to (count, proc);
}
abort ();
/* Was PROC started successfully? */
- if (XPROCESS (proc)->pid <= 0)
+ if (XPROCESS (proc)->pid == -1)
remove_process (proc);
return Qnil;
#ifdef AIX
struct sigaction sighup_action;
#endif
-#else /* !POSIX_SIGNALS */
-#if 0
-#ifdef SIGCHLD
- SIGTYPE (*sigchld)();
-#endif
-#endif /* 0 */
-#endif /* !POSIX_SIGNALS */
+#endif /* POSIX_SIGNALS */
/* Use volatile to protect variables from being clobbered by longjmp. */
volatile int forkin, forkout;
volatile int pty_flag = 0;
#endif
if (forkin < 0)
report_file_error ("Opening pty", Qnil);
-#if defined (DONT_REOPEN_PTY)
- /* In the case that vfork is defined as fork, the parent process
- (Emacs) may send some data before the child process completes
- tty options setup. So we setup tty before forking. */
- child_setup_tty (forkout);
-#endif /* DONT_REOPEN_PTY */
#else
forkin = forkout = -1;
#endif /* not USG, or USG_SUBTTY_WORKS */
sigprocmask (SIG_BLOCK, &blocked, &procmask);
#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
-#if defined (BSD_SYSTEM) || defined (HPUX)
+#if defined (BSD_SYSTEM)
sigsetmask (sigmask (SIGCHLD));
-#else /* ordinary USG */
-#if 0
- sigchld_deferred = 0;
- sigchld = signal (SIGCHLD, create_process_sigchld);
-#endif
-#endif /* ordinary USG */
+#endif /* BSD_SYSTEM */
#endif /* SIGCHLD */
#endif /* !POSIX_SIGNALS */
sigprocmask (SIG_SETMASK, &procmask, 0);
#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
-#if defined (BSD_SYSTEM) || defined (HPUX)
+#if defined (BSD_SYSTEM)
sigsetmask (SIGEMPTYMASK);
-#else /* ordinary USG */
-#if 0
- signal (SIGCHLD, sigchld);
-#endif
-#endif /* ordinary USG */
+#endif /* BSD_SYSTEM */
#endif /* SIGCHLD */
#endif /* !POSIX_SIGNALS */
-#if !defined (DONT_REOPEN_PTY)
if (pty_flag)
child_setup_tty (xforkout);
-#endif /* not DONT_REOPEN_PTY */
#ifdef WINDOWSNT
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
sigprocmask (SIG_SETMASK, &procmask, 0);
#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
-#if defined (BSD_SYSTEM) || defined (HPUX)
+#if defined (BSD_SYSTEM)
sigsetmask (SIGEMPTYMASK);
-#else /* ordinary USG */
-#if 0
- signal (SIGCHLD, sigchld);
- /* Now really handle any of these signals
- that came in during this function. */
- if (sigchld_deferred)
- kill (getpid (), SIGCHLD);
-#endif
-#endif /* ordinary USG */
+#endif /* BSD_SYSTEM */
#endif /* SIGCHLD */
#endif /* !POSIX_SIGNALS */
report_file_error ("Doing vfork", Qnil);
}
+void
+create_pty (process)
+ Lisp_Object process;
+{
+ int inchannel, outchannel;
+
+ /* Use volatile to protect variables from being clobbered by longjmp. */
+ volatile int forkin, forkout;
+ volatile int pty_flag = 0;
+
+ inchannel = outchannel = -1;
+
+#ifdef HAVE_PTYS
+ if (!NILP (Vprocess_connection_type))
+ outchannel = inchannel = allocate_pty ();
+
+ if (inchannel >= 0)
+ {
+#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
+ /* 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). */
+ forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
+#else
+ forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
+#endif
+ if (forkin < 0)
+ report_file_error ("Opening pty", Qnil);
+#if defined (DONT_REOPEN_PTY)
+ /* In the case that vfork is defined as fork, the parent process
+ (Emacs) may send some data before the child process completes
+ tty options setup. So we setup tty before forking. */
+ child_setup_tty (forkout);
+#endif /* DONT_REOPEN_PTY */
+#else
+ forkin = forkout = -1;
+#endif /* not USG, or USG_SUBTTY_WORKS */
+ pty_flag = 1;
+ }
+#endif /* HAVE_PTYS */
+
+#ifdef O_NONBLOCK
+ fcntl (inchannel, F_SETFL, O_NONBLOCK);
+ fcntl (outchannel, F_SETFL, O_NONBLOCK);
+#else
+#ifdef O_NDELAY
+ fcntl (inchannel, F_SETFL, O_NDELAY);
+ fcntl (outchannel, F_SETFL, O_NDELAY);
+#endif
+#endif
+
+ /* Record this as an active process, with its channels.
+ As a result, child_setup will close Emacs's side of the pipes. */
+ chan_process[inchannel] = process;
+ XPROCESS (process)->infd = inchannel;
+ XPROCESS (process)->outfd = outchannel;
+
+ /* Previously we recorded the tty descriptor used in the subprocess.
+ It was only used for getting the foreground tty process, so now
+ we just reopen the device (see emacs_get_tty_pgrp) as this is
+ more portable (see USG_SUBTTY_WORKS above). */
+
+ XPROCESS (process)->pty_flag = pty_flag;
+ XPROCESS (process)->status = Qrun;
+ setup_process_coding_systems (process);
+
+ FD_SET (inchannel, &input_wait_mask);
+ FD_SET (inchannel, &non_keyboard_wait_mask);
+ if (inchannel > max_process_desc)
+ max_process_desc = inchannel;
+
+ XPROCESS (process)->pid = -2;
+#ifdef HAVE_PTYS
+ if (pty_flag)
+ XPROCESS (process)->tty_name = build_string (pty_name);
+ else
+#endif
+ XPROCESS (process)->tty_name = Qnil;
+}
+
\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 empty_unibyte_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;
}
#endif
\f
-static struct socket_options {
+static const struct socket_options {
/* The name of this option. Should be lowercase version of option
name without SO_ prefix. */
char *name;
Lisp_Object opt, val;
{
char *name;
- struct socket_options *sopt;
+ const struct socket_options *sopt;
int ret = 0;
CHECK_SYMBOL (opt);
string, e.g. "80", as well as an integer. This is not portable.)
:type TYPE -- TYPE is the type of connection. The default (nil) is a
-stream type connection, `datagram' creates a datagram type connection.
+stream type connection, `datagram' creates a datagram type connection,
+`seqpacket' creates a reliable datagram connection.
:family FAMILY -- FAMILY is the address (and protocol) family for the
service specified by HOST and SERVICE. The default (nil) is to use
#ifdef DATAGRAM_SOCKETS
else if (EQ (tem, Qdatagram))
socktype = SOCK_DGRAM;
+#endif
+#ifdef HAVE_SEQPACKET
+ else if (EQ (tem, Qseqpacket))
+ socktype = SOCK_SEQPACKET;
#endif
else
error ("Unsupported connection type");
QCaddress = is_server ? QClocal : QCremote;
/* :nowait BOOL */
- if (!is_server && socktype == SOCK_STREAM
+ if (!is_server && socktype != SOCK_DGRAM
&& (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
{
#ifndef NON_BLOCKING_CONNECT
Some kernels have a bug which causes retrying connect to fail
after a connect. Polling can interfere with gethostbyname too. */
#ifdef POLL_FOR_INPUT
- if (socktype == SOCK_STREAM)
+ if (socktype != SOCK_DGRAM)
{
record_unwind_protect (unwind_stop_other_atimers, Qnil);
bind_polling_period (10);
#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;
/* Parse network options in the arg list.
We simply ignore anything which isn't a known option (including other keywords).
- An error is signaled 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]);
}
#endif
- if (socktype == SOCK_STREAM && listen (s, backlog))
+ if (socktype != SOCK_DGRAM && listen (s, backlog))
report_file_error ("Cannot listen on server socket", Qnil);
break;
immediate_quit = 1;
QUIT;
- /* This turns off all alarm-based interrupts; the
- bind_polling_period call above doesn't always turn all the
- short-interval ones off, especially if interrupt_input is
- set.
-
- It'd be nice to be able to control the connect timeout
- though. Would non-blocking connect calls be portable?
-
- This used to be conditioned by HAVE_GETADDRINFO. Why? */
-
- turn_on_atimers (0);
-
ret = connect (s, lres->ai_addr, lres->ai_addrlen);
xerrno = errno;
- turn_on_atimers (1);
-
if (ret == 0 || xerrno == EISCONN)
{
/* The unwind-protect will be discarded afterwards.
#endif
#endif
+#ifndef WINDOWSNT
+ if (xerrno == EINTR)
+ {
+ /* Unlike most other syscalls connect() cannot be called
+ again. (That would return EALREADY.) The proper way to
+ wait for completion is select(). */
+ int sc, len;
+ SELECT_TYPE fdset;
+ retry_select:
+ FD_ZERO (&fdset);
+ FD_SET (s, &fdset);
+ QUIT;
+ sc = select (s + 1, (SELECT_TYPE *)0, &fdset, (SELECT_TYPE *)0,
+ (EMACS_TIME *)0);
+ if (sc == -1)
+ {
+ if (errno == EINTR)
+ goto retry_select;
+ else
+ report_file_error ("select failed", Qnil);
+ }
+ eassert (sc > 0);
+
+ len = sizeof xerrno;
+ eassert (FD_ISSET (s, &fdset));
+ if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) == -1)
+ report_file_error ("getsockopt failed", Qnil);
+ if (xerrno)
+ errno = xerrno, report_file_error ("error during connect", Qnil);
+ else
+ break;
+ }
+#endif /* !WINDOWSNT */
+
immediate_quit = 0;
/* Discard the unwind protect closing S. */
emacs_close (s);
s = -1;
+#ifdef WINDOWSNT
if (xerrno == EINTR)
goto retry_connect;
+#endif
}
if (s >= 0)
p->pid = 0;
p->infd = inch;
p->outfd = outch;
- if (is_server && socktype == SOCK_STREAM)
+ if (is_server && socktype != SOCK_DGRAM)
p->status = Qlisten;
/* Make the process marker point into the process buffer (if any). */
struct ifflag_def {
int flag_bit;
- char *flag_sym;
+ const char *flag_sym;
};
-static struct ifflag_def ifflag_table[] = {
+static const struct ifflag_def ifflag_table[] = {
#ifdef IFF_UP
{ IFF_UP, "up" },
#endif
if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
{
int flags = rq.ifr_flags;
- struct ifflag_def *fp;
+ const struct ifflag_def *fp;
int fnum;
any++;
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.
}
/* Use a wrapper around select to work around a bug in gdb 5.3.
- Normally, the wrapper is optimzed away by inlining.
+ Normally, the wrapper is optimized away by inlining.
If emacs is stopped inside select, the gdb backtrace doesn't
show the function which called select, so it is practically
FD_ZERO (&Connecting);
#endif
+ if (time_limit == 0 && wait_proc && !NILP (Vinhibit_quit)
+ && !(CONSP (wait_proc->status) && EQ (XCAR (wait_proc->status), Qexit)))
+ message ("Blocking call to accept-process-output with quit inhibited!!");
+
/* If wait_proc is a process to watch, set wait_channel accordingly. */
if (wait_proc != NULL)
wait_channel = wait_proc->infd;
QUIT;
#ifdef SYNC_INPUT
else
- {
- if (interrupt_input_pending)
- handle_async_input ();
- if (pending_atimers)
- do_pending_atimers ();
- }
+ process_pending_signals ();
#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. 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))
+ timeout to get our attention. */
+ if (update_tick != process_tick)
{
SELECT_TYPE Atemp;
#ifdef NON_BLOCKING_CONNECT
the loop, since timeout has already been zeroed out. */
clear_waiting_for_input ();
status_notify (NULL);
+ if (do_display) redisplay_preserve_echo_area (13);
}
}
/* 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)
- {
+ 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
-#ifdef HAVE_NS
- nfds = ns_select
+#if defined (USE_GTK) || defined (HAVE_GCONF)
+ nfds = xg_select
+#elif defined (HAVE_NS)
+ nfds = ns_select
#else
- nfds = select
+ nfds = select
#endif
- (max (max (max_process_desc, max_keyboard_desc),
+ (max (max (max_process_desc, max_keyboard_desc),
max_gpm_desc) + 1,
&Available,
#ifdef NON_BLOCKING_CONNECT
It can't hurt. */
else if (nread == -1 && errno == EIO)
{
- /* Clear the descriptor now, so we only raise the signal once. */
- FD_CLR (channel, &input_wait_mask);
- FD_CLR (channel, &non_keyboard_wait_mask);
+ /* Clear the descriptor now, so we only raise the
+ signal once. Don't do this if `process' is only
+ a pty. */
+ if (XPROCESS (proc)->pid != -2)
+ {
+ FD_CLR (channel, &input_wait_mask);
+ FD_CLR (channel, &non_keyboard_wait_mask);
- kill (getpid (), SIGCHLD);
+ kill (getpid (), SIGCHLD);
+ }
}
#endif /* HAVE_PTYS */
/* If we can detect process termination, don't consider the process
#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))
register int nbytes;
char *chars;
register Lisp_Object outstream;
- register struct buffer *old = current_buffer;
register struct Lisp_Process *p = XPROCESS (proc);
register int opoint;
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = p->decoding_carryover;
int readmax = 4096;
+ int count = SPECPDL_INDEX ();
+ Lisp_Object odeactivate;
chars = (char *) alloca (carryover + readmax);
if (carryover)
/* Now set NBYTES how many bytes we must decode. */
nbytes += carryover;
+ odeactivate = Vdeactivate_mark;
+ /* There's no good reason to let process filters change the current
+ buffer, and many callers of accept-process-output, sit-for, and
+ friends don't expect current-buffer to be changed from under them. */
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+
/* Read and dispose of the process output. */
outstream = p->filter;
if (!NILP (outstream))
{
- /* 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_INDEX ();
- Lisp_Object odeactivate;
Lisp_Object obuffer, okeymap;
Lisp_Object text;
int outer_running_asynch_code = running_asynch_code;
/* No need to gcpro these, because all we do with them later
is test them for EQness, and none of them should be a string. */
- odeactivate = Vdeactivate_mark;
XSETBUFFER (obuffer, current_buffer);
okeymap = current_buffer->keymap;
+ /* 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. */
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
restore_search_regs ();
running_asynch_code = outer_running_asynch_code;
- /* Handling the process output should not deactivate the mark. */
- Vdeactivate_mark = odeactivate;
-
/* Restore waiting_for_user_input_p as it was
when we were called, in case the filter clobbered it. */
waiting_for_user_input_p = waiting;
cause trouble (for example it would make sit_for return). */
if (waiting_for_user_input_p == -1)
record_asynch_buffer_change ();
-
- unbind_to (count, Qnil);
- return nbytes;
}
/* If no filter, write into buffer if it isn't dead. */
- if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
+ else if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
{
Lisp_Object old_read_only;
int old_begv, old_zv;
int old_begv_byte, old_zv_byte;
- Lisp_Object odeactivate;
int before, before_byte;
int opoint_byte;
Lisp_Object text;
struct buffer *b;
- odeactivate = Vdeactivate_mark;
-
Fset_buffer (p->buffer);
opoint = PT;
opoint_byte = PT_BYTE;
if (old_begv != BEGV || old_zv != ZV)
Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
- /* Handling the process output should not deactivate the mark. */
- Vdeactivate_mark = odeactivate;
current_buffer->read_only = old_read_only;
SET_PT_BOTH (opoint, opoint_byte);
- set_buffer_internal (old);
}
+ /* Handling the process output should not deactivate the mark. */
+ Vdeactivate_mark = odeactivate;
+
+ unbind_to (count, Qnil);
return nbytes;
}
}
else if (STRINGP (object))
{
- encode_coding_string (coding, object, 1);
+ encode_coding_object (coding, object, 0, 0, SCHARS (object),
+ SBYTES (object), Qt);
}
else
{
}
len = coding->produced;
- buf = SDATA (coding->dst_object);
+ object = coding->dst_object;
+ buf = SDATA (object);
}
if (pty_max_bytes == 0)
{
int this = len;
- /* Decide how much data we can send in one batch.
- Long lines need to be split into multiple batches. */
- 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.
- 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
- in the process object. */
- int linepos = 0;
- unsigned char *ptr = (unsigned char *) buf;
- unsigned char *end = (unsigned char *) buf + len;
-
- /* Scan through this text for a line that is too long. */
- while (ptr != end && linepos < pty_max_bytes)
- {
- if (*ptr == '\n')
- linepos = 0;
- else
- linepos++;
- ptr++;
- }
- /* If we found one, break the line there
- and put in a C-d to force the buffer through. */
- this = ptr - buf;
- }
-
/* Send this batch, using one or more write calls. */
while (this > 0)
{
len -= rv;
this -= rv;
}
-
- /* 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);
}
}
else
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;
p->status = Qrun;
p->tick = ++process_tick;
if (!nomsg)
- status_notify (NULL);
+ {
+ status_notify (NULL);
+ redisplay_preserve_echo_area (13);
+ }
break;
#endif /* ! defined (SIGCONT) */
case SIGINT:
#endif /* no WUNTRACED */
/* Keep trying to get a status until we get a definitive result. */
do
- {
+ {
errno = 0;
pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
}
/* PID == 0 means no processes found, PID == -1 means a real
failure. We have done all our job, so return. */
- /* USG systems forget handlers when they are used;
- must reestablish each time */
-#if defined (USG) && !defined (POSIX_SIGNALS)
- signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
-#endif
errno = old_errno;
return;
}
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)))
-#if defined (USG) && ! defined (POSIX_SIGNALS)
- signal (signo, sigchld_handler);
-#endif
+ && !(defined HPUX && defined WNOHANG)))
errno = old_errno;
return;
#endif /* USG, but not HPUX with WNOHANG */
XSETBUFFER (obuffer, current_buffer);
okeymap = current_buffer->keymap;
+ /* There's no good reason to let sentinels change the current
+ buffer, and many callers of accept-process-output, sit-for, and
+ friends don't expect current-buffer to be changed from under them. */
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+
sentinel = p->sentinel;
if (NILP (sentinel))
return;
record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
/* Inhibit quit so that random quits don't screw up a running filter. */
specbind (Qinhibit_quit, Qt);
- specbind (Qlast_nonmenu_event, Qt);
+ specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
/* In case we get recursively called,
and we already saved the match data nonrecursively,
when a process becomes runnable. */
else if (!EQ (symbol, Qrun) && !NILP (buffer))
{
- Lisp_Object ro, tem;
+ Lisp_Object tem;
struct buffer *old = current_buffer;
int opoint, opoint_byte;
int before, before_byte;
- ro = XBUFFER (buffer)->read_only;
-
/* Avoid error if buffer is deleted
(probably that's why the process is dead, too) */
if (NILP (XBUFFER (buffer)->name))
} /* end for */
update_mode_lines++; /* in case buffers use %s in mode-line-format */
- redisplay_preserve_echo_area (13);
-
UNGCPRO;
}
\f
/* Enumeration of and access to system processes a-la ps(1). */
-#if HAVE_PROCFS
-
-/* Process enumeration and access via /proc. */
-
-static Lisp_Object
-procfs_list_system_processes ()
-{
- Lisp_Object procdir, match, proclist, next;
- struct gcpro gcpro1, gcpro2;
- register Lisp_Object tail;
-
- GCPRO2 (procdir, match);
- /* For every process on the system, there's a directory in the
- "/proc" pseudo-directory whose name is the numeric ID of that
- process. */
- procdir = build_string ("/proc");
- match = build_string ("[0-9]+");
- proclist = directory_files_internal (procdir, Qnil, match, Qt, 0, Qnil);
-
- /* `proclist' gives process IDs as strings. Destructively convert
- each string into a number. */
- for (tail = proclist; CONSP (tail); tail = next)
- {
- next = XCDR (tail);
- XSETCAR (tail, Fstring_to_number (XCAR (tail), Qnil));
- }
- UNGCPRO;
-
- /* directory_files_internal returns the files in reverse order; undo
- that. */
- proclist = Fnreverse (proclist);
- return proclist;
-}
-
-static void
-time_from_jiffies (unsigned long long tval, long hz,
- time_t *sec, unsigned *usec)
-{
- unsigned long long ullsec;
-
- *sec = tval / hz;
- ullsec = *sec;
- tval -= ullsec * hz;
- /* Careful: if HZ > 1 million, then integer division by it yields zero. */
- if (hz <= 1000000)
- *usec = tval * 1000000 / hz;
- else
- *usec = tval / (hz / 1000000);
-}
-
-static Lisp_Object
-ltime_from_jiffies (unsigned long long tval, long hz)
-{
- time_t sec;
- unsigned usec;
-
- time_from_jiffies (tval, hz, &sec, &usec);
-
- return list3 (make_number ((sec >> 16) & 0xffff),
- make_number (sec & 0xffff),
- make_number (usec));
-}
-
-static void
-get_up_time (time_t *sec, unsigned *usec)
-{
- FILE *fup;
-
- *sec = *usec = 0;
-
- BLOCK_INPUT;
- fup = fopen ("/proc/uptime", "r");
-
- if (fup)
- {
- double uptime, idletime;
-
- /* The numbers in /proc/uptime use C-locale decimal point, but
- we already set ourselves to the C locale (see `fixup_locale'
- in emacs.c). */
- if (2 <= fscanf (fup, "%lf %lf", &uptime, &idletime))
- {
- *sec = uptime;
- *usec = (uptime - *sec) * 1000000;
- }
- fclose (fup);
- }
- UNBLOCK_INPUT;
-}
-
-#define MAJOR(d) (((unsigned)(d) >> 8) & 0xfff)
-#define MINOR(d) (((unsigned)(d) & 0xff) | (((unsigned)(d) & 0xfff00000) >> 12))
-
-static Lisp_Object
-procfs_ttyname (rdev)
-{
- FILE *fdev = NULL;
- char name[PATH_MAX];
-
- BLOCK_INPUT;
- fdev = fopen ("/proc/tty/drivers", "r");
-
- if (fdev)
- {
- unsigned major;
- unsigned long minor_beg, minor_end;
- char minor[25]; /* 2 32-bit numbers + dash */
- char *endp;
-
- while (!feof (fdev) && !ferror (fdev))
- {
- if (3 <= fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor)
- && major == MAJOR (rdev))
- {
- minor_beg = strtoul (minor, &endp, 0);
- if (*endp == '\0')
- minor_end = minor_beg;
- else if (*endp == '-')
- minor_end = strtoul (endp + 1, &endp, 0);
- else
- continue;
-
- if (MINOR (rdev) >= minor_beg && MINOR (rdev) <= minor_end)
- {
- sprintf (name + strlen (name), "%lu", MINOR (rdev));
- break;
- }
- }
- }
- fclose (fdev);
- }
- UNBLOCK_INPUT;
- return build_string (name);
-}
-
-static unsigned long
-procfs_get_total_memory (void)
-{
- FILE *fmem = NULL;
- unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */
-
- BLOCK_INPUT;
- fmem = fopen ("/proc/meminfo", "r");
-
- if (fmem)
- {
- unsigned long entry_value;
- char entry_name[20]; /* the longest I saw is 13+1 */
-
- while (!feof (fmem) && !ferror (fmem))
- {
- if (2 <= fscanf (fmem, "%s %lu kB\n", entry_name, &entry_value)
- && strcmp (entry_name, "MemTotal:") == 0)
- {
- retval = entry_value;
- break;
- }
- }
- fclose (fmem);
- }
- UNBLOCK_INPUT;
- return retval;
-}
-
-static Lisp_Object
-procfs_system_process_attributes (pid)
- Lisp_Object pid;
-{
- char procfn[PATH_MAX], fn[PATH_MAX];
- struct stat st;
- struct passwd *pw;
- struct group *gr;
- long clocks_per_sec;
- char *procfn_end;
- char procbuf[1025], *p, *q;
- int fd;
- ssize_t nread;
- char cmd[PATH_MAX];
- char *cmdline = NULL;
- size_t cmdsize;
- int c;
- int proc_id, ppid, uid, gid, pgrp, sess, tty, tpgid, thcount;
- unsigned long long utime, stime, cutime, cstime, start;
- long priority, nice, rss;
- unsigned long minflt, majflt, cminflt, cmajflt, vsize;
- time_t sec;
- unsigned usec;
- EMACS_TIME tnow, tstart, tboot, telapsed,ttotal;
- double pcpu, pmem;
- Lisp_Object attrs = Qnil;
- Lisp_Object cmd_str, decoded_cmd, tem;
- struct gcpro gcpro1, gcpro2;
- EMACS_INT uid_eint, gid_eint;
-
- CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
- sprintf (procfn, "/proc/%lu", proc_id);
- if (stat (procfn, &st) < 0)
- return attrs;
-
- GCPRO2 (attrs, decoded_cmd);
-
- /* euid egid */
- uid = st.st_uid;
- /* Use of EMACS_INT stops GCC whining about limited range of data type. */
- uid_eint = uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid_eint)), attrs);
- BLOCK_INPUT;
- pw = (struct passwd *) getpwuid (uid);
- UNBLOCK_INPUT;
- if (pw)
- attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
-
- gid = st.st_gid;
- gid_eint = gid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid_eint)), attrs);
- BLOCK_INPUT;
- gr = (struct group *) getgrgid (gid);
- UNBLOCK_INPUT;
- if (gr)
- attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
-
- strcpy (fn, procfn);
- procfn_end = fn + strlen (fn);
- strcpy (procfn_end, "/stat");
- fd = emacs_open (fn, O_RDONLY, 0);
- if (fd >= 0 && (nread = emacs_read (fd, procbuf, sizeof(procbuf) - 1)) > 0)
- {
- procbuf[nread] = '\0';
- p = procbuf;
-
- p = strchr (p, '(') + 1;
- q = strchr (p, ')');
- /* comm */
- if (q > p)
- {
- memcpy (cmd, p, q - p);
- cmd[q - p] = '\0';
- }
- else
- strcpy (cmd, "???");
- /* Command name is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmd, q ? q - p : 3);
- decoded_cmd = code_convert_string_norecord (cmd_str,
- Vlocale_coding_system, 0);
- attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
-
- if (q)
- {
- EMACS_INT ppid_eint, pgrp_eint, sess_eint, tpgid_eint, thcount_eint;
- p = q + 2;
- /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt utime stime cutime cstime priority nice thcount . start vsize rss */
- sscanf (p, "%c %d %d %d %d %d %*u %lu %lu %lu %lu %Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld",
- &c, &ppid, &pgrp, &sess, &tty, &tpgid,
- &minflt, &cminflt, &majflt, &cmajflt,
- &utime, &stime, &cutime, &cstime,
- &priority, &nice, &thcount, &start, &vsize, &rss);
- {
- char state_str[2];
-
- state_str[0] = c;
- state_str[1] = '\0';
- tem = build_string (state_str);
- attrs = Fcons (Fcons (Qstate, tem), attrs);
- }
- /* Stops GCC whining about limited range of data type. */
- ppid_eint = ppid;
- pgrp_eint = pgrp;
- sess_eint = sess;
- tpgid_eint = tpgid;
- thcount_eint = thcount;
- attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid_eint)), attrs);
- attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp_eint)), attrs);
- attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess_eint)), attrs);
- attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs);
- attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid_eint)), attrs);
- attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs);
- attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs);
- attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), attrs);
- attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), attrs);
- clocks_per_sec = sysconf (_SC_CLK_TCK);
- if (clocks_per_sec < 0)
- clocks_per_sec = 100;
- attrs = Fcons (Fcons (Qutime,
- ltime_from_jiffies (utime, clocks_per_sec)),
- attrs);
- attrs = Fcons (Fcons (Qstime,
- ltime_from_jiffies (stime, clocks_per_sec)),
- attrs);
- attrs = Fcons (Fcons (Qcutime,
- ltime_from_jiffies (cutime, clocks_per_sec)),
- attrs);
- attrs = Fcons (Fcons (Qcstime,
- ltime_from_jiffies (cstime, clocks_per_sec)),
- attrs);
- attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs);
- attrs = Fcons (Fcons (Qnice, make_number (nice)), attrs);
- attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs);
- EMACS_GET_TIME (tnow);
- get_up_time (&sec, &usec);
- EMACS_SET_SECS (telapsed, sec);
- EMACS_SET_USECS (telapsed, usec);
- EMACS_SUB_TIME (tboot, tnow, telapsed);
- time_from_jiffies (start, clocks_per_sec, &sec, &usec);
- EMACS_SET_SECS (tstart, sec);
- EMACS_SET_USECS (tstart, usec);
- EMACS_ADD_TIME (tstart, tboot, tstart);
- attrs = Fcons (Fcons (Qstart,
- list3 (make_number
- ((EMACS_SECS (tstart) >> 16) & 0xffff),
- make_number
- (EMACS_SECS (tstart) & 0xffff),
- make_number
- (EMACS_USECS (tstart)))),
- attrs);
- attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs);
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs);
- EMACS_SUB_TIME (telapsed, tnow, tstart);
- attrs = Fcons (Fcons (Qetime,
- list3 (make_number
- ((EMACS_SECS (telapsed) >> 16) & 0xffff),
- make_number
- (EMACS_SECS (telapsed) & 0xffff),
- make_number
- (EMACS_USECS (telapsed)))),
- attrs);
- time_from_jiffies (utime + stime, clocks_per_sec, &sec, &usec);
- pcpu = (sec + usec / 1000000.0) / (EMACS_SECS (telapsed) + EMACS_USECS (telapsed) / 1000000.0);
- attrs = Fcons (Fcons (Qpcpu, make_float (pcpu)), attrs);
- pmem = 4.0 * 100 * rss / procfs_get_total_memory ();
- if (pmem > 100)
- pmem = 100;
- attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs);
- }
- }
- if (fd >= 0)
- emacs_close (fd);
-
- /* args */
- strcpy (procfn_end, "/cmdline");
- fd = emacs_open (fn, O_RDONLY, 0);
- if (fd >= 0)
- {
- for (cmdsize = 0; emacs_read (fd, (char *)&c, 1) == 1; cmdsize++)
- {
- if (isspace (c) || c == '\\')
- cmdsize++; /* for later quoting, see below */
- }
- if (cmdsize)
- {
- cmdline = xmalloc (cmdsize + 1);
- lseek (fd, 0L, SEEK_SET);
- cmdline[0] = '\0';
- if ((nread = read (fd, cmdline, cmdsize)) >= 0)
- cmdline[nread++] = '\0';
- /* We don't want trailing null characters. */
- for (p = cmdline + nread - 1; p > cmdline && !*p; p--)
- nread--;
- for (p = cmdline; p < cmdline + nread; p++)
- {
- /* Escape-quote whitespace and backslashes. */
- if (isspace (*p) || *p == '\\')
- {
- memmove (p + 1, p, nread - (p - cmdline));
- nread++;
- *p++ = '\\';
- }
- else if (*p == '\0')
- *p = ' ';
- }
- cmdsize = nread;
- }
- else
- {
- cmdsize = strlen (cmd) + 2;
- cmdline = xmalloc (cmdsize + 1);
- strcpy (cmdline, "[");
- strcat (strcat (cmdline, cmd), "]");
- }
- emacs_close (fd);
- /* Command line is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmdline, cmdsize);
- decoded_cmd = code_convert_string_norecord (cmd_str,
- Vlocale_coding_system, 0);
- xfree (cmdline);
- attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
- }
-
- UNGCPRO;
- return attrs;
-}
-
-#endif /* !HAVE_PROCFS */
-
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. */)
+See `process-attributes' for getting attributes of a process given its ID. */)
()
{
-#ifdef LISTPROC
- return LISTPROC ();
-#else
- return Qnil;
-#endif
+ return list_system_processes ();
}
-DEFUN ("system-process-attributes", Fsystem_process_attributes,
- Ssystem_process_attributeses, 1, 1, 0,
+DEFUN ("process-attributes", Fprocess_attributes,
+ Sprocess_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
- \(ATTR . VALUE)
+ \(KEY . VALUE)
If this functionality is unsupported, the value is nil.
See `list-system-processes' for getting a list of all process IDs.
-The attributes that this function may return are listed below,
-together with the type of the associated value (in parentheses).
+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
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)
Lisp_Object pid;
{
-#ifdef PROCATTR
- return PROCATTR (pid);
-#else
- return Qnil;
-#endif
+ return system_process_attributes (pid);
}
\f
void
#ifdef HAVE_SOCKETS
{
Lisp_Object subfeatures = Qnil;
- struct socket_options *sopt;
+ const struct socket_options *sopt;
#define ADD_SUBFEATURE(key, val) \
- subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
+ subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
#ifdef NON_BLOCKING_CONNECT
ADD_SUBFEATURE (QCnowait, Qt);
#ifdef DATAGRAM_SOCKETS
ADD_SUBFEATURE (QCtype, Qdatagram);
#endif
+#ifdef HAVE_SEQPACKET
+ ADD_SUBFEATURE (QCtype, Qseqpacket);
+#endif
#ifdef HAVE_LOCAL_SOCKETS
ADD_SUBFEATURE (QCfamily, Qlocal);
#endif
#endif
for (sopt = socket_options; sopt->name; sopt++)
- subfeatures = Fcons (intern (sopt->name), subfeatures);
+ subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
- Fprovide (intern ("make-network-process"), subfeatures);
+ Fprovide (intern_c_string ("make-network-process"), subfeatures);
}
#endif /* HAVE_SOCKETS */
void
syms_of_process ()
{
- Qprocessp = intern ("processp");
+ Qprocessp = intern_c_string ("processp");
staticpro (&Qprocessp);
- Qrun = intern ("run");
+ Qrun = intern_c_string ("run");
staticpro (&Qrun);
- Qstop = intern ("stop");
+ Qstop = intern_c_string ("stop");
staticpro (&Qstop);
- Qsignal = intern ("signal");
+ Qsignal = intern_c_string ("signal");
staticpro (&Qsignal);
/* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
here again.
- Qexit = intern ("exit");
+ Qexit = intern_c_string ("exit");
staticpro (&Qexit); */
- Qopen = intern ("open");
+ Qopen = intern_c_string ("open");
staticpro (&Qopen);
- Qclosed = intern ("closed");
+ Qclosed = intern_c_string ("closed");
staticpro (&Qclosed);
- Qconnect = intern ("connect");
+ Qconnect = intern_c_string ("connect");
staticpro (&Qconnect);
- Qfailed = intern ("failed");
+ Qfailed = intern_c_string ("failed");
staticpro (&Qfailed);
- Qlisten = intern ("listen");
+ Qlisten = intern_c_string ("listen");
staticpro (&Qlisten);
- Qlocal = intern ("local");
+ Qlocal = intern_c_string ("local");
staticpro (&Qlocal);
- Qipv4 = intern ("ipv4");
+ Qipv4 = intern_c_string ("ipv4");
staticpro (&Qipv4);
#ifdef AF_INET6
- Qipv6 = intern ("ipv6");
+ Qipv6 = intern_c_string ("ipv6");
staticpro (&Qipv6);
#endif
- Qdatagram = intern ("datagram");
+ Qdatagram = intern_c_string ("datagram");
staticpro (&Qdatagram);
+ Qseqpacket = intern_c_string ("seqpacket");
+ staticpro (&Qseqpacket);
- QCport = intern (":port");
+ QCport = intern_c_string (":port");
staticpro (&QCport);
- QCspeed = intern (":speed");
+ QCspeed = intern_c_string (":speed");
staticpro (&QCspeed);
- QCprocess = intern (":process");
+ QCprocess = intern_c_string (":process");
staticpro (&QCprocess);
- QCbytesize = intern (":bytesize");
+ QCbytesize = intern_c_string (":bytesize");
staticpro (&QCbytesize);
- QCstopbits = intern (":stopbits");
+ QCstopbits = intern_c_string (":stopbits");
staticpro (&QCstopbits);
- QCparity = intern (":parity");
+ QCparity = intern_c_string (":parity");
staticpro (&QCparity);
- Qodd = intern ("odd");
+ Qodd = intern_c_string ("odd");
staticpro (&Qodd);
- Qeven = intern ("even");
+ Qeven = intern_c_string ("even");
staticpro (&Qeven);
- QCflowcontrol = intern (":flowcontrol");
+ QCflowcontrol = intern_c_string (":flowcontrol");
staticpro (&QCflowcontrol);
- Qhw = intern ("hw");
+ Qhw = intern_c_string ("hw");
staticpro (&Qhw);
- Qsw = intern ("sw");
+ Qsw = intern_c_string ("sw");
staticpro (&Qsw);
- QCsummary = intern (":summary");
+ QCsummary = intern_c_string (":summary");
staticpro (&QCsummary);
- Qreal = intern ("real");
+ Qreal = intern_c_string ("real");
staticpro (&Qreal);
- Qnetwork = intern ("network");
+ Qnetwork = intern_c_string ("network");
staticpro (&Qnetwork);
- Qserial = intern ("serial");
+ Qserial = intern_c_string ("serial");
staticpro (&Qserial);
- QCname = intern (":name");
+ QCname = intern_c_string (":name");
staticpro (&QCname);
- QCbuffer = intern (":buffer");
+ QCbuffer = intern_c_string (":buffer");
staticpro (&QCbuffer);
- QChost = intern (":host");
+ QChost = intern_c_string (":host");
staticpro (&QChost);
- QCservice = intern (":service");
+ QCservice = intern_c_string (":service");
staticpro (&QCservice);
- QCtype = intern (":type");
+ QCtype = intern_c_string (":type");
staticpro (&QCtype);
- QClocal = intern (":local");
+ QClocal = intern_c_string (":local");
staticpro (&QClocal);
- QCremote = intern (":remote");
+ QCremote = intern_c_string (":remote");
staticpro (&QCremote);
- QCcoding = intern (":coding");
+ QCcoding = intern_c_string (":coding");
staticpro (&QCcoding);
- QCserver = intern (":server");
+ QCserver = intern_c_string (":server");
staticpro (&QCserver);
- QCnowait = intern (":nowait");
+ QCnowait = intern_c_string (":nowait");
staticpro (&QCnowait);
- QCsentinel = intern (":sentinel");
+ QCsentinel = intern_c_string (":sentinel");
staticpro (&QCsentinel);
- QClog = intern (":log");
+ QClog = intern_c_string (":log");
staticpro (&QClog);
- QCnoquery = intern (":noquery");
+ QCnoquery = intern_c_string (":noquery");
staticpro (&QCnoquery);
- QCstop = intern (":stop");
+ QCstop = intern_c_string (":stop");
staticpro (&QCstop);
- QCoptions = intern (":options");
+ QCoptions = intern_c_string (":options");
staticpro (&QCoptions);
- QCplist = intern (":plist");
+ QCplist = intern_c_string (":plist");
staticpro (&QCplist);
- Qlast_nonmenu_event = intern ("last-nonmenu-event");
+ Qlast_nonmenu_event = intern_c_string ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
staticpro (&Vprocess_alist);
staticpro (&deleted_pid_list);
#endif
- Qeuid = intern ("euid");
+ Qeuid = intern_c_string ("euid");
staticpro (&Qeuid);
- Qegid = intern ("egid");
+ Qegid = intern_c_string ("egid");
staticpro (&Qegid);
- Quser = intern ("user");
+ Quser = intern_c_string ("user");
staticpro (&Quser);
- Qgroup = intern ("group");
+ Qgroup = intern_c_string ("group");
staticpro (&Qgroup);
- Qcomm = intern ("comm");
+ Qcomm = intern_c_string ("comm");
staticpro (&Qcomm);
- Qstate = intern ("state");
+ Qstate = intern_c_string ("state");
staticpro (&Qstate);
- Qppid = intern ("ppid");
+ Qppid = intern_c_string ("ppid");
staticpro (&Qppid);
- Qpgrp = intern ("pgrp");
+ Qpgrp = intern_c_string ("pgrp");
staticpro (&Qpgrp);
- Qsess = intern ("sess");
+ Qsess = intern_c_string ("sess");
staticpro (&Qsess);
- Qttname = intern ("ttname");
+ Qttname = intern_c_string ("ttname");
staticpro (&Qttname);
- Qtpgid = intern ("tpgid");
+ Qtpgid = intern_c_string ("tpgid");
staticpro (&Qtpgid);
- Qminflt = intern ("minflt");
+ Qminflt = intern_c_string ("minflt");
staticpro (&Qminflt);
- Qmajflt = intern ("majflt");
+ Qmajflt = intern_c_string ("majflt");
staticpro (&Qmajflt);
- Qcminflt = intern ("cminflt");
+ Qcminflt = intern_c_string ("cminflt");
staticpro (&Qcminflt);
- Qcmajflt = intern ("cmajflt");
+ Qcmajflt = intern_c_string ("cmajflt");
staticpro (&Qcmajflt);
- Qutime = intern ("utime");
+ Qutime = intern_c_string ("utime");
staticpro (&Qutime);
- Qstime = intern ("stime");
+ Qstime = intern_c_string ("stime");
staticpro (&Qstime);
- Qcutime = intern ("cutime");
+ Qtime = intern_c_string ("time");
+ staticpro (&Qtime);
+ Qcutime = intern_c_string ("cutime");
staticpro (&Qcutime);
- Qcstime = intern ("cstime");
+ Qcstime = intern_c_string ("cstime");
staticpro (&Qcstime);
- Qpri = intern ("pri");
+ Qctime = intern_c_string ("ctime");
+ staticpro (&Qctime);
+ Qpri = intern_c_string ("pri");
staticpro (&Qpri);
- Qnice = intern ("nice");
+ Qnice = intern_c_string ("nice");
staticpro (&Qnice);
- Qthcount = intern ("thcount");
+ Qthcount = intern_c_string ("thcount");
staticpro (&Qthcount);
- Qstart = intern ("start");
+ Qstart = intern_c_string ("start");
staticpro (&Qstart);
- Qvsize = intern ("vsize");
+ Qvsize = intern_c_string ("vsize");
staticpro (&Qvsize);
- Qrss = intern ("rss");
+ Qrss = intern_c_string ("rss");
staticpro (&Qrss);
- Qetime = intern ("etime");
+ Qetime = intern_c_string ("etime");
staticpro (&Qetime);
- Qpcpu = intern ("pcpu");
+ Qpcpu = intern_c_string ("pcpu");
staticpro (&Qpcpu);
- Qpmem = intern ("pmem");
+ Qpmem = intern_c_string ("pmem");
staticpro (&Qpmem);
- Qargs = intern ("args");
+ Qargs = intern_c_string ("args");
staticpro (&Qargs);
DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
defsubr (&Sset_process_filter_multibyte);
defsubr (&Sprocess_filter_multibyte_p);
defsubr (&Slist_system_processes);
- defsubr (&Ssystem_process_attributeses);
+ defsubr (&Sprocess_attributes);
}
\f
#include <sys/stat.h>
#include <stdlib.h>
#include <fcntl.h>
+#include <setjmp.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
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:
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. */)
+See `process-attributes' for getting attributes of a process given its ID. */)
()
{
- return Qnil;
+ return list_system_processes ();
}
-DEFUN ("system-process-attributes", Fsystem_process_attributes,
- Ssystem_process_attributeses, 1, 1, 0,
+DEFUN ("process-attributes", Fprocess_attributes,
+ Sprocess_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
- \(ATTR . VALUE)
+ \(KEY . VALUE)
If this functionality is unsupported, the value is nil.
See `list-system-processes' for getting a list of all process IDs.
-The attributes that this function may return are listed below,
-together with the type of the associated value (in parentheses).
+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
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)
Lisp_Object pid;
{
- return Qnil;
+ return system_process_attributes (pid);
}
void
void
syms_of_process ()
{
- QCtype = intern (":type");
+ QCtype = intern_c_string (":type");
+ staticpro (&QCtype);
+ QCname = intern_c_string (":name");
+ staticpro (&QCname);
+ QCtype = intern_c_string (":type");
staticpro (&QCtype);
+ QCname = intern_c_string (":name");
+ staticpro (&QCname);
+ Qeuid = intern_c_string ("euid");
+ staticpro (&Qeuid);
+ Qegid = intern_c_string ("egid");
+ staticpro (&Qegid);
+ Quser = intern_c_string ("user");
+ staticpro (&Quser);
+ Qgroup = intern_c_string ("group");
+ staticpro (&Qgroup);
+ Qcomm = intern_c_string ("comm");
+ staticpro (&Qcomm);
+ Qstate = intern_c_string ("state");
+ staticpro (&Qstate);
+ Qppid = intern_c_string ("ppid");
+ staticpro (&Qppid);
+ Qpgrp = intern_c_string ("pgrp");
+ staticpro (&Qpgrp);
+ Qsess = intern_c_string ("sess");
+ staticpro (&Qsess);
+ Qttname = intern_c_string ("ttname");
+ staticpro (&Qttname);
+ Qtpgid = intern_c_string ("tpgid");
+ staticpro (&Qtpgid);
+ Qminflt = intern_c_string ("minflt");
+ staticpro (&Qminflt);
+ Qmajflt = intern_c_string ("majflt");
+ staticpro (&Qmajflt);
+ Qcminflt = intern_c_string ("cminflt");
+ staticpro (&Qcminflt);
+ Qcmajflt = intern_c_string ("cmajflt");
+ staticpro (&Qcmajflt);
+ Qutime = intern_c_string ("utime");
+ staticpro (&Qutime);
+ Qstime = intern_c_string ("stime");
+ staticpro (&Qstime);
+ Qtime = intern_c_string ("time");
+ staticpro (&Qtime);
+ Qcutime = intern_c_string ("cutime");
+ staticpro (&Qcutime);
+ Qcstime = intern_c_string ("cstime");
+ staticpro (&Qcstime);
+ Qctime = intern_c_string ("ctime");
+ staticpro (&Qctime);
+ Qpri = intern_c_string ("pri");
+ staticpro (&Qpri);
+ Qnice = intern_c_string ("nice");
+ staticpro (&Qnice);
+ Qthcount = intern_c_string ("thcount");
+ staticpro (&Qthcount);
+ Qstart = intern_c_string ("start");
+ staticpro (&Qstart);
+ Qvsize = intern_c_string ("vsize");
+ staticpro (&Qvsize);
+ Qrss = intern_c_string ("rss");
+ staticpro (&Qrss);
+ Qetime = intern_c_string ("etime");
+ staticpro (&Qetime);
+ Qpcpu = intern_c_string ("pcpu");
+ staticpro (&Qpcpu);
+ Qpmem = intern_c_string ("pmem");
+ staticpro (&Qpmem);
+ Qargs = intern_c_string ("args");
+ staticpro (&Qargs);
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_inherit_coding_system_flag);
defsubr (&Slist_system_processes);
- defsubr (&Ssystem_process_attributeses);
+ defsubr (&Sprocess_attributes);
}
\f
HCoop / bpt / emacs.git / blobdiff