/* Asynchronous subprocess control for GNU Emacs.
- Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
+ 2001, 2002 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Boston, MA 02111-1307, USA. */
-#define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
#include <config.h>
#include <signal.h>
#include <unistd.h>
#endif
-#ifdef WINDOWSNT
+#if defined(WINDOWSNT) || defined(UNIX98_PTYS)
#include <stdlib.h>
#include <fcntl.h>
#endif /* not WINDOWSNT */
#ifdef NEED_NET_ERRNO_H
#include <net/errno.h>
#endif /* NEED_NET_ERRNO_H */
+
+/* Are local (unix) sockets supported? */
+#if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
+#if !defined (AF_LOCAL) && defined (AF_UNIX)
+#define AF_LOCAL AF_UNIX
+#endif
+#ifdef AF_LOCAL
+#define HAVE_LOCAL_SOCKETS
+#include <sys/un.h>
+#endif
+#endif
#endif /* HAVE_SOCKETS */
/* TERM is a poor-man's SLIP, used on GNU/Linux. */
#include <sys/sysmacros.h> /* for "minor" */
#endif /* not IRIS */
+#ifdef HAVE_SYS_WAIT
+#include <sys/wait.h>
+#endif
+
#include "systime.h"
#include "systty.h"
#include "termhooks.h"
#include "termopts.h"
#include "commands.h"
+#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
-#include "keyboard.h"
#include "dispextern.h"
#include "composite.h"
#include "atimer.h"
-#define max(a, b) ((a) > (b) ? (a) : (b))
-
Lisp_Object Qprocessp;
-Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
+Lisp_Object Qrun, Qstop, Qsignal;
+Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
+Lisp_Object Qlocal, Qdatagram;
+Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
+Lisp_Object QClocal, QCremote, QCcoding;
+Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
+Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
+Lisp_Object QCfilter_multibyte;
Lisp_Object Qlast_nonmenu_event;
+/* QCfamily is declared and initialized in xfaces.c,
+ QCfilter in keyboard.c. */
+extern Lisp_Object QCfamily, QCfilter;
+
/* Qexit is declared and initialized in eval.c. */
+/* QCfamily is defined in xfaces.c. */
+extern Lisp_Object QCfamily;
+/* QCfilter is defined in keyboard.c. */
+extern Lisp_Object QCfilter;
+
/* a process object is a network connection when its childp field is neither
- Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
+ Qt nor Qnil but is instead a property list (KEY VAL ...). */
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
+#define NETCONN1_P(p) (GC_CONSP ((p)->childp))
#else
#define NETCONN_P(p) 0
+#define NETCONN1_P(p) 0
#endif /* HAVE_SOCKETS */
/* Define first descriptor number available for subprocesses. */
extern void set_waiting_for_input P_ ((EMACS_TIME *));
+#ifndef USE_CRT_DLL
extern int errno;
+#endif
#ifdef VMS
extern char *sys_errlist[];
#endif
/* Number of events for which the user or sentinel has been notified. */
int update_tick;
+/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
+
+#ifdef BROKEN_NON_BLOCKING_CONNECT
+#undef NON_BLOCKING_CONNECT
+#else
+#ifndef NON_BLOCKING_CONNECT
+#ifdef HAVE_SOCKETS
+#ifdef HAVE_SELECT
+#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
+#if defined (O_NONBLOCK) || defined (O_NDELAY)
+#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
+#define NON_BLOCKING_CONNECT
+#endif /* EWOULDBLOCK || EINPROGRESS */
+#endif /* O_NONBLOCK || O_NDELAY */
+#endif /* HAVE_GETPEERNAME || GNU_LINUX */
+#endif /* HAVE_SELECT */
+#endif /* HAVE_SOCKETS */
+#endif /* NON_BLOCKING_CONNECT */
+#endif /* BROKEN_NON_BLOCKING_CONNECT */
+
+/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
+ this system. We need to read full packets, so we need a
+ "non-destructive" select. So we require either native select,
+ or emulation of select using FIONREAD. */
+
+#ifdef BROKEN_DATAGRAM_SOCKETS
+#undef DATAGRAM_SOCKETS
+#else
+#ifndef DATAGRAM_SOCKETS
+#ifdef HAVE_SOCKETS
+#if defined (HAVE_SELECT) || defined (FIONREAD)
+#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
+#define DATAGRAM_SOCKETS
+#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
+#endif /* HAVE_SELECT || FIONREAD */
+#endif /* HAVE_SOCKETS */
+#endif /* DATAGRAM_SOCKETS */
+#endif /* BROKEN_DATAGRAM_SOCKETS */
+
+#ifdef TERM
+#undef NON_BLOCKING_CONNECT
+#undef DATAGRAM_SOCKETS
+#endif
+
+
#include "sysselect.h"
extern int keyboard_bit_set P_ ((SELECT_TYPE *));
static SELECT_TYPE non_process_wait_mask;
+/* Mask of bits indicating the descriptors that we wait for connect to
+ complete on. Once they complete, they are removed from this mask
+ and added to the input_wait_mask and non_keyboard_wait_mask. */
+
+static SELECT_TYPE connect_wait_mask;
+
+/* Number of bits set in connect_wait_mask. */
+static int num_pending_connects;
+
/* The largest descriptor currently in use for a process object. */
static int max_process_desc;
static struct coding_system *proc_decode_coding_system[MAXDESC];
static struct coding_system *proc_encode_coding_system[MAXDESC];
+#ifdef DATAGRAM_SOCKETS
+/* Table of `partner address' for datagram sockets. */
+struct sockaddr_and_len {
+ struct sockaddr *sa;
+ int len;
+} datagram_address[MAXDESC];
+#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
+#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
+#else
+#define DATAGRAM_CHAN_P(chan) (0)
+#define DATAGRAM_CONN_P(proc) (0)
+#endif
+
static Lisp_Object get_process ();
+static void exec_sentinel ();
extern EMACS_TIME timer_check ();
extern int timers_run;
extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
#ifdef HAVE_PTYS
+#ifdef HAVE_PTY_H
+#include <pty.h>
+#endif
/* The file name of the pty opened by allocate_pty. */
static char pty_name[24];
p->raw_status_high = Qnil;
}
-/* Convert a process status word in Unix format to
+/* Convert a process status word in Unix format to
the list that we use internally. */
Lisp_Object
/* Return a string describing a process status list. */
-Lisp_Object
+Lisp_Object
status_message (status)
Lisp_Object status;
{
signame = "unknown";
string = build_string (signame);
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
- XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
+ SSET (string, 0, DOWNCASE (SREF (string, 0)));
return concat2 (string, string2);
}
else if (EQ (symbol, Qexit))
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
- return concat2 (build_string ("exited abnormally with code "),
- concat2 (string, string2));
+ return concat3 (build_string ("exited abnormally with code "),
+ string, string2);
+ }
+ else if (EQ (symbol, Qfailed))
+ {
+ string = Fnumber_to_string (make_number (code));
+ string2 = build_string ("\n");
+ return concat3 (build_string ("failed with code "),
+ string, string2);
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
make_process (name)
Lisp_Object name;
{
- struct Lisp_Vector *vec;
register Lisp_Object val, tem, name1;
register struct Lisp_Process *p;
char suffix[10];
register int i;
- vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct Lisp_Process));
- for (i = 0; i < VECSIZE (struct Lisp_Process); i++)
- vec->contents[i] = Qnil;
- vec->size = VECSIZE (struct Lisp_Process);
- p = (struct Lisp_Process *)vec;
+ p = allocate_process ();
XSETINT (p->infd, -1);
XSETINT (p->outfd, -1);
deactivate_process (proc);
}
+
+/* Setup coding systems of PROCESS. */
+
+void
+setup_process_coding_systems (process)
+ Lisp_Object process;
+{
+ struct Lisp_Process *p = XPROCESS (process);
+ int inch = XINT (p->infd);
+ int outch = XINT (p->outfd);
+
+ if (inch < 0 || outch < 0)
+ return;
+
+ if (!proc_decode_coding_system[inch])
+ proc_decode_coding_system[inch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->decode_coding_system,
+ proc_decode_coding_system[inch]);
+ if (! NILP (p->filter))
+ {
+ if (NILP (p->filter_multibyte))
+ setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ }
+ else if (BUFFERP (p->buffer))
+ {
+ if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
+ setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ }
+
+ if (!proc_encode_coding_system[outch])
+ proc_encode_coding_system[outch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->encode_coding_system,
+ proc_encode_coding_system[outch]);
+}
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
- "Return t if OBJECT is a process.")
- (object)
+ doc: /* Return t if OBJECT is a process. */)
+ (object)
Lisp_Object object;
{
return PROCESSP (object) ? Qt : Qnil;
}
DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
- "Return the process named NAME, or nil if there is none.")
- (name)
+ doc: /* Return the process named NAME, or nil if there is none. */)
+ (name)
register Lisp_Object name;
{
if (PROCESSP (name))
return name;
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
return Fcdr (Fassoc (name, Vprocess_alist));
}
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
- "Return the (or a) process associated with BUFFER.\n\
-BUFFER may be a buffer or the name of one.")
- (buffer)
+ doc: /* Return the (or a) process associated with BUFFER.
+BUFFER may be a buffer or the name of one. */)
+ (buffer)
register Lisp_Object buffer;
{
register Lisp_Object buf, tail, proc;
if (NILP (obj))
obj = Fget_buffer (name);
if (NILP (obj))
- error ("Process %s does not exist", XSTRING (name)->data);
+ error ("Process %s does not exist", SDATA (name));
}
else if (NILP (name))
obj = Fcurrent_buffer ();
{
proc = Fget_buffer_process (obj);
if (NILP (proc))
- error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data);
+ error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
}
else
{
- CHECK_PROCESS (obj, 0);
+ CHECK_PROCESS (obj);
proc = obj;
}
return proc;
}
DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
- "Delete PROCESS: kill it and forget about it immediately.\n\
-PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
-nil, indicating the current buffer's process.")
- (process)
+ doc: /* Delete PROCESS: kill it and forget about it immediately.
+PROCESS may be a process, a buffer, the name of a process or buffer, or
+nil, indicating the current buffer's process. */)
+ (process)
register Lisp_Object process;
{
process = get_process (process);
{
Fkill_process (process, Qnil);
/* Do this now, since remove_process will make sigchld_handler do nothing. */
- XPROCESS (process)->status
+ XPROCESS (process)->status
= Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
XSETINT (XPROCESS (process)->tick, ++process_tick);
status_notify ();
}
\f
DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
- "Return the status of PROCESS.\n\
-The returned value is one of the following symbols:\n\
-run -- for a process that is running.\n\
-stop -- for a process stopped but continuable.\n\
-exit -- for a process that has exited.\n\
-signal -- for a process that has got a fatal signal.\n\
-open -- for a network stream connection that is open.\n\
-closed -- for a network stream connection that is closed.\n\
-nil -- if arg is a process name and no such process exists.\n\
-PROCESS may be a process, a buffer, the name of a process, or\n\
-nil, indicating the current buffer's process.")
- (process)
+ doc: /* Return the status of PROCESS.
+The returned value is one of the following symbols:
+run -- for a process that is running.
+stop -- for a process stopped but continuable.
+exit -- for a process that has exited.
+signal -- for a process that has got a fatal signal.
+open -- for a network stream connection that is open.
+listen -- for a network stream server that is listening.
+closed -- for a network stream connection that is closed.
+connect -- when waiting for a non-blocking connection to complete.
+failed -- when a non-blocking connection has failed.
+nil -- if arg is a process name and no such process exists.
+PROCESS may be a process, a buffer, the name of a process, or
+nil, indicating the current buffer's process. */)
+ (process)
register Lisp_Object process;
{
register struct Lisp_Process *p;
status = p->status;
if (CONSP (status))
status = XCAR (status);
- if (NETCONN_P (process))
+ if (NETCONN1_P (p))
{
- if (EQ (status, Qrun))
- status = Qopen;
- else if (EQ (status, Qexit))
+ if (EQ (status, Qexit))
status = Qclosed;
+ else if (EQ (p->command, Qt))
+ status = Qstop;
+ else if (EQ (status, Qrun))
+ status = Qopen;
}
return status;
}
DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
1, 1, 0,
- "Return the exit status of PROCESS or the signal number that killed it.\n\
-If PROCESS has not yet exited or died, return 0.")
- (process)
+ doc: /* Return the exit status of PROCESS or the signal number that killed it.
+If PROCESS has not yet exited or died, return 0. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
if (!NILP (XPROCESS (process)->raw_status_low))
update_status (XPROCESS (process));
if (CONSP (XPROCESS (process)->status))
}
DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
- "Return the process id of PROCESS.\n\
-This is the pid of the Unix process which PROCESS uses or talks to.\n\
-For a network connection, this value is nil.")
- (process)
+ doc: /* Return the process id of PROCESS.
+This is the pid of the Unix process which PROCESS uses or talks to.
+For a network connection, this value is nil. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->pid;
}
DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
- "Return the name of PROCESS, as a string.\n\
-This is the name of the program invoked in PROCESS,\n\
-possibly modified to make it unique among process names.")
- (process)
+ doc: /* Return the name of PROCESS, as a string.
+This is the name of the program invoked in PROCESS,
+possibly modified to make it unique among process names. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->name;
}
DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
- "Return the command that was executed to start PROCESS.\n\
-This is a list of strings, the first string being the program executed\n\
-and the rest of the strings being the arguments given to it.\n\
-For a non-child channel, this is nil.")
- (process)
+ 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. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->command;
}
DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
- "Return the name of the terminal PROCESS uses, or nil if none.\n\
-This is the terminal that the process itself reads and writes on,\n\
-not the name of the pty that Emacs uses to talk with that terminal.")
- (process)
+ doc: /* Return the name of the terminal PROCESS uses, or nil if none.
+This is the terminal that the process itself reads and writes on,
+not the name of the pty that Emacs uses to talk with that terminal. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->tty_name;
}
DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
- 2, 2, 0,
- "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
- (process, buffer)
+ 2, 2, 0,
+ doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
+ (process, buffer)
register Lisp_Object process, buffer;
{
- CHECK_PROCESS (process, 0);
+ struct Lisp_Process *p;
+
+ CHECK_PROCESS (process);
if (!NILP (buffer))
- CHECK_BUFFER (buffer, 1);
- XPROCESS (process)->buffer = buffer;
+ CHECK_BUFFER (buffer);
+ p = XPROCESS (process);
+ p->buffer = buffer;
+ if (NETCONN1_P (p))
+ p->childp = Fplist_put (p->childp, QCbuffer, buffer);
+ setup_process_coding_systems (process);
return buffer;
}
DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
- 1, 1, 0,
- "Return the buffer PROCESS is associated with.\n\
-Output from PROCESS is inserted in this buffer unless PROCESS has a filter.")
- (process)
+ 1, 1, 0,
+ doc: /* Return the buffer PROCESS is associated with.
+Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->buffer;
}
DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
- 1, 1, 0,
- "Return the marker for the end of the last output from PROCESS.")
- (process)
+ 1, 1, 0,
+ doc: /* Return the marker for the end of the last output from PROCESS. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->mark;
}
DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
- 2, 2, 0,
- "Give PROCESS the filter function FILTER; nil means no filter.\n\
-t means stop accepting output from the process.\n\
-When a process has a filter, each time it does output\n\
-the entire string of output is passed to the filter.\n\
-The filter gets two arguments: the process and the string of output.\n\
-If the process has a filter, its buffer is not used for output.")
- (process, filter)
+ 2, 2, 0,
+ doc: /* Give PROCESS the filter function FILTER; nil means no filter.
+t means stop accepting output from the process.
+
+When a process has a filter, its buffer is not used for output.
+Instead, each time it does output, the entire string of output is
+passed to the filter.
+
+The filter gets two arguments: the process and the string of output.
+The string argument is normally a multibyte string, except:
+- if the process' input coding system is no-conversion or raw-text,
+ it is a unibyte string (the non-converted input), or else
+- if `default-enable-multibyte-characters' is nil, it is a unibyte
+ string (the result of converting the decoded input multibyte
+ string to unibyte with `string-make-unibyte'). */)
+ (process, filter)
register Lisp_Object process, filter;
{
- CHECK_PROCESS (process, 0);
- if (EQ (filter, Qt))
- {
- FD_CLR (XINT (XPROCESS (process)->infd), &input_wait_mask);
- FD_CLR (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
- }
- else if (EQ (XPROCESS (process)->filter, Qt))
+ struct Lisp_Process *p;
+
+ CHECK_PROCESS (process);
+ p = XPROCESS (process);
+
+ /* Don't signal an error if the process' input file descriptor
+ is closed. This could make debugging Lisp more difficult,
+ for example when doing something like
+
+ (setq process (start-process ...))
+ (debug)
+ (set-process-filter process ...) */
+
+ if (XINT (p->infd) >= 0)
{
- FD_SET (XINT (XPROCESS (process)->infd), &input_wait_mask);
- FD_SET (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
+ if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
+ {
+ FD_CLR (XINT (p->infd), &input_wait_mask);
+ FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ else if (EQ (p->filter, Qt)
+ && !EQ (p->command, Qt)) /* Network process not stopped. */
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
}
- XPROCESS (process)->filter = filter;
+
+ p->filter = filter;
+ if (NETCONN1_P (p))
+ p->childp = Fplist_put (p->childp, QCfilter, filter);
+ setup_process_coding_systems (process);
return filter;
}
DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
- 1, 1, 0,
- "Returns the filter function of PROCESS; nil if none.\n\
-See `set-process-filter' for more info on filter functions.")
- (process)
+ 1, 1, 0,
+ doc: /* Returns the filter function of PROCESS; nil if none.
+See `set-process-filter' for more info on filter functions. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->filter;
}
DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
- 2, 2, 0,
- "Give PROCESS the sentinel SENTINEL; nil for none.\n\
-The sentinel is called as a function when the process changes state.\n\
-It gets two arguments: the process, and a string describing the change.")
- (process, sentinel)
+ 2, 2, 0,
+ doc: /* Give PROCESS the sentinel SENTINEL; nil for none.
+The sentinel is called as a function when the process changes state.
+It gets two arguments: the process, and a string describing the change. */)
+ (process, sentinel)
register Lisp_Object process, sentinel;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
XPROCESS (process)->sentinel = sentinel;
return sentinel;
}
DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
- 1, 1, 0,
- "Return the sentinel of PROCESS; nil if none.\n\
-See `set-process-sentinel' for more info on sentinels.")
- (process)
+ 1, 1, 0,
+ doc: /* Return the sentinel of PROCESS; nil if none.
+See `set-process-sentinel' for more info on sentinels. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->sentinel;
}
DEFUN ("set-process-window-size", Fset_process_window_size,
- Sset_process_window_size, 3, 3, 0,
- "Tell PROCESS that it has logical window size HEIGHT and WIDTH.")
- (process, height, width)
+ Sset_process_window_size, 3, 3, 0,
+ doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
+ (process, height, width)
register Lisp_Object process, height, width;
{
- CHECK_PROCESS (process, 0);
- CHECK_NATNUM (height, 0);
- CHECK_NATNUM (width, 0);
- if (set_window_size (XINT (XPROCESS (process)->infd),
- XINT (height), XINT (width)) <= 0)
+ CHECK_PROCESS (process);
+ CHECK_NATNUM (height);
+ CHECK_NATNUM (width);
+
+ if (XINT (XPROCESS (process)->infd) < 0
+ || set_window_size (XINT (XPROCESS (process)->infd),
+ XINT (height), XINT (width)) <= 0)
return Qnil;
else
return Qt;
}
DEFUN ("set-process-inherit-coding-system-flag",
- Fset_process_inherit_coding_system_flag,
- Sset_process_inherit_coding_system_flag, 2, 2, 0,
- "Determine whether buffer of PROCESS will inherit coding-system.\n\
-If the second argument FLAG is non-nil, then the variable\n\
-`buffer-file-coding-system' of the buffer associated with PROCESS\n\
-will be bound to the value of the coding system used to decode\n\
-the process output.\n\
-\n\
-This is useful when the coding system specified for the process buffer\n\
-leaves either the character code conversion or the end-of-line conversion\n\
-unspecified, or if the coding system used to decode the process output\n\
-is more appropriate for saving the process buffer.\n\
-\n\
-Binding the variable `inherit-process-coding-system' to non-nil before\n\
-starting the process is an alternative way of setting the inherit flag\n\
-for the process which will run.")
- (process, flag)
+ Fset_process_inherit_coding_system_flag,
+ Sset_process_inherit_coding_system_flag, 2, 2, 0,
+ doc: /* Determine whether buffer of PROCESS will inherit coding-system.
+If the second argument FLAG is non-nil, then the variable
+`buffer-file-coding-system' of the buffer associated with PROCESS
+will be bound to the value of the coding system used to decode
+the process output.
+
+This is useful when the coding system specified for the process buffer
+leaves either the character code conversion or the end-of-line conversion
+unspecified, or if the coding system used to decode the process output
+is more appropriate for saving the process buffer.
+
+Binding the variable `inherit-process-coding-system' to non-nil before
+starting the process is an alternative way of setting the inherit flag
+for the process which will run. */)
+ (process, flag)
register Lisp_Object process, flag;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
XPROCESS (process)->inherit_coding_system_flag = flag;
return flag;
}
DEFUN ("process-inherit-coding-system-flag",
- Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
- 1, 1, 0,
- "Return the value of inherit-coding-system flag for PROCESS.\n\
-If this flag is t, `buffer-file-coding-system' of the buffer\n\
-associated with PROCESS will inherit the coding system used to decode\n\
-the process output.")
- (process)
+ Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
+ 1, 1, 0,
+ doc: /* Return the value of inherit-coding-system flag for PROCESS.
+If this flag is t, `buffer-file-coding-system' of the buffer
+associated with PROCESS will inherit the coding system used to decode
+the process output. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
return XPROCESS (process)->inherit_coding_system_flag;
}
-DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
- Sprocess_kill_without_query, 1, 2, 0,
- "Say no query needed if PROCESS is running when Emacs is exited.\n\
-Optional second argument if non-nil says to require a query.\n\
-Value is t if a query was formerly required.")
- (process, value)
- register Lisp_Object process, value;
+DEFUN ("set-process-query-on-exit-flag",
+ Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
+ 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. */)
+ (process, flag)
+ register Lisp_Object process, flag;
{
- Lisp_Object tem;
-
- CHECK_PROCESS (process, 0);
- tem = XPROCESS (process)->kill_without_query;
- XPROCESS (process)->kill_without_query = Fnull (value);
+ CHECK_PROCESS (process);
+ XPROCESS (process)->kill_without_query = Fnull (flag);
+ return flag;
+}
- return Fnull (tem);
+DEFUN ("process-query-on-exit-flag",
+ Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
+ 1, 1, 0,
+ doc: /* Return the current value of query on exit flag for PROCESS. */)
+ (process)
+ register Lisp_Object process;
+{
+ CHECK_PROCESS (process);
+ return Fnull (XPROCESS (process)->kill_without_query);
}
+#ifdef DATAGRAM_SOCKETS
+Lisp_Object Fprocess_datagram_address ();
+#endif
+
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
- 1, 1, 0,
- "Return the contact info of PROCESS; t for a real child.\n\
-For a net connection, the value is a cons cell of the form (HOST SERVICE).")
- (process)
+ 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. */)
+ (process, key)
+ register Lisp_Object process, key;
+{
+ Lisp_Object contact;
+
+ CHECK_PROCESS (process);
+ contact = XPROCESS (process)->childp;
+
+#ifdef DATAGRAM_SOCKETS
+ if (DATAGRAM_CONN_P (process)
+ && (EQ (key, Qt) || EQ (key, QCremote)))
+ contact = Fplist_put (contact, QCremote,
+ Fprocess_datagram_address (process));
+#endif
+
+ if (!NETCONN_P (process) || EQ (key, Qt))
+ return contact;
+ if (NILP (key))
+ return Fcons (Fplist_get (contact, QChost),
+ Fcons (Fplist_get (contact, QCservice), Qnil));
+ return Fplist_get (contact, key);
+}
+
+DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
+ 1, 1, 0,
+ doc: /* Return the plist of PROCESS. */)
+ (process)
register Lisp_Object process;
{
- CHECK_PROCESS (process, 0);
- return XPROCESS (process)->childp;
+ CHECK_PROCESS (process);
+ return XPROCESS (process)->plist;
+}
+
+DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
+ 2, 2, 0,
+ doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
+ (process, plist)
+ register Lisp_Object process, plist;
+{
+ CHECK_PROCESS (process);
+ CHECK_LIST (plist);
+
+ XPROCESS (process)->plist = plist;
+ return plist;
}
#if 0 /* Turned off because we don't currently record this info
in the process. Perhaps add it. */
DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
- "Return the connection type of PROCESS.\n\
-The value is nil for a pipe, t or `pty' for a pty, or `stream' for\n\
-a socket connection.")
- (process)
+ doc: /* Return the connection type of PROCESS.
+The value is nil for a pipe, t or `pty' for a pty, or `stream' for
+a socket connection. */)
+ (process)
Lisp_Object process;
{
return XPROCESS (process)->type;
}
#endif
+
+#ifdef HAVE_SOCKETS
+DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
+ 1, 2, 0,
+ doc: /* Convert network ADDRESS from internal format to a string.
+If optional second argument OMIT-PORT is non-nil, don't include a port
+number in the string; in this case, interpret a 4 element vector as an
+IP address. Returns nil if format of ADDRESS is invalid. */)
+ (address, omit_port)
+ Lisp_Object address, omit_port;
+{
+ if (NILP (address))
+ return Qnil;
+
+ if (STRINGP (address)) /* AF_LOCAL */
+ return address;
+
+ if (VECTORP (address)) /* AF_INET */
+ {
+ register struct Lisp_Vector *p = XVECTOR (address);
+ Lisp_Object args[6];
+ int nargs, i;
+
+ if (!NILP (omit_port) && (p->size == 4 || p->size == 5))
+ {
+ args[0] = build_string ("%d.%d.%d.%d");
+ nargs = 4;
+ }
+ else if (p->size == 5)
+ {
+ args[0] = build_string ("%d.%d.%d.%d:%d");
+ nargs = 5;
+ }
+ else
+ return Qnil;
+
+ for (i = 0; i < nargs; i++)
+ args[i+1] = p->contents[i];
+ return Fformat (nargs+1, args);
+ }
+
+ if (CONSP (address))
+ {
+ Lisp_Object args[2];
+ args[0] = build_string ("<Family %d>");
+ args[1] = Fcar (address);
+ return Fformat (2, args);
+
+ }
+
+ return Qnil;
+}
+#endif
\f
Lisp_Object
-list_processes_1 ()
+list_processes_1 (query_only)
+ Lisp_Object query_only;
{
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
register struct Lisp_Process *p;
- char tembuf[80];
+ char tembuf[300];
+ int w_proc, w_buffer, w_tty;
+ Lisp_Object i_status, i_buffer, i_tty, i_command;
+
+ w_proc = 4; /* Proc */
+ w_buffer = 6; /* Buffer */
+ w_tty = 0; /* Omit if no ttys */
+
+ for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
+ {
+ int i;
+
+ proc = Fcdr (Fcar (tail));
+ p = XPROCESS (proc);
+ if (NILP (p->childp))
+ continue;
+ if (!NILP (query_only) && !NILP (p->kill_without_query))
+ continue;
+ if (STRINGP (p->name)
+ && ( i = SCHARS (p->name), (i > w_proc)))
+ w_proc = i;
+ if (!NILP (p->buffer))
+ {
+ if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
+ w_buffer = 8; /* (Killed) */
+ else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
+ w_buffer = i;
+ }
+ if (STRINGP (p->tty_name)
+ && (i = SCHARS (p->tty_name), (i > w_tty)))
+ w_tty = i;
+ }
+
+ XSETFASTINT (i_status, w_proc + 1);
+ XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
+ if (w_tty)
+ {
+ XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
+ XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1);
+ } else {
+ i_tty = Qnil;
+ XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
+ }
XSETFASTINT (minspace, 1);
current_buffer->truncate_lines = Qt;
- write_string ("\
-Proc Status Buffer Tty Command\n\
----- ------ ------ --- -------\n", -1);
+ write_string ("Proc", -1);
+ Findent_to (i_status, minspace); write_string ("Status", -1);
+ Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
+ if (!NILP (i_tty))
+ {
+ Findent_to (i_tty, minspace); write_string ("Tty", -1);
+ }
+ Findent_to (i_command, minspace); write_string ("Command", -1);
+ write_string ("\n", -1);
+
+ write_string ("----", -1);
+ Findent_to (i_status, minspace); write_string ("------", -1);
+ Findent_to (i_buffer, minspace); write_string ("------", -1);
+ if (!NILP (i_tty))
+ {
+ Findent_to (i_tty, minspace); write_string ("---", -1);
+ }
+ Findent_to (i_command, minspace); write_string ("-------", -1);
+ write_string ("\n", -1);
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
p = XPROCESS (proc);
if (NILP (p->childp))
continue;
+ if (!NILP (query_only) && !NILP (p->kill_without_query))
+ continue;
Finsert (1, &p->name);
- Findent_to (make_number (13), minspace);
+ Findent_to (i_status, minspace);
if (!NILP (p->raw_status_low))
update_status (p);
if (CONSP (p->status))
symbol = XCAR (p->status);
-
+
if (EQ (symbol, Qsignal))
{
Lisp_Object tem;
#endif
Fprinc (symbol, Qnil);
}
- else if (NETCONN_P (proc))
+ else if (NETCONN1_P (p))
{
- if (EQ (symbol, Qrun))
- write_string ("open", -1);
- else if (EQ (symbol, Qexit))
+ if (EQ (symbol, Qexit))
write_string ("closed", -1);
+ else if (EQ (p->command, Qt))
+ write_string ("stopped", -1);
+ else if (EQ (symbol, Qrun))
+ write_string ("open", -1);
else
Fprinc (symbol, Qnil);
}
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
remove_process (proc);
- Findent_to (make_number (22), minspace);
+ Findent_to (i_buffer, minspace);
if (NILP (p->buffer))
insert_string ("(none)");
else if (NILP (XBUFFER (p->buffer)->name))
else
Finsert (1, &XBUFFER (p->buffer)->name);
- Findent_to (make_number (37), minspace);
-
- if (STRINGP (p->tty_name))
- Finsert (1, &p->tty_name);
- else
- insert_string ("(none)");
+ if (!NILP (i_tty))
+ {
+ Findent_to (i_tty, minspace);
+ if (STRINGP (p->tty_name))
+ Finsert (1, &p->tty_name);
+ }
- Findent_to (make_number (49), minspace);
+ Findent_to (i_command, minspace);
- if (NETCONN_P (proc))
+ if (EQ (p->status, Qlisten))
+ {
+ Lisp_Object port = Fplist_get (p->childp, QCservice);
+ if (INTEGERP (port))
+ port = Fnumber_to_string (port);
+ if (NILP (port))
+ port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
+ sprintf (tembuf, "(network %s server on %s)\n",
+ (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
+ (STRINGP (port) ? (char *)SDATA (port) : "?"));
+ insert_string (tembuf);
+ }
+ else if (NETCONN1_P (p))
{
- sprintf (tembuf, "(network stream connection to %s)\n",
- XSTRING (XCAR (p->childp))->data);
+ /* For a local socket, there is no host name,
+ so display service instead. */
+ Lisp_Object host = Fplist_get (p->childp, QChost);
+ if (!STRINGP (host))
+ {
+ host = Fplist_get (p->childp, QCservice);
+ if (INTEGERP (host))
+ host = Fnumber_to_string (host);
+ }
+ if (NILP (host))
+ host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
+ sprintf (tembuf, "(network %s connection to %s)\n",
+ (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
+ (STRINGP (host) ? (char *)SDATA (host) : "?"));
insert_string (tembuf);
}
- else
+ else
{
tem = p->command;
while (1)
return Qnil;
}
-DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
- "Display a list of all processes.\n\
-Any process listed as exited or signaled is actually eliminated\n\
-after the listing is made.")
- ()
+DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
+ doc: /* Display a list of all processes.
+If optional argument QUERY-ONLY is non-nil, only processes with
+the query-on-exit flag set will be listed.
+Any process listed as exited or signaled is actually eliminated
+after the listing is made. */)
+ (query_only)
+ Lisp_Object query_only;
{
internal_with_output_to_temp_buffer ("*Process List*",
- list_processes_1, Qnil);
+ list_processes_1, query_only);
return Qnil;
}
DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
- "Return a list of all processes.")
- ()
+ doc: /* Return a list of all processes. */)
+ ()
{
return Fmapcar (Qcdr, Vprocess_alist);
}
static Lisp_Object start_process_unwind ();
DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
- "Start a program in a subprocess. Return the process object for it.\n\
-Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
-NAME is name for process. It is modified if necessary to make it unique.\n\
-BUFFER is the buffer or (buffer-name) to associate with the process.\n\
- Process output goes at end of that buffer, unless you specify\n\
- an output stream or filter function to handle the output.\n\
- BUFFER may be also nil, meaning that this process is not associated\n\
- with any buffer.\n\
-Third arg is program file name. It is searched for in PATH.\n\
-Remaining arguments are strings to give program as arguments.")
- (nargs, args)
+ doc: /* Start a program in a subprocess. Return the process object for it.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer or (buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer.
+Third arg is program file name. It is searched for in PATH.
+Remaining arguments are strings to give program as arguments.
+
+usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
+ (nargs, args)
int nargs;
register Lisp_Object *args;
{
register unsigned char **new_argv;
#endif
register int i;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
buffer = args[1];
if (!NILP (buffer))
GCPRO2 (buffer, current_dir);
- current_dir
+ current_dir
= expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
}
name = args[0];
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
program = args[2];
- CHECK_STRING (program, 2);
-
-#ifdef VMS
- /* Make a one member argv with all args concatenated
- together separated by a blank. */
- len = STRING_BYTES (XSTRING (program)) + 2;
- for (i = 3; i < nargs; i++)
- {
- tem = args[i];
- CHECK_STRING (tem, i);
- len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */
- }
- new_argv = (unsigned char *) alloca (len);
- strcpy (new_argv, XSTRING (program)->data);
- for (i = 3; i < nargs; i++)
- {
- tem = args[i];
- CHECK_STRING (tem, i);
- strcat (new_argv, " ");
- strcat (new_argv, XSTRING (tem)->data);
- }
- /* Need to add code here to check for program existence on VMS */
-
-#else /* not VMS */
- new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
-
- /* If program file name is not absolute, search our path for it */
- if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0])
- && !(XSTRING (program)->size > 1
- && IS_DEVICE_SEP (XSTRING (program)->data[1])))
- {
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- tem = Qnil;
- GCPRO4 (name, program, buffer, current_dir);
- openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1);
- UNGCPRO;
- if (NILP (tem))
- report_file_error ("Searching for program", Fcons (program, Qnil));
- tem = Fexpand_file_name (tem, Qnil);
- new_argv[0] = XSTRING (tem)->data;
- }
- else
- {
- if (!NILP (Ffile_directory_p (program)))
- error ("Specified program for new process is a directory");
-
- new_argv[0] = XSTRING (program)->data;
- }
-
- for (i = 3; i < nargs; i++)
- {
- tem = args[i];
- CHECK_STRING (tem, i);
- new_argv[i - 2] = XSTRING (tem)->data;
- }
- new_argv[i - 2] = 0;
-#endif /* not VMS */
+ CHECK_STRING (program);
proc = make_process (name);
/* If an error occurs and we can't start the process, we want to
record_unwind_protect (start_process_unwind, proc);
XPROCESS (proc)->childp = Qt;
+ XPROCESS (proc)->plist = Qnil;
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
+ XPROCESS (proc)->filter_multibyte
+ = buffer_defaults.enable_multibyte_characters;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
/* Make the process marker point into the process buffer (if any). */
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
val = Vcoding_system_for_read;
if (NILP (val))
args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
- GCPRO1 (proc);
+ GCPRO2 (proc, current_dir);
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
UNGCPRO;
if (CONSP (coding_systems))
args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
- GCPRO1 (proc);
+ GCPRO2 (proc, current_dir);
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
UNGCPRO;
}
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.
+ 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);
+
+ /* Encode the file name and put it in NEW_ARGV.
+ That's where the child will use it to execute the program. */
+ tem = ENCODE_FILE (tem);
+ new_argv[0] = SDATA (tem);
+
+ /* Here we encode arguments by the coding system used for sending
+ data to the process. We don't support using different coding
+ systems for encoding arguments and for encoding data sent to the
+ process. */
+
+ for (i = 3; i < nargs; i++)
+ {
+ tem = args[i];
+ CHECK_STRING (tem);
+ if (STRING_MULTIBYTE (tem))
+ tem = (code_convert_string_norecord
+ (tem, XPROCESS (proc)->encode_coding_system, 1));
+ new_argv[i - 2] = SDATA (tem);
+ }
+ new_argv[i - 2] = 0;
+#endif /* not VMS */
+
XPROCESS (proc)->decoding_buf = make_uninit_string (0);
XPROCESS (proc)->decoding_carryover = make_number (0);
XPROCESS (proc)->encoding_buf = make_uninit_string (0);
/* Use volatile to protect variables from being clobbered by longjmp. */
volatile int forkin, forkout;
volatile int pty_flag = 0;
+#ifndef USE_CRT_DLL
extern char **environ;
- Lisp_Object buffer = XPROCESS (process)->buffer;
+#endif
inchannel = outchannel = -1;
if (inchannel >= 0)
{
-#ifndef USG
- /* On USG systems it does not work to open the pty's tty here
- and then close and reopen it in the child. */
+#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
+ /* On most USG systems it does not work to open the pty's tty here,
+ then close it and reopen it in the child. */
#ifdef O_NOCTTY
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
report_file_error ("Opening pty", Qnil);
#else
forkin = forkout = -1;
-#endif /* not USG */
+#endif /* not USG, or USG_SUBTTY_WORKS */
pty_flag = 1;
}
else
XSETFASTINT (XPROCESS (process)->subtty, forkin);
XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
XPROCESS (process)->status = Qrun;
- if (!proc_decode_coding_system[inchannel])
- proc_decode_coding_system[inchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->decode_coding_system,
- proc_decode_coding_system[inchannel]);
- if (!proc_encode_coding_system[outchannel])
- proc_encode_coding_system[outchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->encode_coding_system,
- proc_encode_coding_system[outchannel]);
-
- if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
- || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
- {
- /* In unibyte mode, character code conversion should not take
- place but EOL conversion should. So, setup raw-text or one
- of the subsidiary according to the information just setup. */
- if (!NILP (XPROCESS (process)->decode_coding_system))
- setup_raw_text_coding_system (proc_decode_coding_system[inchannel]);
- if (!NILP (XPROCESS (process)->encode_coding_system))
- setup_raw_text_coding_system (proc_encode_coding_system[outchannel]);
- }
-
- if (CODING_REQUIRE_ENCODING (proc_encode_coding_system[outchannel]))
- {
- /* Here we encode arguments by the coding system used for
- sending data to the process. We don't support using
- different coding systems for encoding arguments and for
- encoding data sent to the process. */
- struct gcpro gcpro1;
- int i = 1;
- struct coding_system *coding = proc_encode_coding_system[outchannel];
-
- coding->mode |= CODING_MODE_LAST_BLOCK;
- GCPRO1 (process);
- while (new_argv[i] != 0)
- {
- int len = strlen (new_argv[i]);
- int size = encoding_buffer_size (coding, len);
- unsigned char *buf = (unsigned char *) alloca (size);
-
- encode_coding (coding, (unsigned char *)new_argv[i], buf, len, size);
- buf[coding->produced] = 0;
- /* We don't have to free new_argv[i] because it points to a
- Lisp string given as an argument to `start-process'. */
- new_argv[i++] = (char *) buf;
- }
- UNGCPRO;
- coding->mode &= ~CODING_MODE_LAST_BLOCK;
- }
+ setup_process_coding_systems (process);
/* Delay interrupts until we have a chance to store
the new fork's pid in its process structure */
#ifdef SIGCHLD
sigaddset (&blocked, SIGCHLD);
#endif
-#ifdef HAVE_VFORK
+#ifdef HAVE_WORKING_VFORK
/* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
this sets the parent's signal handlers as well as the child's.
So delay all interrupts whose handlers the child might munge,
#ifdef AIX
sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
#endif
-#endif /* HAVE_VFORK */
+#endif /* HAVE_WORKING_VFORK */
sigprocmask (SIG_BLOCK, &blocked, &procmask);
#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
XSETINT (XPROCESS (process)->pid, -1);
BLOCK_INPUT;
-
+
{
/* child_setup must clobber environ on systems with true vfork.
Protect it from permanent change. */
}
#endif
#endif
-#ifdef TIOCNOTTY
+#ifdef TIOCNOTTY
/* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
can do TIOCSPGRP only to the process's controlling tty. */
if (pty_flag)
{
- /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
+ /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
I can't test it since I don't have 4.3. */
int j = emacs_open ("/dev/tty", O_RDWR, 0);
ioctl (j, TIOCNOTTY, 0);
#ifdef WINDOWSNT
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
-#else /* not WINDOWSNT */
+#else /* not WINDOWSNT */
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
#endif /* not WINDOWSNT */
{
struct atimer *timer;
EMACS_TIME offset;
-
+
stop_polling ();
EMACS_SET_SECS_USECS (offset, 1, 0);
timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
-
+
XPROCESS (process)->subtty = Qnil;
if (forkin >= 0)
emacs_close (forkin);
cancel_atimer (timer);
start_polling ();
}
-
+
if (forkin != forkout && forkout >= 0)
emacs_close (forkout);
/* Restore the signal state whether vfork succeeded or not.
(We will signal an error, below, if it failed.) */
#ifdef POSIX_SIGNALS
-#ifdef HAVE_VFORK
+#ifdef HAVE_WORKING_VFORK
/* Restore the parent's signal handlers. */
sigaction (SIGINT, &sigint_action, 0);
sigaction (SIGQUIT, &sigquit_action, 0);
#ifdef AIX
sigaction (SIGHUP, &sighup_action, 0);
#endif
-#endif /* HAVE_VFORK */
+#endif /* HAVE_WORKING_VFORK */
/* Stop blocking signals in the parent. */
sigprocmask (SIG_SETMASK, &procmask, 0);
#else /* !POSIX_SIGNALS */
}
#endif /* not VMS */
+\f
#ifdef HAVE_SOCKETS
-/* open a TCP network connection to a given HOST/SERVICE. Treated
- exactly like a normal process when reading and writing. Only
+/* Convert an internal struct sockaddr to a lisp object (vector or string).
+ The address family of sa is not included in the result. */
+
+static Lisp_Object
+conv_sockaddr_to_lisp (sa, len)
+ struct sockaddr *sa;
+ int len;
+{
+ Lisp_Object address;
+ int i;
+ unsigned char *cp;
+ register struct Lisp_Vector *p;
+
+ switch (sa->sa_family)
+ {
+ case AF_INET:
+ {
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ len = sizeof (sin->sin_addr) + 1;
+ address = Fmake_vector (make_number (len), Qnil);
+ p = XVECTOR (address);
+ p->contents[--len] = make_number (ntohs (sin->sin_port));
+ cp = (unsigned char *)&sin->sin_addr;
+ break;
+ }
+#ifdef HAVE_LOCAL_SOCKETS
+ case AF_LOCAL:
+ {
+ struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
+ for (i = 0; i < sizeof (sockun->sun_path); i++)
+ if (sockun->sun_path[i] == 0)
+ break;
+ return make_unibyte_string (sockun->sun_path, i);
+ }
+#endif
+ default:
+ len -= sizeof (sa->sa_family);
+ address = Fcons (make_number (sa->sa_family),
+ Fmake_vector (make_number (len), Qnil));
+ p = XVECTOR (XCDR (address));
+ cp = (unsigned char *) sa + sizeof (sa->sa_family);
+ break;
+ }
+
+ i = 0;
+ while (i < len)
+ p->contents[i++] = make_number (*cp++);
+
+ return address;
+}
+
+
+/* Get family and required size for sockaddr structure to hold ADDRESS. */
+
+static int
+get_lisp_to_sockaddr_size (address, familyp)
+ Lisp_Object address;
+ int *familyp;
+{
+ register struct Lisp_Vector *p;
+
+ if (VECTORP (address))
+ {
+ p = XVECTOR (address);
+ if (p->size == 5)
+ {
+ *familyp = AF_INET;
+ return sizeof (struct sockaddr_in);
+ }
+ }
+#ifdef HAVE_LOCAL_SOCKETS
+ else if (STRINGP (address))
+ {
+ *familyp = AF_LOCAL;
+ return sizeof (struct sockaddr_un);
+ }
+#endif
+ else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
+ {
+ struct sockaddr *sa;
+ *familyp = XINT (XCAR (address));
+ p = XVECTOR (XCDR (address));
+ return p->size + sizeof (sa->sa_family);
+ }
+ return 0;
+}
+
+/* Convert an address object (vector or string) to an internal sockaddr.
+ Format of address has already been validated by size_lisp_to_sockaddr. */
+
+static void
+conv_lisp_to_sockaddr (family, address, sa, len)
+ int family;
+ Lisp_Object address;
+ struct sockaddr *sa;
+ int len;
+{
+ register struct Lisp_Vector *p;
+ register unsigned char *cp;
+ register int i;
+
+ bzero (sa, len);
+ sa->sa_family = family;
+
+ if (VECTORP (address))
+ {
+ p = XVECTOR (address);
+ if (family == AF_INET)
+ {
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ len = sizeof (sin->sin_addr) + 1;
+ i = XINT (p->contents[--len]);
+ sin->sin_port = htons (i);
+ cp = (unsigned char *)&sin->sin_addr;
+ }
+ }
+ else if (STRINGP (address))
+ {
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family == AF_LOCAL)
+ {
+ struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
+ cp = SDATA (address);
+ for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
+ sockun->sun_path[i] = *cp++;
+ }
+#endif
+ return;
+ }
+ else
+ {
+ p = XVECTOR (XCDR (address));
+ cp = (unsigned char *)sa + sizeof (sa->sa_family);
+ }
+
+ for (i = 0; i < len; i++)
+ if (INTEGERP (p->contents[i]))
+ *cp++ = XFASTINT (p->contents[i]) & 0xff;
+}
+
+#ifdef DATAGRAM_SOCKETS
+DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
+ 1, 1, 0,
+ doc: /* Get the current datagram address associated with PROCESS. */)
+ (process)
+ Lisp_Object process;
+{
+ int channel;
+
+ CHECK_PROCESS (process);
+
+ if (!DATAGRAM_CONN_P (process))
+ return Qnil;
+
+ channel = XINT (XPROCESS (process)->infd);
+ return conv_sockaddr_to_lisp (datagram_address[channel].sa,
+ datagram_address[channel].len);
+}
+
+DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
+ 2, 2, 0,
+ doc: /* Set the datagram address for PROCESS to ADDRESS.
+Returns nil upon error setting address, ADDRESS otherwise. */)
+ (process, address)
+ Lisp_Object process, address;
+{
+ int channel;
+ int family, len;
+
+ CHECK_PROCESS (process);
+
+ if (!DATAGRAM_CONN_P (process))
+ return Qnil;
+
+ channel = XINT (XPROCESS (process)->infd);
+
+ len = get_lisp_to_sockaddr_size (address, &family);
+ if (datagram_address[channel].len != len)
+ return Qnil;
+ conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
+ return address;
+}
+#endif
+\f
+
+static struct socket_options {
+ /* The name of this option. Should be lowercase version of option
+ name without SO_ prefix. */
+ char *name;
+ /* Length of name. */
+ int nlen;
+ /* Option level SOL_... */
+ int optlevel;
+ /* Option number SO_... */
+ int optnum;
+ enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype;
+} socket_options[] =
+ {
+#ifdef SO_BINDTODEVICE
+ { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
+#endif
+#ifdef SO_BROADCAST
+ { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
+#endif
+#ifdef SO_DONTROUTE
+ { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
+#endif
+#ifdef SO_KEEPALIVE
+ { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
+#endif
+#ifdef SO_LINGER
+ { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
+#endif
+#ifdef SO_OOBINLINE
+ { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
+#endif
+#ifdef SO_PRIORITY
+ { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
+#endif
+#ifdef SO_REUSEADDR
+ { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
+#endif
+ { 0, 0, 0, 0, SOPT_UNKNOWN }
+ };
+
+/* Process list of socket options OPTS on socket S.
+ Only check if options are supported is S < 0.
+ If NO_ERROR is non-zero, continue silently if an option
+ cannot be set.
+
+ Each element specifies one option. An element is either a string
+ "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
+ or a symbol. */
+
+static int
+set_socket_options (s, opts, no_error)
+ int s;
+ Lisp_Object opts;
+ int no_error;
+{
+ if (!CONSP (opts))
+ opts = Fcons (opts, Qnil);
+
+ while (CONSP (opts))
+ {
+ Lisp_Object opt;
+ Lisp_Object val;
+ char *name, *arg;
+ struct socket_options *sopt;
+ int ret = 0;
+
+ opt = XCAR (opts);
+ opts = XCDR (opts);
+
+ name = 0;
+ val = Qt;
+ if (CONSP (opt))
+ {
+ val = XCDR (opt);
+ opt = XCAR (opt);
+ }
+ if (STRINGP (opt))
+ name = (char *) SDATA (opt);
+ else if (SYMBOLP (opt))
+ name = (char *) SDATA (SYMBOL_NAME (opt));
+ else {
+ error ("Mal-formed option list");
+ return 0;
+ }
+
+ if (strncmp (name, "no", 2) == 0)
+ {
+ val = Qnil;
+ name += 2;
+ }
+
+ arg = 0;
+ for (sopt = socket_options; sopt->name; sopt++)
+ if (strncmp (name, sopt->name, sopt->nlen) == 0)
+ {
+ if (name[sopt->nlen] == 0)
+ break;
+ if (name[sopt->nlen] == '=')
+ {
+ arg = name + sopt->nlen + 1;
+ break;
+ }
+ }
+
+ switch (sopt->opttype)
+ {
+ case SOPT_BOOL:
+ {
+ int optval;
+ if (s < 0)
+ return 1;
+ if (arg)
+ optval = (*arg == '0' || *arg == 'n') ? 0 : 1;
+ else if (INTEGERP (val))
+ optval = XINT (val) == 0 ? 0 : 1;
+ else
+ optval = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
+
+ case SOPT_INT:
+ {
+ int optval;
+ if (arg)
+ optval = atoi(arg);
+ else if (INTEGERP (val))
+ optval = XINT (val);
+ else
+ error ("Bad option argument for %s", name);
+ if (s < 0)
+ return 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
+
+ case SOPT_STR:
+ {
+ if (!arg)
+ {
+ if (NILP (val))
+ arg = "";
+ else if (STRINGP (val))
+ arg = (char *) SDATA (val);
+ else if (XSYMBOL (val))
+ arg = (char *) SDATA (SYMBOL_NAME (val));
+ else
+ error ("Invalid argument to %s option", name);
+ }
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ arg, strlen (arg));
+ }
+
+#ifdef SO_LINGER
+ case SOPT_LINGER:
+ {
+ struct linger linger;
+
+ linger.l_onoff = 1;
+ linger.l_linger = 0;
+
+ if (s < 0)
+ return 1;
+
+ if (arg)
+ {
+ if (*arg == 'n' || *arg == 't' || *arg == 'y')
+ linger.l_onoff = (*arg == 'n') ? 0 : 1;
+ else
+ linger.l_linger = atoi(arg);
+ }
+ else if (INTEGERP (val))
+ linger.l_linger = XINT (val);
+ else
+ linger.l_onoff = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &linger, sizeof (linger));
+ break;
+ }
+#endif
+ default:
+ if (s < 0)
+ return 0;
+ if (no_error)
+ continue;
+ error ("Unsupported option: %s", name);
+ }
+ if (ret < 0 && ! no_error)
+ report_file_error ("Cannot set network option: %s", opt);
+ }
+ return 1;
+}
+
+DEFUN ("set-network-process-options",
+ Fset_network_process_options, Sset_network_process_options,
+ 1, MANY, 0,
+ doc: /* Set one or more options for network process PROCESS.
+Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
+A boolean value is false if it either zero or nil, true otherwise.
+
+The following options are known. Consult the relevant system manual
+pages for more information.
+
+bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
+broadcast=BOOL -- Allow send and receive of datagram broadcasts.
+dontroute=BOOL -- Only send to directly connected hosts.
+keepalive=BOOL -- Send keep-alive messages on network stream.
+linger=BOOL or TIMEOUT -- Send queued messages before closing.
+oobinline=BOOL -- Place out-of-band data in receive data stream.
+priority=INT -- Set protocol defined priority for sent packets.
+reuseaddr=BOOL -- Allow reusing a recently used address.
+
+usage: (set-network-process-options PROCESS &rest OPTIONS) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object process;
+ Lisp_Object opts;
+
+ process = args[0];
+ CHECK_PROCESS (process);
+ if (nargs > 1 && XINT (XPROCESS (process)->infd) >= 0)
+ {
+ opts = Flist (nargs, args);
+ set_socket_options (XINT (XPROCESS (process)->infd), opts, 0);
+ }
+ return process;
+}
+\f
+/* A version of request_sigio suitable for a record_unwind_protect. */
+
+Lisp_Object
+unwind_request_sigio (dummy)
+ Lisp_Object dummy;
+{
+ if (interrupt_input)
+ request_sigio ();
+ return Qnil;
+}
+
+/* Create a network stream/datagram client/server process. Treated
+ exactly like a normal process when reading and writing. Primary
differences are in status display and process deletion. A network
connection has no PID; you cannot signal it. All you can do is
- deactivate and close it via delete-process */
-
-DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
- 4, 4, 0,
- "Open a TCP connection for a service to a host.\n\
-Returns a subprocess-object to represent the connection.\n\
-Input and output work as for subprocesses; `delete-process' closes it.\n\
-Args are NAME BUFFER HOST SERVICE.\n\
-NAME is name for process. It is modified if necessary to make it unique.\n\
-BUFFER is the buffer (or buffer-name) to associate with the process.\n\
- Process output goes at end of that buffer, unless you specify\n\
- an output stream or filter function to handle the output.\n\
- BUFFER may be also nil, meaning that this process is not associated\n\
- with any buffer\n\
-Third arg is name of the host to connect to, or its IP address.\n\
-Fourth arg SERVICE is name of the service desired, or an integer\n\
- specifying a port number to connect to.")
- (name, buffer, host, service)
- Lisp_Object name, buffer, host, service;
+ stop/continue it and deactivate/close it via delete-process */
+
+DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
+ 0, MANY, 0,
+ doc: /* Create and return a network server or client process.
+
+In Emacs, network connections are represented by process objects, so
+input and output work as for subprocesses and `delete-process' closes
+a network connection. However, a network process has no process id,
+it cannot be signalled, and the status codes are different from normal
+processes.
+
+Arguments are specified as keyword/argument pairs. The following
+arguments are defined:
+
+:name NAME -- NAME is name for process. It is modified if necessary
+to make it unique.
+
+:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
+with the process. Process output goes at end of that buffer, unless
+you specify an output stream or filter function to handle the output.
+BUFFER may be also nil, meaning that this process is not associated
+with any buffer.
+
+:host HOST -- HOST is name of the host to connect to, or its IP
+address. The symbol `local' specifies the local host. If specified
+for a server process, it must be a valid name or address for the local
+host, and only clients connecting to that address will be accepted.
+
+:service SERVICE -- SERVICE is name of the service desired, or an
+integer specifying a port number to connect to. If SERVICE is t,
+a random port number is selected for the server.
+
+:type TYPE -- TYPE is the type of connection. The default (nil) is a
+stream type connection, `datagram' creates a datagram type connection.
+
+:family FAMILY -- FAMILY is the address (and protocol) family for the
+service specified by HOST and SERVICE. The default address family is
+Inet (or IPv4) for the host and port number specified by HOST and
+SERVICE. Other address families supported are:
+ local -- for a local (i.e. UNIX) address specified by SERVICE.
+
+:local ADDRESS -- ADDRESS is the local address used for the connection.
+This parameter is ignored when opening a client process. When specified
+for a server process, the FAMILY, HOST and SERVICE args are ignored.
+
+:remote ADDRESS -- ADDRESS is the remote partner's address for the
+connection. This parameter is ignored when opening a stream server
+process. For a datagram server process, it specifies the initial
+setting of the remote datagram address. When specified for a client
+process, the FAMILY, HOST, and SERVICE args are ignored.
+
+The format of ADDRESS depends on the address family:
+- An IPv4 address is represented as an vector of integers [A B C D P]
+corresponding to numeric IP address A.B.C.D and port number P.
+- A local address is represented as a string with the address in the
+local address space.
+- An "unsupported family" address is represented by a cons (F . AV)
+where F is the family number and AV is a vector containing the socket
+address data with one element per address data byte. Do not rely on
+this format in portable code, as it may depend on implementation
+defined constants, data sizes, and data structure alignment.
+
+:coding CODING -- CODING is coding system for this process.
+
+:options OPTIONS -- Set the specified options for the network process.
+See `set-network-process-options' for details.
+
+:nowait BOOL -- If BOOL is non-nil for a stream type client process,
+return without waiting for the connection to complete; instead, the
+sentinel function will be called with second arg matching "open" (if
+successful) or "failed" when the connect completes. Default is to use
+a blocking connect (i.e. wait) for stream type connections.
+
+:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
+running when emacs is exited.
+
+:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
+In the stopped state, a server process does not accept new
+connections, and a client process does not handle incoming traffic.
+The stopped state is cleared by `continue-process' and set by
+`stop-process'.
+
+:filter FILTER -- Install FILTER as the process filter.
+
+:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
+process filter are multibyte, otherwise they are unibyte.
+If this keyword is not specified, the strings are multibyte iff
+`default-enable-multibyte-characters' is non-nil.
+
+:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+
+:log LOG -- Install LOG as the server process log function. This
+function is called when the server accepts a network connection from a
+client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
+is the server process, CLIENT is the new process for the connection,
+and MESSAGE is a string.
+
+:plist PLIST -- Install PLIST as the new process' initial plist.
+
+:server BOOL -- if BOOL is non-nil, create a server process for the
+specified FAMILY, SERVICE, and connection type (stream or datagram).
+Default is a client process.
+
+A server process will listen for and accept connections from
+clients. When a client connection is accepted, a new network process
+is created for the connection with the following parameters:
+- The client's process name is constructed by concatenating the server
+process' NAME and a client identification string.
+- If the FILTER argument is non-nil, the client process will not get a
+separate process buffer; otherwise, the client's process buffer is a newly
+created buffer named after the server process' BUFFER name or process
+NAME concatenated with the client identification string.
+- The connection type and the process filter and sentinel parameters are
+inherited from the server process' TYPE, FILTER and SENTINEL.
+- The client process' contact info is set according to the client's
+addressing information (typically an IP address and a port number).
+- The client process' plist is initialized from the server's plist.
+
+Notice that the FILTER and SENTINEL args are never used directly by
+the server process. Also, the BUFFER argument is not used directly by
+the server process, but via the optional :log function, accepted (and
+failed) connections may be logged in the server process' buffer.
+
+The original argument list, modified with the actual connection
+information, is available via the `process-contact' function.
+
+usage: (make-network-process &rest ARGS) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
{
Lisp_Object proc;
-#ifndef HAVE_GETADDRINFO
- struct sockaddr_in address;
- struct servent *svc_info;
- struct hostent *host_info_ptr, host_info;
- char *(addr_list[2]);
- IN_ADDR numeric_addr;
- int port;
+ Lisp_Object contact;
+ struct Lisp_Process *p;
+#ifdef HAVE_GETADDRINFO
+ struct addrinfo ai, *res, *lres;
+ struct addrinfo hints;
+ char *portstring, portbuf[128];
#else /* HAVE_GETADDRINFO */
- struct addrinfo hints, *res, *lres;
+ struct _emacs_addrinfo
+ {
+ int ai_family;
+ int ai_socktype;
+ int ai_protocol;
+ int ai_addrlen;
+ struct sockaddr *ai_addr;
+ struct _emacs_addrinfo *ai_next;
+ } ai, *res, *lres;
+#endif /* HAVE_GETADDRINFO */
+ struct sockaddr_in address_in;
+#ifdef HAVE_LOCAL_SOCKETS
+ struct sockaddr_un address_un;
+#endif
+ int port;
int ret = 0;
int xerrno = 0;
- char *portstring, portbuf[128];
-#endif /* HAVE_GETADDRINFO */
int s = -1, outch, inch;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1;
int retry = 0;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int count1;
+ Lisp_Object QCaddress; /* one of QClocal or QCremote */
+ Lisp_Object tem;
+ Lisp_Object name, buffer, host, service, address;
+ Lisp_Object filter, sentinel;
+ int is_non_blocking_client = 0;
+ int is_server = 0;
+ int socktype;
+ int family = -1;
+
+ if (nargs == 0)
+ return Qnil;
+
+ /* Save arguments for process-contact and clone-process. */
+ contact = Flist (nargs, args);
+ GCPRO1 (contact);
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
- GCPRO4 (name, buffer, host, service);
- CHECK_STRING (name, 0);
- CHECK_STRING (host, 0);
+ /* :type TYPE (nil: stream, datagram */
+ tem = Fplist_get (contact, QCtype);
+ if (NILP (tem))
+ socktype = SOCK_STREAM;
+#ifdef DATAGRAM_SOCKETS
+ else if (EQ (tem, Qdatagram))
+ socktype = SOCK_DGRAM;
+#endif
+ else
+ error ("Unsupported connection type");
-#ifdef HAVE_GETADDRINFO
- /*
- * SERVICE can either be a string or int.
- * Convert to a C string for later use by getaddrinfo.
- */
- if (INTEGERP (service))
+ /* :server BOOL */
+ tem = Fplist_get (contact, QCserver);
+ if (!NILP (tem))
{
- sprintf (portbuf, "%d", XINT (service));
- portstring = portbuf;
+ /* Don't support network sockets when non-blocking mode is
+ not available, since a blocked Emacs is not useful. */
+#if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
+ error ("Network servers not supported");
+#else
+ is_server = 1;
+#endif
}
- else
+
+ /* Make QCaddress an alias for :local (server) or :remote (client). */
+ QCaddress = is_server ? QClocal : QCremote;
+
+ /* :wait BOOL */
+ if (!is_server && socktype == SOCK_STREAM
+ && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
{
- CHECK_STRING (service, 0);
- portstring = XSTRING (service)->data;
+#ifndef NON_BLOCKING_CONNECT
+ error ("Non-blocking connect not supported");
+#else
+ is_non_blocking_client = 1;
+#endif
}
-#else /* ! HAVE_GETADDRINFO */
+
+ name = Fplist_get (contact, QCname);
+ buffer = Fplist_get (contact, QCbuffer);
+ filter = Fplist_get (contact, QCfilter);
+ sentinel = Fplist_get (contact, QCsentinel);
+
+ CHECK_STRING (name);
+
+#ifdef TERM
+ /* 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
{
- CHECK_STRING (service, 0);
- svc_info = getservbyname (XSTRING (service)->data, "tcp");
+ struct servent *svc_info;
+ CHECK_STRING (service);
+ svc_info = getservbyname (SDATA (service), "tcp");
if (svc_info == 0)
- error ("Unknown service \"%s\"", XSTRING (service)->data);
+ error ("Unknown service: %s", SDATA (service));
port = svc_info->s_port;
}
-#endif /* ! HAVE_GETADDRINFO */
+ 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;
+ ai.ai_next = NULL;
+ res = &ai;
+
+ /* :local ADDRESS or :remote ADDRESS */
+ address = Fplist_get (contact, QCaddress);
+ if (!NILP (address))
+ {
+ host = service = Qnil;
+
+ if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
+ error ("Malformed :address");
+ ai.ai_family = family;
+ ai.ai_addr = alloca (ai.ai_addrlen);
+ conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
+ goto open_socket;
+ }
+
+ /* :family FAMILY -- nil (for Inet), local, or integer. */
+ tem = Fplist_get (contact, QCfamily);
+ if (INTEGERP (tem))
+ family = XINT (tem);
+ else
+ {
+ if (NILP (tem))
+ family = AF_INET;
+#ifdef HAVE_LOCAL_SOCKETS
+ else if (EQ (tem, Qlocal))
+ family = AF_LOCAL;
+#endif
+ }
+ if (family < 0)
+ error ("Unknown address family");
+ ai.ai_family = family;
+
+ /* :service SERVICE -- string, integer (port number), or t (random port). */
+ service = Fplist_get (contact, QCservice);
+
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family == AF_LOCAL)
+ {
+ /* Host is not used. */
+ host = Qnil;
+ CHECK_STRING (service);
+ bzero (&address_un, sizeof address_un);
+ address_un.sun_family = AF_LOCAL;
+ strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path);
+ ai.ai_addr = (struct sockaddr *) &address_un;
+ ai.ai_addrlen = sizeof address_un;
+ goto open_socket;
+ }
+#endif
+
+ /* :host HOST -- hostname, ip address, or 'local for localhost. */
+ host = Fplist_get (contact, QChost);
+ if (!NILP (host))
+ {
+ if (EQ (host, Qlocal))
+ host = build_string ("localhost");
+ CHECK_STRING (host);
+ }
/* Slow down polling to every ten seconds.
Some kernels have a bug which causes retrying connect to fail
after a connect. Polling can interfere with gethostbyname too. */
#ifdef POLL_FOR_INPUT
- bind_polling_period (10);
+ if (socktype == SOCK_STREAM)
+ {
+ record_unwind_protect (unwind_stop_other_atimers, Qnil);
+ bind_polling_period (10);
+ }
#endif
-#ifndef TERM
#ifdef HAVE_GETADDRINFO
- {
- immediate_quit = 1;
- QUIT;
- memset (&hints, 0, sizeof (hints));
- hints.ai_flags = 0;
- hints.ai_family = AF_UNSPEC;
- hints.ai_socktype = SOCK_STREAM;
- hints.ai_protocol = 0;
- ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
- if (ret)
- {
- error ("%s/%s %s", XSTRING (host)->data, portstring,
- strerror (ret));
- }
- immediate_quit = 0;
- }
+ /* If we have a host, use getaddrinfo to resolve both host and service.
+ Otherwise, use getservbyname to lookup the service. */
+ if (!NILP (host))
+ {
+ /* SERVICE can either be a string or int.
+ Convert to a C string for later use by getaddrinfo. */
+ if (EQ (service, Qt))
+ portstring = "0";
+ else if (INTEGERP (service))
+ {
+ sprintf (portbuf, "%ld", (long) XINT (service));
+ portstring = portbuf;
+ }
+ else
+ {
+ CHECK_STRING (service);
+ portstring = SDATA (service);
+ }
+
+ immediate_quit = 1;
+ QUIT;
+ memset (&hints, 0, sizeof (hints));
+ hints.ai_flags = 0;
+ hints.ai_family = NILP (Fplist_member (contact, QCfamily)) ? AF_UNSPEC : family;
+ hints.ai_socktype = socktype;
+ hints.ai_protocol = 0;
+ ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
+ if (ret)
+#ifdef HAVE_GAI_STRERROR
+ error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
+#else
+ error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
+#endif
+ immediate_quit = 0;
+
+ goto open_socket;
+ }
+#endif /* HAVE_GETADDRINFO */
+
+ /* We end up here if getaddrinfo is not defined, or in case no hostname
+ has been specified (e.g. for a local server process). */
+
+ if (EQ (service, Qt))
+ port = 0;
+ else if (INTEGERP (service))
+ port = htons ((unsigned short) XINT (service));
+ else
+ {
+ struct servent *svc_info;
+ CHECK_STRING (service);
+ svc_info = getservbyname (SDATA (service),
+ (socktype == SOCK_DGRAM ? "udp" : "tcp"));
+ if (svc_info == 0)
+ error ("Unknown service: %s", SDATA (service));
+ port = svc_info->s_port;
+ }
+
+ bzero (&address_in, sizeof address_in);
+ address_in.sin_family = family;
+ address_in.sin_addr.s_addr = INADDR_ANY;
+ address_in.sin_port = port;
+
+#ifndef HAVE_GETADDRINFO
+ if (!NILP (host))
+ {
+ struct hostent *host_info_ptr;
+
+ /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
+ as it may `hang' emacs for a very long time. */
+ immediate_quit = 1;
+ QUIT;
+ host_info_ptr = gethostbyname (SDATA (host));
+ immediate_quit = 0;
+
+ if (host_info_ptr)
+ {
+ bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
+ host_info_ptr->h_length);
+ family = host_info_ptr->h_addrtype;
+ address_in.sin_family = family;
+ }
+ else
+ /* Attempt to interpret host as numeric inet address */
+ {
+ IN_ADDR numeric_addr;
+ numeric_addr = inet_addr ((char *) SDATA (host));
+ if (NUMERIC_ADDR_ERROR)
+ error ("Unknown host \"%s\"", SDATA (host));
+
+ bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
+ sizeof (address_in.sin_addr));
+ }
+
+ }
+#endif /* not HAVE_GETADDRINFO */
+
+ ai.ai_family = family;
+ ai.ai_addr = (struct sockaddr *) &address_in;
+ ai.ai_addrlen = sizeof address_in;
+
+ open_socket:
+
+ /* 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 ();
+ }
+
+ /* Do this in case we never enter the for-loop below. */
+ count1 = SPECPDL_INDEX ();
s = -1;
- count1 = specpdl_ptr - specpdl;
- record_unwind_protect (close_file_unwind, make_number (s));
for (lres = res; lres; lres = lres->ai_next)
{
s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
- if (s < 0)
- continue;
+ if (s < 0)
+ {
+ xerrno = errno;
+ continue;
+ }
- /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
- when connect is interrupted. So let's not let it get interrupted.
- Note we do not turn off polling, because polling is only used
- when not interrupt_input, and thus not normally used on the systems
- which have this bug. On systems which use polling, there's no way
- to quit if polling is turned off. */
- if (interrupt_input)
- unrequest_sigio ();
+#ifdef DATAGRAM_SOCKETS
+ if (!is_server && socktype == SOCK_DGRAM)
+ break;
+#endif /* DATAGRAM_SOCKETS */
- immediate_quit = 1;
- QUIT;
+#ifdef NON_BLOCKING_CONNECT
+ if (is_non_blocking_client)
+ {
+#ifdef O_NONBLOCK
+ ret = fcntl (s, F_SETFL, O_NONBLOCK);
+#else
+ ret = fcntl (s, F_SETFL, O_NDELAY);
+#endif
+ if (ret < 0)
+ {
+ xerrno = errno;
+ emacs_close (s);
+ s = -1;
+ continue;
+ }
+ }
+#endif
+
+ /* Make us close S if quit. */
+ record_unwind_protect (close_file_unwind, make_number (s));
+
+ if (is_server)
+ {
+ /* Configure as a server socket. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ {
+ int optval = 1;
+ if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
+ report_file_error ("Cannot set reuse option on server socket.", Qnil);
+ }
+
+ if (bind (s, lres->ai_addr, lres->ai_addrlen))
+ report_file_error ("Cannot bind server socket", Qnil);
+
+#ifdef HAVE_GETSOCKNAME
+ if (EQ (service, Qt))
+ {
+ struct sockaddr_in sa1;
+ int len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ {
+ ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
+ service = make_number (ntohs (sa1.sin_port));
+ contact = Fplist_put (contact, QCservice, service);
+ }
+ }
+#endif
- ret = connect (s, lres->ai_addr, lres->ai_addrlen);
- if (ret == 0)
- break;
- emacs_close (s);
- s = -1;
- }
+ if (socktype == SOCK_STREAM && listen (s, 5))
+ report_file_error ("Cannot listen on server socket", Qnil);
- freeaddrinfo (res);
- if (s < 0)
- {
- if (interrupt_input)
- request_sigio ();
+ break;
+ }
- errno = xerrno;
- report_file_error ("connection failed",
- Fcons (host, Fcons (name, Qnil)));
- }
-#else /* ! HAVE_GETADDRINFO */
+ retry_connect:
- while (1)
- {
-#if 0
-#ifdef TRY_AGAIN
- h_errno = 0;
-#endif
-#endif
immediate_quit = 1;
QUIT;
- host_info_ptr = gethostbyname (XSTRING (host)->data);
- immediate_quit = 0;
-#if 0
-#ifdef TRY_AGAIN
- if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
-#endif
-#endif
- break;
- Fsleep_for (make_number (1), Qnil);
- }
- if (host_info_ptr == 0)
- /* Attempt to interpret host as numeric inet address */
- {
- numeric_addr = inet_addr ((char *) XSTRING (host)->data);
- if (NUMERIC_ADDR_ERROR)
- error ("Unknown host \"%s\"", XSTRING (host)->data);
-
- host_info_ptr = &host_info;
- host_info.h_name = 0;
- host_info.h_aliases = 0;
- host_info.h_addrtype = AF_INET;
-#ifdef h_addr
- /* Older machines have only one address slot called h_addr.
- Newer machines have h_addr_list, but #define h_addr to
- be its first element. */
- host_info.h_addr_list = &(addr_list[0]);
-#endif
- host_info.h_addr = (char*)(&numeric_addr);
- addr_list[1] = 0;
- /* numeric_addr isn't null-terminated; it has fixed length. */
- host_info.h_length = sizeof (numeric_addr);
- }
- bzero (&address, sizeof address);
- bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
- host_info_ptr->h_length);
- address.sin_family = host_info_ptr->h_addrtype;
- address.sin_port = port;
+ /* 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.
- s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
- if (s < 0)
- report_file_error ("error creating socket", Fcons (name, Qnil));
+ It'd be nice to be able to control the connect timeout
+ though. Would non-blocking connect calls be portable?
- count1 = specpdl_ptr - specpdl;
- record_unwind_protect (close_file_unwind, make_number (s));
+ This used to be conditioned by HAVE_GETADDRINFO. Why? */
- /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
- when connect is interrupted. So let's not let it get interrupted.
- Note we do not turn off polling, because polling is only used
- when not interrupt_input, and thus not normally used on the systems
- which have this bug. On systems which use polling, there's no way
- to quit if polling is turned off. */
- if (interrupt_input)
- unrequest_sigio ();
+ turn_on_atimers (0);
- loop:
+ ret = connect (s, lres->ai_addr, lres->ai_addrlen);
+ xerrno = errno;
- immediate_quit = 1;
- QUIT;
+ turn_on_atimers (1);
- if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
- && errno != EISCONN)
- {
- int xerrno = errno;
+ if (ret == 0 || xerrno == EISCONN)
+ {
+ /* The unwind-protect will be discarded afterwards.
+ Likewise for immediate_quit. */
+ break;
+ }
+
+#ifdef NON_BLOCKING_CONNECT
+#ifdef EINPROGRESS
+ if (is_non_blocking_client && xerrno == EINPROGRESS)
+ break;
+#else
+#ifdef EWOULDBLOCK
+ if (is_non_blocking_client && xerrno == EWOULDBLOCK)
+ break;
+#endif
+#endif
+#endif
immediate_quit = 0;
- if (errno == EINTR)
- goto loop;
- if (errno == EADDRINUSE && retry < 20)
+ if (xerrno == EINTR)
+ goto retry_connect;
+ if (xerrno == EADDRINUSE && retry < 20)
{
/* A delay here is needed on some FreeBSD systems,
and it is harmless, since this retrying takes time anyway
and should be infrequent. */
Fsleep_for (make_number (1), Qnil);
retry++;
- goto loop;
+ goto retry_connect;
}
- /* Discard the unwind protect. */
+ /* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count1;
-
emacs_close (s);
+ s = -1;
+ }
- if (interrupt_input)
- request_sigio ();
-
- errno = xerrno;
- report_file_error ("connection failed",
- Fcons (host, Fcons (name, Qnil)));
+ if (s >= 0)
+ {
+#ifdef DATAGRAM_SOCKETS
+ if (socktype == SOCK_DGRAM)
+ {
+ if (datagram_address[s].sa)
+ abort ();
+ datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
+ datagram_address[s].len = lres->ai_addrlen;
+ if (is_server)
+ {
+ Lisp_Object remote;
+ bzero (datagram_address[s].sa, lres->ai_addrlen);
+ if (remote = Fplist_get (contact, QCremote), !NILP (remote))
+ {
+ int rfamily, rlen;
+ rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
+ if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
+ conv_lisp_to_sockaddr (rfamily, remote,
+ datagram_address[s].sa, rlen);
+ }
+ }
+ else
+ bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
+ }
+#endif
+ contact = Fplist_put (contact, QCaddress,
+ conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
+#ifdef HAVE_GETSOCKNAME
+ if (!is_server)
+ {
+ struct sockaddr_in sa1;
+ int len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp (&sa1, len1));
+ }
+#endif
}
-#endif /* ! HAVE_GETADDRINFO */
+
+#ifdef HAVE_GETADDRINFO
+ if (res != &ai)
+ freeaddrinfo (res);
+#endif
immediate_quit = 0;
- /* Discard the unwind protect. */
+ /* Discard the unwind protect for closing S, if any. */
specpdl_ptr = specpdl + count1;
-#ifdef POLL_FOR_INPUT
+ /* Unwind bind_polling_period and request_sigio. */
unbind_to (count, Qnil);
-#endif
-
- if (interrupt_input)
- request_sigio ();
-#else /* TERM */
- s = connect_server (0);
if (s < 0)
- report_file_error ("error creating socket", Fcons (name, Qnil));
- send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
- send_command (s, C_DUMB, 1, 0);
-#endif /* TERM */
+ {
+ /* If non-blocking got this far - and failed - assume non-blocking is
+ not supported after all. This is probably a wrong assumption, but
+ the normal blocking calls to open-network-stream handles this error
+ better. */
+ if (is_non_blocking_client)
+ return Qnil;
+
+ errno = xerrno;
+ if (is_server)
+ report_file_error ("make server process failed", contact);
+ else
+ report_file_error ("make client process failed", contact);
+ }
+
+ tem = Fplist_get (contact, QCoptions);
+ if (!NILP (tem))
+ set_socket_options (s, tem, 1);
+
+#endif /* not TERM */
inch = s;
outch = s;
#endif
#endif
- XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
- XPROCESS (proc)->command_channel_p = Qnil;
- XPROCESS (proc)->buffer = buffer;
- XPROCESS (proc)->sentinel = Qnil;
- XPROCESS (proc)->filter = Qnil;
- XPROCESS (proc)->command = Qnil;
- XPROCESS (proc)->pid = Qnil;
- XSETINT (XPROCESS (proc)->infd, inch);
- XSETINT (XPROCESS (proc)->outfd, outch);
- XPROCESS (proc)->status = Qrun;
- FD_SET (inch, &input_wait_mask);
- FD_SET (inch, &non_keyboard_wait_mask);
+ p = XPROCESS (proc);
+
+ p->childp = contact;
+ p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
+
+ p->buffer = buffer;
+ p->sentinel = sentinel;
+ p->filter = filter;
+ p->filter_multibyte = buffer_defaults.enable_multibyte_characters;
+ /* Override the above only if :filter-multibyte is specified. */
+ if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
+ p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte);
+ p->log = Fplist_get (contact, QClog);
+ if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
+ p->kill_without_query = Qt;
+ if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
+ p->command = Qt;
+ p->pid = Qnil;
+ XSETINT (p->infd, inch);
+ XSETINT (p->outfd, outch);
+ if (is_server && socktype == SOCK_STREAM)
+ p->status = Qlisten;
+
+#ifdef NON_BLOCKING_CONNECT
+ if (is_non_blocking_client)
+ {
+ /* We may get here if connect did succeed immediately. However,
+ in that case, we still need to signal this like a non-blocking
+ connection. */
+ p->status = Qconnect;
+ if (!FD_ISSET (inch, &connect_wait_mask))
+ {
+ FD_SET (inch, &connect_wait_mask);
+ num_pending_connects++;
+ }
+ }
+ else
+#endif
+ /* A server may have a client filter setting of Qt, but it must
+ still listen for incoming connects unless it is stopped. */
+ if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
+ || (EQ (p->status, Qlisten) && NILP (p->command)))
+ {
+ FD_SET (inch, &input_wait_mask);
+ FD_SET (inch, &non_keyboard_wait_mask);
+ }
+
if (inch > max_process_desc)
max_process_desc = inch;
+ tem = Fplist_member (contact, QCcoding);
+ if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
+ tem = Qnil; /* No error message (too late!). */
+
{
/* Setup coding systems for communicating with the network stream. */
struct gcpro gcpro1;
Lisp_Object coding_systems = Qt;
Lisp_Object args[5], val;
- if (!NILP (Vcoding_system_for_read))
+ if (!NILP (tem))
+ val = XCAR (XCDR (tem));
+ else if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
|| (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
val = Qnil;
else
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
else
val = Qnil;
}
- XPROCESS (proc)->decode_coding_system = val;
+ p->decode_coding_system = val;
- if (!NILP (Vcoding_system_for_write))
+ if (!NILP (tem))
+ val = XCAR (XCDR (tem));
+ else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (current_buffer->enable_multibyte_characters))
val = Qnil;
{
if (EQ (coding_systems, Qt))
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
}
if (CONSP (coding_systems))
val = XCDR (coding_systems);
else
val = Qnil;
}
- XPROCESS (proc)->encode_coding_system = val;
+ p->encode_coding_system = val;
}
+ setup_process_coding_systems (proc);
- if (!proc_decode_coding_system[inch])
- proc_decode_coding_system[inch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (proc)->decode_coding_system,
- proc_decode_coding_system[inch]);
- if (!proc_encode_coding_system[outch])
- proc_encode_coding_system[outch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (proc)->encode_coding_system,
- proc_encode_coding_system[outch]);
-
- XPROCESS (proc)->decoding_buf = make_uninit_string (0);
- XPROCESS (proc)->decoding_carryover = make_number (0);
- XPROCESS (proc)->encoding_buf = make_uninit_string (0);
- XPROCESS (proc)->encoding_carryover = make_number (0);
+ p->decoding_buf = make_uninit_string (0);
+ p->decoding_carryover = make_number (0);
+ p->encoding_buf = make_uninit_string (0);
+ p->encoding_carryover = make_number (0);
- XPROCESS (proc)->inherit_coding_system_flag
- = (NILP (buffer) || !inherit_process_coding_system
+ p->inherit_coding_system_flag
+ = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system
? Qnil : Qt);
UNGCPRO;
XSETINT (p->infd, -1);
XSETINT (p->outfd, -1);
+#ifdef DATAGRAM_SOCKETS
+ if (DATAGRAM_CHAN_P (inchannel))
+ {
+ xfree (datagram_address[inchannel].sa);
+ datagram_address[inchannel].sa = 0;
+ datagram_address[inchannel].len = 0;
+ }
+#endif
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
+ if (FD_ISSET (inchannel, &connect_wait_mask))
+ {
+ FD_CLR (inchannel, &connect_wait_mask);
+ if (--num_pending_connects < 0)
+ abort ();
+ }
if (inchannel == max_process_desc)
{
int i;
}
\f
DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
- 0, 3, 0,
- "Allow any pending output from subprocesses to be read by Emacs.\n\
-It is read into the process' buffers or given to their filter functions.\n\
-Non-nil arg PROCESS means do not return until some output has been received\n\
-from PROCESS.\n\
-Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
-seconds and microseconds to wait; return after that much time whether\n\
-or not there is input.\n\
-Return non-nil iff we received any output before the timeout expired.")
- (process, timeout, timeout_msecs)
+ 0, 3, 0,
+ doc: /* Allow any pending output from subprocesses to be read by Emacs.
+It is read into the process' buffers or given to their filter functions.
+Non-nil arg PROCESS means do not return until some output has been received
+from PROCESS.
+Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
+seconds and microseconds to wait; return after that much time whether
+or not there is input.
+Return non-nil iff we received any output before the timeout expired. */)
+ (process, timeout, timeout_msecs)
register Lisp_Object process, timeout, timeout_msecs;
{
int seconds;
int useconds;
if (! NILP (process))
- CHECK_PROCESS (process, 0);
+ CHECK_PROCESS (process);
if (! NILP (timeout_msecs))
{
- CHECK_NUMBER (timeout_msecs, 2);
+ CHECK_NUMBER (timeout_msecs);
useconds = XINT (timeout_msecs);
if (!INTEGERP (timeout))
XSETINT (timeout, 0);
if (! NILP (timeout))
{
- CHECK_NUMBER (timeout, 1);
+ CHECK_NUMBER (timeout);
seconds = XINT (timeout);
if (seconds < 0 || (seconds == 0 && useconds == 0))
seconds = -1;
? Qt : Qnil);
}
+/* Accept a connection for server process SERVER on CHANNEL. */
+
+static int connect_counter = 0;
+
+static void
+server_accept_connection (server, channel)
+ Lisp_Object server;
+ int channel;
+{
+ Lisp_Object proc, caller, name, buffer;
+ Lisp_Object contact, host, service;
+ struct Lisp_Process *ps= XPROCESS (server);
+ struct Lisp_Process *p;
+ int s;
+ union u_sockaddr {
+ struct sockaddr sa;
+ struct sockaddr_in in;
+#ifdef HAVE_LOCAL_SOCKETS
+ struct sockaddr_un un;
+#endif
+ } saddr;
+ int len = sizeof saddr;
+
+ s = accept (channel, &saddr.sa, &len);
+
+ if (s < 0)
+ {
+ int code = errno;
+
+ if (code == EAGAIN)
+ return;
+#ifdef EWOULDBLOCK
+ if (code == EWOULDBLOCK)
+ return;
+#endif
+
+ if (!NILP (ps->log))
+ call3 (ps->log, server, Qnil,
+ concat3 (build_string ("accept failed with code"),
+ Fnumber_to_string (make_number (code)),
+ build_string ("\n")));
+ return;
+ }
+
+ connect_counter++;
+
+ /* Setup a new process to handle the connection. */
+
+ /* Generate a unique identification of the caller, and build contact
+ information for this process. */
+ host = Qt;
+ service = Qnil;
+ switch (saddr.sa.sa_family)
+ {
+ case AF_INET:
+ {
+ Lisp_Object args[5];
+ unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
+ args[0] = build_string ("%d.%d.%d.%d");
+ args[1] = make_number (*ip++);
+ args[2] = make_number (*ip++);
+ args[3] = make_number (*ip++);
+ args[4] = make_number (*ip++);
+ host = Fformat (5, args);
+ service = make_number (ntohs (saddr.in.sin_port));
+
+ args[0] = build_string (" <%s:%d>");
+ args[1] = host;
+ args[2] = service;
+ caller = Fformat (3, args);
+ }
+ break;
+
+#ifdef HAVE_LOCAL_SOCKETS
+ case AF_LOCAL:
+#endif
+ default:
+ caller = Fnumber_to_string (make_number (connect_counter));
+ caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
+ break;
+ }
+
+ /* Create a new buffer name for this process if it doesn't have a
+ filter. The new buffer name is based on the buffer name or
+ process name of the server process concatenated with the caller
+ identification. */
+
+ if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
+ buffer = Qnil;
+ else
+ {
+ buffer = ps->buffer;
+ if (!NILP (buffer))
+ buffer = Fbuffer_name (buffer);
+ else
+ buffer = ps->name;
+ if (!NILP (buffer))
+ {
+ buffer = concat2 (buffer, caller);
+ buffer = Fget_buffer_create (buffer);
+ }
+ }
+
+ /* Generate a unique name for the new server process. Combine the
+ server process name with the caller identification. */
+
+ name = concat2 (ps->name, caller);
+ proc = make_process (name);
+
+ chan_process[s] = proc;
+
+#ifdef O_NONBLOCK
+ fcntl (s, F_SETFL, O_NONBLOCK);
+#else
+#ifdef O_NDELAY
+ fcntl (s, F_SETFL, O_NDELAY);
+#endif
+#endif
+
+ p = XPROCESS (proc);
+
+ /* Build new contact information for this setup. */
+ contact = Fcopy_sequence (ps->childp);
+ contact = Fplist_put (contact, QCserver, Qnil);
+ contact = Fplist_put (contact, QChost, host);
+ if (!NILP (service))
+ contact = Fplist_put (contact, QCservice, service);
+ contact = Fplist_put (contact, QCremote,
+ conv_sockaddr_to_lisp (&saddr.sa, len));
+#ifdef HAVE_GETSOCKNAME
+ len = sizeof saddr;
+ if (getsockname (s, &saddr.sa, &len) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp (&saddr.sa, len));
+#endif
+
+ p->childp = contact;
+ p->plist = Fcopy_sequence (ps->plist);
+
+ p->buffer = buffer;
+ p->sentinel = ps->sentinel;
+ p->filter = ps->filter;
+ p->command = Qnil;
+ p->pid = Qnil;
+ XSETINT (p->infd, s);
+ XSETINT (p->outfd, s);
+ p->status = Qrun;
+
+ /* Client processes for accepted connections are not stopped initially. */
+ if (!EQ (p->filter, Qt))
+ {
+ FD_SET (s, &input_wait_mask);
+ FD_SET (s, &non_keyboard_wait_mask);
+ }
+
+ if (s > max_process_desc)
+ max_process_desc = s;
+
+ /* Setup coding system for new process based on server process.
+ This seems to be the proper thing to do, as the coding system
+ of the new process should reflect the settings at the time the
+ server socket was opened; not the current settings. */
+
+ p->decode_coding_system = ps->decode_coding_system;
+ p->encode_coding_system = ps->encode_coding_system;
+ setup_process_coding_systems (proc);
+
+ p->decoding_buf = make_uninit_string (0);
+ p->decoding_carryover = make_number (0);
+ p->encoding_buf = make_uninit_string (0);
+ p->encoding_carryover = make_number (0);
+
+ p->inherit_coding_system_flag
+ = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
+
+ if (!NILP (ps->log))
+ call3 (ps->log, server, proc,
+ concat3 (build_string ("accept from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n")));
+
+ if (!NILP (p->sentinel))
+ exec_sentinel (proc,
+ concat3 (build_string ("open from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n")));
+}
+
/* This variable is different from waiting_for_input in keyboard.c.
It is used to communicate to a lisp process-filter/sentinel (via the
function Fwaiting_for_user_input_p below) whether emacs was waiting
{
register int channel, nfds;
static SELECT_TYPE Available;
+ static SELECT_TYPE Connecting;
+ int check_connect, no_avail;
int xerrno;
Lisp_Object proc;
EMACS_TIME timeout, end_time;
- SELECT_TYPE Atemp;
int wait_channel = -1;
struct Lisp_Process *wait_proc = 0;
int got_some_input = 0;
- Lisp_Object *wait_for_cell = 0;
+ /* Either nil or a cons cell, the car of which is of interest and
+ may be changed outside of this routine. */
+ Lisp_Object wait_for_cell = Qnil;
FD_ZERO (&Available);
+ FD_ZERO (&Connecting);
/* If read_kbd is a process to watch, set wait_proc and wait_channel
accordingly. */
/* If waiting for non-nil in a cell, record where. */
if (CONSP (read_kbd))
{
- wait_for_cell = &XCAR (read_kbd);
+ wait_for_cell = read_kbd;
XSETFASTINT (read_kbd, 0);
}
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
-#ifdef hpux
+#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) */
+ Turn off periodic alarms (in case they are in use),
+ and then turn off any other atimers. */
+ stop_polling ();
turn_on_atimers (0);
-#endif
+#endif /* POLL_INTERRUPTED_SYS_CALL */
while (1)
{
int timeout_reduced_for_timers = 0;
-#ifdef HAVE_X_WINDOWS
- if (display_busy_cursor_p)
- Fx_hide_busy_cursor (Qnil);
-#endif
-
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
Otherwise, do pending quit if requested. */
QUIT;
/* Exit now if the cell we're waiting for became non-nil. */
- if (wait_for_cell && ! NILP (*wait_for_cell))
+ if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
/* Compute time from now till when time limit is up */
But not if wait_for_cell; in those cases,
the wait is supposed to be short,
and those callers cannot handle running arbitrary Lisp code here. */
- if (! wait_for_cell)
+ if (NILP (wait_for_cell))
{
EMACS_TIME timer_delay;
- int old_timers_run;
- retry:
- old_timers_run = timers_run;
- timer_delay = timer_check (1);
- if (timers_run != old_timers_run && do_display)
+ do
{
- redisplay_preserve_echo_area ();
- /* We must retry, since a timer may have requeued itself
- and that could alter the time_delay. */
- goto retry;
+ int old_timers_run = timers_run;
+ struct buffer *old_buffer = current_buffer;
+
+ timer_delay = timer_check (1);
+
+ /* If a timer has run, this might have changed buffers
+ an alike. Make read_key_sequence aware of that. */
+ if (timers_run != old_timers_run
+ && old_buffer != current_buffer
+ && waiting_for_user_input_p == -1)
+ record_asynch_buffer_change ();
+
+ if (timers_run != old_timers_run && do_display)
+ /* We must retry, since a timer may have requeued itself
+ and that could alter the time_delay. */
+ redisplay_preserve_echo_area (9);
+ else
+ break;
}
+ while (!detect_input_pending ());
/* If there is unread keyboard input, also return. */
if (XINT (read_kbd) != 0
timeout to get our attention. */
if (update_tick != process_tick && do_display)
{
+ SELECT_TYPE Atemp, Ctemp;
+
Atemp = input_wait_mask;
+#ifdef MAC_OSX
+ /* On Mac OS X, the SELECT system call always says input is
+ present (for reading) at stdin, even when none is. This
+ causes the call to SELECT below to return 1 and
+ status_notify not to be called. As a result output of
+ subprocesses are incorrectly discarded. */
+ FD_CLR (0, &Atemp);
+#endif
+ Ctemp = connect_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
- &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout)
+ &Atemp,
+ (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
+ (SELECT_TYPE *)0, &timeout)
<= 0))
{
/* It's okay for us to do this and then continue with
}
}
- /* Don't wait for output from a non-running process. */
+ /* Don't wait for output from a non-running process. Just
+ read whatever data has already been received. */
if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
update_status (wait_proc);
if (wait_proc != 0
- && ! EQ (wait_proc->status, Qrun))
+ && ! EQ (wait_proc->status, Qrun)
+ && ! EQ (wait_proc->status, Qconnect))
{
int nread, total_nread = 0;
if (nread == 0)
break;
- if (0 < nread)
+ if (0 < nread)
total_nread += nread;
#ifdef EIO
else if (nread == -1 && EIO == errno)
#endif
}
if (total_nread > 0 && do_display)
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (10);
break;
}
/* Wait till there is something to do */
- if (wait_for_cell)
- Available = non_process_wait_mask;
- else if (! XINT (read_kbd))
- Available = non_keyboard_wait_mask;
+ if (!NILP (wait_for_cell))
+ {
+ Available = non_process_wait_mask;
+ check_connect = 0;
+ }
else
- Available = input_wait_mask;
+ {
+ if (! XINT (read_kbd))
+ Available = non_keyboard_wait_mask;
+ else
+ Available = input_wait_mask;
+ check_connect = (num_pending_connects > 0);
+ }
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
if (frame_garbaged && do_display)
{
clear_waiting_for_input ();
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (11);
if (XINT (read_kbd) < 0)
set_waiting_for_input (&timeout);
}
+ no_avail = 0;
if (XINT (read_kbd) && detect_input_pending ())
{
nfds = 0;
- FD_ZERO (&Available);
+ no_avail = 1;
}
else
- nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
- &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout);
+ {
+ if (check_connect)
+ Connecting = connect_wait_mask;
+ nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
+ &Available,
+ (check_connect ? &Connecting : (SELECT_TYPE *)0),
+ (SELECT_TYPE *)0, &timeout);
+ }
xerrno = errno;
if (nfds < 0)
{
if (xerrno == EINTR)
- FD_ZERO (&Available);
+ no_avail = 1;
#ifdef ultrix
/* Ultrix select seems to return ENOMEM when it is
interrupted. Treat it just like EINTR. Bleah. Note
"__ultrix__"; the latter is only defined under GCC, but
not by DEC's bundled CC. -JimB */
else if (xerrno == ENOMEM)
- FD_ZERO (&Available);
+ no_avail = 1;
#endif
#ifdef ALLIANT
/* This happens for no known reason on ALLIANT.
I am guessing that this is the right response. -- RMS. */
else if (xerrno == EFAULT)
- FD_ZERO (&Available);
+ no_avail = 1;
#endif
else if (xerrno == EBADF)
{
So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
in m/ibmrt-aix.h), and here we just ignore the select error.
Cleanup occurs c/o status_notify after SIGCLD. */
- FD_ZERO (&Available); /* Cannot depend on values returned */
+ no_avail = 1; /* Cannot depend on values returned */
#else
abort ();
#endif
else
error ("select error: %s", emacs_strerror (xerrno));
}
+
+ if (no_avail)
+ {
+ FD_ZERO (&Available);
+ check_connect = 0;
+ }
+
#if defined(sun) && !defined(USG5_4)
- else if (nfds > 0 && keyboard_bit_set (&Available)
- && interrupt_input)
+ 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
/* If there is any, return immediately
to give it higher priority than subprocesses */
- if (XINT (read_kbd) != 0
- && detect_input_pending_run_timers (do_display))
+ if (XINT (read_kbd) != 0)
{
- swallow_events (do_display);
+ int old_timers_run = timers_run;
+ struct buffer *old_buffer = current_buffer;
+ int leave = 0;
+
if (detect_input_pending_run_timers (do_display))
+ {
+ swallow_events (do_display);
+ if (detect_input_pending_run_timers (do_display))
+ leave = 1;
+ }
+
+ /* If a timer has run, this might have changed buffers
+ an alike. Make read_key_sequence aware of that. */
+ if (timers_run != old_timers_run
+ && waiting_for_user_input_p == -1
+ && old_buffer != current_buffer)
+ record_asynch_buffer_change ();
+
+ if (leave)
break;
}
}
/* Exit now if the cell we're waiting for became non-nil. */
- if (wait_for_cell && ! NILP (*wait_for_cell))
+ if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
#ifdef SIGIO
/* If checking input just got us a size-change event from X,
obey it now if we should. */
- if (XINT (read_kbd) || wait_for_cell)
+ if (XINT (read_kbd) || ! NILP (wait_for_cell))
do_pending_window_change (0);
/* Check for data from a process. */
+ if (no_avail || nfds == 0)
+ continue;
+
/* Really FIRST_PROC_DESC should be 0 on Unix,
but this is safer in the short run. */
for (channel = 0; channel <= max_process_desc; channel++)
if (NILP (proc))
continue;
+ /* If this is a server stream socket, accept connection. */
+ if (EQ (XPROCESS (proc)->status, Qlisten))
+ {
+ server_accept_connection (proc, channel);
+ continue;
+ }
+
/* Read data from the process, starting with our
buffered-ahead character if we have one. */
FD_ZERO (&Available);
if (do_display)
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (12);
}
#ifdef EWOULDBLOCK
else if (nread == -1 && errno == EWOULDBLOCK)
= Fcons (Qexit, Fcons (make_number (256), Qnil));
}
}
+#ifdef NON_BLOCKING_CONNECT
+ if (check_connect && FD_ISSET (channel, &Connecting))
+ {
+ struct Lisp_Process *p;
+
+ FD_CLR (channel, &connect_wait_mask);
+ if (--num_pending_connects < 0)
+ abort ();
+
+ proc = chan_process[channel];
+ if (NILP (proc))
+ continue;
+
+ p = XPROCESS (proc);
+
+#ifdef GNU_LINUX
+ /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
+ 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))
+ xerrno = errno;
+ }
+#else
+ {
+ struct sockaddr pname;
+ int pnamelen = sizeof(pname);
+
+ /* If connection failed, getpeername will fail. */
+ xerrno = 0;
+ if (getpeername(channel, &pname, &pnamelen) < 0)
+ {
+ /* Obtain connect failure code through error slippage. */
+ char dummy;
+ xerrno = errno;
+ if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
+ xerrno = errno;
+ }
+ }
+#endif
+ if (xerrno)
+ {
+ XSETINT (p->tick, ++process_tick);
+ p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
+ deactivate_process (proc);
+ }
+ else
+ {
+ p->status = Qrun;
+ /* Execute the sentinel here. If we had relied on
+ status_notify to do it later, it will read input
+ from the process before calling the sentinel. */
+ exec_sentinel (proc, build_string ("open\n"));
+ if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ }
+ }
+#endif /* NON_BLOCKING_CONNECT */
} /* end for each file descriptor */
} /* end while exit conditions not met */
clear_input_pending ();
QUIT;
}
-#ifdef hpux
+#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
+#endif /* POLL_INTERRUPTED_SYS_CALL */
-#ifdef HAVE_X_WINDOWS
- if (display_busy_cursor_p)
- if (!inhibit_busy_cursor)
- Fx_show_busy_cursor ();
-#endif
-
return got_some_input;
}
\f
Vinhibit_quit = Qt;
update_echo_area ();
Fsleep_for (make_number (2), Qnil);
+ return Qt;
}
/* Read pending output from the process channel,
{
register int nchars, nbytes;
char *chars;
-#ifdef VMS
- int chars_allocated = 0; /* If 1, `chars' should be freed later. */
-#else
- char buf[1024];
-#endif
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 chars_in_decoding_buf = 0; /* If 1, `chars' points
- XSTRING (p->decoding_buf)->data. */
int carryover = XINT (p->decoding_carryover);
+ int readmax = 1024;
#ifdef VMS
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
/* 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. */
- char *buf = (char *) xmalloc (nbytes + carryover);
-
- bcopy (XSTRING (p->decoding_buf)->data
- + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover,
- buf, carryover);
- bcopy (chars, buf + carryover, nbytes);
- chars = buf;
- chars_allocated = 1;
+ chars = (char *) alloca (nbytes + carryover);
+ bcopy (SDATA (p->decoding_buf), buf, carryover);
+ bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else /* not VMS */
+#ifdef DATAGRAM_SOCKETS
+ /* A datagram is one packet; allow at least 1500+ bytes of data
+ corresponding to the typical Ethernet frame size. */
+ if (DATAGRAM_CHAN_P (channel))
+ {
+ /* carryover = 0; */ /* Does carryover make sense for datagrams? */
+ readmax += 1024;
+ }
+#endif
+
+ chars = (char *) alloca (carryover + readmax);
if (carryover)
/* See the comment above. */
- bcopy (XSTRING (p->decoding_buf)->data
- + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover,
- buf, carryover);
+ bcopy (SDATA (p->decoding_buf), chars, carryover);
+#ifdef DATAGRAM_SOCKETS
+ /* We have a working select, so proc_buffered_char is always -1. */
+ if (DATAGRAM_CHAN_P (channel))
+ {
+ int len = datagram_address[channel].len;
+ nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
+ 0, datagram_address[channel].sa, &len);
+ }
+ else
+#endif
if (proc_buffered_char[channel] < 0)
- nbytes = emacs_read (channel, buf + carryover, (sizeof buf) - carryover);
+ nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
else
{
- buf[carryover] = proc_buffered_char[channel];
+ chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
- nbytes = emacs_read (channel, buf + carryover + 1,
- (sizeof buf) - carryover - 1);
+ nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover);
if (nbytes < 0)
nbytes = 1;
else
nbytes = nbytes + 1;
}
- chars = buf;
#endif /* not VMS */
XSETINT (p->decoding_carryover, 0);
- /* At this point, NBYTES holds number of characters just received
+ /* At this point, NBYTES holds number of bytes just received
(including the one in proc_buffered_char[channel]). */
if (nbytes <= 0)
{
/* Now set NBYTES how many bytes we must decode. */
nbytes += carryover;
- nchars = nbytes;
-
- if (CODING_MAY_REQUIRE_DECODING (coding))
- {
- int require = decoding_buffer_size (coding, nbytes);
- int result;
-
- if (STRING_BYTES (XSTRING (p->decoding_buf)) < require)
- p->decoding_buf = make_uninit_string (require);
- result = decode_coding (coding, chars, XSTRING (p->decoding_buf)->data,
- nbytes, STRING_BYTES (XSTRING (p->decoding_buf)));
- carryover = nbytes - coding->consumed;
- if (carryover > 0)
- {
- /* Copy the carryover bytes to the end of p->decoding_buf, to
- be processed on the next read. Since decoding_buffer_size
- asks for an extra amount of space beyond the maximum
- expected for the output, there should always be sufficient
- space for the carryover (which is by definition a sequence
- of bytes that was not long enough to be decoded, and thus
- has a bounded length). */
- if (STRING_BYTES (XSTRING (p->decoding_buf))
- < coding->produced + carryover)
- abort ();
- bcopy (chars + coding->consumed,
- XSTRING (p->decoding_buf)->data
- + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover,
- carryover);
- XSETINT (p->decoding_carryover, carryover);
- }
-
- /* A new coding system might be found by `decode_coding'. */
- if (!EQ (p->decode_coding_system, coding->symbol))
- {
- p->decode_coding_system = coding->symbol;
-
- /* Don't call setup_coding_system for
- proc_decode_coding_system[channel] here. It is done in
- detect_coding called via decode_coding above. */
-
- /* If a coding system for encoding is not yet decided, we set
- it as the same as coding-system for decoding.
-
- But, before doing that we must check if
- proc_encode_coding_system[p->outfd] surely points to a
- valid memory because p->outfd will be changed once EOF is
- sent to the process. */
- if (NILP (p->encode_coding_system)
- && proc_encode_coding_system[XINT (p->outfd)])
- {
- p->encode_coding_system = coding->symbol;
- setup_coding_system (coding->symbol,
- proc_encode_coding_system[XINT (p->outfd)]);
- }
- }
-
-#ifdef VMS
- /* Now we don't need the contents of `chars'. */
- if (chars_allocated)
- free (chars);
-#endif
- if (coding->produced == 0)
- return 0;
- chars = (char *) XSTRING (p->decoding_buf)->data;
- nbytes = coding->produced;
- nchars = (coding->fake_multibyte
- ? multibyte_chars_in_text (chars, nbytes)
- : coding->produced_char);
- chars_in_decoding_buf = 1;
- }
- else
- {
-#ifdef VMS
- if (chars_allocated)
- {
- /* Although we don't have to decode the received data, we
- must move it to an area which we don't have to free. */
- if (! STRINGP (p->decoding_buf)
- || STRING_BYTES (XSTRING (p->decoding_buf)) < nbytes)
- p->decoding_buf = make_uninit_string (nbytes);
- bcopy (chars, XSTRING (p->decoding_buf)->data, nbytes);
- free (chars);
- chars = XSTRING (p->decoding_buf)->data;
- chars_in_decoding_buf = 1;
- }
-#endif
- nchars = multibyte_chars_in_text (chars, nbytes);
- }
-
- Vlast_coding_system_used = coding->symbol;
-
- /* If the caller required, let the process associated buffer
- inherit the coding-system used to decode the process output. */
- if (! NILP (p->inherit_coding_system_flag)
- && !NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
- {
- struct buffer *prev_buf = current_buffer;
-
- Fset_buffer (p->buffer);
- call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
- make_number (nbytes));
- set_buffer_internal (prev_buf);
- }
/* Read and dispose of the process output. */
outstream = p->filter;
if (!NILP (outstream))
{
- /* We inhibit quit here instead of just catching it so that
+ /* We inhibit quit here instead of just catching it so that
hitting ^G when a filter happens to be running won't screw
it up. */
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
Lisp_Object obuffer, okeymap;
Lisp_Object text;
save the match data in a special nonrecursive fashion. */
running_asynch_code = 1;
- /* The multibyteness of a string given to the filter is decided
- by which coding system we used for decoding. */
- if (coding->type == coding_type_no_conversion
- || coding->type == coding_type_raw_text)
- text = make_unibyte_string (chars, nbytes);
- else
- text = make_multibyte_string (chars, nchars, nbytes);
+ text = decode_coding_string (make_unibyte_string (chars, nbytes),
+ coding, 0);
+ Vlast_coding_system_used = coding->symbol;
+ /* A new coding system might be found. */
+ if (!EQ (p->decode_coding_system, coding->symbol))
+ {
+ p->decode_coding_system = coding->symbol;
+
+ /* Don't call setup_coding_system for
+ proc_decode_coding_system[channel] here. It is done in
+ detect_coding called via decode_coding above. */
+
+ /* If a coding system for encoding is not yet decided, we set
+ it as the same as coding-system for decoding.
+
+ But, before doing that we must check if
+ proc_encode_coding_system[p->outfd] surely points to a
+ valid memory because p->outfd will be changed once EOF is
+ sent to the process. */
+ if (NILP (p->encode_coding_system)
+ && proc_encode_coding_system[XINT (p->outfd)])
+ {
+ p->encode_coding_system = coding->symbol;
+ setup_coding_system (coding->symbol,
+ proc_encode_coding_system[XINT (p->outfd)]);
+ }
+ }
- internal_condition_case_1 (read_process_output_call,
- Fcons (outstream,
- Fcons (proc, Fcons (text, Qnil))),
- !NILP (Vdebug_on_error) ? Qnil : Qerror,
- read_process_output_error_handler);
+ carryover = nbytes - coding->consumed;
+ bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
+ carryover);
+ XSETINT (p->decoding_carryover, carryover);
+ /* Adjust the multibyteness of TEXT to that of the filter. */
+ if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text))
+ text = (STRING_MULTIBYTE (text)
+ ? Fstring_as_unibyte (text)
+ : Fstring_to_multibyte (text));
+ nbytes = SBYTES (text);
+ nchars = SCHARS (text);
+ if (nbytes > 0)
+ internal_condition_case_1 (read_process_output_call,
+ Fcons (outstream,
+ Fcons (proc, Fcons (text, Qnil))),
+ !NILP (Vdebug_on_error) ? Qnil : Qerror,
+ read_process_output_error_handler);
/* If we saved the match data nonrecursively, restore it now. */
restore_match_data ();
Lisp_Object odeactivate;
int before, before_byte;
int opoint_byte;
+ Lisp_Object text;
+ struct buffer *b;
odeactivate = Vdeactivate_mark;
if (! (BEGV <= PT && PT <= ZV))
Fwiden ();
- if (NILP (current_buffer->enable_multibyte_characters))
- nchars = nbytes;
-
- /* Insert before markers in case we are inserting where
- the buffer's mark is, and the user's next command is Meta-y. */
- if (chars_in_decoding_buf)
+ text = decode_coding_string (make_unibyte_string (chars, nbytes),
+ coding, 0);
+ Vlast_coding_system_used = coding->symbol;
+ /* A new coding system might be found. See the comment in the
+ similar code in the previous `if' block. */
+ if (!EQ (p->decode_coding_system, coding->symbol))
{
- /* Since multibyteness of p->docoding_buf is corrupted, we
- can't use insert_from_string_before_markers. */
- char *temp_buf;
-
- temp_buf = (char *) alloca (nbytes);
- bcopy (XSTRING (p->decoding_buf)->data, temp_buf, nbytes);
- insert_before_markers (temp_buf, nbytes);
+ p->decode_coding_system = coding->symbol;
+ if (NILP (p->encode_coding_system)
+ && proc_encode_coding_system[XINT (p->outfd)])
+ {
+ p->encode_coding_system = coding->symbol;
+ setup_coding_system (coding->symbol,
+ proc_encode_coding_system[XINT (p->outfd)]);
+ }
}
+ carryover = nbytes - coding->consumed;
+ bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
+ carryover);
+ XSETINT (p->decoding_carryover, carryover);
+ /* Adjust the multibyteness of TEXT to that of the buffer. */
+ if (NILP (current_buffer->enable_multibyte_characters)
+ != ! STRING_MULTIBYTE (text))
+ text = (STRING_MULTIBYTE (text)
+ ? Fstring_as_unibyte (text)
+ : Fstring_to_multibyte (text));
+ nbytes = SBYTES (text);
+ nchars = SCHARS (text);
+ /* Insert before markers in case we are inserting where
+ the buffer's mark is, and the user's next command is Meta-y. */
+ insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
+
+ /* Make sure the process marker's position is valid when the
+ process buffer is changed in the signal_after_change above.
+ W3 is known to do that. */
+ if (BUFFERP (p->buffer)
+ && (b = XBUFFER (p->buffer), b != current_buffer))
+ set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
else
- {
- insert_1_both (chars, nchars, nbytes, 0, 1, 1);
- signal_after_change (before, 0, PT - before);
- update_compositions (before, PT, CHECK_BORDER);
- }
- set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
+ set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
update_mode_lines++;
DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
0, 0, 0,
- "Returns non-nil if emacs is waiting for input from the user.\n\
-This is intended for use by asynchronous process output filters and sentinels.")
- ()
+ doc: /* Returns non-nil if emacs is waiting for input from the user.
+This is intended for use by asynchronous process output filters and sentinels. */)
+ ()
{
return (waiting_for_user_input_p ? Qt : Qnil);
}
/* Sending data to subprocess */
jmp_buf send_process_frame;
+Lisp_Object process_sent_to;
SIGTYPE
send_process_trap ()
/* Send some data to process PROC.
BUF is the beginning of the data; LEN is the number of characters.
- OBJECT is the Lisp object that the data comes from.
+ OBJECT is the Lisp object that the data comes from. If OBJECT is
+ nil or t, it means that the data comes from C string.
- The data is encoded by PROC's coding-system for encoding before it
- is sent. But if the data ends at the middle of multi-byte
- representation, that incomplete sequence of bytes are sent without
- being encoded. Should we store them in a buffer to prepend them to
- the data send later? */
+ If OBJECT is not nil, the data is encoded by PROC's coding-system
+ for encoding before it is sent.
+
+ This function can evaluate Lisp code and can garbage collect. */
void
send_process (proc, buf, len, object)
volatile Lisp_Object proc;
- unsigned char *buf;
- int len;
- Lisp_Object object;
+ unsigned char *volatile buf;
+ volatile int len;
+ volatile Lisp_Object object;
{
/* Use volatile to protect variables from being clobbered by longjmp. */
int rv;
- volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
struct coding_system *coding;
struct gcpro gcpro1;
- int carryover = XINT (XPROCESS (proc)->encoding_carryover);
GCPRO1 (object);
if (! NILP (XPROCESS (proc)->raw_status_low))
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
- error ("Process %s not running", procname);
+ error ("Process %s not running",
+ SDATA (XPROCESS (proc)->name));
if (XINT (XPROCESS (proc)->outfd) < 0)
- error ("Output file descriptor of %s is closed", procname);
+ error ("Output file descriptor of %s is closed",
+ SDATA (XPROCESS (proc)->name));
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
Vlast_coding_system_used = coding->symbol;
+ if ((STRINGP (object) && STRING_MULTIBYTE (object))
+ || (BUFFERP (object)
+ && !NILP (XBUFFER (object)->enable_multibyte_characters))
+ || EQ (object, Qt))
+ {
+ if (!EQ (coding->symbol, XPROCESS (proc)->encode_coding_system))
+ /* The coding system for encoding was changed to raw-text
+ because we sent a unibyte text previously. Now we are
+ sending a multibyte text, thus we must encode it by the
+ original coding system specified for the current
+ process. */
+ setup_coding_system (XPROCESS (proc)->encode_coding_system, coding);
+ /* src_multibyte should be set to 1 _after_ a call to
+ setup_coding_system, since it resets src_multibyte to
+ zero. */
+ coding->src_multibyte = 1;
+ }
+ else
+ {
+ /* For sending a unibyte text, character code conversion should
+ not take place but EOL conversion should. So, setup raw-text
+ or one of the subsidiary if we have not yet done it. */
+ if (coding->type != coding_type_raw_text)
+ {
+ if (CODING_REQUIRE_FLUSHING (coding))
+ {
+ /* But, before changing the coding, we must flush out data. */
+ coding->mode |= CODING_MODE_LAST_BLOCK;
+ send_process (proc, "", 0, Qt);
+ }
+ coding->src_multibyte = 0;
+ setup_raw_text_coding_system (coding);
+ }
+ }
+ coding->dst_multibyte = 0;
+
if (CODING_REQUIRE_ENCODING (coding))
{
int require = encoding_buffer_size (coding, len);
- int offset;
+ int from_byte = -1, from = -1, to = -1;
unsigned char *temp_buf = NULL;
- /* Remember the offset of data because a string or a buffer may
- be relocated. Setting OFFSET to -1 means we don't have to
- care about relocation. */
- offset = (BUFFERP (object)
- ? BUF_PTR_BYTE_POS (XBUFFER (object), buf)
- : (STRINGP (object)
- ? buf - XSTRING (object)->data
- : -1));
-
- if (carryover > 0)
+ if (BUFFERP (object))
{
- temp_buf = (unsigned char *) xmalloc (len + carryover);
-
- if (offset >= 0)
- {
- if (BUFFERP (object))
- buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
- else if (STRINGP (object))
- buf = offset + XSTRING (object)->data;
- /* Now we don't have to care about relocation. */
- offset = -1;
- }
- bcopy ((XSTRING (XPROCESS (proc)->encoding_buf)->data
- + STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf))
- - carryover),
- temp_buf,
- carryover);
- bcopy (buf, temp_buf + carryover, len);
- buf = temp_buf;
+ from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
+ from = buf_bytepos_to_charpos (XBUFFER (object), from_byte);
+ to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len);
}
-
- if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require)
+ else if (STRINGP (object))
{
- XPROCESS (proc)->encoding_buf = make_uninit_string (require);
+ from_byte = buf - SDATA (object);
+ from = string_byte_to_char (object, from_byte);
+ to = string_byte_to_char (object, from_byte + len);
+ }
- if (offset >= 0)
- {
- if (BUFFERP (object))
- buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
- else if (STRINGP (object))
- buf = offset + XSTRING (object)->data;
- }
+ if (coding->composing != COMPOSITION_DISABLED)
+ {
+ if (from_byte >= 0)
+ coding_save_composition (coding, from, to, object);
+ else
+ coding->composing = COMPOSITION_DISABLED;
}
+
+ if (SBYTES (XPROCESS (proc)->encoding_buf) < require)
+ XPROCESS (proc)->encoding_buf = make_uninit_string (require);
+
+ if (from_byte >= 0)
+ buf = (BUFFERP (object)
+ ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
+ : SDATA (object) + from_byte);
+
object = XPROCESS (proc)->encoding_buf;
- encode_coding (coding, buf, XSTRING (object)->data,
- len, STRING_BYTES (XSTRING (object)));
+ encode_coding (coding, (char *) buf, SDATA (object),
+ len, SBYTES (object));
len = coding->produced;
- buf = XSTRING (object)->data;
+ buf = SDATA (object);
if (temp_buf)
xfree (temp_buf);
}
error ("Could not find this process: %x", p->pid);
else if (write_to_vms_process (vs, buf, len))
;
-#else
+#else /* not VMS */
if (pty_max_bytes == 0)
{
pty_max_bytes--;
}
+ /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
+ CFLAGS="-g -O": The value of the parameter `proc' is clobbered
+ when returning with longjmp despite being declared volatile. */
if (!setjmp (send_process_frame))
- while (len > 0)
- {
- int this = len;
- SIGTYPE (*old_sigpipe)();
+ {
+ process_sent_to = proc;
+ while (len > 0)
+ {
+ int this = len;
+ SIGTYPE (*old_sigpipe)();
- /* Decide how much data we can send in one batch.
- Long lines need to be split into multiple batches. */
- if (!NILP (XPROCESS (proc)->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 = buf;
- unsigned char *end = 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;
- }
+ /* Decide how much data we can send in one batch.
+ Long lines need to be split into multiple batches. */
+ if (!NILP (XPROCESS (proc)->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)
- {
- old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
- rv = emacs_write (XINT (XPROCESS (proc)->outfd), buf, this);
- signal (SIGPIPE, old_sigpipe);
+ /* Send this batch, using one or more write calls. */
+ while (this > 0)
+ {
+ int outfd = XINT (XPROCESS (proc)->outfd);
+ old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
+#ifdef DATAGRAM_SOCKETS
+ if (DATAGRAM_CHAN_P (outfd))
+ {
+ rv = sendto (outfd, (char *) buf, this,
+ 0, datagram_address[outfd].sa,
+ datagram_address[outfd].len);
+ if (rv < 0 && errno == EMSGSIZE)
+ report_file_error ("sending datagram", Fcons (proc, Qnil));
+ }
+ else
+#endif
+ rv = emacs_write (outfd, (char *) buf, this);
+ signal (SIGPIPE, old_sigpipe);
- if (rv < 0)
- {
- if (0
+ if (rv < 0)
+ {
+ if (0
#ifdef EWOULDBLOCK
- || errno == EWOULDBLOCK
+ || errno == EWOULDBLOCK
#endif
#ifdef EAGAIN
- || errno == EAGAIN
+ || errno == EAGAIN
#endif
- )
- /* Buffer is full. Wait, accepting input;
- that may allow the program
- to finish doing output and read more. */
- {
- Lisp_Object zero;
- int offset;
-
- /* Running filters might relocate buffers or strings.
- Arrange to relocate BUF. */
- if (BUFFERP (object))
- offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
- else if (STRINGP (object))
- offset = buf - XSTRING (object)->data;
-
- XSETFASTINT (zero, 0);
+ )
+ /* Buffer is full. Wait, accepting input;
+ that may allow the program
+ to finish doing output and read more. */
+ {
+ Lisp_Object zero;
+ int offset = 0;
+
+#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
+ /* A gross hack to work around a bug in FreeBSD.
+ In the following sequence, read(2) returns
+ bogus data:
+
+ write(2) 1022 bytes
+ write(2) 954 bytes, get EAGAIN
+ read(2) 1024 bytes in process_read_output
+ read(2) 11 bytes in process_read_output
+
+ That is, read(2) returns more bytes than have
+ ever been written successfully. The 1033 bytes
+ read are the 1022 bytes written successfully
+ after processing (for example with CRs added if
+ the terminal is set up that way which it is
+ here). The same bytes will be seen again in a
+ later read(2), without the CRs. */
+
+ if (errno == EAGAIN)
+ {
+ int flags = FWRITE;
+ ioctl (XINT (XPROCESS (proc)->outfd), TIOCFLUSH,
+ &flags);
+ }
+#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
+
+ /* Running filters might relocate buffers or strings.
+ Arrange to relocate BUF. */
+ if (BUFFERP (object))
+ offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
+ else if (STRINGP (object))
+ offset = buf - SDATA (object);
+
+ XSETFASTINT (zero, 0);
#ifdef EMACS_HAS_USECS
- wait_reading_process_input (0, 20000, zero, 0);
+ wait_reading_process_input (0, 20000, zero, 0);
#else
- wait_reading_process_input (1, 0, zero, 0);
+ wait_reading_process_input (1, 0, zero, 0);
#endif
- if (BUFFERP (object))
- buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
- else if (STRINGP (object))
- buf = offset + XSTRING (object)->data;
+ if (BUFFERP (object))
+ buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
+ else if (STRINGP (object))
+ buf = offset + SDATA (object);
- rv = 0;
- }
- else
- /* This is a real error. */
- report_file_error ("writing to process", Fcons (proc, Qnil));
- }
- buf += rv;
- len -= rv;
- this -= rv;
- }
+ rv = 0;
+ }
+ else
+ /* This is a real error. */
+ report_file_error ("writing to process", Fcons (proc, Qnil));
+ }
+ buf += rv;
+ len -= rv;
+ this -= rv;
+ }
- /* If we sent just part of the string, put in an EOF
- to force it through, before we send the rest. */
- if (len > 0)
- Fprocess_send_eof (proc);
- }
-#endif
+ /* If we sent just part of the string, put in an EOF
+ to force it through, before we send the rest. */
+ if (len > 0)
+ Fprocess_send_eof (proc);
+ }
+ }
+#endif /* not VMS */
else
{
+#ifndef VMS
+ proc = process_sent_to;
+#endif
XPROCESS (proc)->raw_status_low = Qnil;
XPROCESS (proc)->raw_status_high = Qnil;
XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
XSETINT (XPROCESS (proc)->tick, ++process_tick);
deactivate_process (proc);
#ifdef VMS
- error ("Error writing to process %s; closed it", procname);
+ error ("Error writing to process %s; closed it",
+ SDATA (XPROCESS (proc)->name));
#else
- error ("SIGPIPE raised on process %s; closed it", procname);
+ error ("SIGPIPE raised on process %s; closed it",
+ SDATA (XPROCESS (proc)->name));
#endif
}
}
DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
- 3, 3, 0,
- "Send current contents of region as input to PROCESS.\n\
-PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
-nil, indicating the current buffer's process.\n\
-Called from program, takes three arguments, PROCESS, START and END.\n\
-If the region is more than 500 characters long,\n\
-it is sent in several bunches. This may happen even for shorter regions.\n\
-Output from processes can arrive in between bunches.")
- (process, start, end)
+ 3, 3, 0,
+ doc: /* Send current contents of region as input to PROCESS.
+PROCESS may be a process, a buffer, the name of a process or buffer, or
+nil, indicating the current buffer's process.
+Called from program, takes three arguments, PROCESS, START and END.
+If the region is more than 500 characters long,
+it is sent in several bunches. This may happen even for shorter regions.
+Output from processes can arrive in between bunches. */)
+ (process, start, end)
Lisp_Object process, start, end;
{
Lisp_Object proc;
}
DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
- 2, 2, 0,
- "Send PROCESS the contents of STRING as input.\n\
-PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
-nil, indicating the current buffer's process.\n\
-If STRING is more than 500 characters long,\n\
-it is sent in several bunches. This may happen even for shorter strings.\n\
-Output from processes can arrive in between bunches.")
- (process, string)
+ 2, 2, 0,
+ doc: /* Send PROCESS the contents of STRING as input.
+PROCESS may be a process, a buffer, the name of a process or buffer, or
+nil, indicating the current buffer's process.
+If STRING is more than 500 characters long,
+it is sent in several bunches. This may happen even for shorter strings.
+Output from processes can arrive in between bunches. */)
+ (process, string)
Lisp_Object process, string;
{
Lisp_Object proc;
- CHECK_STRING (string, 1);
+ CHECK_STRING (string);
proc = get_process (process);
- send_process (proc, XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)), string);
+ send_process (proc, SDATA (string),
+ SBYTES (string), string);
return Qnil;
}
\f
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
- "Return t if PROCESS has given the terminal to a child.\n\
-If the operating system does not make it possible to find out,\n\
-return t unconditionally.")
- (process)
+ doc: /* Return t if PROCESS has given the terminal to a child.
+If the operating system does not make it possible to find out,
+return t unconditionally. */)
+ (process)
Lisp_Object process;
{
/* Initialize in case ioctl doesn't exist or gives an error,
if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
- XSTRING (p->name)->data);
+ SDATA (p->name));
-#ifdef TIOCGPGRP
+#ifdef TIOCGPGRP
if (!NILP (p->subtty))
ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
else
if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (NILP (p->pty_flag))
current_group = Qnil;
/* If we are using pgrps, get a pgrp number and make it negative. */
- if (!NILP (current_group))
+ if (NILP (current_group))
+ /* Send the signal to the shell's process group. */
+ gid = XFASTINT (p->pid);
+ else
{
#ifdef SIGNALS_VIA_CHARACTERS
/* If possible, send signals to the entire pgrp
#endif /* ! defined (TCGETA) */
#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
#endif /* ! defined HAVE_TERMIOS */
-#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
+ abort ();
+ /* The code above always returns from the function. */
+#endif /* defined (SIGNALS_VIA_CHARACTERS) */
-#ifdef TIOCGPGRP
- /* Get the pgrp using the tty itself, if we have that.
+#ifdef TIOCGPGRP
+ /* Get the current pgrp using the tty itself, if we have that.
Otherwise, use the pty to get the pgrp.
On pfa systems, saka@pfu.fujitsu.co.JP writes:
"TIOCGPGRP symbol defined in sys/ioctl.h at E50.
else
err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
-#ifdef pfa
if (err == -1)
- gid = - XFASTINT (p->pid);
-#endif /* ! defined (pfa) */
+ /* If we can't get the information, assume
+ the shell owns the tty. */
+ gid = XFASTINT (p->pid);
}
+
+ /* It is not clear whether anything really can set GID to -1.
+ Perhaps on some system one of those ioctls can or could do so.
+ Or perhaps this is vestigial. */
if (gid == -1)
no_pgrp = 1;
- else
- gid = - gid;
#else /* ! defined (TIOCGPGRP ) */
/* Can't select pgrps on this system, so we know that
the child itself heads the pgrp. */
- gid = - XFASTINT (p->pid);
+ gid = XFASTINT (p->pid);
#endif /* ! defined (TIOCGPGRP ) */
/* If current_group is lambda, and the shell owns the terminal,
don't send any signal. */
- if (EQ (current_group, Qlambda) && gid == - XFASTINT (p->pid))
+ if (EQ (current_group, Qlambda) && gid == XFASTINT (p->pid))
return;
}
- else
- gid = - XFASTINT (p->pid);
switch (signo)
{
kill (gid, signo);
}
#else /* ! defined (TIOCSIGSEND) */
- EMACS_KILLPG (-gid, signo);
+ EMACS_KILLPG (gid, signo);
#endif /* ! defined (TIOCSIGSEND) */
}
DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
- "Interrupt process PROCESS.\n\
-PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
-nil or no arg means current buffer's process.\n\
-Second arg CURRENT-GROUP non-nil means send signal to\n\
-the current process-group of the process's controlling terminal\n\
-rather than to the process's own process group.\n\
-If the process is a shell, this means interrupt current subjob\n\
-rather than the shell.\n\
-\n\
-If CURRENT-GROUP is `lambda', and if the shell owns the terminal,\n\
-don't send the signal.")
- (process, current_group)
+ doc: /* Interrupt process PROCESS.
+PROCESS may be a process, a buffer, or the name of a process or buffer.
+nil or no arg means current buffer's process.
+Second arg CURRENT-GROUP non-nil means send signal to
+the current process-group of the process's controlling terminal
+rather than to the process's own process group.
+If the process is a shell, this means interrupt current subjob
+rather than the shell.
+
+If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
+don't send the signal. */)
+ (process, current_group)
Lisp_Object process, current_group;
{
process_send_signal (process, SIGINT, current_group, 0);
}
DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
- "Kill process PROCESS. May be process or name of one.\n\
-See function `interrupt-process' for more details on usage.")
- (process, current_group)
+ doc: /* Kill process PROCESS. May be process or name of one.
+See function `interrupt-process' for more details on usage. */)
+ (process, current_group)
Lisp_Object process, current_group;
{
process_send_signal (process, SIGKILL, current_group, 0);
}
DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
- "Send QUIT signal to process PROCESS. May be process or name of one.\n\
-See function `interrupt-process' for more details on usage.")
- (process, current_group)
+ doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
+See function `interrupt-process' for more details on usage. */)
+ (process, current_group)
Lisp_Object process, current_group;
{
process_send_signal (process, SIGQUIT, current_group, 0);
}
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
- "Stop process PROCESS. May be process or name of one.\n\
-See function `interrupt-process' for more details on usage.")
- (process, current_group)
+ 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. */)
+ (process, current_group)
Lisp_Object process, current_group;
{
+#ifdef HAVE_SOCKETS
+ if (PROCESSP (process) && NETCONN_P (process))
+ {
+ struct Lisp_Process *p;
+
+ p = XPROCESS (process);
+ if (NILP (p->command)
+ && XINT (p->infd) >= 0)
+ {
+ FD_CLR (XINT (p->infd), &input_wait_mask);
+ FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ p->command = Qt;
+ return process;
+ }
+#endif
#ifndef SIGTSTP
error ("no SIGTSTP support");
#else
}
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
- "Continue process PROCESS. May be process or name of one.\n\
-See function `interrupt-process' for more details on usage.")
- (process, current_group)
+ 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. */)
+ (process, current_group)
Lisp_Object process, current_group;
{
+#ifdef HAVE_SOCKETS
+ if (PROCESSP (process) && NETCONN_P (process))
+ {
+ struct Lisp_Process *p;
+
+ p = XPROCESS (process);
+ if (EQ (p->command, Qt)
+ && XINT (p->infd) >= 0
+ && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ p->command = Qnil;
+ return process;
+ }
+#endif
#ifdef SIGCONT
process_send_signal (process, SIGCONT, current_group, 0);
#else
}
DEFUN ("signal-process", Fsignal_process, Ssignal_process,
- 2, 2, "nProcess number: \nnSignal code: ",
- "Send the process with process id PID the signal with code SIGCODE.\n\
-PID must be an integer. The process need not be a child of this Emacs.\n\
-SIGCODE may be an integer, or a symbol whose name is a signal name.")
- (pid, sigcode)
- Lisp_Object pid, sigcode;
+ 2, 2, "sProcess (name or number): \nnSignal code: ",
+ doc: /* Send PROCESS the signal with code SIGCODE.
+PROCESS may also be an integer specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
+SIGCODE may be an integer, or a symbol whose name is a signal name. */)
+ (process, sigcode)
+ Lisp_Object process, sigcode;
{
- CHECK_NUMBER (pid, 0);
+ Lisp_Object pid;
+
+ if (INTEGERP (process))
+ {
+ pid = process;
+ goto got_it;
+ }
+
+ if (STRINGP (process))
+ {
+ Lisp_Object tem;
+ if (tem = Fget_process (process), NILP (tem))
+ {
+ pid = Fstring_to_number (process, make_number (10));
+ if (XINT (pid) != 0)
+ goto got_it;
+ }
+ process = tem;
+ }
+ else
+ process = get_process (process);
+
+ if (NILP (process))
+ return process;
+
+ CHECK_PROCESS (process);
+ pid = XPROCESS (process)->pid;
+ if (!INTEGERP (pid) || XINT (pid) <= 0)
+ error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
+
+ got_it:
#define handle_signal(NAME, VALUE) \
else if (!strcmp (name, NAME)) \
{
unsigned char *name;
- CHECK_SYMBOL (sigcode, 1);
- name = XSYMBOL (sigcode)->name->data;
+ CHECK_SYMBOL (sigcode);
+ name = SDATA (SYMBOL_NAME (sigcode));
if (0)
;
}
DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
- "Make PROCESS see end-of-file in its input.\n\
-EOF comes after any text already sent to it.\n\
-PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
-nil, indicating the current buffer's process.\n\
-If PROCESS is a network connection, or is a process communicating\n\
-through a pipe (as opposed to a pty), then you cannot send any more\n\
-text to PROCESS after you call this function.")
- (process)
+ doc: /* Make PROCESS see end-of-file in its input.
+EOF comes after any text already sent to it.
+PROCESS may be a process, a buffer, the name of a process or buffer, or
+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. */)
+ (process)
Lisp_Object process;
{
Lisp_Object proc;
struct coding_system *coding;
+ if (DATAGRAM_CONN_P (process))
+ return process;
+
proc = get_process (process);
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
if (! NILP (XPROCESS (proc)->raw_status_low))
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
- error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+ error ("Process %s not running", SDATA (XPROCESS (proc)->name));
if (CODING_REQUIRE_FLUSHING (coding))
{
}
/* Kill all processes associated with `buffer'.
- If `buffer' is nil, kill all processes */
+ If `buffer' is nil, kill all processes */
void
kill_buffer_processes (buffer)
}
}
\f
-/* On receipt of a signal that a child status has changed,
- loop asking about children with changed statuses until
- the system says there are no more.
- All we do is change the status;
- we do not run sentinels or print notifications.
- That is saved for the next time keyboard input is done,
- in order to avoid timing errors. */
-
-/** WARNING: this can be called during garbage collection.
- Therefore, it must not be fooled by the presence of mark bits in
- Lisp objects. */
-
-/** USG WARNING: Although it is not obvious from the documentation
- in signal(2), on a USG system the SIGCLD handler MUST NOT call
- signal() before executing at least one wait(), otherwise the handler
- will be called again, resulting in an infinite loop. The relevant
- portion of the documentation reads "SIGCLD signals will be queued
- and the signal-catching function will be continually reentered until
- the queue is empty". Invoking signal() causes the kernel to reexamine
- the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
+/* On receipt of a signal that a child status has changed, loop asking
+ about children with changed statuses until the system says there
+ are no more.
+
+ All we do is change the status; we do not run sentinels or print
+ notifications. That is saved for the next time keyboard input is
+ done, in order to avoid timing errors.
+
+ ** WARNING: this can be called during garbage collection.
+ Therefore, it must not be fooled by the presence of mark bits in
+ Lisp objects.
+
+ ** USG WARNING: Although it is not obvious from the documentation
+ in signal(2), on a USG system the SIGCLD handler MUST NOT call
+ signal() before executing at least one wait(), otherwise the
+ handler will be called again, resulting in an infinite loop. The
+ relevant portion of the documentation reads "SIGCLD signals will be
+ queued and the signal-catching function will be continually
+ reentered until the queue is empty". Invoking signal() causes the
+ kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
+ Inc. */
SIGTYPE
sigchld_handler (signo)
#define WUNTRACED 0
#endif /* no WUNTRACED */
/* Keep trying to get a status until we get a definitive result. */
- do
+ do
{
errno = 0;
pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
}
- while (pid <= 0 && errno == EINTR);
+ while (pid < 0 && errno == EINTR);
if (pid <= 0)
{
- /* A real failure. We have done all our job, so return. */
+ /* 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 */
/* Find the process that signaled us, and record its status. */
p = 0;
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
+ for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
- if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
+ if (GC_EQ (p->childp, Qt) && XINT (p->pid) == pid)
break;
p = 0;
}
/* Look for an asynchronous process whose pid hasn't been filled
in yet. */
if (p == 0)
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
+ for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
- if (INTEGERP (p->pid) && XINT (p->pid) == -1)
+ if (GC_INTEGERP (p->pid) && XINT (p->pid) == -1)
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;
-
+
XSETINT (p->tick, ++process_tick);
u.wt = w;
XSETINT (p->raw_status_low, u.i & 0xffff);
XSETINT (p->raw_status_high, u.i >> 16);
-
+
/* If process has terminated, stop waiting for its output. */
if ((WIFSIGNALED (w) || WIFEXITED (w))
&& XINT (p->infd) >= 0)
get another signal.
Otherwise (on systems that have WNOHANG), loop around
to use up all the processes that have something to tell us. */
-#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
+#if (defined WINDOWSNT \
+ || (defined USG && !defined GNU_LINUX \
+ && !(defined HPUX && defined WNOHANG)))
#if defined (USG) && ! defined (POSIX_SIGNALS)
signal (signo, sigchld_handler);
#endif
Vinhibit_quit = Qt;
update_echo_area ();
Fsleep_for (make_number (2), Qnil);
+ return Qt;
}
static void
{
Lisp_Object sentinel, obuffer, odeactivate, okeymap;
register struct Lisp_Process *p = XPROCESS (proc);
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
/* Report all recent events of a change in process status
(either run the sentinel or output a message).
- This is done while Emacs is waiting for keyboard input. */
+ This is usually done while Emacs is waiting for keyboard input
+ but can be done at other times. */
void
status_notify ()
/* If process is still active, read any output that remains. */
while (! EQ (p->filter, Qt)
+ && ! EQ (p->status, Qconnect)
+ && ! EQ (p->status, Qlisten)
+ && ! EQ (p->command, Qt) /* Network process not stopped. */
&& XINT (p->infd) >= 0
&& read_process_output (proc, XINT (p->infd)) > 0);
} /* end for */
update_mode_lines++; /* in case buffers use %s in mode-line-format */
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (13);
UNGCPRO;
}
\f
DEFUN ("set-process-coding-system", Fset_process_coding_system,
Sset_process_coding_system, 1, 3, 0,
- "Set coding systems of PROCESS to DECODING and ENCODING.\n\
-DECODING will be used to decode subprocess output and ENCODING to\n\
-encode subprocess input.")
- (proc, decoding, encoding)
+ doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
+DECODING will be used to decode subprocess output and ENCODING to
+encode subprocess input. */)
+ (proc, decoding, encoding)
register Lisp_Object proc, decoding, encoding;
{
register struct Lisp_Process *p;
- CHECK_PROCESS (proc, 0);
+ CHECK_PROCESS (proc);
p = XPROCESS (proc);
if (XINT (p->infd) < 0)
- error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
+ error ("Input file descriptor of %s closed", SDATA (p->name));
if (XINT (p->outfd) < 0)
- error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
+ error ("Output file descriptor of %s closed", SDATA (p->name));
+ Fcheck_coding_system (decoding);
+ Fcheck_coding_system (encoding);
- p->decode_coding_system = Fcheck_coding_system (decoding);
- p->encode_coding_system = Fcheck_coding_system (encoding);
- setup_coding_system (decoding,
- proc_decode_coding_system[XINT (p->infd)]);
- setup_coding_system (encoding,
- proc_encode_coding_system[XINT (p->outfd)]);
+ p->decode_coding_system = decoding;
+ p->encode_coding_system = encoding;
+ setup_process_coding_systems (proc);
return Qnil;
}
DEFUN ("process-coding-system",
Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
- "Return a cons of coding systems for decoding and encoding of PROCESS.")
- (proc)
+ doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
+ (proc)
register Lisp_Object proc;
{
- CHECK_PROCESS (proc, 0);
+ CHECK_PROCESS (proc);
return Fcons (XPROCESS (proc)->decode_coding_system,
XPROCESS (proc)->encode_coding_system);
}
+
+DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
+ Sset_process_filter_multibyte, 2, 2, 0,
+ doc: /* Set multibyteness of the strings given to PROCESS's filter.
+If FLAG is non-nil, the filter is given multibyte strings.
+If FLAG is nil, the filter is given unibyte strings. In this case,
+all character code conversion except for end-of-line conversion is
+suppressed. */)
+ (proc, flag)
+ Lisp_Object proc, flag;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+ p->filter_multibyte = flag;
+ setup_process_coding_systems (proc);
+
+ return Qnil;
+}
+
+DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
+ Sprocess_filter_multibyte_p, 1, 1, 0,
+ doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
+ (proc)
+ Lisp_Object proc;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+
+ return (NILP (p->filter_multibyte) ? Qnil : Qt);
+}
+
+
\f
/* The first time this is called, assume keyboard input comes from DESC
instead of from where we used to expect it.
}
bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+#ifdef DATAGRAM_SOCKETS
+ bzero (datagram_address, sizeof datagram_address);
+#endif
+
+#ifdef HAVE_SOCKETS
+ {
+ Lisp_Object subfeatures = Qnil;
+#define ADD_SUBFEATURE(key, val) \
+ subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
- Vdefault_process_coding_system
- = (NILP (buffer_defaults.enable_multibyte_characters)
- ? Fcons (Qraw_text, Qnil)
- : Fcons (Qemacs_mule, Qnil));
+#ifdef NON_BLOCKING_CONNECT
+ ADD_SUBFEATURE (QCnowait, Qt);
+#endif
+#ifdef DATAGRAM_SOCKETS
+ ADD_SUBFEATURE (QCtype, Qdatagram);
+#endif
+#ifdef HAVE_LOCAL_SOCKETS
+ ADD_SUBFEATURE (QCfamily, Qlocal);
+#endif
+#ifdef HAVE_GETSOCKNAME
+ ADD_SUBFEATURE (QCservice, Qt);
+#endif
+#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
+ ADD_SUBFEATURE (QCserver, Qt);
+#endif
+#ifdef SO_BINDTODEVICE
+ ADD_SUBFEATURE (QCoptions, intern ("bindtodevice"));
+#endif
+#ifdef SO_BROADCAST
+ ADD_SUBFEATURE (QCoptions, intern ("broadcast"));
+#endif
+#ifdef SO_DONTROUTE
+ ADD_SUBFEATURE (QCoptions, intern ("dontroute"));
+#endif
+#ifdef SO_KEEPALIVE
+ ADD_SUBFEATURE (QCoptions, intern ("keepalive"));
+#endif
+#ifdef SO_LINGER
+ ADD_SUBFEATURE (QCoptions, intern ("linger"));
+#endif
+#ifdef SO_OOBINLINE
+ ADD_SUBFEATURE (QCoptions, intern ("oobinline"));
+#endif
+#ifdef SO_PRIORITY
+ ADD_SUBFEATURE (QCoptions, intern ("priority"));
+#endif
+#ifdef SO_REUSEADDR
+ ADD_SUBFEATURE (QCoptions, intern ("reuseaddr"));
+#endif
+ Fprovide (intern ("make-network-process"), subfeatures);
+ }
+#endif /* HAVE_SOCKETS */
}
void
staticpro (&Qopen);
Qclosed = intern ("closed");
staticpro (&Qclosed);
+ Qconnect = intern ("connect");
+ staticpro (&Qconnect);
+ Qfailed = intern ("failed");
+ staticpro (&Qfailed);
+ Qlisten = intern ("listen");
+ staticpro (&Qlisten);
+ Qlocal = intern ("local");
+ staticpro (&Qlocal);
+ Qdatagram = intern ("datagram");
+ staticpro (&Qdatagram);
+
+ QCname = intern (":name");
+ staticpro (&QCname);
+ QCbuffer = intern (":buffer");
+ staticpro (&QCbuffer);
+ QChost = intern (":host");
+ staticpro (&QChost);
+ QCservice = intern (":service");
+ staticpro (&QCservice);
+ QCtype = intern (":type");
+ staticpro (&QCtype);
+ QClocal = intern (":local");
+ staticpro (&QClocal);
+ QCremote = intern (":remote");
+ staticpro (&QCremote);
+ QCcoding = intern (":coding");
+ staticpro (&QCcoding);
+ QCserver = intern (":server");
+ staticpro (&QCserver);
+ QCnowait = intern (":nowait");
+ staticpro (&QCnowait);
+ QCsentinel = intern (":sentinel");
+ staticpro (&QCsentinel);
+ QClog = intern (":log");
+ staticpro (&QClog);
+ QCnoquery = intern (":noquery");
+ staticpro (&QCnoquery);
+ QCstop = intern (":stop");
+ staticpro (&QCstop);
+ QCoptions = intern (":options");
+ staticpro (&QCoptions);
+ QCplist = intern (":plist");
+ staticpro (&QCplist);
+ QCfilter_multibyte = intern (":filter-multibyte");
+ staticpro (&QCfilter_multibyte);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
staticpro (&Vprocess_alist);
DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
- "*Non-nil means delete processes immediately when they exit.\n\
-nil means don't delete them until `list-processes' is run.");
+ doc: /* *Non-nil means delete processes immediately when they exit.
+nil means don't delete them until `list-processes' is run. */);
delete_exited_processes = 1;
DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
- "Control type of device used to communicate with subprocesses.\n\
-Values are nil to use a pipe, or t or `pty' to use a pty.\n\
-The value has no effect if the system has no ptys or if all ptys are busy:\n\
-then a pipe is used in any case.\n\
-The value takes effect when `start-process' is called.");
+ doc: /* Control type of device used to communicate with subprocesses.
+Values are nil to use a pipe, or t or `pty' to use a pty.
+The value has no effect if the system has no ptys or if all ptys are busy:
+then a pipe is used in any case.
+The value takes effect when `start-process' is called. */);
Vprocess_connection_type = Qt;
defsubr (&Sprocessp);
defsubr (&Sset_process_window_size);
defsubr (&Sset_process_inherit_coding_system_flag);
defsubr (&Sprocess_inherit_coding_system_flag);
- defsubr (&Sprocess_kill_without_query);
+ defsubr (&Sset_process_query_on_exit_flag);
+ defsubr (&Sprocess_query_on_exit_flag);
defsubr (&Sprocess_contact);
+ defsubr (&Sprocess_plist);
+ defsubr (&Sset_process_plist);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
- defsubr (&Sopen_network_stream);
+ defsubr (&Sset_network_process_options);
+ defsubr (&Smake_network_process);
+ defsubr (&Sformat_network_address);
#endif /* HAVE_SOCKETS */
+#ifdef DATAGRAM_SOCKETS
+ defsubr (&Sprocess_datagram_address);
+ defsubr (&Sset_process_datagram_address);
+#endif
defsubr (&Saccept_process_output);
defsubr (&Sprocess_send_region);
defsubr (&Sprocess_send_string);
/* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
+ defsubr (&Sset_process_filter_multibyte);
+ defsubr (&Sprocess_filter_multibyte_p);
}
\f
extern EMACS_TIME timer_check ();
extern int timers_run;
+Lisp_Object QCtype;
+
/* As described above, except assuming that there are no subprocesses:
Wait for timeout to elapse and/or keyboard input to be available.
EMACS_TIME end_time, timeout;
SELECT_TYPE waitchannels;
int xerrno;
- Lisp_Object *wait_for_cell = 0;
+ /* Either nil or a cons cell, the car of which is of interest and
+ may be changed outside of this routine. */
+ Lisp_Object wait_for_cell;
+
+ wait_for_cell = Qnil;
/* If waiting for non-nil in a cell, record where. */
if (CONSP (read_kbd))
{
- wait_for_cell = &XCAR (read_kbd);
+ wait_for_cell = read_kbd;
XSETFASTINT (read_kbd, 0);
}
}
/* Turn off periodic alarms (in case they are in use)
+ and then turn off any other atimers,
because the select emulator uses alarms. */
+ stop_polling ();
turn_on_atimers (0);
while (1)
QUIT;
/* Exit now if the cell we're waiting for became non-nil. */
- if (wait_for_cell && ! NILP (*wait_for_cell))
+ if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
/* Compute time from now till when time limit is up */
run timer events directly.
(Callers that will immediately read keyboard events
call timer_delay on their own.) */
- if (! wait_for_cell)
+ if (NILP (wait_for_cell))
{
EMACS_TIME timer_delay;
- int old_timers_run;
- retry:
- old_timers_run = timers_run;
- timer_delay = timer_check (1);
- if (timers_run != old_timers_run && do_display)
+ do
{
- redisplay_preserve_echo_area ();
- /* We must retry, since a timer may have requeued itself
- and that could alter the time delay. */
- goto retry;
+ int old_timers_run = timers_run;
+ timer_delay = timer_check (1);
+ if (timers_run != old_timers_run && do_display)
+ /* We must retry, since a timer may have requeued itself
+ and that could alter the time delay. */
+ redisplay_preserve_echo_area (14);
+ else
+ break;
}
+ while (!detect_input_pending ());
/* If there is unread keyboard input, also return. */
if (XINT (read_kbd) != 0
/* Wait till there is something to do. */
- if (! XINT (read_kbd) && wait_for_cell == 0)
+ if (! XINT (read_kbd) && NILP (wait_for_cell))
FD_ZERO (&waitchannels);
else
FD_SET (0, &waitchannels);
if (frame_garbaged && do_display)
{
clear_waiting_for_input ();
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (15);
if (XINT (read_kbd) < 0)
set_waiting_for_input (&timeout);
}
input at all when wait_for_cell, but the code
has been this way since July 1994.
Try changing this after version 19.31.) */
- if (wait_for_cell
+ if (! NILP (wait_for_cell)
&& detect_input_pending ())
{
swallow_events (do_display);
}
/* Exit now if the cell we're waiting for became non-nil. */
- if (wait_for_cell && ! NILP (*wait_for_cell))
+ if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
}
}
+/* Don't confuse make-docfile by having two doc strings for this function.
+ make-docfile does not pay attention to #if, for good reason! */
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
- /* Don't confuse make-docfile by having two doc strings for this function.
- make-docfile does not pay attention to #if, for good reason! */
- 0)
- (name)
+ 0)
+ (name)
register Lisp_Object name;
{
return Qnil;
}
-DEFUN ("process-inherit-coding-system-flag",
- Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
- 1, 1, 0,
/* Don't confuse make-docfile by having two doc strings for this function.
make-docfile does not pay attention to #if, for good reason! */
- 0)
- (process)
+DEFUN ("process-inherit-coding-system-flag",
+ Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
+ 1, 1, 0,
+ 0)
+ (process)
register Lisp_Object process;
{
/* Ignore the argument and return the value of
void
syms_of_process ()
{
+ QCtype = intern (":type");
+ staticpro (&QCtype);
+
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_inherit_coding_system_flag);
}