HCoop / bpt / emacs.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
(Foverlay_buffer): Add EXFUN.
[bpt/emacs.git] / src / process.c
... / ...
CommitLineData
1/* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1996, 1998, 1999, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 3, or (at your option)
11any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21Boston, MA 02110-1301, USA. */
22
23
24#include <config.h>
25#include <signal.h>
26
27/* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
33
34\f
35#ifdef subprocesses
36
37#include <stdio.h>
38#include <errno.h>
39#include <setjmp.h>
40#include <sys/types.h> /* some typedefs are used in sys/file.h */
41#include <sys/file.h>
42#include <sys/stat.h>
43#ifdef HAVE_INTTYPES_H
44#include <inttypes.h>
45#endif
46#ifdef HAVE_UNISTD_H
47#include <unistd.h>
48#endif
49
50#if defined(WINDOWSNT) || defined(UNIX98_PTYS)
51#include <stdlib.h>
52#include <fcntl.h>
53#endif /* not WINDOWSNT */
54
55#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
56#include <sys/socket.h>
57#include <netdb.h>
58#include <netinet/in.h>
59#include <arpa/inet.h>
60#ifdef NEED_NET_ERRNO_H
61#include <net/errno.h>
62#endif /* NEED_NET_ERRNO_H */
63
64/* Are local (unix) sockets supported? */
65#if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
66#if !defined (AF_LOCAL) && defined (AF_UNIX)
67#define AF_LOCAL AF_UNIX
68#endif
69#ifdef AF_LOCAL
70#define HAVE_LOCAL_SOCKETS
71#include <sys/un.h>
72#endif
73#endif
74#endif /* HAVE_SOCKETS */
75
76/* TERM is a poor-man's SLIP, used on GNU/Linux. */
77#ifdef TERM
78#include <client.h>
79#endif
80
81/* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
82#ifdef HAVE_BROKEN_INET_ADDR
83#define IN_ADDR struct in_addr
84#define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
85#else
86#define IN_ADDR unsigned long
87#define NUMERIC_ADDR_ERROR (numeric_addr == -1)
88#endif
89
90#if defined(BSD_SYSTEM) || defined(STRIDE)
91#include <sys/ioctl.h>
92#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
93#include <fcntl.h>
94#endif /* HAVE_PTYS and no O_NDELAY */
95#endif /* BSD_SYSTEM || STRIDE */
96
97#ifdef BROKEN_O_NONBLOCK
98#undef O_NONBLOCK
99#endif /* BROKEN_O_NONBLOCK */
100
101#ifdef NEED_BSDTTY
102#include <bsdtty.h>
103#endif
104
105/* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
106#ifdef HAVE_SOCKETS
107#if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
108/* sys/ioctl.h may have been included already */
109#ifndef SIOCGIFADDR
110#include <sys/ioctl.h>
111#endif
112#include <net/if.h>
113#endif
114#endif
115
116#ifdef IRIS
117#include <sys/sysmacros.h> /* for "minor" */
118#endif /* not IRIS */
119
120#ifdef HAVE_SYS_WAIT
121#include <sys/wait.h>
122#endif
123
124/* Disable IPv6 support for w32 until someone figures out how to do it
125 properly. */
126#ifdef WINDOWSNT
127# ifdef AF_INET6
128# undef AF_INET6
129# endif
130#endif
131
132#include "lisp.h"
133#include "systime.h"
134#include "systty.h"
135
136#include "window.h"
137#include "buffer.h"
138#include "charset.h"
139#include "coding.h"
140#include "process.h"
141#include "termhooks.h"
142#include "termopts.h"
143#include "commands.h"
144#include "keyboard.h"
145#include "frame.h"
146#include "blockinput.h"
147#include "dispextern.h"
148#include "composite.h"
149#include "atimer.h"
150
151Lisp_Object Qprocessp;
152Lisp_Object Qrun, Qstop, Qsignal;
153Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
154Lisp_Object Qlocal, Qipv4, Qdatagram;
155#ifdef AF_INET6
156Lisp_Object Qipv6;
157#endif
158Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
159Lisp_Object QClocal, QCremote, QCcoding;
160Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
161Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
162Lisp_Object QCfilter_multibyte;
163Lisp_Object Qlast_nonmenu_event;
164/* QCfamily is declared and initialized in xfaces.c,
165 QCfilter in keyboard.c. */
166extern Lisp_Object QCfamily, QCfilter;
167
168/* Qexit is declared and initialized in eval.c. */
169
170/* QCfamily is defined in xfaces.c. */
171extern Lisp_Object QCfamily;
172/* QCfilter is defined in keyboard.c. */
173extern Lisp_Object QCfilter;
174
175/* a process object is a network connection when its childp field is neither
176 Qt nor Qnil but is instead a property list (KEY VAL ...). */
177
178#ifdef HAVE_SOCKETS
179#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
180#define NETCONN1_P(p) (GC_CONSP ((p)->childp))
181#else
182#define NETCONN_P(p) 0
183#define NETCONN1_P(p) 0
184#endif /* HAVE_SOCKETS */
185
186/* Define first descriptor number available for subprocesses. */
187#ifdef VMS
188#define FIRST_PROC_DESC 1
189#else /* Not VMS */
190#define FIRST_PROC_DESC 3
191#endif
192
193/* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
194 testing SIGCHLD. */
195
196#if !defined (SIGCHLD) && defined (SIGCLD)
197#define SIGCHLD SIGCLD
198#endif /* SIGCLD */
199
200#include "syssignal.h"
201
202#include "syswait.h"
203
204extern char *get_operating_system_release ();
205
206#ifndef USE_CRT_DLL
207extern int errno;
208#endif
209#ifdef VMS
210extern char *sys_errlist[];
211#endif
212
213#ifndef HAVE_H_ERRNO
214extern int h_errno;
215#endif
216
217/* t means use pty, nil means use a pipe,
218 maybe other values to come. */
219static Lisp_Object Vprocess_connection_type;
220
221#ifdef SKTPAIR
222#ifndef HAVE_SOCKETS
223#include <sys/socket.h>
224#endif
225#endif /* SKTPAIR */
226
227/* These next two vars are non-static since sysdep.c uses them in the
228 emulation of `select'. */
229/* Number of events of change of status of a process. */
230int process_tick;
231/* Number of events for which the user or sentinel has been notified. */
232int update_tick;
233
234/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
235
236#ifdef BROKEN_NON_BLOCKING_CONNECT
237#undef NON_BLOCKING_CONNECT
238#else
239#ifndef NON_BLOCKING_CONNECT
240#ifdef HAVE_SOCKETS
241#ifdef HAVE_SELECT
242#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
243#if defined (O_NONBLOCK) || defined (O_NDELAY)
244#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
245#define NON_BLOCKING_CONNECT
246#endif /* EWOULDBLOCK || EINPROGRESS */
247#endif /* O_NONBLOCK || O_NDELAY */
248#endif /* HAVE_GETPEERNAME || GNU_LINUX */
249#endif /* HAVE_SELECT */
250#endif /* HAVE_SOCKETS */
251#endif /* NON_BLOCKING_CONNECT */
252#endif /* BROKEN_NON_BLOCKING_CONNECT */
253
254/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
255 this system. We need to read full packets, so we need a
256 "non-destructive" select. So we require either native select,
257 or emulation of select using FIONREAD. */
258
259#ifdef BROKEN_DATAGRAM_SOCKETS
260#undef DATAGRAM_SOCKETS
261#else
262#ifndef DATAGRAM_SOCKETS
263#ifdef HAVE_SOCKETS
264#if defined (HAVE_SELECT) || defined (FIONREAD)
265#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
266#define DATAGRAM_SOCKETS
267#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
268#endif /* HAVE_SELECT || FIONREAD */
269#endif /* HAVE_SOCKETS */
270#endif /* DATAGRAM_SOCKETS */
271#endif /* BROKEN_DATAGRAM_SOCKETS */
272
273#ifdef TERM
274#undef NON_BLOCKING_CONNECT
275#undef DATAGRAM_SOCKETS
276#endif
277
278#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
279#ifdef EMACS_HAS_USECS
280#define ADAPTIVE_READ_BUFFERING
281#endif
282#endif
283
284#ifdef ADAPTIVE_READ_BUFFERING
285#define READ_OUTPUT_DELAY_INCREMENT 10000
286#define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
287#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
288
289/* Number of processes which have a non-zero read_output_delay,
290 and therefore might be delayed for adaptive read buffering. */
291
292static int process_output_delay_count;
293
294/* Non-zero if any process has non-nil read_output_skip. */
295
296static int process_output_skip;
297
298/* Non-nil means to delay reading process output to improve buffering.
299 A value of t means that delay is reset after each send, any other
300 non-nil value does not reset the delay. A value of nil disables
301 adaptive read buffering completely. */
302static Lisp_Object Vprocess_adaptive_read_buffering;
303#else
304#define process_output_delay_count 0
305#endif
306
307
308#include "sysselect.h"
309
310static int keyboard_bit_set P_ ((SELECT_TYPE *));
311static void deactivate_process P_ ((Lisp_Object));
312static void status_notify P_ ((struct Lisp_Process *));
313static int read_process_output P_ ((Lisp_Object, int));
314
315/* If we support a window system, turn on the code to poll periodically
316 to detect C-g. It isn't actually used when doing interrupt input. */
317#ifdef HAVE_WINDOW_SYSTEM
318#define POLL_FOR_INPUT
319#endif
320
321static Lisp_Object get_process ();
322static void exec_sentinel ();
323
324extern EMACS_TIME timer_check ();
325extern int timers_run;
326\f
327/* Mask of bits indicating the descriptors that we wait for input on. */
328
329static SELECT_TYPE input_wait_mask;
330
331/* Mask that excludes keyboard input descriptor (s). */
332
333static SELECT_TYPE non_keyboard_wait_mask;
334
335/* Mask that excludes process input descriptor (s). */
336
337static SELECT_TYPE non_process_wait_mask;
338
339#ifdef NON_BLOCKING_CONNECT
340/* Mask of bits indicating the descriptors that we wait for connect to
341 complete on. Once they complete, they are removed from this mask
342 and added to the input_wait_mask and non_keyboard_wait_mask. */
343
344static SELECT_TYPE connect_wait_mask;
345
346/* Number of bits set in connect_wait_mask. */
347static int num_pending_connects;
348
349#define IF_NON_BLOCKING_CONNECT(s) s
350#else
351#define IF_NON_BLOCKING_CONNECT(s)
352#endif
353
354/* The largest descriptor currently in use for a process object. */
355static int max_process_desc;
356
357/* The largest descriptor currently in use for keyboard input. */
358static int max_keyboard_desc;
359
360/* Nonzero means delete a process right away if it exits. */
361static int delete_exited_processes;
362
363/* Indexed by descriptor, gives the process (if any) for that descriptor */
364Lisp_Object chan_process[MAXDESC];
365
366/* Alist of elements (NAME . PROCESS) */
367Lisp_Object Vprocess_alist;
368
369/* Buffered-ahead input char from process, indexed by channel.
370 -1 means empty (no char is buffered).
371 Used on sys V where the only way to tell if there is any
372 output from the process is to read at least one char.
373 Always -1 on systems that support FIONREAD. */
374
375/* Don't make static; need to access externally. */
376int proc_buffered_char[MAXDESC];
377
378/* Table of `struct coding-system' for each process. */
379static struct coding_system *proc_decode_coding_system[MAXDESC];
380static struct coding_system *proc_encode_coding_system[MAXDESC];
381
382#ifdef DATAGRAM_SOCKETS
383/* Table of `partner address' for datagram sockets. */
384struct sockaddr_and_len {
385 struct sockaddr *sa;
386 int len;
387} datagram_address[MAXDESC];
388#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
389#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
390#else
391#define DATAGRAM_CHAN_P(chan) (0)
392#define DATAGRAM_CONN_P(proc) (0)
393#endif
394
395/* Maximum number of bytes to send to a pty without an eof. */
396static int pty_max_bytes;
397
398/* Nonzero means don't run process sentinels. This is used
399 when exiting. */
400int inhibit_sentinels;
401
402#ifdef HAVE_PTYS
403#ifdef HAVE_PTY_H
404#include <pty.h>
405#endif
406/* The file name of the pty opened by allocate_pty. */
407
408static char pty_name[24];
409#endif
410\f
411/* Compute the Lisp form of the process status, p->status, from
412 the numeric status that was returned by `wait'. */
413
414static Lisp_Object status_convert ();
415
416static void
417update_status (p)
418 struct Lisp_Process *p;
419{
420 union { int i; WAITTYPE wt; } u;
421 eassert (p->raw_status_new);
422 u.i = p->raw_status;
423 p->status = status_convert (u.wt);
424 p->raw_status_new = 0;
425}
426
427/* Convert a process status word in Unix format to
428 the list that we use internally. */
429
430static Lisp_Object
431status_convert (w)
432 WAITTYPE w;
433{
434 if (WIFSTOPPED (w))
435 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
436 else if (WIFEXITED (w))
437 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
438 WCOREDUMP (w) ? Qt : Qnil));
439 else if (WIFSIGNALED (w))
440 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
441 WCOREDUMP (w) ? Qt : Qnil));
442 else
443 return Qrun;
444}
445
446/* Given a status-list, extract the three pieces of information
447 and store them individually through the three pointers. */
448
449static void
450decode_status (l, symbol, code, coredump)
451 Lisp_Object l;
452 Lisp_Object *symbol;
453 int *code;
454 int *coredump;
455{
456 Lisp_Object tem;
457
458 if (SYMBOLP (l))
459 {
460 *symbol = l;
461 *code = 0;
462 *coredump = 0;
463 }
464 else
465 {
466 *symbol = XCAR (l);
467 tem = XCDR (l);
468 *code = XFASTINT (XCAR (tem));
469 tem = XCDR (tem);
470 *coredump = !NILP (tem);
471 }
472}
473
474/* Return a string describing a process status list. */
475
476static Lisp_Object
477status_message (p)
478 struct Lisp_Process *p;
479{
480 Lisp_Object status = p->status;
481 Lisp_Object symbol;
482 int code, coredump;
483 Lisp_Object string, string2;
484
485 decode_status (status, &symbol, &code, &coredump);
486
487 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
488 {
489 char *signame;
490 synchronize_system_messages_locale ();
491 signame = strsignal (code);
492 if (signame == 0)
493 signame = "unknown";
494 string = build_string (signame);
495 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
496 SSET (string, 0, DOWNCASE (SREF (string, 0)));
497 return concat2 (string, string2);
498 }
499 else if (EQ (symbol, Qexit))
500 {
501 if (NETCONN1_P (p))
502 return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
503 if (code == 0)
504 return build_string ("finished\n");
505 string = Fnumber_to_string (make_number (code));
506 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
507 return concat3 (build_string ("exited abnormally with code "),
508 string, string2);
509 }
510 else if (EQ (symbol, Qfailed))
511 {
512 string = Fnumber_to_string (make_number (code));
513 string2 = build_string ("\n");
514 return concat3 (build_string ("failed with code "),
515 string, string2);
516 }
517 else
518 return Fcopy_sequence (Fsymbol_name (symbol));
519}
520\f
521#ifdef HAVE_PTYS
522
523/* Open an available pty, returning a file descriptor.
524 Return -1 on failure.
525 The file name of the terminal corresponding to the pty
526 is left in the variable pty_name. */
527
528static int
529allocate_pty ()
530{
531 register int c, i;
532 int fd;
533
534#ifdef PTY_ITERATION
535 PTY_ITERATION
536#else
537 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
538 for (i = 0; i < 16; i++)
539#endif
540 {
541 struct stat stb; /* Used in some PTY_OPEN. */
542#ifdef PTY_NAME_SPRINTF
543 PTY_NAME_SPRINTF
544#else
545 sprintf (pty_name, "/dev/pty%c%x", c, i);
546#endif /* no PTY_NAME_SPRINTF */
547
548#ifdef PTY_OPEN
549 PTY_OPEN;
550#else /* no PTY_OPEN */
551 {
552# ifdef IRIS
553 /* Unusual IRIS code */
554 *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
555 if (fd < 0)
556 return -1;
557 if (fstat (fd, &stb) < 0)
558 return -1;
559# else /* not IRIS */
560 { /* Some systems name their pseudoterminals so that there are gaps in
561 the usual sequence - for example, on HP9000/S700 systems, there
562 are no pseudoterminals with names ending in 'f'. So we wait for
563 three failures in a row before deciding that we've reached the
564 end of the ptys. */
565 int failed_count = 0;
566
567 if (stat (pty_name, &stb) < 0)
568 {
569 failed_count++;
570 if (failed_count >= 3)
571 return -1;
572 }
573 else
574 failed_count = 0;
575 }
576# ifdef O_NONBLOCK
577 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
578# else
579 fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
580# endif
581# endif /* not IRIS */
582 }
583#endif /* no PTY_OPEN */
584
585 if (fd >= 0)
586 {
587 /* check to make certain that both sides are available
588 this avoids a nasty yet stupid bug in rlogins */
589#ifdef PTY_TTY_NAME_SPRINTF
590 PTY_TTY_NAME_SPRINTF
591#else
592 sprintf (pty_name, "/dev/tty%c%x", c, i);
593#endif /* no PTY_TTY_NAME_SPRINTF */
594#ifndef UNIPLUS
595 if (access (pty_name, 6) != 0)
596 {
597 emacs_close (fd);
598# if !defined(IRIS) && !defined(__sgi)
599 continue;
600# else
601 return -1;
602# endif /* IRIS */
603 }
604#endif /* not UNIPLUS */
605 setup_pty (fd);
606 return fd;
607 }
608 }
609 return -1;
610}
611#endif /* HAVE_PTYS */
612\f
613static Lisp_Object
614make_process (name)
615 Lisp_Object name;
616{
617 register Lisp_Object val, tem, name1;
618 register struct Lisp_Process *p;
619 char suffix[10];
620 register int i;
621
622 p = allocate_process ();
623
624 XSETINT (p->infd, -1);
625 XSETINT (p->outfd, -1);
626 XSETFASTINT (p->tick, 0);
627 XSETFASTINT (p->update_tick, 0);
628 p->pid = 0;
629 p->pty_flag = Qnil;
630 p->raw_status_new = 0;
631 p->status = Qrun;
632 p->mark = Fmake_marker ();
633
634#ifdef ADAPTIVE_READ_BUFFERING
635 p->adaptive_read_buffering = Qnil;
636 XSETFASTINT (p->read_output_delay, 0);
637 p->read_output_skip = Qnil;
638#endif
639
640 /* If name is already in use, modify it until it is unused. */
641
642 name1 = name;
643 for (i = 1; ; i++)
644 {
645 tem = Fget_process (name1);
646 if (NILP (tem)) break;
647 sprintf (suffix, "<%d>", i);
648 name1 = concat2 (name, build_string (suffix));
649 }
650 name = name1;
651 p->name = name;
652 XSETPROCESS (val, p);
653 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
654 return val;
655}
656
657static void
658remove_process (proc)
659 register Lisp_Object proc;
660{
661 register Lisp_Object pair;
662
663 pair = Frassq (proc, Vprocess_alist);
664 Vprocess_alist = Fdelq (pair, Vprocess_alist);
665
666 deactivate_process (proc);
667}
668
669/* Setup coding systems of PROCESS. */
670
671void
672setup_process_coding_systems (process)
673 Lisp_Object process;
674{
675 struct Lisp_Process *p = XPROCESS (process);
676 int inch = XINT (p->infd);
677 int outch = XINT (p->outfd);
678
679 if (inch < 0 || outch < 0)
680 return;
681
682 if (!proc_decode_coding_system[inch])
683 proc_decode_coding_system[inch]
684 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
685 setup_coding_system (p->decode_coding_system,
686 proc_decode_coding_system[inch]);
687 if (! NILP (p->filter))
688 {
689 if (NILP (p->filter_multibyte))
690 setup_raw_text_coding_system (proc_decode_coding_system[inch]);
691 }
692 else if (BUFFERP (p->buffer))
693 {
694 if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
695 setup_raw_text_coding_system (proc_decode_coding_system[inch]);
696 }
697
698 if (!proc_encode_coding_system[outch])
699 proc_encode_coding_system[outch]
700 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
701 setup_coding_system (p->encode_coding_system,
702 proc_encode_coding_system[outch]);
703 if (proc_encode_coding_system[outch]->eol_type == CODING_EOL_UNDECIDED)
704 proc_encode_coding_system[outch]->eol_type = system_eol_type;
705}
706\f
707DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
708 doc: /* Return t if OBJECT is a process. */)
709 (object)
710 Lisp_Object object;
711{
712 return PROCESSP (object) ? Qt : Qnil;
713}
714
715DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
716 doc: /* Return the process named NAME, or nil if there is none. */)
717 (name)
718 register Lisp_Object name;
719{
720 if (PROCESSP (name))
721 return name;
722 CHECK_STRING (name);
723 return Fcdr (Fassoc (name, Vprocess_alist));
724}
725
726DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
727 doc: /* Return the (or a) process associated with BUFFER.
728BUFFER may be a buffer or the name of one. */)
729 (buffer)
730 register Lisp_Object buffer;
731{
732 register Lisp_Object buf, tail, proc;
733
734 if (NILP (buffer)) return Qnil;
735 buf = Fget_buffer (buffer);
736 if (NILP (buf)) return Qnil;
737
738 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
739 {
740 proc = Fcdr (Fcar (tail));
741 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
742 return proc;
743 }
744 return Qnil;
745}
746
747/* This is how commands for the user decode process arguments. It
748 accepts a process, a process name, a buffer, a buffer name, or nil.
749 Buffers denote the first process in the buffer, and nil denotes the
750 current buffer. */
751
752static Lisp_Object
753get_process (name)
754 register Lisp_Object name;
755{
756 register Lisp_Object proc, obj;
757 if (STRINGP (name))
758 {
759 obj = Fget_process (name);
760 if (NILP (obj))
761 obj = Fget_buffer (name);
762 if (NILP (obj))
763 error ("Process %s does not exist", SDATA (name));
764 }
765 else if (NILP (name))
766 obj = Fcurrent_buffer ();
767 else
768 obj = name;
769
770 /* Now obj should be either a buffer object or a process object.
771 */
772 if (BUFFERP (obj))
773 {
774 proc = Fget_buffer_process (obj);
775 if (NILP (proc))
776 error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
777 }
778 else
779 {
780 CHECK_PROCESS (obj);
781 proc = obj;
782 }
783 return proc;
784}
785
786
787#ifdef SIGCHLD
788/* Fdelete_process promises to immediately forget about the process, but in
789 reality, Emacs needs to remember those processes until they have been
790 treated by sigchld_handler; otherwise this handler would consider the
791 process as being synchronous and say that the synchronous process is
792 dead. */
793static Lisp_Object deleted_pid_list;
794#endif
795
796DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
797 doc: /* Delete PROCESS: kill it and forget about it immediately.
798PROCESS may be a process, a buffer, the name of a process or buffer, or
799nil, indicating the current buffer's process. */)
800 (process)
801 register Lisp_Object process;
802{
803 register struct Lisp_Process *p;
804
805 process = get_process (process);
806 p = XPROCESS (process);
807
808 p->raw_status_new = 0;
809 if (NETCONN1_P (p))
810 {
811 p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
812 XSETINT (p->tick, ++process_tick);
813 status_notify (p);
814 }
815 else if (XINT (p->infd) >= 0)
816 {
817#ifdef SIGCHLD
818 Lisp_Object symbol;
819 /* Assignment to EMACS_INT stops GCC whining about limited range
820 of data type. */
821 EMACS_INT pid = p->pid;
822
823 /* No problem storing the pid here, as it is still in Vprocess_alist. */
824 deleted_pid_list = Fcons (make_fixnum_or_float (pid),
825 /* GC treated elements set to nil. */
826 Fdelq (Qnil, deleted_pid_list));
827 /* If the process has already signaled, remove it from the list. */
828 if (p->raw_status_new)
829 update_status (p);
830 symbol = p->status;
831 if (CONSP (p->status))
832 symbol = XCAR (p->status);
833 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
834 deleted_pid_list
835 = Fdelete (make_fixnum_or_float (pid), deleted_pid_list);
836 else
837#endif
838 {
839 Fkill_process (process, Qnil);
840 /* Do this now, since remove_process will make sigchld_handler do nothing. */
841 p->status
842 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
843 XSETINT (p->tick, ++process_tick);
844 status_notify (p);
845 }
846 }
847 remove_process (process);
848 return Qnil;
849}
850\f
851DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
852 doc: /* Return the status of PROCESS.
853The returned value is one of the following symbols:
854run -- for a process that is running.
855stop -- for a process stopped but continuable.
856exit -- for a process that has exited.
857signal -- for a process that has got a fatal signal.
858open -- for a network stream connection that is open.
859listen -- for a network stream server that is listening.
860closed -- for a network stream connection that is closed.
861connect -- when waiting for a non-blocking connection to complete.
862failed -- when a non-blocking connection has failed.
863nil -- if arg is a process name and no such process exists.
864PROCESS may be a process, a buffer, the name of a process, or
865nil, indicating the current buffer's process. */)
866 (process)
867 register Lisp_Object process;
868{
869 register struct Lisp_Process *p;
870 register Lisp_Object status;
871
872 if (STRINGP (process))
873 process = Fget_process (process);
874 else
875 process = get_process (process);
876
877 if (NILP (process))
878 return process;
879
880 p = XPROCESS (process);
881 if (p->raw_status_new)
882 update_status (p);
883 status = p->status;
884 if (CONSP (status))
885 status = XCAR (status);
886 if (NETCONN1_P (p))
887 {
888 if (EQ (status, Qexit))
889 status = Qclosed;
890 else if (EQ (p->command, Qt))
891 status = Qstop;
892 else if (EQ (status, Qrun))
893 status = Qopen;
894 }
895 return status;
896}
897
898DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
899 1, 1, 0,
900 doc: /* Return the exit status of PROCESS or the signal number that killed it.
901If PROCESS has not yet exited or died, return 0. */)
902 (process)
903 register Lisp_Object process;
904{
905 CHECK_PROCESS (process);
906 if (XPROCESS (process)->raw_status_new)
907 update_status (XPROCESS (process));
908 if (CONSP (XPROCESS (process)->status))
909 return XCAR (XCDR (XPROCESS (process)->status));
910 return make_number (0);
911}
912
913DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
914 doc: /* Return the process id of PROCESS.
915This is the pid of the external process which PROCESS uses or talks to.
916For a network connection, this value is nil. */)
917 (process)
918 register Lisp_Object process;
919{
920 /* Assignment to EMACS_INT stops GCC whining about limited range of
921 data type. */
922 EMACS_INT pid;
923
924 CHECK_PROCESS (process);
925 pid = XPROCESS (process)->pid;
926 return (pid ? make_fixnum_or_float (pid) : Qnil);
927}
928
929DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
930 doc: /* Return the name of PROCESS, as a string.
931This is the name of the program invoked in PROCESS,
932possibly modified to make it unique among process names. */)
933 (process)
934 register Lisp_Object process;
935{
936 CHECK_PROCESS (process);
937 return XPROCESS (process)->name;
938}
939
940DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
941 doc: /* Return the command that was executed to start PROCESS.
942This is a list of strings, the first string being the program executed
943and the rest of the strings being the arguments given to it.
944For a non-child channel, this is nil. */)
945 (process)
946 register Lisp_Object process;
947{
948 CHECK_PROCESS (process);
949 return XPROCESS (process)->command;
950}
951
952DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
953 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
954This is the terminal that the process itself reads and writes on,
955not the name of the pty that Emacs uses to talk with that terminal. */)
956 (process)
957 register Lisp_Object process;
958{
959 CHECK_PROCESS (process);
960 return XPROCESS (process)->tty_name;
961}
962
963DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
964 2, 2, 0,
965 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
966 (process, buffer)
967 register Lisp_Object process, buffer;
968{
969 struct Lisp_Process *p;
970
971 CHECK_PROCESS (process);
972 if (!NILP (buffer))
973 CHECK_BUFFER (buffer);
974 p = XPROCESS (process);
975 p->buffer = buffer;
976 if (NETCONN1_P (p))
977 p->childp = Fplist_put (p->childp, QCbuffer, buffer);
978 setup_process_coding_systems (process);
979 return buffer;
980}
981
982DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
983 1, 1, 0,
984 doc: /* Return the buffer PROCESS is associated with.
985Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
986 (process)
987 register Lisp_Object process;
988{
989 CHECK_PROCESS (process);
990 return XPROCESS (process)->buffer;
991}
992
993DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
994 1, 1, 0,
995 doc: /* Return the marker for the end of the last output from PROCESS. */)
996 (process)
997 register Lisp_Object process;
998{
999 CHECK_PROCESS (process);
1000 return XPROCESS (process)->mark;
1001}
1002
1003DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
1004 2, 2, 0,
1005 doc: /* Give PROCESS the filter function FILTER; nil means no filter.
1006A value of t means stop accepting output from the process.
1007
1008When a process has a filter, its buffer is not used for output.
1009Instead, each time it does output, the entire string of output is
1010passed to the filter.
1011
1012The filter gets two arguments: the process and the string of output.
1013The string argument is normally a multibyte string, except:
1014- if the process' input coding system is no-conversion or raw-text,
1015 it is a unibyte string (the non-converted input), or else
1016- if `default-enable-multibyte-characters' is nil, it is a unibyte
1017 string (the result of converting the decoded input multibyte
1018 string to unibyte with `string-make-unibyte'). */)
1019 (process, filter)
1020 register Lisp_Object process, filter;
1021{
1022 struct Lisp_Process *p;
1023
1024 CHECK_PROCESS (process);
1025 p = XPROCESS (process);
1026
1027 /* Don't signal an error if the process' input file descriptor
1028 is closed. This could make debugging Lisp more difficult,
1029 for example when doing something like
1030
1031 (setq process (start-process ...))
1032 (debug)
1033 (set-process-filter process ...) */
1034
1035 if (XINT (p->infd) >= 0)
1036 {
1037 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
1038 {
1039 FD_CLR (XINT (p->infd), &input_wait_mask);
1040 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
1041 }
1042 else if (EQ (p->filter, Qt)
1043 && !EQ (p->command, Qt)) /* Network process not stopped. */
1044 {
1045 FD_SET (XINT (p->infd), &input_wait_mask);
1046 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
1047 }
1048 }
1049
1050 p->filter = filter;
1051 if (NETCONN1_P (p))
1052 p->childp = Fplist_put (p->childp, QCfilter, filter);
1053 setup_process_coding_systems (process);
1054 return filter;
1055}
1056
1057DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1058 1, 1, 0,
1059 doc: /* Returns the filter function of PROCESS; nil if none.
1060See `set-process-filter' for more info on filter functions. */)
1061 (process)
1062 register Lisp_Object process;
1063{
1064 CHECK_PROCESS (process);
1065 return XPROCESS (process)->filter;
1066}
1067
1068DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1069 2, 2, 0,
1070 doc: /* Give PROCESS the sentinel SENTINEL; nil for none.
1071The sentinel is called as a function when the process changes state.
1072It gets two arguments: the process, and a string describing the change. */)
1073 (process, sentinel)
1074 register Lisp_Object process, sentinel;
1075{
1076 struct Lisp_Process *p;
1077
1078 CHECK_PROCESS (process);
1079 p = XPROCESS (process);
1080
1081 p->sentinel = sentinel;
1082 if (NETCONN1_P (p))
1083 p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
1084 return sentinel;
1085}
1086
1087DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1088 1, 1, 0,
1089 doc: /* Return the sentinel of PROCESS; nil if none.
1090See `set-process-sentinel' for more info on sentinels. */)
1091 (process)
1092 register Lisp_Object process;
1093{
1094 CHECK_PROCESS (process);
1095 return XPROCESS (process)->sentinel;
1096}
1097
1098DEFUN ("set-process-window-size", Fset_process_window_size,
1099 Sset_process_window_size, 3, 3, 0,
1100 doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1101 (process, height, width)
1102 register Lisp_Object process, height, width;
1103{
1104 CHECK_PROCESS (process);
1105 CHECK_NATNUM (height);
1106 CHECK_NATNUM (width);
1107
1108 if (XINT (XPROCESS (process)->infd) < 0
1109 || set_window_size (XINT (XPROCESS (process)->infd),
1110 XINT (height), XINT (width)) <= 0)
1111 return Qnil;
1112 else
1113 return Qt;
1114}
1115
1116DEFUN ("set-process-inherit-coding-system-flag",
1117 Fset_process_inherit_coding_system_flag,
1118 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1119 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1120If the second argument FLAG is non-nil, then the variable
1121`buffer-file-coding-system' of the buffer associated with PROCESS
1122will be bound to the value of the coding system used to decode
1123the process output.
1124
1125This is useful when the coding system specified for the process buffer
1126leaves either the character code conversion or the end-of-line conversion
1127unspecified, or if the coding system used to decode the process output
1128is more appropriate for saving the process buffer.
1129
1130Binding the variable `inherit-process-coding-system' to non-nil before
1131starting the process is an alternative way of setting the inherit flag
1132for the process which will run. */)
1133 (process, flag)
1134 register Lisp_Object process, flag;
1135{
1136 CHECK_PROCESS (process);
1137 XPROCESS (process)->inherit_coding_system_flag = flag;
1138 return flag;
1139}
1140
1141DEFUN ("process-inherit-coding-system-flag",
1142 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
1143 1, 1, 0,
1144 doc: /* Return the value of inherit-coding-system flag for PROCESS.
1145If this flag is t, `buffer-file-coding-system' of the buffer
1146associated with PROCESS will inherit the coding system used to decode
1147the process output. */)
1148 (process)
1149 register Lisp_Object process;
1150{
1151 CHECK_PROCESS (process);
1152 return XPROCESS (process)->inherit_coding_system_flag;
1153}
1154
1155DEFUN ("set-process-query-on-exit-flag",
1156 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1157 2, 2, 0,
1158 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1159If the second argument FLAG is non-nil, Emacs will query the user before
1160exiting if PROCESS is running. */)
1161 (process, flag)
1162 register Lisp_Object process, flag;
1163{
1164 CHECK_PROCESS (process);
1165 XPROCESS (process)->kill_without_query = Fnull (flag);
1166 return flag;
1167}
1168
1169DEFUN ("process-query-on-exit-flag",
1170 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1171 1, 1, 0,
1172 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
1173 (process)
1174 register Lisp_Object process;
1175{
1176 CHECK_PROCESS (process);
1177 return Fnull (XPROCESS (process)->kill_without_query);
1178}
1179
1180#ifdef DATAGRAM_SOCKETS
1181Lisp_Object Fprocess_datagram_address ();
1182#endif
1183
1184DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1185 1, 2, 0,
1186 doc: /* Return the contact info of PROCESS; t for a real child.
1187For a net connection, the value depends on the optional KEY arg.
1188If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1189if KEY is t, the complete contact information for the connection is
1190returned, else the specific value for the keyword KEY is returned.
1191See `make-network-process' for a list of keywords. */)
1192 (process, key)
1193 register Lisp_Object process, key;
1194{
1195 Lisp_Object contact;
1196
1197 CHECK_PROCESS (process);
1198 contact = XPROCESS (process)->childp;
1199
1200#ifdef DATAGRAM_SOCKETS
1201 if (DATAGRAM_CONN_P (process)
1202 && (EQ (key, Qt) || EQ (key, QCremote)))
1203 contact = Fplist_put (contact, QCremote,
1204 Fprocess_datagram_address (process));
1205#endif
1206
1207 if (!NETCONN_P (process) || EQ (key, Qt))
1208 return contact;
1209 if (NILP (key))
1210 return Fcons (Fplist_get (contact, QChost),
1211 Fcons (Fplist_get (contact, QCservice), Qnil));
1212 return Fplist_get (contact, key);
1213}
1214
1215DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1216 1, 1, 0,
1217 doc: /* Return the plist of PROCESS. */)
1218 (process)
1219 register Lisp_Object process;
1220{
1221 CHECK_PROCESS (process);
1222 return XPROCESS (process)->plist;
1223}
1224
1225DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1226 2, 2, 0,
1227 doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1228 (process, plist)
1229 register Lisp_Object process, plist;
1230{
1231 CHECK_PROCESS (process);
1232 CHECK_LIST (plist);
1233
1234 XPROCESS (process)->plist = plist;
1235 return plist;
1236}
1237
1238#if 0 /* Turned off because we don't currently record this info
1239 in the process. Perhaps add it. */
1240DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1241 doc: /* Return the connection type of PROCESS.
1242The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1243a socket connection. */)
1244 (process)
1245 Lisp_Object process;
1246{
1247 return XPROCESS (process)->type;
1248}
1249#endif
1250
1251#ifdef HAVE_SOCKETS
1252DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1253 1, 2, 0,
1254 doc: /* Convert network ADDRESS from internal format to a string.
1255A 4 or 5 element vector represents an IPv4 address (with port number).
1256An 8 or 9 element vector represents an IPv6 address (with port number).
1257If optional second argument OMIT-PORT is non-nil, don't include a port
1258number in the string, even when present in ADDRESS.
1259Returns nil if format of ADDRESS is invalid. */)
1260 (address, omit_port)
1261 Lisp_Object address, omit_port;
1262{
1263 if (NILP (address))
1264 return Qnil;
1265
1266 if (STRINGP (address)) /* AF_LOCAL */
1267 return address;
1268
1269 if (VECTORP (address)) /* AF_INET or AF_INET6 */
1270 {
1271 register struct Lisp_Vector *p = XVECTOR (address);
1272 Lisp_Object args[10];
1273 int nargs, i;
1274
1275 if (p->size == 4 || (p->size == 5 && !NILP (omit_port)))
1276 {
1277 args[0] = build_string ("%d.%d.%d.%d");
1278 nargs = 4;
1279 }
1280 else if (p->size == 5)
1281 {
1282 args[0] = build_string ("%d.%d.%d.%d:%d");
1283 nargs = 5;
1284 }
1285 else if (p->size == 8 || (p->size == 9 && !NILP (omit_port)))
1286 {
1287 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1288 nargs = 8;
1289 }
1290 else if (p->size == 9)
1291 {
1292 args[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1293 nargs = 9;
1294 }
1295 else
1296 return Qnil;
1297
1298 for (i = 0; i < nargs; i++)
1299 {
1300 EMACS_INT element = XINT (p->contents[i]);
1301
1302 if (element < 0 || element > 65535)
1303 return Qnil;
1304
1305 if (nargs <= 5 /* IPv4 */
1306 && i < 4 /* host, not port */
1307 && element > 255)
1308 return Qnil;
1309
1310 args[i+1] = p->contents[i];
1311 }
1312
1313 return Fformat (nargs+1, args);
1314 }
1315
1316 if (CONSP (address))
1317 {
1318 Lisp_Object args[2];
1319 args[0] = build_string ("<Family %d>");
1320 args[1] = Fcar (address);
1321 return Fformat (2, args);
1322 }
1323
1324 return Qnil;
1325}
1326#endif
1327\f
1328static Lisp_Object
1329list_processes_1 (query_only)
1330 Lisp_Object query_only;
1331{
1332 register Lisp_Object tail, tem;
1333 Lisp_Object proc, minspace, tem1;
1334 register struct Lisp_Process *p;
1335 char tembuf[300];
1336 int w_proc, w_buffer, w_tty;
1337 int exited = 0;
1338 Lisp_Object i_status, i_buffer, i_tty, i_command;
1339
1340 w_proc = 4; /* Proc */
1341 w_buffer = 6; /* Buffer */
1342 w_tty = 0; /* Omit if no ttys */
1343
1344 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
1345 {
1346 int i;
1347
1348 proc = Fcdr (Fcar (tail));
1349 p = XPROCESS (proc);
1350 if (NILP (p->childp))
1351 continue;
1352 if (!NILP (query_only) && !NILP (p->kill_without_query))
1353 continue;
1354 if (STRINGP (p->name)
1355 && ( i = SCHARS (p->name), (i > w_proc)))
1356 w_proc = i;
1357 if (!NILP (p->buffer))
1358 {
1359 if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
1360 w_buffer = 8; /* (Killed) */
1361 else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
1362 w_buffer = i;
1363 }
1364 if (STRINGP (p->tty_name)
1365 && (i = SCHARS (p->tty_name), (i > w_tty)))
1366 w_tty = i;
1367 }
1368
1369 XSETFASTINT (i_status, w_proc + 1);
1370 XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
1371 if (w_tty)
1372 {
1373 XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
1374 XSETFASTINT (i_command, XFASTINT (i_tty) + w_tty + 1);
1375 }
1376 else
1377 {
1378 i_tty = Qnil;
1379 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
1380 }
1381
1382 XSETFASTINT (minspace, 1);
1383
1384 set_buffer_internal (XBUFFER (Vstandard_output));
1385 current_buffer->undo_list = Qt;
1386
1387 current_buffer->truncate_lines = Qt;
1388
1389 write_string ("Proc", -1);
1390 Findent_to (i_status, minspace); write_string ("Status", -1);
1391 Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
1392 if (!NILP (i_tty))
1393 {
1394 Findent_to (i_tty, minspace); write_string ("Tty", -1);
1395 }
1396 Findent_to (i_command, minspace); write_string ("Command", -1);
1397 write_string ("\n", -1);
1398
1399 write_string ("----", -1);
1400 Findent_to (i_status, minspace); write_string ("------", -1);
1401 Findent_to (i_buffer, minspace); write_string ("------", -1);
1402 if (!NILP (i_tty))
1403 {
1404 Findent_to (i_tty, minspace); write_string ("---", -1);
1405 }
1406 Findent_to (i_command, minspace); write_string ("-------", -1);
1407 write_string ("\n", -1);
1408
1409 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
1410 {
1411 Lisp_Object symbol;
1412
1413 proc = Fcdr (Fcar (tail));
1414 p = XPROCESS (proc);
1415 if (NILP (p->childp))
1416 continue;
1417 if (!NILP (query_only) && !NILP (p->kill_without_query))
1418 continue;
1419
1420 Finsert (1, &p->name);
1421 Findent_to (i_status, minspace);
1422
1423 if (p->raw_status_new)
1424 update_status (p);
1425 symbol = p->status;
1426 if (CONSP (p->status))
1427 symbol = XCAR (p->status);
1428
1429 if (EQ (symbol, Qsignal))
1430 {
1431 Lisp_Object tem;
1432 tem = Fcar (Fcdr (p->status));
1433#ifdef VMS
1434 if (XINT (tem) < NSIG)
1435 write_string (sys_errlist [XINT (tem)], -1);
1436 else
1437#endif
1438 Fprinc (symbol, Qnil);
1439 }
1440 else if (NETCONN1_P (p))
1441 {
1442 if (EQ (symbol, Qexit))
1443 write_string ("closed", -1);
1444 else if (EQ (p->command, Qt))
1445 write_string ("stopped", -1);
1446 else if (EQ (symbol, Qrun))
1447 write_string ("open", -1);
1448 else
1449 Fprinc (symbol, Qnil);
1450 }
1451 else
1452 Fprinc (symbol, Qnil);
1453
1454 if (EQ (symbol, Qexit))
1455 {
1456 Lisp_Object tem;
1457 tem = Fcar (Fcdr (p->status));
1458 if (XFASTINT (tem))
1459 {
1460 sprintf (tembuf, " %d", (int) XFASTINT (tem));
1461 write_string (tembuf, -1);
1462 }
1463 }
1464
1465 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed))
1466 exited++;
1467
1468 Findent_to (i_buffer, minspace);
1469 if (NILP (p->buffer))
1470 insert_string ("(none)");
1471 else if (NILP (XBUFFER (p->buffer)->name))
1472 insert_string ("(Killed)");
1473 else
1474 Finsert (1, &XBUFFER (p->buffer)->name);
1475
1476 if (!NILP (i_tty))
1477 {
1478 Findent_to (i_tty, minspace);
1479 if (STRINGP (p->tty_name))
1480 Finsert (1, &p->tty_name);
1481 }
1482
1483 Findent_to (i_command, minspace);
1484
1485 if (EQ (p->status, Qlisten))
1486 {
1487 Lisp_Object port = Fplist_get (p->childp, QCservice);
1488 if (INTEGERP (port))
1489 port = Fnumber_to_string (port);
1490 if (NILP (port))
1491 port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
1492 sprintf (tembuf, "(network %s server on %s)\n",
1493 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
1494 (STRINGP (port) ? (char *)SDATA (port) : "?"));
1495 insert_string (tembuf);
1496 }
1497 else if (NETCONN1_P (p))
1498 {
1499 /* For a local socket, there is no host name,
1500 so display service instead. */
1501 Lisp_Object host = Fplist_get (p->childp, QChost);
1502 if (!STRINGP (host))
1503 {
1504 host = Fplist_get (p->childp, QCservice);
1505 if (INTEGERP (host))
1506 host = Fnumber_to_string (host);
1507 }
1508 if (NILP (host))
1509 host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
1510 sprintf (tembuf, "(network %s connection to %s)\n",
1511 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
1512 (STRINGP (host) ? (char *)SDATA (host) : "?"));
1513 insert_string (tembuf);
1514 }
1515 else
1516 {
1517 tem = p->command;
1518 while (1)
1519 {
1520 tem1 = Fcar (tem);
1521 Finsert (1, &tem1);
1522 tem = Fcdr (tem);
1523 if (NILP (tem))
1524 break;
1525 insert_string (" ");
1526 }
1527 insert_string ("\n");
1528 }
1529 }
1530 if (exited)
1531 status_notify (NULL);
1532 return Qnil;
1533}
1534
1535DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
1536 doc: /* Display a list of all processes.
1537If optional argument QUERY-ONLY is non-nil, only processes with
1538the query-on-exit flag set will be listed.
1539Any process listed as exited or signaled is actually eliminated
1540after the listing is made. */)
1541 (query_only)
1542 Lisp_Object query_only;
1543{
1544 internal_with_output_to_temp_buffer ("*Process List*",
1545 list_processes_1, query_only);
1546 return Qnil;
1547}
1548
1549DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1550 doc: /* Return a list of all processes. */)
1551 ()
1552{
1553 return Fmapcar (Qcdr, Vprocess_alist);
1554}
1555\f
1556/* Starting asynchronous inferior processes. */
1557
1558static Lisp_Object start_process_unwind ();
1559
1560DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
1561 doc: /* Start a program in a subprocess. Return the process object for it.
1562NAME is name for process. It is modified if necessary to make it unique.
1563BUFFER is the buffer (or buffer name) to associate with the process.
1564
1565Process output (both standard output and standard error streams) goes
1566at end of BUFFER, unless you specify an output stream or filter
1567function to handle the output. BUFFER may also be nil, meaning that
1568this process is not associated with any buffer.
1569
1570PROGRAM is the program file name. It is searched for in PATH.
1571Remaining arguments are strings to give program as arguments.
1572
1573If you want to separate standard output from standard error, invoke
1574the command through a shell and redirect one of them using the shell
1575syntax.
1576
1577usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1578 (nargs, args)
1579 int nargs;
1580 register Lisp_Object *args;
1581{
1582 Lisp_Object buffer, name, program, proc, current_dir, tem;
1583#ifdef VMS
1584 register unsigned char *new_argv;
1585 int len;
1586#else
1587 register unsigned char **new_argv;
1588#endif
1589 register int i;
1590 int count = SPECPDL_INDEX ();
1591
1592 buffer = args[1];
1593 if (!NILP (buffer))
1594 buffer = Fget_buffer_create (buffer);
1595
1596 /* Make sure that the child will be able to chdir to the current
1597 buffer's current directory, or its unhandled equivalent. We
1598 can't just have the child check for an error when it does the
1599 chdir, since it's in a vfork.
1600
1601 We have to GCPRO around this because Fexpand_file_name and
1602 Funhandled_file_name_directory might call a file name handling
1603 function. The argument list is protected by the caller, so all
1604 we really have to worry about is buffer. */
1605 {
1606 struct gcpro gcpro1, gcpro2;
1607
1608 current_dir = current_buffer->directory;
1609
1610 GCPRO2 (buffer, current_dir);
1611
1612 current_dir
1613 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
1614 Qnil);
1615 if (NILP (Ffile_accessible_directory_p (current_dir)))
1616 report_file_error ("Setting current directory",
1617 Fcons (current_buffer->directory, Qnil));
1618
1619 UNGCPRO;
1620 }
1621
1622 name = args[0];
1623 CHECK_STRING (name);
1624
1625 program = args[2];
1626
1627 CHECK_STRING (program);
1628
1629 proc = make_process (name);
1630 /* If an error occurs and we can't start the process, we want to
1631 remove it from the process list. This means that each error
1632 check in create_process doesn't need to call remove_process
1633 itself; it's all taken care of here. */
1634 record_unwind_protect (start_process_unwind, proc);
1635
1636 XPROCESS (proc)->childp = Qt;
1637 XPROCESS (proc)->plist = Qnil;
1638 XPROCESS (proc)->buffer = buffer;
1639 XPROCESS (proc)->sentinel = Qnil;
1640 XPROCESS (proc)->filter = Qnil;
1641 XPROCESS (proc)->filter_multibyte
1642 = buffer_defaults.enable_multibyte_characters;
1643 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1644
1645#ifdef ADAPTIVE_READ_BUFFERING
1646 XPROCESS (proc)->adaptive_read_buffering = Vprocess_adaptive_read_buffering;
1647#endif
1648
1649 /* Make the process marker point into the process buffer (if any). */
1650 if (BUFFERP (buffer))
1651 set_marker_both (XPROCESS (proc)->mark, buffer,
1652 BUF_ZV (XBUFFER (buffer)),
1653 BUF_ZV_BYTE (XBUFFER (buffer)));
1654
1655 {
1656 /* Decide coding systems for communicating with the process. Here
1657 we don't setup the structure coding_system nor pay attention to
1658 unibyte mode. They are done in create_process. */
1659
1660 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1661 Lisp_Object coding_systems = Qt;
1662 Lisp_Object val, *args2;
1663 struct gcpro gcpro1, gcpro2;
1664
1665 val = Vcoding_system_for_read;
1666 if (NILP (val))
1667 {
1668 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1669 args2[0] = Qstart_process;
1670 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1671 GCPRO2 (proc, current_dir);
1672 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1673 UNGCPRO;
1674 if (CONSP (coding_systems))
1675 val = XCAR (coding_systems);
1676 else if (CONSP (Vdefault_process_coding_system))
1677 val = XCAR (Vdefault_process_coding_system);
1678 }
1679 XPROCESS (proc)->decode_coding_system = val;
1680
1681 val = Vcoding_system_for_write;
1682 if (NILP (val))
1683 {
1684 if (EQ (coding_systems, Qt))
1685 {
1686 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
1687 args2[0] = Qstart_process;
1688 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1689 GCPRO2 (proc, current_dir);
1690 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1691 UNGCPRO;
1692 }
1693 if (CONSP (coding_systems))
1694 val = XCDR (coding_systems);
1695 else if (CONSP (Vdefault_process_coding_system))
1696 val = XCDR (Vdefault_process_coding_system);
1697 }
1698 XPROCESS (proc)->encode_coding_system = val;
1699 }
1700
1701#ifdef VMS
1702 /* Make a one member argv with all args concatenated
1703 together separated by a blank. */
1704 len = SBYTES (program) + 2;
1705 for (i = 3; i < nargs; i++)
1706 {
1707 tem = args[i];
1708 CHECK_STRING (tem);
1709 len += SBYTES (tem) + 1; /* count the blank */
1710 }
1711 new_argv = (unsigned char *) alloca (len);
1712 strcpy (new_argv, SDATA (program));
1713 for (i = 3; i < nargs; i++)
1714 {
1715 tem = args[i];
1716 CHECK_STRING (tem);
1717 strcat (new_argv, " ");
1718 strcat (new_argv, SDATA (tem));
1719 }
1720 /* Need to add code here to check for program existence on VMS */
1721
1722#else /* not VMS */
1723 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1724
1725 /* If program file name is not absolute, search our path for it.
1726 Put the name we will really use in TEM. */
1727 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1728 && !(SCHARS (program) > 1
1729 && IS_DEVICE_SEP (SREF (program, 1))))
1730 {
1731 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1732
1733 tem = Qnil;
1734 GCPRO4 (name, program, buffer, current_dir);
1735 openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
1736 UNGCPRO;
1737 if (NILP (tem))
1738 report_file_error ("Searching for program", Fcons (program, Qnil));
1739 tem = Fexpand_file_name (tem, Qnil);
1740 }
1741 else
1742 {
1743 if (!NILP (Ffile_directory_p (program)))
1744 error ("Specified program for new process is a directory");
1745 tem = program;
1746 }
1747
1748 /* If program file name starts with /: for quoting a magic name,
1749 discard that. */
1750 if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
1751 && SREF (tem, 1) == ':')
1752 tem = Fsubstring (tem, make_number (2), Qnil);
1753
1754 /* Encode the file name and put it in NEW_ARGV.
1755 That's where the child will use it to execute the program. */
1756 tem = ENCODE_FILE (tem);
1757 new_argv[0] = SDATA (tem);
1758
1759 /* Here we encode arguments by the coding system used for sending
1760 data to the process. We don't support using different coding
1761 systems for encoding arguments and for encoding data sent to the
1762 process. */
1763
1764 for (i = 3; i < nargs; i++)
1765 {
1766 tem = args[i];
1767 CHECK_STRING (tem);
1768 if (STRING_MULTIBYTE (tem))
1769 tem = (code_convert_string_norecord
1770 (tem, XPROCESS (proc)->encode_coding_system, 1));
1771 new_argv[i - 2] = SDATA (tem);
1772 }
1773 new_argv[i - 2] = 0;
1774#endif /* not VMS */
1775
1776 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
1777 XPROCESS (proc)->decoding_carryover = make_number (0);
1778 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
1779 XPROCESS (proc)->encoding_carryover = make_number (0);
1780
1781 XPROCESS (proc)->inherit_coding_system_flag
1782 = (NILP (buffer) || !inherit_process_coding_system
1783 ? Qnil : Qt);
1784
1785 create_process (proc, (char **) new_argv, current_dir);
1786
1787 return unbind_to (count, proc);
1788}
1789
1790/* This function is the unwind_protect form for Fstart_process. If
1791 PROC doesn't have its pid set, then we know someone has signaled
1792 an error and the process wasn't started successfully, so we should
1793 remove it from the process list. */
1794static Lisp_Object
1795start_process_unwind (proc)
1796 Lisp_Object proc;
1797{
1798 if (!PROCESSP (proc))
1799 abort ();
1800
1801 /* Was PROC started successfully? */
1802 if (XPROCESS (proc)->pid <= 0)
1803 remove_process (proc);
1804
1805 return Qnil;
1806}
1807
1808static void
1809create_process_1 (timer)
1810 struct atimer *timer;
1811{
1812 /* Nothing to do. */
1813}
1814
1815
1816#if 0 /* This doesn't work; see the note before sigchld_handler. */
1817#ifdef USG
1818#ifdef SIGCHLD
1819/* Mimic blocking of signals on system V, which doesn't really have it. */
1820
1821/* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1822int sigchld_deferred;
1823
1824SIGTYPE
1825create_process_sigchld ()
1826{
1827 signal (SIGCHLD, create_process_sigchld);
1828
1829 sigchld_deferred = 1;
1830}
1831#endif
1832#endif
1833#endif
1834
1835#ifndef VMS /* VMS version of this function is in vmsproc.c. */
1836void
1837create_process (process, new_argv, current_dir)
1838 Lisp_Object process;
1839 char **new_argv;
1840 Lisp_Object current_dir;
1841{
1842 int inchannel, outchannel;
1843 pid_t pid;
1844 int sv[2];
1845#ifdef POSIX_SIGNALS
1846 sigset_t procmask;
1847 sigset_t blocked;
1848 struct sigaction sigint_action;
1849 struct sigaction sigquit_action;
1850#ifdef AIX
1851 struct sigaction sighup_action;
1852#endif
1853#else /* !POSIX_SIGNALS */
1854#if 0
1855#ifdef SIGCHLD
1856 SIGTYPE (*sigchld)();
1857#endif
1858#endif /* 0 */
1859#endif /* !POSIX_SIGNALS */
1860 /* Use volatile to protect variables from being clobbered by longjmp. */
1861 volatile int forkin, forkout;
1862 volatile int pty_flag = 0;
1863#ifndef USE_CRT_DLL
1864 extern char **environ;
1865#endif
1866
1867 inchannel = outchannel = -1;
1868
1869#ifdef HAVE_PTYS
1870 if (!NILP (Vprocess_connection_type))
1871 outchannel = inchannel = allocate_pty ();
1872
1873 if (inchannel >= 0)
1874 {
1875#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1876 /* On most USG systems it does not work to open the pty's tty here,
1877 then close it and reopen it in the child. */
1878#ifdef O_NOCTTY
1879 /* Don't let this terminal become our controlling terminal
1880 (in case we don't have one). */
1881 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1882#else
1883 forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
1884#endif
1885 if (forkin < 0)
1886 report_file_error ("Opening pty", Qnil);
1887#if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1888 /* In the case that vfork is defined as fork, the parent process
1889 (Emacs) may send some data before the child process completes
1890 tty options setup. So we setup tty before forking. */
1891 child_setup_tty (forkout);
1892#endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1893#else
1894 forkin = forkout = -1;
1895#endif /* not USG, or USG_SUBTTY_WORKS */
1896 pty_flag = 1;
1897 }
1898 else
1899#endif /* HAVE_PTYS */
1900#ifdef SKTPAIR
1901 {
1902 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1903 report_file_error ("Opening socketpair", Qnil);
1904 outchannel = inchannel = sv[0];
1905 forkout = forkin = sv[1];
1906 }
1907#else /* not SKTPAIR */
1908 {
1909 int tem;
1910 tem = pipe (sv);
1911 if (tem < 0)
1912 report_file_error ("Creating pipe", Qnil);
1913 inchannel = sv[0];
1914 forkout = sv[1];
1915 tem = pipe (sv);
1916 if (tem < 0)
1917 {
1918 emacs_close (inchannel);
1919 emacs_close (forkout);
1920 report_file_error ("Creating pipe", Qnil);
1921 }
1922 outchannel = sv[1];
1923 forkin = sv[0];
1924 }
1925#endif /* not SKTPAIR */
1926
1927#if 0
1928 /* Replaced by close_process_descs */
1929 set_exclusive_use (inchannel);
1930 set_exclusive_use (outchannel);
1931#endif
1932
1933/* Stride people say it's a mystery why this is needed
1934 as well as the O_NDELAY, but that it fails without this. */
1935#if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1936 {
1937 int one = 1;
1938 ioctl (inchannel, FIONBIO, &one);
1939 }
1940#endif
1941
1942#ifdef O_NONBLOCK
1943 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1944 fcntl (outchannel, F_SETFL, O_NONBLOCK);
1945#else
1946#ifdef O_NDELAY
1947 fcntl (inchannel, F_SETFL, O_NDELAY);
1948 fcntl (outchannel, F_SETFL, O_NDELAY);
1949#endif
1950#endif
1951
1952 /* Record this as an active process, with its channels.
1953 As a result, child_setup will close Emacs's side of the pipes. */
1954 chan_process[inchannel] = process;
1955 XSETINT (XPROCESS (process)->infd, inchannel);
1956 XSETINT (XPROCESS (process)->outfd, outchannel);
1957
1958 /* Previously we recorded the tty descriptor used in the subprocess.
1959 It was only used for getting the foreground tty process, so now
1960 we just reopen the device (see emacs_get_tty_pgrp) as this is
1961 more portable (see USG_SUBTTY_WORKS above). */
1962
1963 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1964 XPROCESS (process)->status = Qrun;
1965 setup_process_coding_systems (process);
1966
1967 /* Delay interrupts until we have a chance to store
1968 the new fork's pid in its process structure */
1969#ifdef POSIX_SIGNALS
1970 sigemptyset (&blocked);
1971#ifdef SIGCHLD
1972 sigaddset (&blocked, SIGCHLD);
1973#endif
1974#ifdef HAVE_WORKING_VFORK
1975 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1976 this sets the parent's signal handlers as well as the child's.
1977 So delay all interrupts whose handlers the child might munge,
1978 and record the current handlers so they can be restored later. */
1979 sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
1980 sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
1981#ifdef AIX
1982 sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
1983#endif
1984#endif /* HAVE_WORKING_VFORK */
1985 sigprocmask (SIG_BLOCK, &blocked, &procmask);
1986#else /* !POSIX_SIGNALS */
1987#ifdef SIGCHLD
1988#ifdef BSD4_1
1989 sighold (SIGCHLD);
1990#else /* not BSD4_1 */
1991#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1992 sigsetmask (sigmask (SIGCHLD));
1993#else /* ordinary USG */
1994#if 0
1995 sigchld_deferred = 0;
1996 sigchld = signal (SIGCHLD, create_process_sigchld);
1997#endif
1998#endif /* ordinary USG */
1999#endif /* not BSD4_1 */
2000#endif /* SIGCHLD */
2001#endif /* !POSIX_SIGNALS */
2002
2003 FD_SET (inchannel, &input_wait_mask);
2004 FD_SET (inchannel, &non_keyboard_wait_mask);
2005 if (inchannel > max_process_desc)
2006 max_process_desc = inchannel;
2007
2008 /* Until we store the proper pid, enable sigchld_handler
2009 to recognize an unknown pid as standing for this process.
2010 It is very important not to let this `marker' value stay
2011 in the table after this function has returned; if it does
2012 it might cause call-process to hang and subsequent asynchronous
2013 processes to get their return values scrambled. */
2014 XPROCESS (process)->pid = -1;
2015
2016 BLOCK_INPUT;
2017
2018 {
2019 /* child_setup must clobber environ on systems with true vfork.
2020 Protect it from permanent change. */
2021 char **save_environ = environ;
2022
2023 current_dir = ENCODE_FILE (current_dir);
2024
2025#ifndef WINDOWSNT
2026 pid = vfork ();
2027 if (pid == 0)
2028#endif /* not WINDOWSNT */
2029 {
2030 int xforkin = forkin;
2031 int xforkout = forkout;
2032
2033#if 0 /* This was probably a mistake--it duplicates code later on,
2034 but fails to handle all the cases. */
2035 /* Make sure SIGCHLD is not blocked in the child. */
2036 sigsetmask (SIGEMPTYMASK);
2037#endif
2038
2039 /* Make the pty be the controlling terminal of the process. */
2040#ifdef HAVE_PTYS
2041 /* First, disconnect its current controlling terminal. */
2042#ifdef HAVE_SETSID
2043 /* We tried doing setsid only if pty_flag, but it caused
2044 process_set_signal to fail on SGI when using a pipe. */
2045 setsid ();
2046 /* Make the pty's terminal the controlling terminal. */
2047 if (pty_flag)
2048 {
2049#ifdef TIOCSCTTY
2050 /* We ignore the return value
2051 because faith@cs.unc.edu says that is necessary on Linux. */
2052 ioctl (xforkin, TIOCSCTTY, 0);
2053#endif
2054 }
2055#else /* not HAVE_SETSID */
2056#ifdef USG
2057 /* It's very important to call setpgrp here and no time
2058 afterwards. Otherwise, we lose our controlling tty which
2059 is set when we open the pty. */
2060 setpgrp ();
2061#endif /* USG */
2062#endif /* not HAVE_SETSID */
2063#if defined (HAVE_TERMIOS) && defined (LDISC1)
2064 if (pty_flag && xforkin >= 0)
2065 {
2066 struct termios t;
2067 tcgetattr (xforkin, &t);
2068 t.c_lflag = LDISC1;
2069 if (tcsetattr (xforkin, TCSANOW, &t) < 0)
2070 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2071 }
2072#else
2073#if defined (NTTYDISC) && defined (TIOCSETD)
2074 if (pty_flag && xforkin >= 0)
2075 {
2076 /* Use new line discipline. */
2077 int ldisc = NTTYDISC;
2078 ioctl (xforkin, TIOCSETD, &ldisc);
2079 }
2080#endif
2081#endif
2082#ifdef TIOCNOTTY
2083 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2084 can do TIOCSPGRP only to the process's controlling tty. */
2085 if (pty_flag)
2086 {
2087 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2088 I can't test it since I don't have 4.3. */
2089 int j = emacs_open ("/dev/tty", O_RDWR, 0);
2090 ioctl (j, TIOCNOTTY, 0);
2091 emacs_close (j);
2092#ifndef USG
2093 /* In order to get a controlling terminal on some versions
2094 of BSD, it is necessary to put the process in pgrp 0
2095 before it opens the terminal. */
2096#ifdef HAVE_SETPGID
2097 setpgid (0, 0);
2098#else
2099 setpgrp (0, 0);
2100#endif
2101#endif
2102 }
2103#endif /* TIOCNOTTY */
2104
2105#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2106/*** There is a suggestion that this ought to be a
2107 conditional on TIOCSPGRP,
2108 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2109 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2110 that system does seem to need this code, even though
2111 both HAVE_SETSID and TIOCSCTTY are defined. */
2112 /* Now close the pty (if we had it open) and reopen it.
2113 This makes the pty the controlling terminal of the subprocess. */
2114 if (pty_flag)
2115 {
2116#ifdef SET_CHILD_PTY_PGRP
2117 int pgrp = getpid ();
2118#endif
2119
2120 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2121 would work? */
2122 if (xforkin >= 0)
2123 emacs_close (xforkin);
2124 xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
2125
2126 if (xforkin < 0)
2127 {
2128 emacs_write (1, "Couldn't open the pty terminal ", 31);
2129 emacs_write (1, pty_name, strlen (pty_name));
2130 emacs_write (1, "\n", 1);
2131 _exit (1);
2132 }
2133
2134#ifdef SET_CHILD_PTY_PGRP
2135 ioctl (xforkin, TIOCSPGRP, &pgrp);
2136 ioctl (xforkout, TIOCSPGRP, &pgrp);
2137#endif
2138 }
2139#endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2140
2141#ifdef SETUP_SLAVE_PTY
2142 if (pty_flag)
2143 {
2144 SETUP_SLAVE_PTY;
2145 }
2146#endif /* SETUP_SLAVE_PTY */
2147#ifdef AIX
2148 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2149 Now reenable it in the child, so it will die when we want it to. */
2150 if (pty_flag)
2151 signal (SIGHUP, SIG_DFL);
2152#endif
2153#endif /* HAVE_PTYS */
2154
2155 signal (SIGINT, SIG_DFL);
2156 signal (SIGQUIT, SIG_DFL);
2157
2158 /* Stop blocking signals in the child. */
2159#ifdef POSIX_SIGNALS
2160 sigprocmask (SIG_SETMASK, &procmask, 0);
2161#else /* !POSIX_SIGNALS */
2162#ifdef SIGCHLD
2163#ifdef BSD4_1
2164 sigrelse (SIGCHLD);
2165#else /* not BSD4_1 */
2166#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2167 sigsetmask (SIGEMPTYMASK);
2168#else /* ordinary USG */
2169#if 0
2170 signal (SIGCHLD, sigchld);
2171#endif
2172#endif /* ordinary USG */
2173#endif /* not BSD4_1 */
2174#endif /* SIGCHLD */
2175#endif /* !POSIX_SIGNALS */
2176
2177#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2178 if (pty_flag)
2179 child_setup_tty (xforkout);
2180#endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2181#ifdef WINDOWSNT
2182 pid = child_setup (xforkin, xforkout, xforkout,
2183 new_argv, 1, current_dir);
2184#else /* not WINDOWSNT */
2185 child_setup (xforkin, xforkout, xforkout,
2186 new_argv, 1, current_dir);
2187#endif /* not WINDOWSNT */
2188 }
2189 environ = save_environ;
2190 }
2191
2192 UNBLOCK_INPUT;
2193
2194 /* This runs in the Emacs process. */
2195 if (pid < 0)
2196 {
2197 if (forkin >= 0)
2198 emacs_close (forkin);
2199 if (forkin != forkout && forkout >= 0)
2200 emacs_close (forkout);
2201 }
2202 else
2203 {
2204 /* vfork succeeded. */
2205 XPROCESS (process)->pid = pid;
2206
2207#ifdef WINDOWSNT
2208 register_child (pid, inchannel);
2209#endif /* WINDOWSNT */
2210
2211 /* If the subfork execv fails, and it exits,
2212 this close hangs. I don't know why.
2213 So have an interrupt jar it loose. */
2214 {
2215 struct atimer *timer;
2216 EMACS_TIME offset;
2217
2218 stop_polling ();
2219 EMACS_SET_SECS_USECS (offset, 1, 0);
2220 timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
2221
2222 if (forkin >= 0)
2223 emacs_close (forkin);
2224
2225 cancel_atimer (timer);
2226 start_polling ();
2227 }
2228
2229 if (forkin != forkout && forkout >= 0)
2230 emacs_close (forkout);
2231
2232#ifdef HAVE_PTYS
2233 if (pty_flag)
2234 XPROCESS (process)->tty_name = build_string (pty_name);
2235 else
2236#endif
2237 XPROCESS (process)->tty_name = Qnil;
2238 }
2239
2240 /* Restore the signal state whether vfork succeeded or not.
2241 (We will signal an error, below, if it failed.) */
2242#ifdef POSIX_SIGNALS
2243#ifdef HAVE_WORKING_VFORK
2244 /* Restore the parent's signal handlers. */
2245 sigaction (SIGINT, &sigint_action, 0);
2246 sigaction (SIGQUIT, &sigquit_action, 0);
2247#ifdef AIX
2248 sigaction (SIGHUP, &sighup_action, 0);
2249#endif
2250#endif /* HAVE_WORKING_VFORK */
2251 /* Stop blocking signals in the parent. */
2252 sigprocmask (SIG_SETMASK, &procmask, 0);
2253#else /* !POSIX_SIGNALS */
2254#ifdef SIGCHLD
2255#ifdef BSD4_1
2256 sigrelse (SIGCHLD);
2257#else /* not BSD4_1 */
2258#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2259 sigsetmask (SIGEMPTYMASK);
2260#else /* ordinary USG */
2261#if 0
2262 signal (SIGCHLD, sigchld);
2263 /* Now really handle any of these signals
2264 that came in during this function. */
2265 if (sigchld_deferred)
2266 kill (getpid (), SIGCHLD);
2267#endif
2268#endif /* ordinary USG */
2269#endif /* not BSD4_1 */
2270#endif /* SIGCHLD */
2271#endif /* !POSIX_SIGNALS */
2272
2273 /* Now generate the error if vfork failed. */
2274 if (pid < 0)
2275 report_file_error ("Doing vfork", Qnil);
2276}
2277#endif /* not VMS */
2278
2279\f
2280#ifdef HAVE_SOCKETS
2281
2282/* Convert an internal struct sockaddr to a lisp object (vector or string).
2283 The address family of sa is not included in the result. */
2284
2285static Lisp_Object
2286conv_sockaddr_to_lisp (sa, len)
2287 struct sockaddr *sa;
2288 int len;
2289{
2290 Lisp_Object address;
2291 int i;
2292 unsigned char *cp;
2293 register struct Lisp_Vector *p;
2294
2295 switch (sa->sa_family)
2296 {
2297 case AF_INET:
2298 {
2299 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2300 len = sizeof (sin->sin_addr) + 1;
2301 address = Fmake_vector (make_number (len), Qnil);
2302 p = XVECTOR (address);
2303 p->contents[--len] = make_number (ntohs (sin->sin_port));
2304 cp = (unsigned char *)&sin->sin_addr;
2305 break;
2306 }
2307#ifdef AF_INET6
2308 case AF_INET6:
2309 {
2310 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
2311 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
2312 len = sizeof (sin6->sin6_addr)/2 + 1;
2313 address = Fmake_vector (make_number (len), Qnil);
2314 p = XVECTOR (address);
2315 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2316 for (i = 0; i < len; i++)
2317 p->contents[i] = make_number (ntohs (ip6[i]));
2318 return address;
2319 }
2320#endif
2321#ifdef HAVE_LOCAL_SOCKETS
2322 case AF_LOCAL:
2323 {
2324 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2325 for (i = 0; i < sizeof (sockun->sun_path); i++)
2326 if (sockun->sun_path[i] == 0)
2327 break;
2328 return make_unibyte_string (sockun->sun_path, i);
2329 }
2330#endif
2331 default:
2332 len -= sizeof (sa->sa_family);
2333 address = Fcons (make_number (sa->sa_family),
2334 Fmake_vector (make_number (len), Qnil));
2335 p = XVECTOR (XCDR (address));
2336 cp = (unsigned char *) sa + sizeof (sa->sa_family);
2337 break;
2338 }
2339
2340 i = 0;
2341 while (i < len)
2342 p->contents[i++] = make_number (*cp++);
2343
2344 return address;
2345}
2346
2347
2348/* Get family and required size for sockaddr structure to hold ADDRESS. */
2349
2350static int
2351get_lisp_to_sockaddr_size (address, familyp)
2352 Lisp_Object address;
2353 int *familyp;
2354{
2355 register struct Lisp_Vector *p;
2356
2357 if (VECTORP (address))
2358 {
2359 p = XVECTOR (address);
2360 if (p->size == 5)
2361 {
2362 *familyp = AF_INET;
2363 return sizeof (struct sockaddr_in);
2364 }
2365#ifdef AF_INET6
2366 else if (p->size == 9)
2367 {
2368 *familyp = AF_INET6;
2369 return sizeof (struct sockaddr_in6);
2370 }
2371#endif
2372 }
2373#ifdef HAVE_LOCAL_SOCKETS
2374 else if (STRINGP (address))
2375 {
2376 *familyp = AF_LOCAL;
2377 return sizeof (struct sockaddr_un);
2378 }
2379#endif
2380 else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
2381 {
2382 struct sockaddr *sa;
2383 *familyp = XINT (XCAR (address));
2384 p = XVECTOR (XCDR (address));
2385 return p->size + sizeof (sa->sa_family);
2386 }
2387 return 0;
2388}
2389
2390/* Convert an address object (vector or string) to an internal sockaddr.
2391
2392 The address format has been basically validated by
2393 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2394 it could have come from user data. So if FAMILY is not valid,
2395 we return after zeroing *SA. */
2396
2397static void
2398conv_lisp_to_sockaddr (family, address, sa, len)
2399 int family;
2400 Lisp_Object address;
2401 struct sockaddr *sa;
2402 int len;
2403{
2404 register struct Lisp_Vector *p;
2405 register unsigned char *cp = NULL;
2406 register int i;
2407
2408 bzero (sa, len);
2409
2410 if (VECTORP (address))
2411 {
2412 p = XVECTOR (address);
2413 if (family == AF_INET)
2414 {
2415 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2416 len = sizeof (sin->sin_addr) + 1;
2417 i = XINT (p->contents[--len]);
2418 sin->sin_port = htons (i);
2419 cp = (unsigned char *)&sin->sin_addr;
2420 sa->sa_family = family;
2421 }
2422#ifdef AF_INET6
2423 else if (family == AF_INET6)
2424 {
2425 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
2426 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
2427 len = sizeof (sin6->sin6_addr) + 1;
2428 i = XINT (p->contents[--len]);
2429 sin6->sin6_port = htons (i);
2430 for (i = 0; i < len; i++)
2431 if (INTEGERP (p->contents[i]))
2432 {
2433 int j = XFASTINT (p->contents[i]) & 0xffff;
2434 ip6[i] = ntohs (j);
2435 }
2436 sa->sa_family = family;
2437 }
2438#endif
2439 return;
2440 }
2441 else if (STRINGP (address))
2442 {
2443#ifdef HAVE_LOCAL_SOCKETS
2444 if (family == AF_LOCAL)
2445 {
2446 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2447 cp = SDATA (address);
2448 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2449 sockun->sun_path[i] = *cp++;
2450 sa->sa_family = family;
2451 }
2452#endif
2453 return;
2454 }
2455 else
2456 {
2457 p = XVECTOR (XCDR (address));
2458 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2459 }
2460
2461 for (i = 0; i < len; i++)
2462 if (INTEGERP (p->contents[i]))
2463 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2464}
2465
2466#ifdef DATAGRAM_SOCKETS
2467DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2468 1, 1, 0,
2469 doc: /* Get the current datagram address associated with PROCESS. */)
2470 (process)
2471 Lisp_Object process;
2472{
2473 int channel;
2474
2475 CHECK_PROCESS (process);
2476
2477 if (!DATAGRAM_CONN_P (process))
2478 return Qnil;
2479
2480 channel = XINT (XPROCESS (process)->infd);
2481 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2482 datagram_address[channel].len);
2483}
2484
2485DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2486 2, 2, 0,
2487 doc: /* Set the datagram address for PROCESS to ADDRESS.
2488Returns nil upon error setting address, ADDRESS otherwise. */)
2489 (process, address)
2490 Lisp_Object process, address;
2491{
2492 int channel;
2493 int family, len;
2494
2495 CHECK_PROCESS (process);
2496
2497 if (!DATAGRAM_CONN_P (process))
2498 return Qnil;
2499
2500 channel = XINT (XPROCESS (process)->infd);
2501
2502 len = get_lisp_to_sockaddr_size (address, &family);
2503 if (datagram_address[channel].len != len)
2504 return Qnil;
2505 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2506 return address;
2507}
2508#endif
2509\f
2510
2511static struct socket_options {
2512 /* The name of this option. Should be lowercase version of option
2513 name without SO_ prefix. */
2514 char *name;
2515 /* Option level SOL_... */
2516 int optlevel;
2517 /* Option number SO_... */
2518 int optnum;
2519 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2520 enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
2521} socket_options[] =
2522 {
2523#ifdef SO_BINDTODEVICE
2524 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2525#endif
2526#ifdef SO_BROADCAST
2527 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2528#endif
2529#ifdef SO_DONTROUTE
2530 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2531#endif
2532#ifdef SO_KEEPALIVE
2533 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2534#endif
2535#ifdef SO_LINGER
2536 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2537#endif
2538#ifdef SO_OOBINLINE
2539 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2540#endif
2541#ifdef SO_PRIORITY
2542 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2543#endif
2544#ifdef SO_REUSEADDR
2545 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2546#endif
2547 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2548 };
2549
2550/* Set option OPT to value VAL on socket S.
2551
2552 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2553 Signals an error if setting a known option fails.
2554*/
2555
2556static int
2557set_socket_option (s, opt, val)
2558 int s;
2559 Lisp_Object opt, val;
2560{
2561 char *name;
2562 struct socket_options *sopt;
2563 int ret = 0;
2564
2565 CHECK_SYMBOL (opt);
2566
2567 name = (char *) SDATA (SYMBOL_NAME (opt));
2568 for (sopt = socket_options; sopt->name; sopt++)
2569 if (strcmp (name, sopt->name) == 0)
2570 break;
2571
2572 switch (sopt->opttype)
2573 {
2574 case SOPT_BOOL:
2575 {
2576 int optval;
2577 optval = NILP (val) ? 0 : 1;
2578 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2579 &optval, sizeof (optval));
2580 break;
2581 }
2582
2583 case SOPT_INT:
2584 {
2585 int optval;
2586 if (INTEGERP (val))
2587 optval = XINT (val);
2588 else
2589 error ("Bad option value for %s", name);
2590 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2591 &optval, sizeof (optval));
2592 break;
2593 }
2594
2595#ifdef SO_BINDTODEVICE
2596 case SOPT_IFNAME:
2597 {
2598 char devname[IFNAMSIZ+1];
2599
2600 /* This is broken, at least in the Linux 2.4 kernel.
2601 To unbind, the arg must be a zero integer, not the empty string.
2602 This should work on all systems. KFS. 2003-09-23. */
2603 bzero (devname, sizeof devname);
2604 if (STRINGP (val))
2605 {
2606 char *arg = (char *) SDATA (val);
2607 int len = min (strlen (arg), IFNAMSIZ);
2608 bcopy (arg, devname, len);
2609 }
2610 else if (!NILP (val))
2611 error ("Bad option value for %s", name);
2612 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2613 devname, IFNAMSIZ);
2614 break;
2615 }
2616#endif
2617
2618#ifdef SO_LINGER
2619 case SOPT_LINGER:
2620 {
2621 struct linger linger;
2622
2623 linger.l_onoff = 1;
2624 linger.l_linger = 0;
2625 if (INTEGERP (val))
2626 linger.l_linger = XINT (val);
2627 else
2628 linger.l_onoff = NILP (val) ? 0 : 1;
2629 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2630 &linger, sizeof (linger));
2631 break;
2632 }
2633#endif
2634
2635 default:
2636 return 0;
2637 }
2638
2639 if (ret < 0)
2640 report_file_error ("Cannot set network option",
2641 Fcons (opt, Fcons (val, Qnil)));
2642 return (1 << sopt->optbit);
2643}
2644
2645
2646DEFUN ("set-network-process-option",
2647 Fset_network_process_option, Sset_network_process_option,
2648 3, 4, 0,
2649 doc: /* For network process PROCESS set option OPTION to value VALUE.
2650See `make-network-process' for a list of options and values.
2651If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2652OPTION is not a supported option, return nil instead; otherwise return t. */)
2653 (process, option, value, no_error)
2654 Lisp_Object process, option, value;
2655 Lisp_Object no_error;
2656{
2657 int s;
2658 struct Lisp_Process *p;
2659
2660 CHECK_PROCESS (process);
2661 p = XPROCESS (process);
2662 if (!NETCONN1_P (p))
2663 error ("Process is not a network process");
2664
2665 s = XINT (p->infd);
2666 if (s < 0)
2667 error ("Process is not running");
2668
2669 if (set_socket_option (s, option, value))
2670 {
2671 p->childp = Fplist_put (p->childp, option, value);
2672 return Qt;
2673 }
2674
2675 if (NILP (no_error))
2676 error ("Unknown or unsupported option");
2677
2678 return Qnil;
2679}
2680
2681\f
2682/* A version of request_sigio suitable for a record_unwind_protect. */
2683
2684static Lisp_Object
2685unwind_request_sigio (dummy)
2686 Lisp_Object dummy;
2687{
2688 if (interrupt_input)
2689 request_sigio ();
2690 return Qnil;
2691}
2692
2693/* Create a network stream/datagram client/server process. Treated
2694 exactly like a normal process when reading and writing. Primary
2695 differences are in status display and process deletion. A network
2696 connection has no PID; you cannot signal it. All you can do is
2697 stop/continue it and deactivate/close it via delete-process */
2698
2699DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
2700 0, MANY, 0,
2701 doc: /* Create and return a network server or client process.
2702
2703In Emacs, network connections are represented by process objects, so
2704input and output work as for subprocesses and `delete-process' closes
2705a network connection. However, a network process has no process id,
2706it cannot be signaled, and the status codes are different from normal
2707processes.
2708
2709Arguments are specified as keyword/argument pairs. The following
2710arguments are defined:
2711
2712:name NAME -- NAME is name for process. It is modified if necessary
2713to make it unique.
2714
2715:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2716with the process. Process output goes at end of that buffer, unless
2717you specify an output stream or filter function to handle the output.
2718BUFFER may be also nil, meaning that this process is not associated
2719with any buffer.
2720
2721:host HOST -- HOST is name of the host to connect to, or its IP
2722address. The symbol `local' specifies the local host. If specified
2723for a server process, it must be a valid name or address for the local
2724host, and only clients connecting to that address will be accepted.
2725
2726:service SERVICE -- SERVICE is name of the service desired, or an
2727integer specifying a port number to connect to. If SERVICE is t,
2728a random port number is selected for the server. (If Emacs was
2729compiled with getaddrinfo, a port number can also be specified as a
2730string, e.g. "80", as well as an integer. This is not portable.)
2731
2732:type TYPE -- TYPE is the type of connection. The default (nil) is a
2733stream type connection, `datagram' creates a datagram type connection.
2734
2735:family FAMILY -- FAMILY is the address (and protocol) family for the
2736service specified by HOST and SERVICE. The default (nil) is to use
2737whatever address family (IPv4 or IPv6) that is defined for the host
2738and port number specified by HOST and SERVICE. Other address families
2739supported are:
2740 local -- for a local (i.e. UNIX) address specified by SERVICE.
2741 ipv4 -- use IPv4 address family only.
2742 ipv6 -- use IPv6 address family only.
2743
2744:local ADDRESS -- ADDRESS is the local address used for the connection.
2745This parameter is ignored when opening a client process. When specified
2746for a server process, the FAMILY, HOST and SERVICE args are ignored.
2747
2748:remote ADDRESS -- ADDRESS is the remote partner's address for the
2749connection. This parameter is ignored when opening a stream server
2750process. For a datagram server process, it specifies the initial
2751setting of the remote datagram address. When specified for a client
2752process, the FAMILY, HOST, and SERVICE args are ignored.
2753
2754The format of ADDRESS depends on the address family:
2755- An IPv4 address is represented as an vector of integers [A B C D P]
2756corresponding to numeric IP address A.B.C.D and port number P.
2757- A local address is represented as a string with the address in the
2758local address space.
2759- An "unsupported family" address is represented by a cons (F . AV)
2760where F is the family number and AV is a vector containing the socket
2761address data with one element per address data byte. Do not rely on
2762this format in portable code, as it may depend on implementation
2763defined constants, data sizes, and data structure alignment.
2764
2765:coding CODING -- If CODING is a symbol, it specifies the coding
2766system used for both reading and writing for this process. If CODING
2767is a cons (DECODING . ENCODING), DECODING is used for reading, and
2768ENCODING is used for writing.
2769
2770:nowait BOOL -- If BOOL is non-nil for a stream type client process,
2771return without waiting for the connection to complete; instead, the
2772sentinel function will be called with second arg matching "open" (if
2773successful) or "failed" when the connect completes. Default is to use
2774a blocking connect (i.e. wait) for stream type connections.
2775
2776:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2777running when Emacs is exited.
2778
2779:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2780In the stopped state, a server process does not accept new
2781connections, and a client process does not handle incoming traffic.
2782The stopped state is cleared by `continue-process' and set by
2783`stop-process'.
2784
2785:filter FILTER -- Install FILTER as the process filter.
2786
2787:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2788process filter are multibyte, otherwise they are unibyte.
2789If this keyword is not specified, the strings are multibyte if
2790`default-enable-multibyte-characters' is non-nil.
2791
2792:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2793
2794:log LOG -- Install LOG as the server process log function. This
2795function is called when the server accepts a network connection from a
2796client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2797is the server process, CLIENT is the new process for the connection,
2798and MESSAGE is a string.
2799
2800:plist PLIST -- Install PLIST as the new process' initial plist.
2801
2802:server QLEN -- if QLEN is non-nil, create a server process for the
2803specified FAMILY, SERVICE, and connection type (stream or datagram).
2804If QLEN is an integer, it is used as the max. length of the server's
2805pending connection queue (also known as the backlog); the default
2806queue length is 5. Default is to create a client process.
2807
2808The following network options can be specified for this connection:
2809
2810:broadcast BOOL -- Allow send and receive of datagram broadcasts.
2811:dontroute BOOL -- Only send to directly connected hosts.
2812:keepalive BOOL -- Send keep-alive messages on network stream.
2813:linger BOOL or TIMEOUT -- Send queued messages before closing.
2814:oobinline BOOL -- Place out-of-band data in receive data stream.
2815:priority INT -- Set protocol defined priority for sent packets.
2816:reuseaddr BOOL -- Allow reusing a recently used local address
2817 (this is allowed by default for a server process).
2818:bindtodevice NAME -- bind to interface NAME. Using this may require
2819 special privileges on some systems.
2820
2821Consult the relevant system programmer's manual pages for more
2822information on using these options.
2823
2824
2825A server process will listen for and accept connections from clients.
2826When a client connection is accepted, a new network process is created
2827for the connection with the following parameters:
2828
2829- The client's process name is constructed by concatenating the server
2830process' NAME and a client identification string.
2831- If the FILTER argument is non-nil, the client process will not get a
2832separate process buffer; otherwise, the client's process buffer is a newly
2833created buffer named after the server process' BUFFER name or process
2834NAME concatenated with the client identification string.
2835- The connection type and the process filter and sentinel parameters are
2836inherited from the server process' TYPE, FILTER and SENTINEL.
2837- The client process' contact info is set according to the client's
2838addressing information (typically an IP address and a port number).
2839- The client process' plist is initialized from the server's plist.
2840
2841Notice that the FILTER and SENTINEL args are never used directly by
2842the server process. Also, the BUFFER argument is not used directly by
2843the server process, but via the optional :log function, accepted (and
2844failed) connections may be logged in the server process' buffer.
2845
2846The original argument list, modified with the actual connection
2847information, is available via the `process-contact' function.
2848
2849usage: (make-network-process &rest ARGS) */)
2850 (nargs, args)
2851 int nargs;
2852 Lisp_Object *args;
2853{
2854 Lisp_Object proc;
2855 Lisp_Object contact;
2856 struct Lisp_Process *p;
2857#ifdef HAVE_GETADDRINFO
2858 struct addrinfo ai, *res, *lres;
2859 struct addrinfo hints;
2860 char *portstring, portbuf[128];
2861#else /* HAVE_GETADDRINFO */
2862 struct _emacs_addrinfo
2863 {
2864 int ai_family;
2865 int ai_socktype;
2866 int ai_protocol;
2867 int ai_addrlen;
2868 struct sockaddr *ai_addr;
2869 struct _emacs_addrinfo *ai_next;
2870 } ai, *res, *lres;
2871#endif /* HAVE_GETADDRINFO */
2872 struct sockaddr_in address_in;
2873#ifdef HAVE_LOCAL_SOCKETS
2874 struct sockaddr_un address_un;
2875#endif
2876 int port;
2877 int ret = 0;
2878 int xerrno = 0;
2879 int s = -1, outch, inch;
2880 struct gcpro gcpro1;
2881 int count = SPECPDL_INDEX ();
2882 int count1;
2883 Lisp_Object QCaddress; /* one of QClocal or QCremote */
2884 Lisp_Object tem;
2885 Lisp_Object name, buffer, host, service, address;
2886 Lisp_Object filter, sentinel;
2887 int is_non_blocking_client = 0;
2888 int is_server = 0, backlog = 5;
2889 int socktype;
2890 int family = -1;
2891
2892 if (nargs == 0)
2893 return Qnil;
2894
2895 /* Save arguments for process-contact and clone-process. */
2896 contact = Flist (nargs, args);
2897 GCPRO1 (contact);
2898
2899#ifdef WINDOWSNT
2900 /* Ensure socket support is loaded if available. */
2901 init_winsock (TRUE);
2902#endif
2903
2904 /* :type TYPE (nil: stream, datagram */
2905 tem = Fplist_get (contact, QCtype);
2906 if (NILP (tem))
2907 socktype = SOCK_STREAM;
2908#ifdef DATAGRAM_SOCKETS
2909 else if (EQ (tem, Qdatagram))
2910 socktype = SOCK_DGRAM;
2911#endif
2912 else
2913 error ("Unsupported connection type");
2914
2915 /* :server BOOL */
2916 tem = Fplist_get (contact, QCserver);
2917 if (!NILP (tem))
2918 {
2919 /* Don't support network sockets when non-blocking mode is
2920 not available, since a blocked Emacs is not useful. */
2921#if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2922 error ("Network servers not supported");
2923#else
2924 is_server = 1;
2925 if (INTEGERP (tem))
2926 backlog = XINT (tem);
2927#endif
2928 }
2929
2930 /* Make QCaddress an alias for :local (server) or :remote (client). */
2931 QCaddress = is_server ? QClocal : QCremote;
2932
2933 /* :nowait BOOL */
2934 if (!is_server && socktype == SOCK_STREAM
2935 && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
2936 {
2937#ifndef NON_BLOCKING_CONNECT
2938 error ("Non-blocking connect not supported");
2939#else
2940 is_non_blocking_client = 1;
2941#endif
2942 }
2943
2944 name = Fplist_get (contact, QCname);
2945 buffer = Fplist_get (contact, QCbuffer);
2946 filter = Fplist_get (contact, QCfilter);
2947 sentinel = Fplist_get (contact, QCsentinel);
2948
2949 CHECK_STRING (name);
2950
2951#ifdef TERM
2952 /* Let's handle TERM before things get complicated ... */
2953 host = Fplist_get (contact, QChost);
2954 CHECK_STRING (host);
2955
2956 service = Fplist_get (contact, QCservice);
2957 if (INTEGERP (service))
2958 port = htons ((unsigned short) XINT (service));
2959 else
2960 {
2961 struct servent *svc_info;
2962 CHECK_STRING (service);
2963 svc_info = getservbyname (SDATA (service), "tcp");
2964 if (svc_info == 0)
2965 error ("Unknown service: %s", SDATA (service));
2966 port = svc_info->s_port;
2967 }
2968
2969 s = connect_server (0);
2970 if (s < 0)
2971 report_file_error ("error creating socket", Fcons (name, Qnil));
2972 send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port));
2973 send_command (s, C_DUMB, 1, 0);
2974
2975#else /* not TERM */
2976
2977 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2978 ai.ai_socktype = socktype;
2979 ai.ai_protocol = 0;
2980 ai.ai_next = NULL;
2981 res = &ai;
2982
2983 /* :local ADDRESS or :remote ADDRESS */
2984 address = Fplist_get (contact, QCaddress);
2985 if (!NILP (address))
2986 {
2987 host = service = Qnil;
2988
2989 if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
2990 error ("Malformed :address");
2991 ai.ai_family = family;
2992 ai.ai_addr = alloca (ai.ai_addrlen);
2993 conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
2994 goto open_socket;
2995 }
2996
2997 /* :family FAMILY -- nil (for Inet), local, or integer. */
2998 tem = Fplist_get (contact, QCfamily);
2999 if (NILP (tem))
3000 {
3001#if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
3002 family = AF_UNSPEC;
3003#else
3004 family = AF_INET;
3005#endif
3006 }
3007#ifdef HAVE_LOCAL_SOCKETS
3008 else if (EQ (tem, Qlocal))
3009 family = AF_LOCAL;
3010#endif
3011#ifdef AF_INET6
3012 else if (EQ (tem, Qipv6))
3013 family = AF_INET6;
3014#endif
3015 else if (EQ (tem, Qipv4))
3016 family = AF_INET;
3017 else if (INTEGERP (tem))
3018 family = XINT (tem);
3019 else
3020 error ("Unknown address family");
3021
3022 ai.ai_family = family;
3023
3024 /* :service SERVICE -- string, integer (port number), or t (random port). */
3025 service = Fplist_get (contact, QCservice);
3026
3027#ifdef HAVE_LOCAL_SOCKETS
3028 if (family == AF_LOCAL)
3029 {
3030 /* Host is not used. */
3031 host = Qnil;
3032 CHECK_STRING (service);
3033 bzero (&address_un, sizeof address_un);
3034 address_un.sun_family = AF_LOCAL;
3035 strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path);
3036 ai.ai_addr = (struct sockaddr *) &address_un;
3037 ai.ai_addrlen = sizeof address_un;
3038 goto open_socket;
3039 }
3040#endif
3041
3042 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3043 host = Fplist_get (contact, QChost);
3044 if (!NILP (host))
3045 {
3046 if (EQ (host, Qlocal))
3047 host = build_string ("localhost");
3048 CHECK_STRING (host);
3049 }
3050
3051 /* Slow down polling to every ten seconds.
3052 Some kernels have a bug which causes retrying connect to fail
3053 after a connect. Polling can interfere with gethostbyname too. */
3054#ifdef POLL_FOR_INPUT
3055 if (socktype == SOCK_STREAM)
3056 {
3057 record_unwind_protect (unwind_stop_other_atimers, Qnil);
3058 bind_polling_period (10);
3059 }
3060#endif
3061
3062#ifdef HAVE_GETADDRINFO
3063 /* If we have a host, use getaddrinfo to resolve both host and service.
3064 Otherwise, use getservbyname to lookup the service. */
3065 if (!NILP (host))
3066 {
3067
3068 /* SERVICE can either be a string or int.
3069 Convert to a C string for later use by getaddrinfo. */
3070 if (EQ (service, Qt))
3071 portstring = "0";
3072 else if (INTEGERP (service))
3073 {
3074 sprintf (portbuf, "%ld", (long) XINT (service));
3075 portstring = portbuf;
3076 }
3077 else
3078 {
3079 CHECK_STRING (service);
3080 portstring = SDATA (service);
3081 }
3082
3083 immediate_quit = 1;
3084 QUIT;
3085 memset (&hints, 0, sizeof (hints));
3086 hints.ai_flags = 0;
3087 hints.ai_family = family;
3088 hints.ai_socktype = socktype;
3089 hints.ai_protocol = 0;
3090 ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
3091 if (ret)
3092#ifdef HAVE_GAI_STRERROR
3093 error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
3094#else
3095 error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
3096#endif
3097 immediate_quit = 0;
3098
3099 goto open_socket;
3100 }
3101#endif /* HAVE_GETADDRINFO */
3102
3103 /* We end up here if getaddrinfo is not defined, or in case no hostname
3104 has been specified (e.g. for a local server process). */
3105
3106 if (EQ (service, Qt))
3107 port = 0;
3108 else if (INTEGERP (service))
3109 port = htons ((unsigned short) XINT (service));
3110 else
3111 {
3112 struct servent *svc_info;
3113 CHECK_STRING (service);
3114 svc_info = getservbyname (SDATA (service),
3115 (socktype == SOCK_DGRAM ? "udp" : "tcp"));
3116 if (svc_info == 0)
3117 error ("Unknown service: %s", SDATA (service));
3118 port = svc_info->s_port;
3119 }
3120
3121 bzero (&address_in, sizeof address_in);
3122 address_in.sin_family = family;
3123 address_in.sin_addr.s_addr = INADDR_ANY;
3124 address_in.sin_port = port;
3125
3126#ifndef HAVE_GETADDRINFO
3127 if (!NILP (host))
3128 {
3129 struct hostent *host_info_ptr;
3130
3131 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3132 as it may `hang' Emacs for a very long time. */
3133 immediate_quit = 1;
3134 QUIT;
3135 host_info_ptr = gethostbyname (SDATA (host));
3136 immediate_quit = 0;
3137
3138 if (host_info_ptr)
3139 {
3140 bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
3141 host_info_ptr->h_length);
3142 family = host_info_ptr->h_addrtype;
3143 address_in.sin_family = family;
3144 }
3145 else
3146 /* Attempt to interpret host as numeric inet address */
3147 {
3148 IN_ADDR numeric_addr;
3149 numeric_addr = inet_addr ((char *) SDATA (host));
3150 if (NUMERIC_ADDR_ERROR)
3151 error ("Unknown host \"%s\"", SDATA (host));
3152
3153 bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
3154 sizeof (address_in.sin_addr));
3155 }
3156
3157 }
3158#endif /* not HAVE_GETADDRINFO */
3159
3160 ai.ai_family = family;
3161 ai.ai_addr = (struct sockaddr *) &address_in;
3162 ai.ai_addrlen = sizeof address_in;
3163
3164 open_socket:
3165
3166 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3167 when connect is interrupted. So let's not let it get interrupted.
3168 Note we do not turn off polling, because polling is only used
3169 when not interrupt_input, and thus not normally used on the systems
3170 which have this bug. On systems which use polling, there's no way
3171 to quit if polling is turned off. */
3172 if (interrupt_input
3173 && !is_server && socktype == SOCK_STREAM)
3174 {
3175 /* Comment from KFS: The original open-network-stream code
3176 didn't unwind protect this, but it seems like the proper
3177 thing to do. In any case, I don't see how it could harm to
3178 do this -- and it makes cleanup (using unbind_to) easier. */
3179 record_unwind_protect (unwind_request_sigio, Qnil);
3180 unrequest_sigio ();
3181 }
3182
3183 /* Do this in case we never enter the for-loop below. */
3184 count1 = SPECPDL_INDEX ();
3185 s = -1;
3186
3187 for (lres = res; lres; lres = lres->ai_next)
3188 {
3189 int optn, optbits;
3190
3191 retry_connect:
3192
3193 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
3194 if (s < 0)
3195 {
3196 xerrno = errno;
3197 continue;
3198 }
3199
3200#ifdef DATAGRAM_SOCKETS
3201 if (!is_server && socktype == SOCK_DGRAM)
3202 break;
3203#endif /* DATAGRAM_SOCKETS */
3204
3205#ifdef NON_BLOCKING_CONNECT
3206 if (is_non_blocking_client)
3207 {
3208#ifdef O_NONBLOCK
3209 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3210#else
3211 ret = fcntl (s, F_SETFL, O_NDELAY);
3212#endif
3213 if (ret < 0)
3214 {
3215 xerrno = errno;
3216 emacs_close (s);
3217 s = -1;
3218 continue;
3219 }
3220 }
3221#endif
3222
3223 /* Make us close S if quit. */
3224 record_unwind_protect (close_file_unwind, make_number (s));
3225
3226 /* Parse network options in the arg list.
3227 We simply ignore anything which isn't a known option (including other keywords).
3228 An error is signalled if setting a known option fails. */
3229 for (optn = optbits = 0; optn < nargs-1; optn += 2)
3230 optbits |= set_socket_option (s, args[optn], args[optn+1]);
3231
3232 if (is_server)
3233 {
3234 /* Configure as a server socket. */
3235
3236 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3237 explicit :reuseaddr key to override this. */
3238#ifdef HAVE_LOCAL_SOCKETS
3239 if (family != AF_LOCAL)
3240#endif
3241 if (!(optbits & (1 << OPIX_REUSEADDR)))
3242 {
3243 int optval = 1;
3244 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3245 report_file_error ("Cannot set reuse option on server socket", Qnil);
3246 }
3247
3248 if (bind (s, lres->ai_addr, lres->ai_addrlen))
3249 report_file_error ("Cannot bind server socket", Qnil);
3250
3251#ifdef HAVE_GETSOCKNAME
3252 if (EQ (service, Qt))
3253 {
3254 struct sockaddr_in sa1;
3255 int len1 = sizeof (sa1);
3256 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3257 {
3258 ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
3259 service = make_number (ntohs (sa1.sin_port));
3260 contact = Fplist_put (contact, QCservice, service);
3261 }
3262 }
3263#endif
3264
3265 if (socktype == SOCK_STREAM && listen (s, backlog))
3266 report_file_error ("Cannot listen on server socket", Qnil);
3267
3268 break;
3269 }
3270
3271 immediate_quit = 1;
3272 QUIT;
3273
3274 /* This turns off all alarm-based interrupts; the
3275 bind_polling_period call above doesn't always turn all the
3276 short-interval ones off, especially if interrupt_input is
3277 set.
3278
3279 It'd be nice to be able to control the connect timeout
3280 though. Would non-blocking connect calls be portable?
3281
3282 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3283
3284 turn_on_atimers (0);
3285
3286 ret = connect (s, lres->ai_addr, lres->ai_addrlen);
3287 xerrno = errno;
3288
3289 turn_on_atimers (1);
3290
3291 if (ret == 0 || xerrno == EISCONN)
3292 {
3293 /* The unwind-protect will be discarded afterwards.
3294 Likewise for immediate_quit. */
3295 break;
3296 }
3297
3298#ifdef NON_BLOCKING_CONNECT
3299#ifdef EINPROGRESS
3300 if (is_non_blocking_client && xerrno == EINPROGRESS)
3301 break;
3302#else
3303#ifdef EWOULDBLOCK
3304 if (is_non_blocking_client && xerrno == EWOULDBLOCK)
3305 break;
3306#endif
3307#endif
3308#endif
3309
3310 immediate_quit = 0;
3311
3312 /* Discard the unwind protect closing S. */
3313 specpdl_ptr = specpdl + count1;
3314 emacs_close (s);
3315 s = -1;
3316
3317 if (xerrno == EINTR)
3318 goto retry_connect;
3319 }
3320
3321 if (s >= 0)
3322 {
3323#ifdef DATAGRAM_SOCKETS
3324 if (socktype == SOCK_DGRAM)
3325 {
3326 if (datagram_address[s].sa)
3327 abort ();
3328 datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
3329 datagram_address[s].len = lres->ai_addrlen;
3330 if (is_server)
3331 {
3332 Lisp_Object remote;
3333 bzero (datagram_address[s].sa, lres->ai_addrlen);
3334 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3335 {
3336 int rfamily, rlen;
3337 rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3338 if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
3339 conv_lisp_to_sockaddr (rfamily, remote,
3340 datagram_address[s].sa, rlen);
3341 }
3342 }
3343 else
3344 bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
3345 }
3346#endif
3347 contact = Fplist_put (contact, QCaddress,
3348 conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
3349#ifdef HAVE_GETSOCKNAME
3350 if (!is_server)
3351 {
3352 struct sockaddr_in sa1;
3353 int len1 = sizeof (sa1);
3354 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3355 contact = Fplist_put (contact, QClocal,
3356 conv_sockaddr_to_lisp (&sa1, len1));
3357 }
3358#endif
3359 }
3360
3361 immediate_quit = 0;
3362
3363#ifdef HAVE_GETADDRINFO
3364 if (res != &ai)
3365 {
3366 BLOCK_INPUT;
3367 freeaddrinfo (res);
3368 UNBLOCK_INPUT;
3369 }
3370#endif
3371
3372 /* Discard the unwind protect for closing S, if any. */
3373 specpdl_ptr = specpdl + count1;
3374
3375 /* Unwind bind_polling_period and request_sigio. */
3376 unbind_to (count, Qnil);
3377
3378 if (s < 0)
3379 {
3380 /* If non-blocking got this far - and failed - assume non-blocking is
3381 not supported after all. This is probably a wrong assumption, but
3382 the normal blocking calls to open-network-stream handles this error
3383 better. */
3384 if (is_non_blocking_client)
3385 return Qnil;
3386
3387 errno = xerrno;
3388 if (is_server)
3389 report_file_error ("make server process failed", contact);
3390 else
3391 report_file_error ("make client process failed", contact);
3392 }
3393
3394#endif /* not TERM */
3395
3396 inch = s;
3397 outch = s;
3398
3399 if (!NILP (buffer))
3400 buffer = Fget_buffer_create (buffer);
3401 proc = make_process (name);
3402
3403 chan_process[inch] = proc;
3404
3405#ifdef O_NONBLOCK
3406 fcntl (inch, F_SETFL, O_NONBLOCK);
3407#else
3408#ifdef O_NDELAY
3409 fcntl (inch, F_SETFL, O_NDELAY);
3410#endif
3411#endif
3412
3413 p = XPROCESS (proc);
3414
3415 p->childp = contact;
3416 p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
3417
3418 p->buffer = buffer;
3419 p->sentinel = sentinel;
3420 p->filter = filter;
3421 p->filter_multibyte = buffer_defaults.enable_multibyte_characters;
3422 /* Override the above only if :filter-multibyte is specified. */
3423 if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
3424 p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte);
3425 p->log = Fplist_get (contact, QClog);
3426 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3427 p->kill_without_query = Qt;
3428 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3429 p->command = Qt;
3430 p->pid = 0;
3431 XSETINT (p->infd, inch);
3432 XSETINT (p->outfd, outch);
3433 if (is_server && socktype == SOCK_STREAM)
3434 p->status = Qlisten;
3435
3436 /* Make the process marker point into the process buffer (if any). */
3437 if (BUFFERP (buffer))
3438 set_marker_both (p->mark, buffer,
3439 BUF_ZV (XBUFFER (buffer)),
3440 BUF_ZV_BYTE (XBUFFER (buffer)));
3441
3442#ifdef NON_BLOCKING_CONNECT
3443 if (is_non_blocking_client)
3444 {
3445 /* We may get here if connect did succeed immediately. However,
3446 in that case, we still need to signal this like a non-blocking
3447 connection. */
3448 p->status = Qconnect;
3449 if (!FD_ISSET (inch, &connect_wait_mask))
3450 {
3451 FD_SET (inch, &connect_wait_mask);
3452 num_pending_connects++;
3453 }
3454 }
3455 else
3456#endif
3457 /* A server may have a client filter setting of Qt, but it must
3458 still listen for incoming connects unless it is stopped. */
3459 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3460 || (EQ (p->status, Qlisten) && NILP (p->command)))
3461 {
3462 FD_SET (inch, &input_wait_mask);
3463 FD_SET (inch, &non_keyboard_wait_mask);
3464 }
3465
3466 if (inch > max_process_desc)
3467 max_process_desc = inch;
3468
3469 tem = Fplist_member (contact, QCcoding);
3470 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3471 tem = Qnil; /* No error message (too late!). */
3472
3473 {
3474 /* Setup coding systems for communicating with the network stream. */
3475 struct gcpro gcpro1;
3476 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3477 Lisp_Object coding_systems = Qt;
3478 Lisp_Object args[5], val;
3479
3480 if (!NILP (tem))
3481 {
3482 val = XCAR (XCDR (tem));
3483 if (CONSP (val))
3484 val = XCAR (val);
3485 }
3486 else if (!NILP (Vcoding_system_for_read))
3487 val = Vcoding_system_for_read;
3488 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
3489 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
3490 /* We dare not decode end-of-line format by setting VAL to
3491 Qraw_text, because the existing Emacs Lisp libraries
3492 assume that they receive bare code including a sequene of
3493 CR LF. */
3494 val = Qnil;
3495 else
3496 {
3497 if (NILP (host) || NILP (service))
3498 coding_systems = Qnil;
3499 else
3500 {
3501 args[0] = Qopen_network_stream, args[1] = name,
3502 args[2] = buffer, args[3] = host, args[4] = service;
3503 GCPRO1 (proc);
3504 coding_systems = Ffind_operation_coding_system (5, args);
3505 UNGCPRO;
3506 }
3507 if (CONSP (coding_systems))
3508 val = XCAR (coding_systems);
3509 else if (CONSP (Vdefault_process_coding_system))
3510 val = XCAR (Vdefault_process_coding_system);
3511 else
3512 val = Qnil;
3513 }
3514 p->decode_coding_system = val;
3515
3516 if (!NILP (tem))
3517 {
3518 val = XCAR (XCDR (tem));
3519 if (CONSP (val))
3520 val = XCDR (val);
3521 }
3522 else if (!NILP (Vcoding_system_for_write))
3523 val = Vcoding_system_for_write;
3524 else if (NILP (current_buffer->enable_multibyte_characters))
3525 val = Qnil;
3526 else
3527 {
3528 if (EQ (coding_systems, Qt))
3529 {
3530 if (NILP (host) || NILP (service))
3531 coding_systems = Qnil;
3532 else
3533 {
3534 args[0] = Qopen_network_stream, args[1] = name,
3535 args[2] = buffer, args[3] = host, args[4] = service;
3536 GCPRO1 (proc);
3537 coding_systems = Ffind_operation_coding_system (5, args);
3538 UNGCPRO;
3539 }
3540 }
3541 if (CONSP (coding_systems))
3542 val = XCDR (coding_systems);
3543 else if (CONSP (Vdefault_process_coding_system))
3544 val = XCDR (Vdefault_process_coding_system);
3545 else
3546 val = Qnil;
3547 }
3548 p->encode_coding_system = val;
3549 }
3550 setup_process_coding_systems (proc);
3551
3552 p->decoding_buf = make_uninit_string (0);
3553 p->decoding_carryover = make_number (0);
3554 p->encoding_buf = make_uninit_string (0);
3555 p->encoding_carryover = make_number (0);
3556
3557 p->inherit_coding_system_flag
3558 = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system
3559 ? Qnil : Qt);
3560
3561 UNGCPRO;
3562 return proc;
3563}
3564#endif /* HAVE_SOCKETS */
3565
3566\f
3567#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3568
3569#ifdef SIOCGIFCONF
3570DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
3571 doc: /* Return an alist of all network interfaces and their network address.
3572Each element is a cons, the car of which is a string containing the
3573interface name, and the cdr is the network address in internal
3574format; see the description of ADDRESS in `make-network-process'. */)
3575 ()
3576{
3577 struct ifconf ifconf;
3578 struct ifreq *ifreqs = NULL;
3579 int ifaces = 0;
3580 int buf_size, s;
3581 Lisp_Object res;
3582
3583 s = socket (AF_INET, SOCK_STREAM, 0);
3584 if (s < 0)
3585 return Qnil;
3586
3587 again:
3588 ifaces += 25;
3589 buf_size = ifaces * sizeof(ifreqs[0]);
3590 ifreqs = (struct ifreq *)xrealloc(ifreqs, buf_size);
3591 if (!ifreqs)
3592 {
3593 close (s);
3594 return Qnil;
3595 }
3596
3597 ifconf.ifc_len = buf_size;
3598 ifconf.ifc_req = ifreqs;
3599 if (ioctl (s, SIOCGIFCONF, &ifconf))
3600 {
3601 close (s);
3602 return Qnil;
3603 }
3604
3605 if (ifconf.ifc_len == buf_size)
3606 goto again;
3607
3608 close (s);
3609 ifaces = ifconf.ifc_len / sizeof (ifreqs[0]);
3610
3611 res = Qnil;
3612 while (--ifaces >= 0)
3613 {
3614 struct ifreq *ifq = &ifreqs[ifaces];
3615 char namebuf[sizeof (ifq->ifr_name) + 1];
3616 if (ifq->ifr_addr.sa_family != AF_INET)
3617 continue;
3618 bcopy (ifq->ifr_name, namebuf, sizeof (ifq->ifr_name));
3619 namebuf[sizeof (ifq->ifr_name)] = 0;
3620 res = Fcons (Fcons (build_string (namebuf),
3621 conv_sockaddr_to_lisp (&ifq->ifr_addr,
3622 sizeof (struct sockaddr))),
3623 res);
3624 }
3625
3626 return res;
3627}
3628#endif /* SIOCGIFCONF */
3629
3630#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3631
3632struct ifflag_def {
3633 int flag_bit;
3634 char *flag_sym;
3635};
3636
3637static struct ifflag_def ifflag_table[] = {
3638#ifdef IFF_UP
3639 { IFF_UP, "up" },
3640#endif
3641#ifdef IFF_BROADCAST
3642 { IFF_BROADCAST, "broadcast" },
3643#endif
3644#ifdef IFF_DEBUG
3645 { IFF_DEBUG, "debug" },
3646#endif
3647#ifdef IFF_LOOPBACK
3648 { IFF_LOOPBACK, "loopback" },
3649#endif
3650#ifdef IFF_POINTOPOINT
3651 { IFF_POINTOPOINT, "pointopoint" },
3652#endif
3653#ifdef IFF_RUNNING
3654 { IFF_RUNNING, "running" },
3655#endif
3656#ifdef IFF_NOARP
3657 { IFF_NOARP, "noarp" },
3658#endif
3659#ifdef IFF_PROMISC
3660 { IFF_PROMISC, "promisc" },
3661#endif
3662#ifdef IFF_NOTRAILERS
3663 { IFF_NOTRAILERS, "notrailers" },
3664#endif
3665#ifdef IFF_ALLMULTI
3666 { IFF_ALLMULTI, "allmulti" },
3667#endif
3668#ifdef IFF_MASTER
3669 { IFF_MASTER, "master" },
3670#endif
3671#ifdef IFF_SLAVE
3672 { IFF_SLAVE, "slave" },
3673#endif
3674#ifdef IFF_MULTICAST
3675 { IFF_MULTICAST, "multicast" },
3676#endif
3677#ifdef IFF_PORTSEL
3678 { IFF_PORTSEL, "portsel" },
3679#endif
3680#ifdef IFF_AUTOMEDIA
3681 { IFF_AUTOMEDIA, "automedia" },
3682#endif
3683#ifdef IFF_DYNAMIC
3684 { IFF_DYNAMIC, "dynamic" },
3685#endif
3686#ifdef IFF_OACTIVE
3687 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress */
3688#endif
3689#ifdef IFF_SIMPLEX
3690 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions */
3691#endif
3692#ifdef IFF_LINK0
3693 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit */
3694#endif
3695#ifdef IFF_LINK1
3696 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit */
3697#endif
3698#ifdef IFF_LINK2
3699 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit */
3700#endif
3701 { 0, 0 }
3702};
3703
3704DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
3705 doc: /* Return information about network interface named IFNAME.
3706The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3707where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3708NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3709FLAGS is the current flags of the interface. */)
3710 (ifname)
3711 Lisp_Object ifname;
3712{
3713 struct ifreq rq;
3714 Lisp_Object res = Qnil;
3715 Lisp_Object elt;
3716 int s;
3717 int any = 0;
3718
3719 CHECK_STRING (ifname);
3720
3721 bzero (rq.ifr_name, sizeof rq.ifr_name);
3722 strncpy (rq.ifr_name, SDATA (ifname), sizeof (rq.ifr_name));
3723
3724 s = socket (AF_INET, SOCK_STREAM, 0);
3725 if (s < 0)
3726 return Qnil;
3727
3728 elt = Qnil;
3729#if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3730 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
3731 {
3732 int flags = rq.ifr_flags;
3733 struct ifflag_def *fp;
3734 int fnum;
3735
3736 any++;
3737 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
3738 {
3739 if (flags & fp->flag_bit)
3740 {
3741 elt = Fcons (intern (fp->flag_sym), elt);
3742 flags -= fp->flag_bit;
3743 }
3744 }
3745 for (fnum = 0; flags && fnum < 32; fnum++)
3746 {
3747 if (flags & (1 << fnum))
3748 {
3749 elt = Fcons (make_number (fnum), elt);
3750 }
3751 }
3752 }
3753#endif
3754 res = Fcons (elt, res);
3755
3756 elt = Qnil;
3757#if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3758 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
3759 {
3760 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
3761 register struct Lisp_Vector *p = XVECTOR (hwaddr);
3762 int n;
3763
3764 any++;
3765 for (n = 0; n < 6; n++)
3766 p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
3767 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
3768 }
3769#endif
3770 res = Fcons (elt, res);
3771
3772 elt = Qnil;
3773#if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3774 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
3775 {
3776 any++;
3777#ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3778 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
3779#else
3780 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
3781#endif
3782 }
3783#endif
3784 res = Fcons (elt, res);
3785
3786 elt = Qnil;
3787#if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3788 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
3789 {
3790 any++;
3791 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
3792 }
3793#endif
3794 res = Fcons (elt, res);
3795
3796 elt = Qnil;
3797#if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3798 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
3799 {
3800 any++;
3801 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
3802 }
3803#endif
3804 res = Fcons (elt, res);
3805
3806 close (s);
3807
3808 return any ? res : Qnil;
3809}
3810#endif
3811#endif /* HAVE_SOCKETS */
3812
3813/* Turn off input and output for process PROC. */
3814
3815void
3816deactivate_process (proc)
3817 Lisp_Object proc;
3818{
3819 register int inchannel, outchannel;
3820 register struct Lisp_Process *p = XPROCESS (proc);
3821
3822 inchannel = XINT (p->infd);
3823 outchannel = XINT (p->outfd);
3824
3825#ifdef ADAPTIVE_READ_BUFFERING
3826 if (XINT (p->read_output_delay) > 0)
3827 {
3828 if (--process_output_delay_count < 0)
3829 process_output_delay_count = 0;
3830 XSETINT (p->read_output_delay, 0);
3831 p->read_output_skip = Qnil;
3832 }
3833#endif
3834
3835 if (inchannel >= 0)
3836 {
3837 /* Beware SIGCHLD hereabouts. */
3838 flush_pending_output (inchannel);
3839#ifdef VMS
3840 {
3841 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
3842 sys$dassgn (outchannel);
3843 vs = get_vms_process_pointer (p->pid);
3844 if (vs)
3845 give_back_vms_process_stuff (vs);
3846 }
3847#else
3848 emacs_close (inchannel);
3849 if (outchannel >= 0 && outchannel != inchannel)
3850 emacs_close (outchannel);
3851#endif
3852
3853 XSETINT (p->infd, -1);
3854 XSETINT (p->outfd, -1);
3855#ifdef DATAGRAM_SOCKETS
3856 if (DATAGRAM_CHAN_P (inchannel))
3857 {
3858 xfree (datagram_address[inchannel].sa);
3859 datagram_address[inchannel].sa = 0;
3860 datagram_address[inchannel].len = 0;
3861 }
3862#endif
3863 chan_process[inchannel] = Qnil;
3864 FD_CLR (inchannel, &input_wait_mask);
3865 FD_CLR (inchannel, &non_keyboard_wait_mask);
3866#ifdef NON_BLOCKING_CONNECT
3867 if (FD_ISSET (inchannel, &connect_wait_mask))
3868 {
3869 FD_CLR (inchannel, &connect_wait_mask);
3870 if (--num_pending_connects < 0)
3871 abort ();
3872 }
3873#endif
3874 if (inchannel == max_process_desc)
3875 {
3876 int i;
3877 /* We just closed the highest-numbered process input descriptor,
3878 so recompute the highest-numbered one now. */
3879 max_process_desc = 0;
3880 for (i = 0; i < MAXDESC; i++)
3881 if (!NILP (chan_process[i]))
3882 max_process_desc = i;
3883 }
3884 }
3885}
3886
3887/* Close all descriptors currently in use for communication
3888 with subprocess. This is used in a newly-forked subprocess
3889 to get rid of irrelevant descriptors. */
3890
3891void
3892close_process_descs ()
3893{
3894#ifndef WINDOWSNT
3895 int i;
3896 for (i = 0; i < MAXDESC; i++)
3897 {
3898 Lisp_Object process;
3899 process = chan_process[i];
3900 if (!NILP (process))
3901 {
3902 int in = XINT (XPROCESS (process)->infd);
3903 int out = XINT (XPROCESS (process)->outfd);
3904 if (in >= 0)
3905 emacs_close (in);
3906 if (out >= 0 && in != out)
3907 emacs_close (out);
3908 }
3909 }
3910#endif
3911}
3912\f
3913DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
3914 0, 4, 0,
3915 doc: /* Allow any pending output from subprocesses to be read by Emacs.
3916It is read into the process' buffers or given to their filter functions.
3917Non-nil arg PROCESS means do not return until some output has been received
3918from PROCESS.
3919
3920Non-nil second arg SECONDS and third arg MILLISEC are number of
3921seconds and milliseconds to wait; return after that much time whether
3922or not there is input. If SECONDS is a floating point number,
3923it specifies a fractional number of seconds to wait.
3924
3925If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3926from PROCESS, suspending reading output from other processes.
3927If JUST-THIS-ONE is an integer, don't run any timers either.
3928Return non-nil if we received any output before the timeout expired. */)
3929 (process, seconds, millisec, just_this_one)
3930 register Lisp_Object process, seconds, millisec, just_this_one;
3931{
3932 int secs, usecs = 0;
3933
3934 if (! NILP (process))
3935 CHECK_PROCESS (process);
3936 else
3937 just_this_one = Qnil;
3938
3939 if (!NILP (seconds))
3940 {
3941 if (INTEGERP (seconds))
3942 secs = XINT (seconds);
3943 else if (FLOATP (seconds))
3944 {
3945 double timeout = XFLOAT_DATA (seconds);
3946 secs = (int) timeout;
3947 usecs = (int) ((timeout - (double) secs) * 1000000);
3948 }
3949 else
3950 wrong_type_argument (Qnumberp, seconds);
3951
3952 if (INTEGERP (millisec))
3953 {
3954 int carry;
3955 usecs += XINT (millisec) * 1000;
3956 carry = usecs / 1000000;
3957 secs += carry;
3958 if ((usecs -= carry * 1000000) < 0)
3959 {
3960 secs--;
3961 usecs += 1000000;
3962 }
3963 }
3964
3965 if (secs < 0 || (secs == 0 && usecs == 0))
3966 secs = -1, usecs = 0;
3967 }
3968 else
3969 secs = NILP (process) ? -1 : 0;
3970
3971 return
3972 (wait_reading_process_output (secs, usecs, 0, 0,
3973 Qnil,
3974 !NILP (process) ? XPROCESS (process) : NULL,
3975 NILP (just_this_one) ? 0 :
3976 !INTEGERP (just_this_one) ? 1 : -1)
3977 ? Qt : Qnil);
3978}
3979
3980/* Accept a connection for server process SERVER on CHANNEL. */
3981
3982static int connect_counter = 0;
3983
3984static void
3985server_accept_connection (server, channel)
3986 Lisp_Object server;
3987 int channel;
3988{
3989 Lisp_Object proc, caller, name, buffer;
3990 Lisp_Object contact, host, service;
3991 struct Lisp_Process *ps= XPROCESS (server);
3992 struct Lisp_Process *p;
3993 int s;
3994 union u_sockaddr {
3995 struct sockaddr sa;
3996 struct sockaddr_in in;
3997#ifdef AF_INET6
3998 struct sockaddr_in6 in6;
3999#endif
4000#ifdef HAVE_LOCAL_SOCKETS
4001 struct sockaddr_un un;
4002#endif
4003 } saddr;
4004 int len = sizeof saddr;
4005
4006 s = accept (channel, &saddr.sa, &len);
4007
4008 if (s < 0)
4009 {
4010 int code = errno;
4011
4012 if (code == EAGAIN)
4013 return;
4014#ifdef EWOULDBLOCK
4015 if (code == EWOULDBLOCK)
4016 return;
4017#endif
4018
4019 if (!NILP (ps->log))
4020 call3 (ps->log, server, Qnil,
4021 concat3 (build_string ("accept failed with code"),
4022 Fnumber_to_string (make_number (code)),
4023 build_string ("\n")));
4024 return;
4025 }
4026
4027 connect_counter++;
4028
4029 /* Setup a new process to handle the connection. */
4030
4031 /* Generate a unique identification of the caller, and build contact
4032 information for this process. */
4033 host = Qt;
4034 service = Qnil;
4035 switch (saddr.sa.sa_family)
4036 {
4037 case AF_INET:
4038 {
4039 Lisp_Object args[5];
4040 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4041 args[0] = build_string ("%d.%d.%d.%d");
4042 args[1] = make_number (*ip++);
4043 args[2] = make_number (*ip++);
4044 args[3] = make_number (*ip++);
4045 args[4] = make_number (*ip++);
4046 host = Fformat (5, args);
4047 service = make_number (ntohs (saddr.in.sin_port));
4048
4049 args[0] = build_string (" <%s:%d>");
4050 args[1] = host;
4051 args[2] = service;
4052 caller = Fformat (3, args);
4053 }
4054 break;
4055
4056#ifdef AF_INET6
4057 case AF_INET6:
4058 {
4059 Lisp_Object args[9];
4060 uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr;
4061 int i;
4062 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4063 for (i = 0; i < 8; i++)
4064 args[i+1] = make_number (ntohs(ip6[i]));
4065 host = Fformat (9, args);
4066 service = make_number (ntohs (saddr.in.sin_port));
4067
4068 args[0] = build_string (" <[%s]:%d>");
4069 args[1] = host;
4070 args[2] = service;
4071 caller = Fformat (3, args);
4072 }
4073 break;
4074#endif
4075
4076#ifdef HAVE_LOCAL_SOCKETS
4077 case AF_LOCAL:
4078#endif
4079 default:
4080 caller = Fnumber_to_string (make_number (connect_counter));
4081 caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
4082 break;
4083 }
4084
4085 /* Create a new buffer name for this process if it doesn't have a
4086 filter. The new buffer name is based on the buffer name or
4087 process name of the server process concatenated with the caller
4088 identification. */
4089
4090 if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
4091 buffer = Qnil;
4092 else
4093 {
4094 buffer = ps->buffer;
4095 if (!NILP (buffer))
4096 buffer = Fbuffer_name (buffer);
4097 else
4098 buffer = ps->name;
4099 if (!NILP (buffer))
4100 {
4101 buffer = concat2 (buffer, caller);
4102 buffer = Fget_buffer_create (buffer);
4103 }
4104 }
4105
4106 /* Generate a unique name for the new server process. Combine the
4107 server process name with the caller identification. */
4108
4109 name = concat2 (ps->name, caller);
4110 proc = make_process (name);
4111
4112 chan_process[s] = proc;
4113
4114#ifdef O_NONBLOCK
4115 fcntl (s, F_SETFL, O_NONBLOCK);
4116#else
4117#ifdef O_NDELAY
4118 fcntl (s, F_SETFL, O_NDELAY);
4119#endif
4120#endif
4121
4122 p = XPROCESS (proc);
4123
4124 /* Build new contact information for this setup. */
4125 contact = Fcopy_sequence (ps->childp);
4126 contact = Fplist_put (contact, QCserver, Qnil);
4127 contact = Fplist_put (contact, QChost, host);
4128 if (!NILP (service))
4129 contact = Fplist_put (contact, QCservice, service);
4130 contact = Fplist_put (contact, QCremote,
4131 conv_sockaddr_to_lisp (&saddr.sa, len));
4132#ifdef HAVE_GETSOCKNAME
4133 len = sizeof saddr;
4134 if (getsockname (s, &saddr.sa, &len) == 0)
4135 contact = Fplist_put (contact, QClocal,
4136 conv_sockaddr_to_lisp (&saddr.sa, len));
4137#endif
4138
4139 p->childp = contact;
4140 p->plist = Fcopy_sequence (ps->plist);
4141
4142 p->buffer = buffer;
4143 p->sentinel = ps->sentinel;
4144 p->filter = ps->filter;
4145 p->command = Qnil;
4146 p->pid = 0;
4147 XSETINT (p->infd, s);
4148 XSETINT (p->outfd, s);
4149 p->status = Qrun;
4150
4151 /* Client processes for accepted connections are not stopped initially. */
4152 if (!EQ (p->filter, Qt))
4153 {
4154 FD_SET (s, &input_wait_mask);
4155 FD_SET (s, &non_keyboard_wait_mask);
4156 }
4157
4158 if (s > max_process_desc)
4159 max_process_desc = s;
4160
4161 /* Setup coding system for new process based on server process.
4162 This seems to be the proper thing to do, as the coding system
4163 of the new process should reflect the settings at the time the
4164 server socket was opened; not the current settings. */
4165
4166 p->decode_coding_system = ps->decode_coding_system;
4167 p->encode_coding_system = ps->encode_coding_system;
4168 setup_process_coding_systems (proc);
4169
4170 p->decoding_buf = make_uninit_string (0);
4171 p->decoding_carryover = make_number (0);
4172 p->encoding_buf = make_uninit_string (0);
4173 p->encoding_carryover = make_number (0);
4174
4175 p->inherit_coding_system_flag
4176 = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
4177
4178 if (!NILP (ps->log))
4179 call3 (ps->log, server, proc,
4180 concat3 (build_string ("accept from "),
4181 (STRINGP (host) ? host : build_string ("-")),
4182 build_string ("\n")));
4183
4184 if (!NILP (p->sentinel))
4185 exec_sentinel (proc,
4186 concat3 (build_string ("open from "),
4187 (STRINGP (host) ? host : build_string ("-")),
4188 build_string ("\n")));
4189}
4190
4191/* This variable is different from waiting_for_input in keyboard.c.
4192 It is used to communicate to a lisp process-filter/sentinel (via the
4193 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4194 for user-input when that process-filter was called.
4195 waiting_for_input cannot be used as that is by definition 0 when
4196 lisp code is being evalled.
4197 This is also used in record_asynch_buffer_change.
4198 For that purpose, this must be 0
4199 when not inside wait_reading_process_output. */
4200static int waiting_for_user_input_p;
4201
4202static Lisp_Object
4203wait_reading_process_output_unwind (data)
4204 Lisp_Object data;
4205{
4206 waiting_for_user_input_p = XINT (data);
4207 return Qnil;
4208}
4209
4210/* This is here so breakpoints can be put on it. */
4211static void
4212wait_reading_process_output_1 ()
4213{
4214}
4215
4216/* Use a wrapper around select to work around a bug in gdb 5.3.
4217 Normally, the wrapper is optimzed away by inlining.
4218
4219 If emacs is stopped inside select, the gdb backtrace doesn't
4220 show the function which called select, so it is practically
4221 impossible to step through wait_reading_process_output. */
4222
4223#ifndef select
4224static INLINE int
4225select_wrapper (n, rfd, wfd, xfd, tmo)
4226 int n;
4227 SELECT_TYPE *rfd, *wfd, *xfd;
4228 EMACS_TIME *tmo;
4229{
4230 return select (n, rfd, wfd, xfd, tmo);
4231}
4232#define select select_wrapper
4233#endif
4234
4235/* Read and dispose of subprocess output while waiting for timeout to
4236 elapse and/or keyboard input to be available.
4237
4238 TIME_LIMIT is:
4239 timeout in seconds, or
4240 zero for no limit, or
4241 -1 means gobble data immediately available but don't wait for any.
4242
4243 MICROSECS is:
4244 an additional duration to wait, measured in microseconds.
4245 If this is nonzero and time_limit is 0, then the timeout
4246 consists of MICROSECS only.
4247
4248 READ_KBD is a lisp value:
4249 0 to ignore keyboard input, or
4250 1 to return when input is available, or
4251 -1 meaning caller will actually read the input, so don't throw to
4252 the quit handler, or
4253
4254 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4255 output that arrives.
4256
4257 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4258 (and gobble terminal input into the buffer if any arrives).
4259
4260 If WAIT_PROC is specified, wait until something arrives from that
4261 process. The return value is true if we read some input from
4262 that process.
4263
4264 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4265 (suspending output from other processes). A negative value
4266 means don't run any timers either.
4267
4268 If WAIT_PROC is specified, then the function returns true if we
4269 received input from that process before the timeout elapsed.
4270 Otherwise, return true if we received input from any process. */
4271
4272int
4273wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4274 wait_for_cell, wait_proc, just_wait_proc)
4275 int time_limit, microsecs, read_kbd, do_display;
4276 Lisp_Object wait_for_cell;
4277 struct Lisp_Process *wait_proc;
4278 int just_wait_proc;
4279{
4280 register int channel, nfds;
4281 SELECT_TYPE Available;
4282#ifdef NON_BLOCKING_CONNECT
4283 SELECT_TYPE Connecting;
4284 int check_connect;
4285#endif
4286 int check_delay, no_avail;
4287 int xerrno;
4288 Lisp_Object proc;
4289 EMACS_TIME timeout, end_time;
4290 int wait_channel = -1;
4291 int got_some_input = 0;
4292 int count = SPECPDL_INDEX ();
4293
4294 FD_ZERO (&Available);
4295#ifdef NON_BLOCKING_CONNECT
4296 FD_ZERO (&Connecting);
4297#endif
4298
4299 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4300 if (wait_proc != NULL)
4301 wait_channel = XINT (wait_proc->infd);
4302
4303 record_unwind_protect (wait_reading_process_output_unwind,
4304 make_number (waiting_for_user_input_p));
4305 waiting_for_user_input_p = read_kbd;
4306
4307 /* Since we may need to wait several times,
4308 compute the absolute time to return at. */
4309 if (time_limit || microsecs)
4310 {
4311 EMACS_GET_TIME (end_time);
4312 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
4313 EMACS_ADD_TIME (end_time, end_time, timeout);
4314 }
4315#ifdef POLL_INTERRUPTED_SYS_CALL
4316 /* AlainF 5-Jul-1996
4317 HP-UX 10.10 seem to have problems with signals coming in
4318 Causes "poll: interrupted system call" messages when Emacs is run
4319 in an X window
4320 Turn off periodic alarms (in case they are in use),
4321 and then turn off any other atimers. */
4322 stop_polling ();
4323 turn_on_atimers (0);
4324#endif /* POLL_INTERRUPTED_SYS_CALL */
4325
4326 while (1)
4327 {
4328 int timeout_reduced_for_timers = 0;
4329
4330 /* If calling from keyboard input, do not quit
4331 since we want to return C-g as an input character.
4332 Otherwise, do pending quit if requested. */
4333 if (read_kbd >= 0)
4334 QUIT;
4335#ifdef SYNC_INPUT
4336 else if (interrupt_input_pending)
4337 handle_async_input ();
4338#endif
4339
4340 /* Exit now if the cell we're waiting for became non-nil. */
4341 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4342 break;
4343
4344 /* Compute time from now till when time limit is up */
4345 /* Exit if already run out */
4346 if (time_limit == -1)
4347 {
4348 /* -1 specified for timeout means
4349 gobble output available now
4350 but don't wait at all. */
4351
4352 EMACS_SET_SECS_USECS (timeout, 0, 0);
4353 }
4354 else if (time_limit || microsecs)
4355 {
4356 EMACS_GET_TIME (timeout);
4357 EMACS_SUB_TIME (timeout, end_time, timeout);
4358 if (EMACS_TIME_NEG_P (timeout))
4359 break;
4360 }
4361 else
4362 {
4363 EMACS_SET_SECS_USECS (timeout, 100000, 0);
4364 }
4365
4366 /* Normally we run timers here.
4367 But not if wait_for_cell; in those cases,
4368 the wait is supposed to be short,
4369 and those callers cannot handle running arbitrary Lisp code here. */
4370 if (NILP (wait_for_cell)
4371 && just_wait_proc >= 0)
4372 {
4373 EMACS_TIME timer_delay;
4374
4375 do
4376 {
4377 int old_timers_run = timers_run;
4378 struct buffer *old_buffer = current_buffer;
4379 Lisp_Object old_window = selected_window;
4380
4381 timer_delay = timer_check (1);
4382
4383 /* If a timer has run, this might have changed buffers
4384 an alike. Make read_key_sequence aware of that. */
4385 if (timers_run != old_timers_run
4386 && (old_buffer != current_buffer
4387 || !EQ (old_window, selected_window))
4388 && waiting_for_user_input_p == -1)
4389 record_asynch_buffer_change ();
4390
4391 if (timers_run != old_timers_run && do_display)
4392 /* We must retry, since a timer may have requeued itself
4393 and that could alter the time_delay. */
4394 redisplay_preserve_echo_area (9);
4395 else
4396 break;
4397 }
4398 while (!detect_input_pending ());
4399
4400 /* If there is unread keyboard input, also return. */
4401 if (read_kbd != 0
4402 && requeued_events_pending_p ())
4403 break;
4404
4405 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
4406 {
4407 EMACS_TIME difference;
4408 EMACS_SUB_TIME (difference, timer_delay, timeout);
4409 if (EMACS_TIME_NEG_P (difference))
4410 {
4411 timeout = timer_delay;
4412 timeout_reduced_for_timers = 1;
4413 }
4414 }
4415 /* If time_limit is -1, we are not going to wait at all. */
4416 else if (time_limit != -1)
4417 {
4418 /* This is so a breakpoint can be put here. */
4419 wait_reading_process_output_1 ();
4420 }
4421 }
4422
4423 /* Cause C-g and alarm signals to take immediate action,
4424 and cause input available signals to zero out timeout.
4425
4426 It is important that we do this before checking for process
4427 activity. If we get a SIGCHLD after the explicit checks for
4428 process activity, timeout is the only way we will know. */
4429 if (read_kbd < 0)
4430 set_waiting_for_input (&timeout);
4431
4432 /* If status of something has changed, and no input is
4433 available, notify the user of the change right away. After
4434 this explicit check, we'll let the SIGCHLD handler zap
4435 timeout to get our attention. */
4436 if (update_tick != process_tick && do_display)
4437 {
4438 SELECT_TYPE Atemp;
4439#ifdef NON_BLOCKING_CONNECT
4440 SELECT_TYPE Ctemp;
4441#endif
4442
4443 Atemp = input_wait_mask;
4444#if 0
4445 /* On Mac OS X 10.0, the SELECT system call always says input is
4446 present (for reading) at stdin, even when none is. This
4447 causes the call to SELECT below to return 1 and
4448 status_notify not to be called. As a result output of
4449 subprocesses are incorrectly discarded.
4450 */
4451 FD_CLR (0, &Atemp);
4452#endif
4453 IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask);
4454
4455 EMACS_SET_SECS_USECS (timeout, 0, 0);
4456 if ((select (max (max_process_desc, max_keyboard_desc) + 1,
4457 &Atemp,
4458#ifdef NON_BLOCKING_CONNECT
4459 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
4460#else
4461 (SELECT_TYPE *)0,
4462#endif
4463 (SELECT_TYPE *)0, &timeout)
4464 <= 0))
4465 {
4466 /* It's okay for us to do this and then continue with
4467 the loop, since timeout has already been zeroed out. */
4468 clear_waiting_for_input ();
4469 status_notify (NULL);
4470 }
4471 }
4472
4473 /* Don't wait for output from a non-running process. Just
4474 read whatever data has already been received. */
4475 if (wait_proc && wait_proc->raw_status_new)
4476 update_status (wait_proc);
4477 if (wait_proc
4478 && ! EQ (wait_proc->status, Qrun)
4479 && ! EQ (wait_proc->status, Qconnect))
4480 {
4481 int nread, total_nread = 0;
4482
4483 clear_waiting_for_input ();
4484 XSETPROCESS (proc, wait_proc);
4485
4486 /* Read data from the process, until we exhaust it. */
4487 while (XINT (wait_proc->infd) >= 0)
4488 {
4489 nread = read_process_output (proc, XINT (wait_proc->infd));
4490
4491 if (nread == 0)
4492 break;
4493
4494 if (0 < nread)
4495 total_nread += nread;
4496#ifdef EIO
4497 else if (nread == -1 && EIO == errno)
4498 break;
4499#endif
4500#ifdef EAGAIN
4501 else if (nread == -1 && EAGAIN == errno)
4502 break;
4503#endif
4504#ifdef EWOULDBLOCK
4505 else if (nread == -1 && EWOULDBLOCK == errno)
4506 break;
4507#endif
4508 }
4509 if (total_nread > 0 && do_display)
4510 redisplay_preserve_echo_area (10);
4511
4512 break;
4513 }
4514
4515 /* Wait till there is something to do */
4516
4517 if (wait_proc && just_wait_proc)
4518 {
4519 if (XINT (wait_proc->infd) < 0) /* Terminated */
4520 break;
4521 FD_SET (XINT (wait_proc->infd), &Available);
4522 check_delay = 0;
4523 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4524 }
4525 else if (!NILP (wait_for_cell))
4526 {
4527 Available = non_process_wait_mask;
4528 check_delay = 0;
4529 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4530 }
4531 else
4532 {
4533 if (! read_kbd)
4534 Available = non_keyboard_wait_mask;
4535 else
4536 Available = input_wait_mask;
4537 IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0));
4538 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
4539 }
4540
4541 /* If frame size has changed or the window is newly mapped,
4542 redisplay now, before we start to wait. There is a race
4543 condition here; if a SIGIO arrives between now and the select
4544 and indicates that a frame is trashed, the select may block
4545 displaying a trashed screen. */
4546 if (frame_garbaged && do_display)
4547 {
4548 clear_waiting_for_input ();
4549 redisplay_preserve_echo_area (11);
4550 if (read_kbd < 0)
4551 set_waiting_for_input (&timeout);
4552 }
4553
4554 no_avail = 0;
4555 if (read_kbd && detect_input_pending ())
4556 {
4557 nfds = 0;
4558 no_avail = 1;
4559 }
4560 else
4561 {
4562#ifdef NON_BLOCKING_CONNECT
4563 if (check_connect)
4564 Connecting = connect_wait_mask;
4565#endif
4566
4567#ifdef ADAPTIVE_READ_BUFFERING
4568 /* Set the timeout for adaptive read buffering if any
4569 process has non-nil read_output_skip and non-zero
4570 read_output_delay, and we are not reading output for a
4571 specific wait_channel. It is not executed if
4572 Vprocess_adaptive_read_buffering is nil. */
4573 if (process_output_skip && check_delay > 0)
4574 {
4575 int usecs = EMACS_USECS (timeout);
4576 if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX)
4577 usecs = READ_OUTPUT_DELAY_MAX;
4578 for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
4579 {
4580 proc = chan_process[channel];
4581 if (NILP (proc))
4582 continue;
4583 /* Find minimum non-zero read_output_delay among the
4584 processes with non-nil read_output_skip. */
4585 if (XINT (XPROCESS (proc)->read_output_delay) > 0)
4586 {
4587 check_delay--;
4588 if (NILP (XPROCESS (proc)->read_output_skip))
4589 continue;
4590 FD_CLR (channel, &Available);
4591 XPROCESS (proc)->read_output_skip = Qnil;
4592 if (XINT (XPROCESS (proc)->read_output_delay) < usecs)
4593 usecs = XINT (XPROCESS (proc)->read_output_delay);
4594 }
4595 }
4596 EMACS_SET_SECS_USECS (timeout, 0, usecs);
4597 process_output_skip = 0;
4598 }
4599#endif
4600
4601 nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
4602 &Available,
4603#ifdef NON_BLOCKING_CONNECT
4604 (check_connect ? &Connecting : (SELECT_TYPE *)0),
4605#else
4606 (SELECT_TYPE *)0,
4607#endif
4608 (SELECT_TYPE *)0, &timeout);
4609 }
4610
4611 xerrno = errno;
4612
4613 /* Make C-g and alarm signals set flags again */
4614 clear_waiting_for_input ();
4615
4616 /* If we woke up due to SIGWINCH, actually change size now. */
4617 do_pending_window_change (0);
4618
4619 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4620 /* We wanted the full specified time, so return now. */
4621 break;
4622 if (nfds < 0)
4623 {
4624 if (xerrno == EINTR)
4625 no_avail = 1;
4626#ifdef ultrix
4627 /* Ultrix select seems to return ENOMEM when it is
4628 interrupted. Treat it just like EINTR. Bleah. Note
4629 that we want to test for the "ultrix" CPP symbol, not
4630 "__ultrix__"; the latter is only defined under GCC, but
4631 not by DEC's bundled CC. -JimB */
4632 else if (xerrno == ENOMEM)
4633 no_avail = 1;
4634#endif
4635#ifdef ALLIANT
4636 /* This happens for no known reason on ALLIANT.
4637 I am guessing that this is the right response. -- RMS. */
4638 else if (xerrno == EFAULT)
4639 no_avail = 1;
4640#endif
4641 else if (xerrno == EBADF)
4642 {
4643#ifdef AIX
4644 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4645 the child's closure of the pts gives the parent a SIGHUP, and
4646 the ptc file descriptor is automatically closed,
4647 yielding EBADF here or at select() call above.
4648 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4649 in m/ibmrt-aix.h), and here we just ignore the select error.
4650 Cleanup occurs c/o status_notify after SIGCLD. */
4651 no_avail = 1; /* Cannot depend on values returned */
4652#else
4653 abort ();
4654#endif
4655 }
4656 else
4657 error ("select error: %s", emacs_strerror (xerrno));
4658 }
4659
4660 if (no_avail)
4661 {
4662 FD_ZERO (&Available);
4663 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4664 }
4665
4666#if defined(sun) && !defined(USG5_4)
4667 if (nfds > 0 && keyboard_bit_set (&Available)
4668 && interrupt_input)
4669 /* System sometimes fails to deliver SIGIO.
4670
4671 David J. Mackenzie says that Emacs doesn't compile under
4672 Solaris if this code is enabled, thus the USG5_4 in the CPP
4673 conditional. "I haven't noticed any ill effects so far.
4674 If you find a Solaris expert somewhere, they might know
4675 better." */
4676 kill (getpid (), SIGIO);
4677#endif
4678
4679#if 0 /* When polling is used, interrupt_input is 0,
4680 so get_input_pending should read the input.
4681 So this should not be needed. */
4682 /* If we are using polling for input,
4683 and we see input available, make it get read now.
4684 Otherwise it might not actually get read for a second.
4685 And on hpux, since we turn off polling in wait_reading_process_output,
4686 it might never get read at all if we don't spend much time
4687 outside of wait_reading_process_output. */
4688 if (read_kbd && interrupt_input
4689 && keyboard_bit_set (&Available)
4690 && input_polling_used ())
4691 kill (getpid (), SIGALRM);
4692#endif
4693
4694 /* Check for keyboard input */
4695 /* If there is any, return immediately
4696 to give it higher priority than subprocesses */
4697
4698 if (read_kbd != 0)
4699 {
4700 int old_timers_run = timers_run;
4701 struct buffer *old_buffer = current_buffer;
4702 Lisp_Object old_window = selected_window;
4703 int leave = 0;
4704
4705 if (detect_input_pending_run_timers (do_display))
4706 {
4707 swallow_events (do_display);
4708 if (detect_input_pending_run_timers (do_display))
4709 leave = 1;
4710 }
4711
4712 /* If a timer has run, this might have changed buffers
4713 an alike. Make read_key_sequence aware of that. */
4714 if (timers_run != old_timers_run
4715 && waiting_for_user_input_p == -1
4716 && (old_buffer != current_buffer
4717 || !EQ (old_window, selected_window)))
4718 record_asynch_buffer_change ();
4719
4720 if (leave)
4721 break;
4722 }
4723
4724 /* If there is unread keyboard input, also return. */
4725 if (read_kbd != 0
4726 && requeued_events_pending_p ())
4727 break;
4728
4729 /* If we are not checking for keyboard input now,
4730 do process events (but don't run any timers).
4731 This is so that X events will be processed.
4732 Otherwise they may have to wait until polling takes place.
4733 That would causes delays in pasting selections, for example.
4734
4735 (We used to do this only if wait_for_cell.) */
4736 if (read_kbd == 0 && detect_input_pending ())
4737 {
4738 swallow_events (do_display);
4739#if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4740 if (detect_input_pending ())
4741 break;
4742#endif
4743 }
4744
4745 /* Exit now if the cell we're waiting for became non-nil. */
4746 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4747 break;
4748
4749#ifdef SIGIO
4750 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4751 go read it. This can happen with X on BSD after logging out.
4752 In that case, there really is no input and no SIGIO,
4753 but select says there is input. */
4754
4755 if (read_kbd && interrupt_input
4756 && keyboard_bit_set (&Available) && ! noninteractive)
4757 kill (getpid (), SIGIO);
4758#endif
4759
4760 if (! wait_proc)
4761 got_some_input |= nfds > 0;
4762
4763 /* If checking input just got us a size-change event from X,
4764 obey it now if we should. */
4765 if (read_kbd || ! NILP (wait_for_cell))
4766 do_pending_window_change (0);
4767
4768 /* Check for data from a process. */
4769 if (no_avail || nfds == 0)
4770 continue;
4771
4772 /* Really FIRST_PROC_DESC should be 0 on Unix,
4773 but this is safer in the short run. */
4774 for (channel = 0; channel <= max_process_desc; channel++)
4775 {
4776 if (FD_ISSET (channel, &Available)
4777 && FD_ISSET (channel, &non_keyboard_wait_mask))
4778 {
4779 int nread;
4780
4781 /* If waiting for this channel, arrange to return as
4782 soon as no more input to be processed. No more
4783 waiting. */
4784 if (wait_channel == channel)
4785 {
4786 wait_channel = -1;
4787 time_limit = -1;
4788 got_some_input = 1;
4789 }
4790 proc = chan_process[channel];
4791 if (NILP (proc))
4792 continue;
4793
4794 /* If this is a server stream socket, accept connection. */
4795 if (EQ (XPROCESS (proc)->status, Qlisten))
4796 {
4797 server_accept_connection (proc, channel);
4798 continue;
4799 }
4800
4801 /* Read data from the process, starting with our
4802 buffered-ahead character if we have one. */
4803
4804 nread = read_process_output (proc, channel);
4805 if (nread > 0)
4806 {
4807 /* Since read_process_output can run a filter,
4808 which can call accept-process-output,
4809 don't try to read from any other processes
4810 before doing the select again. */
4811 FD_ZERO (&Available);
4812
4813 if (do_display)
4814 redisplay_preserve_echo_area (12);
4815 }
4816#ifdef EWOULDBLOCK
4817 else if (nread == -1 && errno == EWOULDBLOCK)
4818 ;
4819#endif
4820 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4821 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4822#ifdef O_NONBLOCK
4823 else if (nread == -1 && errno == EAGAIN)
4824 ;
4825#else
4826#ifdef O_NDELAY
4827 else if (nread == -1 && errno == EAGAIN)
4828 ;
4829 /* Note that we cannot distinguish between no input
4830 available now and a closed pipe.
4831 With luck, a closed pipe will be accompanied by
4832 subprocess termination and SIGCHLD. */
4833 else if (nread == 0 && !NETCONN_P (proc))
4834 ;
4835#endif /* O_NDELAY */
4836#endif /* O_NONBLOCK */
4837#ifdef HAVE_PTYS
4838 /* On some OSs with ptys, when the process on one end of
4839 a pty exits, the other end gets an error reading with
4840 errno = EIO instead of getting an EOF (0 bytes read).
4841 Therefore, if we get an error reading and errno =
4842 EIO, just continue, because the child process has
4843 exited and should clean itself up soon (e.g. when we
4844 get a SIGCHLD).
4845
4846 However, it has been known to happen that the SIGCHLD
4847 got lost. So raise the signal again just in case.
4848 It can't hurt. */
4849 else if (nread == -1 && errno == EIO)
4850 {
4851 /* Clear the descriptor now, so we only raise the signal once. */
4852 FD_CLR (channel, &input_wait_mask);
4853 FD_CLR (channel, &non_keyboard_wait_mask);
4854
4855 kill (getpid (), SIGCHLD);
4856 }
4857#endif /* HAVE_PTYS */
4858 /* If we can detect process termination, don't consider the process
4859 gone just because its pipe is closed. */
4860#ifdef SIGCHLD
4861 else if (nread == 0 && !NETCONN_P (proc))
4862 ;
4863#endif
4864 else
4865 {
4866 /* Preserve status of processes already terminated. */
4867 XSETINT (XPROCESS (proc)->tick, ++process_tick);
4868 deactivate_process (proc);
4869 if (XPROCESS (proc)->raw_status_new)
4870 update_status (XPROCESS (proc));
4871 if (EQ (XPROCESS (proc)->status, Qrun))
4872 XPROCESS (proc)->status
4873 = Fcons (Qexit, Fcons (make_number (256), Qnil));
4874 }
4875 }
4876#ifdef NON_BLOCKING_CONNECT
4877 if (check_connect && FD_ISSET (channel, &Connecting)
4878 && FD_ISSET (channel, &connect_wait_mask))
4879 {
4880 struct Lisp_Process *p;
4881
4882 FD_CLR (channel, &connect_wait_mask);
4883 if (--num_pending_connects < 0)
4884 abort ();
4885
4886 proc = chan_process[channel];
4887 if (NILP (proc))
4888 continue;
4889
4890 p = XPROCESS (proc);
4891
4892#ifdef GNU_LINUX
4893 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4894 So only use it on systems where it is known to work. */
4895 {
4896 int xlen = sizeof(xerrno);
4897 if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
4898 xerrno = errno;
4899 }
4900#else
4901 {
4902 struct sockaddr pname;
4903 int pnamelen = sizeof(pname);
4904
4905 /* If connection failed, getpeername will fail. */
4906 xerrno = 0;
4907 if (getpeername(channel, &pname, &pnamelen) < 0)
4908 {
4909 /* Obtain connect failure code through error slippage. */
4910 char dummy;
4911 xerrno = errno;
4912 if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
4913 xerrno = errno;
4914 }
4915 }
4916#endif
4917 if (xerrno)
4918 {
4919 XSETINT (p->tick, ++process_tick);
4920 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
4921 deactivate_process (proc);
4922 }
4923 else
4924 {
4925 p->status = Qrun;
4926 /* Execute the sentinel here. If we had relied on
4927 status_notify to do it later, it will read input
4928 from the process before calling the sentinel. */
4929 exec_sentinel (proc, build_string ("open\n"));
4930 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
4931 {
4932 FD_SET (XINT (p->infd), &input_wait_mask);
4933 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
4934 }
4935 }
4936 }
4937#endif /* NON_BLOCKING_CONNECT */
4938 } /* end for each file descriptor */
4939 } /* end while exit conditions not met */
4940
4941 unbind_to (count, Qnil);
4942
4943 /* If calling from keyboard input, do not quit
4944 since we want to return C-g as an input character.
4945 Otherwise, do pending quit if requested. */
4946 if (read_kbd >= 0)
4947 {
4948 /* Prevent input_pending from remaining set if we quit. */
4949 clear_input_pending ();
4950 QUIT;
4951 }
4952#ifdef POLL_INTERRUPTED_SYS_CALL
4953 /* AlainF 5-Jul-1996
4954 HP-UX 10.10 seems to have problems with signals coming in
4955 Causes "poll: interrupted system call" messages when Emacs is run
4956 in an X window
4957 Turn periodic alarms back on */
4958 start_polling ();
4959#endif /* POLL_INTERRUPTED_SYS_CALL */
4960
4961 return got_some_input;
4962}
4963\f
4964/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4965
4966static Lisp_Object
4967read_process_output_call (fun_and_args)
4968 Lisp_Object fun_and_args;
4969{
4970 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
4971}
4972
4973static Lisp_Object
4974read_process_output_error_handler (error)
4975 Lisp_Object error;
4976{
4977 cmd_error_internal (error, "error in process filter: ");
4978 Vinhibit_quit = Qt;
4979 update_echo_area ();
4980 Fsleep_for (make_number (2), Qnil);
4981 return Qt;
4982}
4983
4984/* Read pending output from the process channel,
4985 starting with our buffered-ahead character if we have one.
4986 Yield number of decoded characters read.
4987
4988 This function reads at most 4096 characters.
4989 If you want to read all available subprocess output,
4990 you must call it repeatedly until it returns zero.
4991
4992 The characters read are decoded according to PROC's coding-system
4993 for decoding. */
4994
4995static int
4996read_process_output (proc, channel)
4997 Lisp_Object proc;
4998 register int channel;
4999{
5000 register int nbytes;
5001 char *chars;
5002 register Lisp_Object outstream;
5003 register struct buffer *old = current_buffer;
5004 register struct Lisp_Process *p = XPROCESS (proc);
5005 register int opoint;
5006 struct coding_system *coding = proc_decode_coding_system[channel];
5007 int carryover = XINT (p->decoding_carryover);
5008 int readmax = 4096;
5009
5010#ifdef VMS
5011 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
5012
5013 vs = get_vms_process_pointer (p->pid);
5014 if (vs)
5015 {
5016 if (!vs->iosb[0])
5017 return (0); /* Really weird if it does this */
5018 if (!(vs->iosb[0] & 1))
5019 return -1; /* I/O error */
5020 }
5021 else
5022 error ("Could not get VMS process pointer");
5023 chars = vs->inputBuffer;
5024 nbytes = clean_vms_buffer (chars, vs->iosb[1]);
5025 if (nbytes <= 0)
5026 {
5027 start_vms_process_read (vs); /* Crank up the next read on the process */
5028 return 1; /* Nothing worth printing, say we got 1 */
5029 }
5030 if (carryover > 0)
5031 {
5032 /* The data carried over in the previous decoding (which are at
5033 the tail of decoding buffer) should be prepended to the new
5034 data read to decode all together. */
5035 chars = (char *) alloca (nbytes + carryover);
5036 bcopy (SDATA (p->decoding_buf), buf, carryover);
5037 bcopy (vs->inputBuffer, chars + carryover, nbytes);
5038 }
5039#else /* not VMS */
5040
5041 chars = (char *) alloca (carryover + readmax);
5042 if (carryover)
5043 /* See the comment above. */
5044 bcopy (SDATA (p->decoding_buf), chars, carryover);
5045
5046#ifdef DATAGRAM_SOCKETS
5047 /* We have a working select, so proc_buffered_char is always -1. */
5048 if (DATAGRAM_CHAN_P (channel))
5049 {
5050 int len = datagram_address[channel].len;
5051 nbytes = recvfrom (channel, chars + carryover, readmax,
5052 0, datagram_address[channel].sa, &len);
5053 }
5054 else
5055#endif
5056 if (proc_buffered_char[channel] < 0)
5057 {
5058 nbytes = emacs_read (channel, chars + carryover, readmax);
5059#ifdef ADAPTIVE_READ_BUFFERING
5060 if (nbytes > 0 && !NILP (p->adaptive_read_buffering))
5061 {
5062 int delay = XINT (p->read_output_delay);
5063 if (nbytes < 256)
5064 {
5065 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5066 {
5067 if (delay == 0)
5068 process_output_delay_count++;
5069 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5070 }
5071 }
5072 else if (delay > 0 && (nbytes == readmax))
5073 {
5074 delay -= READ_OUTPUT_DELAY_INCREMENT;
5075 if (delay == 0)
5076 process_output_delay_count--;
5077 }
5078 XSETINT (p->read_output_delay, delay);
5079 if (delay)
5080 {
5081 p->read_output_skip = Qt;
5082 process_output_skip = 1;
5083 }
5084 }
5085#endif
5086 }
5087 else
5088 {
5089 chars[carryover] = proc_buffered_char[channel];
5090 proc_buffered_char[channel] = -1;
5091 nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1);
5092 if (nbytes < 0)
5093 nbytes = 1;
5094 else
5095 nbytes = nbytes + 1;
5096 }
5097#endif /* not VMS */
5098
5099 XSETINT (p->decoding_carryover, 0);
5100
5101 /* At this point, NBYTES holds number of bytes just received
5102 (including the one in proc_buffered_char[channel]). */
5103 if (nbytes <= 0)
5104 {
5105 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5106 return nbytes;
5107 coding->mode |= CODING_MODE_LAST_BLOCK;
5108 }
5109
5110 /* Now set NBYTES how many bytes we must decode. */
5111 nbytes += carryover;
5112
5113 /* Read and dispose of the process output. */
5114 outstream = p->filter;
5115 if (!NILP (outstream))
5116 {
5117 /* We inhibit quit here instead of just catching it so that
5118 hitting ^G when a filter happens to be running won't screw
5119 it up. */
5120 int count = SPECPDL_INDEX ();
5121 Lisp_Object odeactivate;
5122 Lisp_Object obuffer, okeymap;
5123 Lisp_Object text;
5124 int outer_running_asynch_code = running_asynch_code;
5125 int waiting = waiting_for_user_input_p;
5126
5127 /* No need to gcpro these, because all we do with them later
5128 is test them for EQness, and none of them should be a string. */
5129 odeactivate = Vdeactivate_mark;
5130 XSETBUFFER (obuffer, current_buffer);
5131 okeymap = current_buffer->keymap;
5132
5133 specbind (Qinhibit_quit, Qt);
5134 specbind (Qlast_nonmenu_event, Qt);
5135
5136 /* In case we get recursively called,
5137 and we already saved the match data nonrecursively,
5138 save the same match data in safely recursive fashion. */
5139 if (outer_running_asynch_code)
5140 {
5141 Lisp_Object tem;
5142 /* Don't clobber the CURRENT match data, either! */
5143 tem = Fmatch_data (Qnil, Qnil, Qnil);
5144 restore_search_regs ();
5145 record_unwind_save_match_data ();
5146 Fset_match_data (tem, Qt);
5147 }
5148
5149 /* For speed, if a search happens within this code,
5150 save the match data in a special nonrecursive fashion. */
5151 running_asynch_code = 1;
5152
5153 text = decode_coding_string (make_unibyte_string (chars, nbytes),
5154 coding, 0);
5155 Vlast_coding_system_used = coding->symbol;
5156 /* A new coding system might be found. */
5157 if (!EQ (p->decode_coding_system, coding->symbol))
5158 {
5159 p->decode_coding_system = coding->symbol;
5160
5161 /* Don't call setup_coding_system for
5162 proc_decode_coding_system[channel] here. It is done in
5163 detect_coding called via decode_coding above. */
5164
5165 /* If a coding system for encoding is not yet decided, we set
5166 it as the same as coding-system for decoding.
5167
5168 But, before doing that we must check if
5169 proc_encode_coding_system[p->outfd] surely points to a
5170 valid memory because p->outfd will be changed once EOF is
5171 sent to the process. */
5172 if (NILP (p->encode_coding_system)
5173 && proc_encode_coding_system[XINT (p->outfd)])
5174 {
5175 p->encode_coding_system = coding->symbol;
5176 setup_coding_system (coding->symbol,
5177 proc_encode_coding_system[XINT (p->outfd)]);
5178 if (proc_encode_coding_system[XINT (p->outfd)]->eol_type
5179 == CODING_EOL_UNDECIDED)
5180 proc_encode_coding_system[XINT (p->outfd)]->eol_type
5181 = system_eol_type;
5182 }
5183 }
5184
5185 carryover = nbytes - coding->consumed;
5186 if (carryover < 0)
5187 abort ();
5188
5189 if (SCHARS (p->decoding_buf) < carryover)
5190 p->decoding_buf = make_uninit_string (carryover);
5191 bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
5192 carryover);
5193 XSETINT (p->decoding_carryover, carryover);
5194 /* Adjust the multibyteness of TEXT to that of the filter. */
5195 if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text))
5196 text = (STRING_MULTIBYTE (text)
5197 ? Fstring_as_unibyte (text)
5198 : Fstring_to_multibyte (text));
5199 if (SBYTES (text) > 0)
5200 internal_condition_case_1 (read_process_output_call,
5201 Fcons (outstream,
5202 Fcons (proc, Fcons (text, Qnil))),
5203 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5204 read_process_output_error_handler);
5205
5206 /* If we saved the match data nonrecursively, restore it now. */
5207 restore_search_regs ();
5208 running_asynch_code = outer_running_asynch_code;
5209
5210 /* Handling the process output should not deactivate the mark. */
5211 Vdeactivate_mark = odeactivate;
5212
5213 /* Restore waiting_for_user_input_p as it was
5214 when we were called, in case the filter clobbered it. */
5215 waiting_for_user_input_p = waiting;
5216
5217#if 0 /* Call record_asynch_buffer_change unconditionally,
5218 because we might have changed minor modes or other things
5219 that affect key bindings. */
5220 if (! EQ (Fcurrent_buffer (), obuffer)
5221 || ! EQ (current_buffer->keymap, okeymap))
5222#endif
5223 /* But do it only if the caller is actually going to read events.
5224 Otherwise there's no need to make him wake up, and it could
5225 cause trouble (for example it would make sit_for return). */
5226 if (waiting_for_user_input_p == -1)
5227 record_asynch_buffer_change ();
5228
5229#ifdef VMS
5230 start_vms_process_read (vs);
5231#endif
5232 unbind_to (count, Qnil);
5233 return nbytes;
5234 }
5235
5236 /* If no filter, write into buffer if it isn't dead. */
5237 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
5238 {
5239 Lisp_Object old_read_only;
5240 int old_begv, old_zv;
5241 int old_begv_byte, old_zv_byte;
5242 Lisp_Object odeactivate;
5243 int before, before_byte;
5244 int opoint_byte;
5245 Lisp_Object text;
5246 struct buffer *b;
5247
5248 odeactivate = Vdeactivate_mark;
5249
5250 Fset_buffer (p->buffer);
5251 opoint = PT;
5252 opoint_byte = PT_BYTE;
5253 old_read_only = current_buffer->read_only;
5254 old_begv = BEGV;
5255 old_zv = ZV;
5256 old_begv_byte = BEGV_BYTE;
5257 old_zv_byte = ZV_BYTE;
5258
5259 current_buffer->read_only = Qnil;
5260
5261 /* Insert new output into buffer
5262 at the current end-of-output marker,
5263 thus preserving logical ordering of input and output. */
5264 if (XMARKER (p->mark)->buffer)
5265 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
5266 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
5267 ZV_BYTE));
5268 else
5269 SET_PT_BOTH (ZV, ZV_BYTE);
5270 before = PT;
5271 before_byte = PT_BYTE;
5272
5273 /* If the output marker is outside of the visible region, save
5274 the restriction and widen. */
5275 if (! (BEGV <= PT && PT <= ZV))
5276 Fwiden ();
5277
5278 text = decode_coding_string (make_unibyte_string (chars, nbytes),
5279 coding, 0);
5280 Vlast_coding_system_used = coding->symbol;
5281 /* A new coding system might be found. See the comment in the
5282 similar code in the previous `if' block. */
5283 if (!EQ (p->decode_coding_system, coding->symbol))
5284 {
5285 p->decode_coding_system = coding->symbol;
5286 if (NILP (p->encode_coding_system)
5287 && proc_encode_coding_system[XINT (p->outfd)])
5288 {
5289 p->encode_coding_system = coding->symbol;
5290 setup_coding_system (coding->symbol,
5291 proc_encode_coding_system[XINT (p->outfd)]);
5292 if (proc_encode_coding_system[XINT (p->outfd)]->eol_type
5293 == CODING_EOL_UNDECIDED)
5294 proc_encode_coding_system[XINT (p->outfd)]->eol_type
5295 = system_eol_type;
5296 }
5297 }
5298 carryover = nbytes - coding->consumed;
5299 if (carryover < 0)
5300 abort ();
5301
5302 if (SCHARS (p->decoding_buf) < carryover)
5303 p->decoding_buf = make_uninit_string (carryover);
5304 bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
5305 carryover);
5306 XSETINT (p->decoding_carryover, carryover);
5307
5308 /* Adjust the multibyteness of TEXT to that of the buffer. */
5309 if (NILP (current_buffer->enable_multibyte_characters)
5310 != ! STRING_MULTIBYTE (text))
5311 text = (STRING_MULTIBYTE (text)
5312 ? Fstring_as_unibyte (text)
5313 : Fstring_to_multibyte (text));
5314 /* Insert before markers in case we are inserting where
5315 the buffer's mark is, and the user's next command is Meta-y. */
5316 insert_from_string_before_markers (text, 0, 0,
5317 SCHARS (text), SBYTES (text), 0);
5318
5319 /* Make sure the process marker's position is valid when the
5320 process buffer is changed in the signal_after_change above.
5321 W3 is known to do that. */
5322 if (BUFFERP (p->buffer)
5323 && (b = XBUFFER (p->buffer), b != current_buffer))
5324 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
5325 else
5326 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
5327
5328 update_mode_lines++;
5329
5330 /* Make sure opoint and the old restrictions
5331 float ahead of any new text just as point would. */
5332 if (opoint >= before)
5333 {
5334 opoint += PT - before;
5335 opoint_byte += PT_BYTE - before_byte;
5336 }
5337 if (old_begv > before)
5338 {
5339 old_begv += PT - before;
5340 old_begv_byte += PT_BYTE - before_byte;
5341 }
5342 if (old_zv >= before)
5343 {
5344 old_zv += PT - before;
5345 old_zv_byte += PT_BYTE - before_byte;
5346 }
5347
5348 /* If the restriction isn't what it should be, set it. */
5349 if (old_begv != BEGV || old_zv != ZV)
5350 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
5351
5352 /* Handling the process output should not deactivate the mark. */
5353 Vdeactivate_mark = odeactivate;
5354
5355 current_buffer->read_only = old_read_only;
5356 SET_PT_BOTH (opoint, opoint_byte);
5357 set_buffer_internal (old);
5358 }
5359#ifdef VMS
5360 start_vms_process_read (vs);
5361#endif
5362 return nbytes;
5363}
5364
5365DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
5366 0, 0, 0,
5367 doc: /* Returns non-nil if Emacs is waiting for input from the user.
5368This is intended for use by asynchronous process output filters and sentinels. */)
5369 ()
5370{
5371 return (waiting_for_user_input_p ? Qt : Qnil);
5372}
5373\f
5374/* Sending data to subprocess */
5375
5376jmp_buf send_process_frame;
5377Lisp_Object process_sent_to;
5378
5379SIGTYPE
5380send_process_trap ()
5381{
5382 SIGNAL_THREAD_CHECK (SIGPIPE);
5383#ifdef BSD4_1
5384 sigrelse (SIGPIPE);
5385 sigrelse (SIGALRM);
5386#endif /* BSD4_1 */
5387 sigunblock (sigmask (SIGPIPE));
5388 longjmp (send_process_frame, 1);
5389}
5390
5391/* Send some data to process PROC.
5392 BUF is the beginning of the data; LEN is the number of characters.
5393 OBJECT is the Lisp object that the data comes from. If OBJECT is
5394 nil or t, it means that the data comes from C string.
5395
5396 If OBJECT is not nil, the data is encoded by PROC's coding-system
5397 for encoding before it is sent.
5398
5399 This function can evaluate Lisp code and can garbage collect. */
5400
5401static void
5402send_process (proc, buf, len, object)
5403 volatile Lisp_Object proc;
5404 unsigned char *volatile buf;
5405 volatile int len;
5406 volatile Lisp_Object object;
5407{
5408 /* Use volatile to protect variables from being clobbered by longjmp. */
5409 struct Lisp_Process *p = XPROCESS (proc);
5410 int rv;
5411 struct coding_system *coding;
5412 struct gcpro gcpro1;
5413 SIGTYPE (*volatile old_sigpipe) ();
5414
5415 GCPRO1 (object);
5416
5417#ifdef VMS
5418 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
5419#endif /* VMS */
5420
5421 if (p->raw_status_new)
5422 update_status (p);
5423 if (! EQ (p->status, Qrun))
5424 error ("Process %s not running", SDATA (p->name));
5425 if (XINT (p->outfd) < 0)
5426 error ("Output file descriptor of %s is closed", SDATA (p->name));
5427
5428 coding = proc_encode_coding_system[XINT (p->outfd)];
5429 Vlast_coding_system_used = coding->symbol;
5430
5431 if ((STRINGP (object) && STRING_MULTIBYTE (object))
5432 || (BUFFERP (object)
5433 && !NILP (XBUFFER (object)->enable_multibyte_characters))
5434 || EQ (object, Qt))
5435 {
5436 if (!EQ (coding->symbol, p->encode_coding_system))
5437 /* The coding system for encoding was changed to raw-text
5438 because we sent a unibyte text previously. Now we are
5439 sending a multibyte text, thus we must encode it by the
5440 original coding system specified for the current process. */
5441 setup_coding_system (p->encode_coding_system, coding);
5442 if (coding->eol_type == CODING_EOL_UNDECIDED)
5443 coding->eol_type = system_eol_type;
5444 /* src_multibyte should be set to 1 _after_ a call to
5445 setup_coding_system, since it resets src_multibyte to
5446 zero. */
5447 coding->src_multibyte = 1;
5448 }
5449 else
5450 {
5451 /* For sending a unibyte text, character code conversion should
5452 not take place but EOL conversion should. So, setup raw-text
5453 or one of the subsidiary if we have not yet done it. */
5454 if (coding->type != coding_type_raw_text)
5455 {
5456 if (CODING_REQUIRE_FLUSHING (coding))
5457 {
5458 /* But, before changing the coding, we must flush out data. */
5459 coding->mode |= CODING_MODE_LAST_BLOCK;
5460 send_process (proc, "", 0, Qt);
5461 }
5462 coding->src_multibyte = 0;
5463 setup_raw_text_coding_system (coding);
5464 }
5465 }
5466 coding->dst_multibyte = 0;
5467
5468 if (CODING_REQUIRE_ENCODING (coding))
5469 {
5470 int require = encoding_buffer_size (coding, len);
5471 int from_byte = -1, from = -1, to = -1;
5472
5473 if (BUFFERP (object))
5474 {
5475 from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
5476 from = buf_bytepos_to_charpos (XBUFFER (object), from_byte);
5477 to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len);
5478 }
5479 else if (STRINGP (object))
5480 {
5481 from_byte = buf - SDATA (object);
5482 from = string_byte_to_char (object, from_byte);
5483 to = string_byte_to_char (object, from_byte + len);
5484 }
5485
5486 if (coding->composing != COMPOSITION_DISABLED)
5487 {
5488 if (from_byte >= 0)
5489 coding_save_composition (coding, from, to, object);
5490 else
5491 coding->composing = COMPOSITION_DISABLED;
5492 }
5493
5494 if (SBYTES (p->encoding_buf) < require)
5495 p->encoding_buf = make_uninit_string (require);
5496
5497 if (from_byte >= 0)
5498 buf = (BUFFERP (object)
5499 ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
5500 : SDATA (object) + from_byte);
5501
5502 object = p->encoding_buf;
5503 encode_coding (coding, (char *) buf, SDATA (object),
5504 len, SBYTES (object));
5505 coding_free_composition_data (coding);
5506 len = coding->produced;
5507 buf = SDATA (object);
5508 }
5509
5510#ifdef VMS
5511 vs = get_vms_process_pointer (p->pid);
5512 if (vs == 0)
5513 error ("Could not find this process: %x", p->pid);
5514 else if (write_to_vms_process (vs, buf, len))
5515 ;
5516#else /* not VMS */
5517
5518 if (pty_max_bytes == 0)
5519 {
5520#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5521 pty_max_bytes = fpathconf (XFASTINT (p->outfd), _PC_MAX_CANON);
5522 if (pty_max_bytes < 0)
5523 pty_max_bytes = 250;
5524#else
5525 pty_max_bytes = 250;
5526#endif
5527 /* Deduct one, to leave space for the eof. */
5528 pty_max_bytes--;
5529 }
5530
5531 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5532 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5533 when returning with longjmp despite being declared volatile. */
5534 if (!setjmp (send_process_frame))
5535 {
5536 process_sent_to = proc;
5537 while (len > 0)
5538 {
5539 int this = len;
5540
5541 /* Decide how much data we can send in one batch.
5542 Long lines need to be split into multiple batches. */
5543 if (!NILP (p->pty_flag))
5544 {
5545 /* Starting this at zero is always correct when not the first
5546 iteration because the previous iteration ended by sending C-d.
5547 It may not be correct for the first iteration
5548 if a partial line was sent in a separate send_process call.
5549 If that proves worth handling, we need to save linepos
5550 in the process object. */
5551 int linepos = 0;
5552 unsigned char *ptr = (unsigned char *) buf;
5553 unsigned char *end = (unsigned char *) buf + len;
5554
5555 /* Scan through this text for a line that is too long. */
5556 while (ptr != end && linepos < pty_max_bytes)
5557 {
5558 if (*ptr == '\n')
5559 linepos = 0;
5560 else
5561 linepos++;
5562 ptr++;
5563 }
5564 /* If we found one, break the line there
5565 and put in a C-d to force the buffer through. */
5566 this = ptr - buf;
5567 }
5568
5569 /* Send this batch, using one or more write calls. */
5570 while (this > 0)
5571 {
5572 int outfd = XINT (p->outfd);
5573 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
5574#ifdef DATAGRAM_SOCKETS
5575 if (DATAGRAM_CHAN_P (outfd))
5576 {
5577 rv = sendto (outfd, (char *) buf, this,
5578 0, datagram_address[outfd].sa,
5579 datagram_address[outfd].len);
5580 if (rv < 0 && errno == EMSGSIZE)
5581 {
5582 signal (SIGPIPE, old_sigpipe);
5583 report_file_error ("sending datagram",
5584 Fcons (proc, Qnil));
5585 }
5586 }
5587 else
5588#endif
5589 {
5590 rv = emacs_write (outfd, (char *) buf, this);
5591#ifdef ADAPTIVE_READ_BUFFERING
5592 if (XINT (p->read_output_delay) > 0
5593 && EQ (p->adaptive_read_buffering, Qt))
5594 {
5595 XSETFASTINT (p->read_output_delay, 0);
5596 process_output_delay_count--;
5597 p->read_output_skip = Qnil;
5598 }
5599#endif
5600 }
5601 signal (SIGPIPE, old_sigpipe);
5602
5603 if (rv < 0)
5604 {
5605 if (0
5606#ifdef EWOULDBLOCK
5607 || errno == EWOULDBLOCK
5608#endif
5609#ifdef EAGAIN
5610 || errno == EAGAIN
5611#endif
5612 )
5613 /* Buffer is full. Wait, accepting input;
5614 that may allow the program
5615 to finish doing output and read more. */
5616 {
5617 int offset = 0;
5618
5619#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5620 /* A gross hack to work around a bug in FreeBSD.
5621 In the following sequence, read(2) returns
5622 bogus data:
5623
5624 write(2) 1022 bytes
5625 write(2) 954 bytes, get EAGAIN
5626 read(2) 1024 bytes in process_read_output
5627 read(2) 11 bytes in process_read_output
5628
5629 That is, read(2) returns more bytes than have
5630 ever been written successfully. The 1033 bytes
5631 read are the 1022 bytes written successfully
5632 after processing (for example with CRs added if
5633 the terminal is set up that way which it is
5634 here). The same bytes will be seen again in a
5635 later read(2), without the CRs. */
5636
5637 if (errno == EAGAIN)
5638 {
5639 int flags = FWRITE;
5640 ioctl (XINT (p->outfd), TIOCFLUSH, &flags);
5641 }
5642#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5643
5644 /* Running filters might relocate buffers or strings.
5645 Arrange to relocate BUF. */
5646 if (BUFFERP (object))
5647 offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
5648 else if (STRINGP (object))
5649 offset = buf - SDATA (object);
5650
5651#ifdef EMACS_HAS_USECS
5652 wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
5653#else
5654 wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
5655#endif
5656
5657 if (BUFFERP (object))
5658 buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
5659 else if (STRINGP (object))
5660 buf = offset + SDATA (object);
5661
5662 rv = 0;
5663 }
5664 else
5665 /* This is a real error. */
5666 report_file_error ("writing to process", Fcons (proc, Qnil));
5667 }
5668 buf += rv;
5669 len -= rv;
5670 this -= rv;
5671 }
5672
5673 /* If we sent just part of the string, put in an EOF
5674 to force it through, before we send the rest. */
5675 if (len > 0)
5676 Fprocess_send_eof (proc);
5677 }
5678 }
5679#endif /* not VMS */
5680 else
5681 {
5682 signal (SIGPIPE, old_sigpipe);
5683#ifndef VMS
5684 proc = process_sent_to;
5685 p = XPROCESS (proc);
5686#endif
5687 p->raw_status_new = 0;
5688 p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
5689 XSETINT (p->tick, ++process_tick);
5690 deactivate_process (proc);
5691#ifdef VMS
5692 error ("Error writing to process %s; closed it", SDATA (p->name));
5693#else
5694 error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
5695#endif
5696 }
5697
5698 UNGCPRO;
5699}
5700
5701static Lisp_Object
5702send_process_object_unwind (buf)
5703 Lisp_Object buf;
5704{
5705 Lisp_Object tembuf;
5706
5707 if (XBUFFER (buf) == current_buffer)
5708 return Qnil;
5709 tembuf = Fcurrent_buffer ();
5710 Fset_buffer (buf);
5711 Fkill_buffer (tembuf);
5712 return Qnil;
5713}
5714
5715/* Send current contents of region between START and END to PROC.
5716 If START is a string, send it instead.
5717 This function can evaluate Lisp code and can garbage collect. */
5718
5719static void
5720send_process_object (proc, start, end)
5721 Lisp_Object proc, start, end;
5722{
5723 int count = SPECPDL_INDEX ();
5724 Lisp_Object object = STRINGP (start) ? start : Fcurrent_buffer ();
5725 struct buffer *given_buffer = current_buffer;
5726 unsigned char *buf;
5727 int len;
5728
5729 record_unwind_protect (send_process_object_unwind, Fcurrent_buffer ());
5730
5731 if (STRINGP (object) ? STRING_MULTIBYTE (object)
5732 : ! NILP (XBUFFER (object)->enable_multibyte_characters))
5733 {
5734 struct Lisp_Process *p = XPROCESS (proc);
5735 struct coding_system *coding;
5736
5737 if (p->raw_status_new)
5738 update_status (p);
5739 if (! EQ (p->status, Qrun))
5740 error ("Process %s not running", SDATA (p->name));
5741 if (XINT (p->outfd) < 0)
5742 error ("Output file descriptor of %s is closed", SDATA (p->name));
5743
5744 coding = proc_encode_coding_system[XINT (p->outfd)];
5745 if (! EQ (coding->symbol, p->encode_coding_system))
5746 /* The coding system for encoding was changed to raw-text
5747 because we sent a unibyte text previously. Now we are
5748 sending a multibyte text, thus we must encode it by the
5749 original coding system specified for the current process. */
5750 setup_coding_system (p->encode_coding_system, coding);
5751 if (! NILP (coding->pre_write_conversion))
5752 {
5753 struct gcpro gcpro1, gcpro2;
5754
5755 GCPRO2 (proc, object);
5756 call2 (coding->pre_write_conversion, start, end);
5757 UNGCPRO;
5758 if (given_buffer != current_buffer)
5759 {
5760 start = make_number (BEGV), end = make_number (ZV);
5761 object = Fcurrent_buffer ();
5762 }
5763 }
5764 }
5765
5766 if (BUFFERP (object))
5767 {
5768 EMACS_INT start_byte;
5769
5770 if (XINT (start) < GPT && XINT (end) > GPT)
5771 move_gap (XINT (end));
5772 start_byte = CHAR_TO_BYTE (XINT (start));
5773 buf = BYTE_POS_ADDR (start_byte);
5774 len = CHAR_TO_BYTE (XINT (end)) - start_byte;
5775 }
5776 else
5777 {
5778 buf = SDATA (object);
5779 len = SBYTES (object);
5780 }
5781 send_process (proc, buf, len, object);
5782
5783 unbind_to (count, Qnil);
5784}
5785
5786DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
5787 3, 3, 0,
5788 doc: /* Send current contents of region as input to PROCESS.
5789PROCESS may be a process, a buffer, the name of a process or buffer, or
5790nil, indicating the current buffer's process.
5791Called from program, takes three arguments, PROCESS, START and END.
5792If the region is more than 500 characters long,
5793it is sent in several bunches. This may happen even for shorter regions.
5794Output from processes can arrive in between bunches. */)
5795 (process, start, end)
5796 Lisp_Object process, start, end;
5797{
5798 Lisp_Object proc;
5799
5800 proc = get_process (process);
5801 validate_region (&start, &end);
5802 send_process_object (proc, start, end);
5803 return Qnil;
5804}
5805
5806DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
5807 2, 2, 0,
5808 doc: /* Send PROCESS the contents of STRING as input.
5809PROCESS may be a process, a buffer, the name of a process or buffer, or
5810nil, indicating the current buffer's process.
5811If STRING is more than 500 characters long,
5812it is sent in several bunches. This may happen even for shorter strings.
5813Output from processes can arrive in between bunches. */)
5814 (process, string)
5815 Lisp_Object process, string;
5816{
5817 Lisp_Object proc;
5818 CHECK_STRING (string);
5819 proc = get_process (process);
5820 send_process_object (proc, string, Qnil);
5821 return Qnil;
5822}
5823\f
5824/* Return the foreground process group for the tty/pty that
5825 the process P uses. */
5826static int
5827emacs_get_tty_pgrp (p)
5828 struct Lisp_Process *p;
5829{
5830 int gid = -1;
5831
5832#ifdef TIOCGPGRP
5833 if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
5834 {
5835 int fd;
5836 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5837 master side. Try the slave side. */
5838 fd = emacs_open (XSTRING (p->tty_name)->data, O_RDONLY, 0);
5839
5840 if (fd != -1)
5841 {
5842 ioctl (fd, TIOCGPGRP, &gid);
5843 emacs_close (fd);
5844 }
5845 }
5846#endif /* defined (TIOCGPGRP ) */
5847
5848 return gid;
5849}
5850
5851DEFUN ("process-running-child-p", Fprocess_running_child_p,
5852 Sprocess_running_child_p, 0, 1, 0,
5853 doc: /* Return t if PROCESS has given the terminal to a child.
5854If the operating system does not make it possible to find out,
5855return t unconditionally. */)
5856 (process)
5857 Lisp_Object process;
5858{
5859 /* Initialize in case ioctl doesn't exist or gives an error,
5860 in a way that will cause returning t. */
5861 int gid;
5862 Lisp_Object proc;
5863 struct Lisp_Process *p;
5864
5865 proc = get_process (process);
5866 p = XPROCESS (proc);
5867
5868 if (!EQ (p->childp, Qt))
5869 error ("Process %s is not a subprocess",
5870 SDATA (p->name));
5871 if (XINT (p->infd) < 0)
5872 error ("Process %s is not active",
5873 SDATA (p->name));
5874
5875 gid = emacs_get_tty_pgrp (p);
5876
5877 if (gid == p->pid)
5878 return Qnil;
5879 return Qt;
5880}
5881\f
5882/* send a signal number SIGNO to PROCESS.
5883 If CURRENT_GROUP is t, that means send to the process group
5884 that currently owns the terminal being used to communicate with PROCESS.
5885 This is used for various commands in shell mode.
5886 If CURRENT_GROUP is lambda, that means send to the process group
5887 that currently owns the terminal, but only if it is NOT the shell itself.
5888
5889 If NOMSG is zero, insert signal-announcements into process's buffers
5890 right away.
5891
5892 If we can, we try to signal PROCESS by sending control characters
5893 down the pty. This allows us to signal inferiors who have changed
5894 their uid, for which killpg would return an EPERM error. */
5895
5896static void
5897process_send_signal (process, signo, current_group, nomsg)
5898 Lisp_Object process;
5899 int signo;
5900 Lisp_Object current_group;
5901 int nomsg;
5902{
5903 Lisp_Object proc;
5904 register struct Lisp_Process *p;
5905 int gid;
5906 int no_pgrp = 0;
5907
5908 proc = get_process (process);
5909 p = XPROCESS (proc);
5910
5911 if (!EQ (p->childp, Qt))
5912 error ("Process %s is not a subprocess",
5913 SDATA (p->name));
5914 if (XINT (p->infd) < 0)
5915 error ("Process %s is not active",
5916 SDATA (p->name));
5917
5918 if (NILP (p->pty_flag))
5919 current_group = Qnil;
5920
5921 /* If we are using pgrps, get a pgrp number and make it negative. */
5922 if (NILP (current_group))
5923 /* Send the signal to the shell's process group. */
5924 gid = p->pid;
5925 else
5926 {
5927#ifdef SIGNALS_VIA_CHARACTERS
5928 /* If possible, send signals to the entire pgrp
5929 by sending an input character to it. */
5930
5931 /* TERMIOS is the latest and bestest, and seems most likely to
5932 work. If the system has it, use it. */
5933#ifdef HAVE_TERMIOS
5934 struct termios t;
5935 cc_t *sig_char = NULL;
5936
5937 tcgetattr (XINT (p->infd), &t);
5938
5939 switch (signo)
5940 {
5941 case SIGINT:
5942 sig_char = &t.c_cc[VINTR];
5943 break;
5944
5945 case SIGQUIT:
5946 sig_char = &t.c_cc[VQUIT];
5947 break;
5948
5949 case SIGTSTP:
5950#if defined (VSWTCH) && !defined (PREFER_VSUSP)
5951 sig_char = &t.c_cc[VSWTCH];
5952#else
5953 sig_char = &t.c_cc[VSUSP];
5954#endif
5955 break;
5956 }
5957
5958 if (sig_char && *sig_char != CDISABLE)
5959 {
5960 send_process (proc, sig_char, 1, Qnil);
5961 return;
5962 }
5963 /* If we can't send the signal with a character,
5964 fall through and send it another way. */
5965#else /* ! HAVE_TERMIOS */
5966
5967 /* On Berkeley descendants, the following IOCTL's retrieve the
5968 current control characters. */
5969#if defined (TIOCGLTC) && defined (TIOCGETC)
5970
5971 struct tchars c;
5972 struct ltchars lc;
5973
5974 switch (signo)
5975 {
5976 case SIGINT:
5977 ioctl (XINT (p->infd), TIOCGETC, &c);
5978 send_process (proc, &c.t_intrc, 1, Qnil);
5979 return;
5980 case SIGQUIT:
5981 ioctl (XINT (p->infd), TIOCGETC, &c);
5982 send_process (proc, &c.t_quitc, 1, Qnil);
5983 return;
5984#ifdef SIGTSTP
5985 case SIGTSTP:
5986 ioctl (XINT (p->infd), TIOCGLTC, &lc);
5987 send_process (proc, &lc.t_suspc, 1, Qnil);
5988 return;
5989#endif /* ! defined (SIGTSTP) */
5990 }
5991
5992#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5993
5994 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5995 characters. */
5996#ifdef TCGETA
5997 struct termio t;
5998 switch (signo)
5999 {
6000 case SIGINT:
6001 ioctl (XINT (p->infd), TCGETA, &t);
6002 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
6003 return;
6004 case SIGQUIT:
6005 ioctl (XINT (p->infd), TCGETA, &t);
6006 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
6007 return;
6008#ifdef SIGTSTP
6009 case SIGTSTP:
6010 ioctl (XINT (p->infd), TCGETA, &t);
6011 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
6012 return;
6013#endif /* ! defined (SIGTSTP) */
6014 }
6015#else /* ! defined (TCGETA) */
6016 Your configuration files are messed up.
6017 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
6018 you'd better be using one of the alternatives above! */
6019#endif /* ! defined (TCGETA) */
6020#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6021 /* In this case, the code above should alway returns. */
6022 abort ();
6023#endif /* ! defined HAVE_TERMIOS */
6024
6025 /* The code above may fall through if it can't
6026 handle the signal. */
6027#endif /* defined (SIGNALS_VIA_CHARACTERS) */
6028
6029#ifdef TIOCGPGRP
6030 /* Get the current pgrp using the tty itself, if we have that.
6031 Otherwise, use the pty to get the pgrp.
6032 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6033 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6034 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6035 His patch indicates that if TIOCGPGRP returns an error, then
6036 we should just assume that p->pid is also the process group id. */
6037
6038 gid = emacs_get_tty_pgrp (p);
6039
6040 if (gid == -1)
6041 /* If we can't get the information, assume
6042 the shell owns the tty. */
6043 gid = p->pid;
6044
6045 /* It is not clear whether anything really can set GID to -1.
6046 Perhaps on some system one of those ioctls can or could do so.
6047 Or perhaps this is vestigial. */
6048 if (gid == -1)
6049 no_pgrp = 1;
6050#else /* ! defined (TIOCGPGRP ) */
6051 /* Can't select pgrps on this system, so we know that
6052 the child itself heads the pgrp. */
6053 gid = p->pid;
6054#endif /* ! defined (TIOCGPGRP ) */
6055
6056 /* If current_group is lambda, and the shell owns the terminal,
6057 don't send any signal. */
6058 if (EQ (current_group, Qlambda) && gid == p->pid)
6059 return;
6060 }
6061
6062 switch (signo)
6063 {
6064#ifdef SIGCONT
6065 case SIGCONT:
6066 p->raw_status_new = 0;
6067 p->status = Qrun;
6068 XSETINT (p->tick, ++process_tick);
6069 if (!nomsg)
6070 status_notify (NULL);
6071 break;
6072#endif /* ! defined (SIGCONT) */
6073 case SIGINT:
6074#ifdef VMS
6075 send_process (proc, "\003", 1, Qnil); /* ^C */
6076 goto whoosh;
6077#endif
6078 case SIGQUIT:
6079#ifdef VMS
6080 send_process (proc, "\031", 1, Qnil); /* ^Y */
6081 goto whoosh;
6082#endif
6083 case SIGKILL:
6084#ifdef VMS
6085 sys$forcex (&(p->pid), 0, 1);
6086 whoosh:
6087#endif
6088 flush_pending_output (XINT (p->infd));
6089 break;
6090 }
6091
6092 /* If we don't have process groups, send the signal to the immediate
6093 subprocess. That isn't really right, but it's better than any
6094 obvious alternative. */
6095 if (no_pgrp)
6096 {
6097 kill (p->pid, signo);
6098 return;
6099 }
6100
6101 /* gid may be a pid, or minus a pgrp's number */
6102#ifdef TIOCSIGSEND
6103 if (!NILP (current_group))
6104 {
6105 if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1)
6106 EMACS_KILLPG (gid, signo);
6107 }
6108 else
6109 {
6110 gid = - p->pid;
6111 kill (gid, signo);
6112 }
6113#else /* ! defined (TIOCSIGSEND) */
6114 EMACS_KILLPG (gid, signo);
6115#endif /* ! defined (TIOCSIGSEND) */
6116}
6117
6118DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
6119 doc: /* Interrupt process PROCESS.
6120PROCESS may be a process, a buffer, or the name of a process or buffer.
6121No arg or nil means current buffer's process.
6122Second arg CURRENT-GROUP non-nil means send signal to
6123the current process-group of the process's controlling terminal
6124rather than to the process's own process group.
6125If the process is a shell, this means interrupt current subjob
6126rather than the shell.
6127
6128If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6129don't send the signal. */)
6130 (process, current_group)
6131 Lisp_Object process, current_group;
6132{
6133 process_send_signal (process, SIGINT, current_group, 0);
6134 return process;
6135}
6136
6137DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
6138 doc: /* Kill process PROCESS. May be process or name of one.
6139See function `interrupt-process' for more details on usage. */)
6140 (process, current_group)
6141 Lisp_Object process, current_group;
6142{
6143 process_send_signal (process, SIGKILL, current_group, 0);
6144 return process;
6145}
6146
6147DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
6148 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
6149See function `interrupt-process' for more details on usage. */)
6150 (process, current_group)
6151 Lisp_Object process, current_group;
6152{
6153 process_send_signal (process, SIGQUIT, current_group, 0);
6154 return process;
6155}
6156
6157DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
6158 doc: /* Stop process PROCESS. May be process or name of one.
6159See function `interrupt-process' for more details on usage.
6160If PROCESS is a network process, inhibit handling of incoming traffic. */)
6161 (process, current_group)
6162 Lisp_Object process, current_group;
6163{
6164#ifdef HAVE_SOCKETS
6165 if (PROCESSP (process) && NETCONN_P (process))
6166 {
6167 struct Lisp_Process *p;
6168
6169 p = XPROCESS (process);
6170 if (NILP (p->command)
6171 && XINT (p->infd) >= 0)
6172 {
6173 FD_CLR (XINT (p->infd), &input_wait_mask);
6174 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
6175 }
6176 p->command = Qt;
6177 return process;
6178 }
6179#endif
6180#ifndef SIGTSTP
6181 error ("No SIGTSTP support");
6182#else
6183 process_send_signal (process, SIGTSTP, current_group, 0);
6184#endif
6185 return process;
6186}
6187
6188DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
6189 doc: /* Continue process PROCESS. May be process or name of one.
6190See function `interrupt-process' for more details on usage.
6191If PROCESS is a network process, resume handling of incoming traffic. */)
6192 (process, current_group)
6193 Lisp_Object process, current_group;
6194{
6195#ifdef HAVE_SOCKETS
6196 if (PROCESSP (process) && NETCONN_P (process))
6197 {
6198 struct Lisp_Process *p;
6199
6200 p = XPROCESS (process);
6201 if (EQ (p->command, Qt)
6202 && XINT (p->infd) >= 0
6203 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6204 {
6205 FD_SET (XINT (p->infd), &input_wait_mask);
6206 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
6207 }
6208 p->command = Qnil;
6209 return process;
6210 }
6211#endif
6212#ifdef SIGCONT
6213 process_send_signal (process, SIGCONT, current_group, 0);
6214#else
6215 error ("No SIGCONT support");
6216#endif
6217 return process;
6218}
6219
6220DEFUN ("signal-process", Fsignal_process, Ssignal_process,
6221 2, 2, "sProcess (name or number): \nnSignal code: ",
6222 doc: /* Send PROCESS the signal with code SIGCODE.
6223PROCESS may also be a number specifying the process id of the
6224process to signal; in this case, the process need not be a child of
6225this Emacs.
6226SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6227 (process, sigcode)
6228 Lisp_Object process, sigcode;
6229{
6230 pid_t pid;
6231
6232 if (INTEGERP (process))
6233 {
6234 pid = XINT (process);
6235 goto got_it;
6236 }
6237
6238 if (FLOATP (process))
6239 {
6240 pid = (pid_t) XFLOAT_DATA (process);
6241 goto got_it;
6242 }
6243
6244 if (STRINGP (process))
6245 {
6246 Lisp_Object tem;
6247 if (tem = Fget_process (process), NILP (tem))
6248 {
6249 pid = XINT (Fstring_to_number (process, make_number (10)));
6250 if (pid > 0)
6251 goto got_it;
6252 }
6253 process = tem;
6254 }
6255 else
6256 process = get_process (process);
6257
6258 if (NILP (process))
6259 return process;
6260
6261 CHECK_PROCESS (process);
6262 pid = XPROCESS (process)->pid;
6263 if (pid <= 0)
6264 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6265
6266 got_it:
6267
6268#define parse_signal(NAME, VALUE) \
6269 else if (!xstricmp (name, NAME)) \
6270 XSETINT (sigcode, VALUE)
6271
6272 if (INTEGERP (sigcode))
6273 ;
6274 else
6275 {
6276 unsigned char *name;
6277
6278 CHECK_SYMBOL (sigcode);
6279 name = SDATA (SYMBOL_NAME (sigcode));
6280
6281 if (!strncmp(name, "SIG", 3) || !strncmp(name, "sig", 3))
6282 name += 3;
6283
6284 if (0)
6285 ;
6286#ifdef SIGUSR1
6287 parse_signal ("usr1", SIGUSR1);
6288#endif
6289#ifdef SIGUSR2
6290 parse_signal ("usr2", SIGUSR2);
6291#endif
6292#ifdef SIGTERM
6293 parse_signal ("term", SIGTERM);
6294#endif
6295#ifdef SIGHUP
6296 parse_signal ("hup", SIGHUP);
6297#endif
6298#ifdef SIGINT
6299 parse_signal ("int", SIGINT);
6300#endif
6301#ifdef SIGQUIT
6302 parse_signal ("quit", SIGQUIT);
6303#endif
6304#ifdef SIGILL
6305 parse_signal ("ill", SIGILL);
6306#endif
6307#ifdef SIGABRT
6308 parse_signal ("abrt", SIGABRT);
6309#endif
6310#ifdef SIGEMT
6311 parse_signal ("emt", SIGEMT);
6312#endif
6313#ifdef SIGKILL
6314 parse_signal ("kill", SIGKILL);
6315#endif
6316#ifdef SIGFPE
6317 parse_signal ("fpe", SIGFPE);
6318#endif
6319#ifdef SIGBUS
6320 parse_signal ("bus", SIGBUS);
6321#endif
6322#ifdef SIGSEGV
6323 parse_signal ("segv", SIGSEGV);
6324#endif
6325#ifdef SIGSYS
6326 parse_signal ("sys", SIGSYS);
6327#endif
6328#ifdef SIGPIPE
6329 parse_signal ("pipe", SIGPIPE);
6330#endif
6331#ifdef SIGALRM
6332 parse_signal ("alrm", SIGALRM);
6333#endif
6334#ifdef SIGURG
6335 parse_signal ("urg", SIGURG);
6336#endif
6337#ifdef SIGSTOP
6338 parse_signal ("stop", SIGSTOP);
6339#endif
6340#ifdef SIGTSTP
6341 parse_signal ("tstp", SIGTSTP);
6342#endif
6343#ifdef SIGCONT
6344 parse_signal ("cont", SIGCONT);
6345#endif
6346#ifdef SIGCHLD
6347 parse_signal ("chld", SIGCHLD);
6348#endif
6349#ifdef SIGTTIN
6350 parse_signal ("ttin", SIGTTIN);
6351#endif
6352#ifdef SIGTTOU
6353 parse_signal ("ttou", SIGTTOU);
6354#endif
6355#ifdef SIGIO
6356 parse_signal ("io", SIGIO);
6357#endif
6358#ifdef SIGXCPU
6359 parse_signal ("xcpu", SIGXCPU);
6360#endif
6361#ifdef SIGXFSZ
6362 parse_signal ("xfsz", SIGXFSZ);
6363#endif
6364#ifdef SIGVTALRM
6365 parse_signal ("vtalrm", SIGVTALRM);
6366#endif
6367#ifdef SIGPROF
6368 parse_signal ("prof", SIGPROF);
6369#endif
6370#ifdef SIGWINCH
6371 parse_signal ("winch", SIGWINCH);
6372#endif
6373#ifdef SIGINFO
6374 parse_signal ("info", SIGINFO);
6375#endif
6376 else
6377 error ("Undefined signal name %s", name);
6378 }
6379
6380#undef parse_signal
6381
6382 return make_number (kill (pid, XINT (sigcode)));
6383}
6384
6385DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
6386 doc: /* Make PROCESS see end-of-file in its input.
6387EOF comes after any text already sent to it.
6388PROCESS may be a process, a buffer, the name of a process or buffer, or
6389nil, indicating the current buffer's process.
6390If PROCESS is a network connection, or is a process communicating
6391through a pipe (as opposed to a pty), then you cannot send any more
6392text to PROCESS after you call this function. */)
6393 (process)
6394 Lisp_Object process;
6395{
6396 Lisp_Object proc;
6397 struct coding_system *coding;
6398
6399 if (DATAGRAM_CONN_P (process))
6400 return process;
6401
6402 proc = get_process (process);
6403 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
6404
6405 /* Make sure the process is really alive. */
6406 if (XPROCESS (proc)->raw_status_new)
6407 update_status (XPROCESS (proc));
6408 if (! EQ (XPROCESS (proc)->status, Qrun))
6409 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
6410
6411 if (CODING_REQUIRE_FLUSHING (coding))
6412 {
6413 coding->mode |= CODING_MODE_LAST_BLOCK;
6414 send_process (proc, "", 0, Qnil);
6415 }
6416
6417#ifdef VMS
6418 send_process (proc, "\032", 1, Qnil); /* ^z */
6419#else
6420 if (!NILP (XPROCESS (proc)->pty_flag))
6421 send_process (proc, "\004", 1, Qnil);
6422 else
6423 {
6424 int old_outfd, new_outfd;
6425
6426#ifdef HAVE_SHUTDOWN
6427 /* If this is a network connection, or socketpair is used
6428 for communication with the subprocess, call shutdown to cause EOF.
6429 (In some old system, shutdown to socketpair doesn't work.
6430 Then we just can't win.) */
6431 if (XPROCESS (proc)->pid == 0
6432 || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd))
6433 shutdown (XINT (XPROCESS (proc)->outfd), 1);
6434 /* In case of socketpair, outfd == infd, so don't close it. */
6435 if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd))
6436 emacs_close (XINT (XPROCESS (proc)->outfd));
6437#else /* not HAVE_SHUTDOWN */
6438 emacs_close (XINT (XPROCESS (proc)->outfd));
6439#endif /* not HAVE_SHUTDOWN */
6440 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6441 if (new_outfd < 0)
6442 abort ();
6443 old_outfd = XINT (XPROCESS (proc)->outfd);
6444
6445 if (!proc_encode_coding_system[new_outfd])
6446 proc_encode_coding_system[new_outfd]
6447 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
6448 bcopy (proc_encode_coding_system[old_outfd],
6449 proc_encode_coding_system[new_outfd],
6450 sizeof (struct coding_system));
6451 bzero (proc_encode_coding_system[old_outfd],
6452 sizeof (struct coding_system));
6453
6454 XSETINT (XPROCESS (proc)->outfd, new_outfd);
6455 }
6456#endif /* VMS */
6457 return process;
6458}
6459
6460/* Kill all processes associated with `buffer'.
6461 If `buffer' is nil, kill all processes */
6462
6463void
6464kill_buffer_processes (buffer)
6465 Lisp_Object buffer;
6466{
6467 Lisp_Object tail, proc;
6468
6469 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
6470 {
6471 proc = XCDR (XCAR (tail));
6472 if (GC_PROCESSP (proc)
6473 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
6474 {
6475 if (NETCONN_P (proc))
6476 Fdelete_process (proc);
6477 else if (XINT (XPROCESS (proc)->infd) >= 0)
6478 process_send_signal (proc, SIGHUP, Qnil, 1);
6479 }
6480 }
6481}
6482\f
6483/* On receipt of a signal that a child status has changed, loop asking
6484 about children with changed statuses until the system says there
6485 are no more.
6486
6487 All we do is change the status; we do not run sentinels or print
6488 notifications. That is saved for the next time keyboard input is
6489 done, in order to avoid timing errors.
6490
6491 ** WARNING: this can be called during garbage collection.
6492 Therefore, it must not be fooled by the presence of mark bits in
6493 Lisp objects.
6494
6495 ** USG WARNING: Although it is not obvious from the documentation
6496 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6497 signal() before executing at least one wait(), otherwise the
6498 handler will be called again, resulting in an infinite loop. The
6499 relevant portion of the documentation reads "SIGCLD signals will be
6500 queued and the signal-catching function will be continually
6501 reentered until the queue is empty". Invoking signal() causes the
6502 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6503 Inc.
6504
6505 ** Malloc WARNING: This should never call malloc either directly or
6506 indirectly; if it does, that is a bug */
6507
6508#ifdef SIGCHLD
6509SIGTYPE
6510sigchld_handler (signo)
6511 int signo;
6512{
6513 int old_errno = errno;
6514 Lisp_Object proc;
6515 register struct Lisp_Process *p;
6516 extern EMACS_TIME *input_available_clear_time;
6517
6518 SIGNAL_THREAD_CHECK (signo);
6519
6520#ifdef BSD4_1
6521 extern int sigheld;
6522 sigheld |= sigbit (SIGCHLD);
6523#endif
6524
6525 while (1)
6526 {
6527 pid_t pid;
6528 WAITTYPE w;
6529 Lisp_Object tail;
6530
6531#ifdef WNOHANG
6532#ifndef WUNTRACED
6533#define WUNTRACED 0
6534#endif /* no WUNTRACED */
6535 /* Keep trying to get a status until we get a definitive result. */
6536 do
6537 {
6538 errno = 0;
6539 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
6540 }
6541 while (pid < 0 && errno == EINTR);
6542
6543 if (pid <= 0)
6544 {
6545 /* PID == 0 means no processes found, PID == -1 means a real
6546 failure. We have done all our job, so return. */
6547
6548 /* USG systems forget handlers when they are used;
6549 must reestablish each time */
6550#if defined (USG) && !defined (POSIX_SIGNALS)
6551 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
6552#endif
6553#ifdef BSD4_1
6554 sigheld &= ~sigbit (SIGCHLD);
6555 sigrelse (SIGCHLD);
6556#endif
6557 errno = old_errno;
6558 return;
6559 }
6560#else
6561 pid = wait (&w);
6562#endif /* no WNOHANG */
6563
6564 /* Find the process that signaled us, and record its status. */
6565
6566 /* The process can have been deleted by Fdelete_process. */
6567 for (tail = deleted_pid_list; GC_CONSP (tail); tail = XCDR (tail))
6568 {
6569 Lisp_Object xpid = XCAR (tail);
6570 if ((GC_INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
6571 || (GC_FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
6572 {
6573 XSETCAR (tail, Qnil);
6574 goto sigchld_end_of_loop;
6575 }
6576 }
6577
6578 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6579 p = 0;
6580 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
6581 {
6582 proc = XCDR (XCAR (tail));
6583 p = XPROCESS (proc);
6584 if (GC_EQ (p->childp, Qt) && p->pid == pid)
6585 break;
6586 p = 0;
6587 }
6588
6589 /* Look for an asynchronous process whose pid hasn't been filled
6590 in yet. */
6591 if (p == 0)
6592 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
6593 {
6594 proc = XCDR (XCAR (tail));
6595 p = XPROCESS (proc);
6596 if (p->pid == -1)
6597 break;
6598 p = 0;
6599 }
6600
6601 /* Change the status of the process that was found. */
6602 if (p != 0)
6603 {
6604 union { int i; WAITTYPE wt; } u;
6605 int clear_desc_flag = 0;
6606
6607 XSETINT (p->tick, ++process_tick);
6608 u.wt = w;
6609 p->raw_status = u.i;
6610 p->raw_status_new = 1;
6611
6612 /* If process has terminated, stop waiting for its output. */
6613 if ((WIFSIGNALED (w) || WIFEXITED (w))
6614 && XINT (p->infd) >= 0)
6615 clear_desc_flag = 1;
6616
6617 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6618 if (clear_desc_flag)
6619 {
6620 FD_CLR (XINT (p->infd), &input_wait_mask);
6621 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
6622 }
6623
6624 /* Tell wait_reading_process_output that it needs to wake up and
6625 look around. */
6626 if (input_available_clear_time)
6627 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6628 }
6629
6630 /* There was no asynchronous process found for that pid: we have
6631 a synchronous process. */
6632 else
6633 {
6634 synch_process_alive = 0;
6635
6636 /* Report the status of the synchronous process. */
6637 if (WIFEXITED (w))
6638 synch_process_retcode = WRETCODE (w);
6639 else if (WIFSIGNALED (w))
6640 synch_process_termsig = WTERMSIG (w);
6641
6642 /* Tell wait_reading_process_output that it needs to wake up and
6643 look around. */
6644 if (input_available_clear_time)
6645 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6646 }
6647
6648 sigchld_end_of_loop:
6649 ;
6650
6651 /* On some systems, we must return right away.
6652 If any more processes want to signal us, we will
6653 get another signal.
6654 Otherwise (on systems that have WNOHANG), loop around
6655 to use up all the processes that have something to tell us. */
6656#if (defined WINDOWSNT \
6657 || (defined USG && !defined GNU_LINUX \
6658 && !(defined HPUX && defined WNOHANG)))
6659#if defined (USG) && ! defined (POSIX_SIGNALS)
6660 signal (signo, sigchld_handler);
6661#endif
6662 errno = old_errno;
6663 return;
6664#endif /* USG, but not HPUX with WNOHANG */
6665 }
6666}
6667#endif /* SIGCHLD */
6668\f
6669
6670static Lisp_Object
6671exec_sentinel_unwind (data)
6672 Lisp_Object data;
6673{
6674 XPROCESS (XCAR (data))->sentinel = XCDR (data);
6675 return Qnil;
6676}
6677
6678static Lisp_Object
6679exec_sentinel_error_handler (error)
6680 Lisp_Object error;
6681{
6682 cmd_error_internal (error, "error in process sentinel: ");
6683 Vinhibit_quit = Qt;
6684 update_echo_area ();
6685 Fsleep_for (make_number (2), Qnil);
6686 return Qt;
6687}
6688
6689static void
6690exec_sentinel (proc, reason)
6691 Lisp_Object proc, reason;
6692{
6693 Lisp_Object sentinel, obuffer, odeactivate, okeymap;
6694 register struct Lisp_Process *p = XPROCESS (proc);
6695 int count = SPECPDL_INDEX ();
6696 int outer_running_asynch_code = running_asynch_code;
6697 int waiting = waiting_for_user_input_p;
6698
6699 if (inhibit_sentinels)
6700 return;
6701
6702 /* No need to gcpro these, because all we do with them later
6703 is test them for EQness, and none of them should be a string. */
6704 odeactivate = Vdeactivate_mark;
6705 XSETBUFFER (obuffer, current_buffer);
6706 okeymap = current_buffer->keymap;
6707
6708 sentinel = p->sentinel;
6709 if (NILP (sentinel))
6710 return;
6711
6712 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6713 assure that it gets restored no matter how the sentinel exits. */
6714 p->sentinel = Qnil;
6715 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
6716 /* Inhibit quit so that random quits don't screw up a running filter. */
6717 specbind (Qinhibit_quit, Qt);
6718 specbind (Qlast_nonmenu_event, Qt);
6719
6720 /* In case we get recursively called,
6721 and we already saved the match data nonrecursively,
6722 save the same match data in safely recursive fashion. */
6723 if (outer_running_asynch_code)
6724 {
6725 Lisp_Object tem;
6726 tem = Fmatch_data (Qnil, Qnil, Qnil);
6727 restore_search_regs ();
6728 record_unwind_save_match_data ();
6729 Fset_match_data (tem, Qt);
6730 }
6731
6732 /* For speed, if a search happens within this code,
6733 save the match data in a special nonrecursive fashion. */
6734 running_asynch_code = 1;
6735
6736 internal_condition_case_1 (read_process_output_call,
6737 Fcons (sentinel,
6738 Fcons (proc, Fcons (reason, Qnil))),
6739 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6740 exec_sentinel_error_handler);
6741
6742 /* If we saved the match data nonrecursively, restore it now. */
6743 restore_search_regs ();
6744 running_asynch_code = outer_running_asynch_code;
6745
6746 Vdeactivate_mark = odeactivate;
6747
6748 /* Restore waiting_for_user_input_p as it was
6749 when we were called, in case the filter clobbered it. */
6750 waiting_for_user_input_p = waiting;
6751
6752#if 0
6753 if (! EQ (Fcurrent_buffer (), obuffer)
6754 || ! EQ (current_buffer->keymap, okeymap))
6755#endif
6756 /* But do it only if the caller is actually going to read events.
6757 Otherwise there's no need to make him wake up, and it could
6758 cause trouble (for example it would make sit_for return). */
6759 if (waiting_for_user_input_p == -1)
6760 record_asynch_buffer_change ();
6761
6762 unbind_to (count, Qnil);
6763}
6764
6765/* Report all recent events of a change in process status
6766 (either run the sentinel or output a message).
6767 This is usually done while Emacs is waiting for keyboard input
6768 but can be done at other times. */
6769
6770static void
6771status_notify (deleting_process)
6772 struct Lisp_Process *deleting_process;
6773{
6774 register Lisp_Object proc, buffer;
6775 Lisp_Object tail, msg;
6776 struct gcpro gcpro1, gcpro2;
6777
6778 tail = Qnil;
6779 msg = Qnil;
6780 /* We need to gcpro tail; if read_process_output calls a filter
6781 which deletes a process and removes the cons to which tail points
6782 from Vprocess_alist, and then causes a GC, tail is an unprotected
6783 reference. */
6784 GCPRO2 (tail, msg);
6785
6786 /* Set this now, so that if new processes are created by sentinels
6787 that we run, we get called again to handle their status changes. */
6788 update_tick = process_tick;
6789
6790 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
6791 {
6792 Lisp_Object symbol;
6793 register struct Lisp_Process *p;
6794
6795 proc = Fcdr (Fcar (tail));
6796 p = XPROCESS (proc);
6797
6798 if (XINT (p->tick) != XINT (p->update_tick))
6799 {
6800 XSETINT (p->update_tick, XINT (p->tick));
6801
6802 /* If process is still active, read any output that remains. */
6803 while (! EQ (p->filter, Qt)
6804 && ! EQ (p->status, Qconnect)
6805 && ! EQ (p->status, Qlisten)
6806 && ! EQ (p->command, Qt) /* Network process not stopped. */
6807 && XINT (p->infd) >= 0
6808 && p != deleting_process
6809 && read_process_output (proc, XINT (p->infd)) > 0);
6810
6811 buffer = p->buffer;
6812
6813 /* Get the text to use for the message. */
6814 if (p->raw_status_new)
6815 update_status (p);
6816 msg = status_message (p);
6817
6818 /* If process is terminated, deactivate it or delete it. */
6819 symbol = p->status;
6820 if (CONSP (p->status))
6821 symbol = XCAR (p->status);
6822
6823 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
6824 || EQ (symbol, Qclosed))
6825 {
6826 if (delete_exited_processes)
6827 remove_process (proc);
6828 else
6829 deactivate_process (proc);
6830 }
6831
6832 /* The actions above may have further incremented p->tick.
6833 So set p->update_tick again
6834 so that an error in the sentinel will not cause
6835 this code to be run again. */
6836 XSETINT (p->update_tick, XINT (p->tick));
6837 /* Now output the message suitably. */
6838 if (!NILP (p->sentinel))
6839 exec_sentinel (proc, msg);
6840 /* Don't bother with a message in the buffer
6841 when a process becomes runnable. */
6842 else if (!EQ (symbol, Qrun) && !NILP (buffer))
6843 {
6844 Lisp_Object ro, tem;
6845 struct buffer *old = current_buffer;
6846 int opoint, opoint_byte;
6847 int before, before_byte;
6848
6849 ro = XBUFFER (buffer)->read_only;
6850
6851 /* Avoid error if buffer is deleted
6852 (probably that's why the process is dead, too) */
6853 if (NILP (XBUFFER (buffer)->name))
6854 continue;
6855 Fset_buffer (buffer);
6856
6857 opoint = PT;
6858 opoint_byte = PT_BYTE;
6859 /* Insert new output into buffer
6860 at the current end-of-output marker,
6861 thus preserving logical ordering of input and output. */
6862 if (XMARKER (p->mark)->buffer)
6863 Fgoto_char (p->mark);
6864 else
6865 SET_PT_BOTH (ZV, ZV_BYTE);
6866
6867 before = PT;
6868 before_byte = PT_BYTE;
6869
6870 tem = current_buffer->read_only;
6871 current_buffer->read_only = Qnil;
6872 insert_string ("\nProcess ");
6873 Finsert (1, &p->name);
6874 insert_string (" ");
6875 Finsert (1, &msg);
6876 current_buffer->read_only = tem;
6877 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6878
6879 if (opoint >= before)
6880 SET_PT_BOTH (opoint + (PT - before),
6881 opoint_byte + (PT_BYTE - before_byte));
6882 else
6883 SET_PT_BOTH (opoint, opoint_byte);
6884
6885 set_buffer_internal (old);
6886 }
6887 }
6888 } /* end for */
6889
6890 update_mode_lines++; /* in case buffers use %s in mode-line-format */
6891 redisplay_preserve_echo_area (13);
6892
6893 UNGCPRO;
6894}
6895
6896\f
6897DEFUN ("set-process-coding-system", Fset_process_coding_system,
6898 Sset_process_coding_system, 1, 3, 0,
6899 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
6900DECODING will be used to decode subprocess output and ENCODING to
6901encode subprocess input. */)
6902 (process, decoding, encoding)
6903 register Lisp_Object process, decoding, encoding;
6904{
6905 register struct Lisp_Process *p;
6906
6907 CHECK_PROCESS (process);
6908 p = XPROCESS (process);
6909 if (XINT (p->infd) < 0)
6910 error ("Input file descriptor of %s closed", SDATA (p->name));
6911 if (XINT (p->outfd) < 0)
6912 error ("Output file descriptor of %s closed", SDATA (p->name));
6913 Fcheck_coding_system (decoding);
6914 Fcheck_coding_system (encoding);
6915
6916 p->decode_coding_system = decoding;
6917 p->encode_coding_system = encoding;
6918 setup_process_coding_systems (process);
6919
6920 return Qnil;
6921}
6922
6923DEFUN ("process-coding-system",
6924 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
6925 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6926 (process)
6927 register Lisp_Object process;
6928{
6929 CHECK_PROCESS (process);
6930 return Fcons (XPROCESS (process)->decode_coding_system,
6931 XPROCESS (process)->encode_coding_system);
6932}
6933
6934DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
6935 Sset_process_filter_multibyte, 2, 2, 0,
6936 doc: /* Set multibyteness of the strings given to PROCESS's filter.
6937If FLAG is non-nil, the filter is given multibyte strings.
6938If FLAG is nil, the filter is given unibyte strings. In this case,
6939all character code conversion except for end-of-line conversion is
6940suppressed. */)
6941 (process, flag)
6942 Lisp_Object process, flag;
6943{
6944 register struct Lisp_Process *p;
6945
6946 CHECK_PROCESS (process);
6947 p = XPROCESS (process);
6948 p->filter_multibyte = flag;
6949 setup_process_coding_systems (process);
6950
6951 return Qnil;
6952}
6953
6954DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
6955 Sprocess_filter_multibyte_p, 1, 1, 0,
6956 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6957 (process)
6958 Lisp_Object process;
6959{
6960 register struct Lisp_Process *p;
6961
6962 CHECK_PROCESS (process);
6963 p = XPROCESS (process);
6964
6965 return (NILP (p->filter_multibyte) ? Qnil : Qt);
6966}
6967
6968
6969\f
6970/* The first time this is called, assume keyboard input comes from DESC
6971 instead of from where we used to expect it.
6972 Subsequent calls mean assume input keyboard can come from DESC
6973 in addition to other places. */
6974
6975static int add_keyboard_wait_descriptor_called_flag;
6976
6977void
6978add_keyboard_wait_descriptor (desc)
6979 int desc;
6980{
6981 if (! add_keyboard_wait_descriptor_called_flag)
6982 FD_CLR (0, &input_wait_mask);
6983 add_keyboard_wait_descriptor_called_flag = 1;
6984 FD_SET (desc, &input_wait_mask);
6985 FD_SET (desc, &non_process_wait_mask);
6986 if (desc > max_keyboard_desc)
6987 max_keyboard_desc = desc;
6988}
6989
6990/* From now on, do not expect DESC to give keyboard input. */
6991
6992void
6993delete_keyboard_wait_descriptor (desc)
6994 int desc;
6995{
6996 int fd;
6997 int lim = max_keyboard_desc;
6998
6999 FD_CLR (desc, &input_wait_mask);
7000 FD_CLR (desc, &non_process_wait_mask);
7001
7002 if (desc == max_keyboard_desc)
7003 for (fd = 0; fd < lim; fd++)
7004 if (FD_ISSET (fd, &input_wait_mask)
7005 && !FD_ISSET (fd, &non_keyboard_wait_mask))
7006 max_keyboard_desc = fd;
7007}
7008
7009/* Return nonzero if *MASK has a bit set
7010 that corresponds to one of the keyboard input descriptors. */
7011
7012static int
7013keyboard_bit_set (mask)
7014 SELECT_TYPE *mask;
7015{
7016 int fd;
7017
7018 for (fd = 0; fd <= max_keyboard_desc; fd++)
7019 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
7020 && !FD_ISSET (fd, &non_keyboard_wait_mask))
7021 return 1;
7022
7023 return 0;
7024}
7025\f
7026void
7027init_process ()
7028{
7029 register int i;
7030
7031 inhibit_sentinels = 0;
7032
7033#ifdef SIGCHLD
7034#ifndef CANNOT_DUMP
7035 if (! noninteractive || initialized)
7036#endif
7037 signal (SIGCHLD, sigchld_handler);
7038#endif
7039
7040 FD_ZERO (&input_wait_mask);
7041 FD_ZERO (&non_keyboard_wait_mask);
7042 FD_ZERO (&non_process_wait_mask);
7043 max_process_desc = 0;
7044
7045#ifdef NON_BLOCKING_CONNECT
7046 FD_ZERO (&connect_wait_mask);
7047 num_pending_connects = 0;
7048#endif
7049
7050#ifdef ADAPTIVE_READ_BUFFERING
7051 process_output_delay_count = 0;
7052 process_output_skip = 0;
7053#endif
7054
7055 FD_SET (0, &input_wait_mask);
7056
7057 Vprocess_alist = Qnil;
7058#ifdef SIGCHLD
7059 deleted_pid_list = Qnil;
7060#endif
7061 for (i = 0; i < MAXDESC; i++)
7062 {
7063 chan_process[i] = Qnil;
7064 proc_buffered_char[i] = -1;
7065 }
7066 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
7067 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
7068#ifdef DATAGRAM_SOCKETS
7069 bzero (datagram_address, sizeof datagram_address);
7070#endif
7071
7072#ifdef HAVE_SOCKETS
7073 {
7074 Lisp_Object subfeatures = Qnil;
7075 struct socket_options *sopt;
7076
7077#define ADD_SUBFEATURE(key, val) \
7078 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
7079
7080#ifdef NON_BLOCKING_CONNECT
7081 ADD_SUBFEATURE (QCnowait, Qt);
7082#endif
7083#ifdef DATAGRAM_SOCKETS
7084 ADD_SUBFEATURE (QCtype, Qdatagram);
7085#endif
7086#ifdef HAVE_LOCAL_SOCKETS
7087 ADD_SUBFEATURE (QCfamily, Qlocal);
7088#endif
7089 ADD_SUBFEATURE (QCfamily, Qipv4);
7090#ifdef AF_INET6
7091 ADD_SUBFEATURE (QCfamily, Qipv6);
7092#endif
7093#ifdef HAVE_GETSOCKNAME
7094 ADD_SUBFEATURE (QCservice, Qt);
7095#endif
7096#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
7097 ADD_SUBFEATURE (QCserver, Qt);
7098#endif
7099
7100 for (sopt = socket_options; sopt->name; sopt++)
7101 subfeatures = Fcons (intern (sopt->name), subfeatures);
7102
7103 Fprovide (intern ("make-network-process"), subfeatures);
7104 }
7105#endif /* HAVE_SOCKETS */
7106
7107#if defined (DARWIN) || defined (MAC_OSX)
7108 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7109 processes. As such, we only change the default value. */
7110 if (initialized)
7111 {
7112 char *release = get_operating_system_release();
7113 if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION
7114 && release[1] == '.')) {
7115 Vprocess_connection_type = Qnil;
7116 }
7117 }
7118#endif
7119}
7120
7121void
7122syms_of_process ()
7123{
7124 Qprocessp = intern ("processp");
7125 staticpro (&Qprocessp);
7126 Qrun = intern ("run");
7127 staticpro (&Qrun);
7128 Qstop = intern ("stop");
7129 staticpro (&Qstop);
7130 Qsignal = intern ("signal");
7131 staticpro (&Qsignal);
7132
7133 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7134 here again.
7135
7136 Qexit = intern ("exit");
7137 staticpro (&Qexit); */
7138
7139 Qopen = intern ("open");
7140 staticpro (&Qopen);
7141 Qclosed = intern ("closed");
7142 staticpro (&Qclosed);
7143 Qconnect = intern ("connect");
7144 staticpro (&Qconnect);
7145 Qfailed = intern ("failed");
7146 staticpro (&Qfailed);
7147 Qlisten = intern ("listen");
7148 staticpro (&Qlisten);
7149 Qlocal = intern ("local");
7150 staticpro (&Qlocal);
7151 Qipv4 = intern ("ipv4");
7152 staticpro (&Qipv4);
7153#ifdef AF_INET6
7154 Qipv6 = intern ("ipv6");
7155 staticpro (&Qipv6);
7156#endif
7157 Qdatagram = intern ("datagram");
7158 staticpro (&Qdatagram);
7159
7160 QCname = intern (":name");
7161 staticpro (&QCname);
7162 QCbuffer = intern (":buffer");
7163 staticpro (&QCbuffer);
7164 QChost = intern (":host");
7165 staticpro (&QChost);
7166 QCservice = intern (":service");
7167 staticpro (&QCservice);
7168 QCtype = intern (":type");
7169 staticpro (&QCtype);
7170 QClocal = intern (":local");
7171 staticpro (&QClocal);
7172 QCremote = intern (":remote");
7173 staticpro (&QCremote);
7174 QCcoding = intern (":coding");
7175 staticpro (&QCcoding);
7176 QCserver = intern (":server");
7177 staticpro (&QCserver);
7178 QCnowait = intern (":nowait");
7179 staticpro (&QCnowait);
7180 QCsentinel = intern (":sentinel");
7181 staticpro (&QCsentinel);
7182 QClog = intern (":log");
7183 staticpro (&QClog);
7184 QCnoquery = intern (":noquery");
7185 staticpro (&QCnoquery);
7186 QCstop = intern (":stop");
7187 staticpro (&QCstop);
7188 QCoptions = intern (":options");
7189 staticpro (&QCoptions);
7190 QCplist = intern (":plist");
7191 staticpro (&QCplist);
7192 QCfilter_multibyte = intern (":filter-multibyte");
7193 staticpro (&QCfilter_multibyte);
7194
7195 Qlast_nonmenu_event = intern ("last-nonmenu-event");
7196 staticpro (&Qlast_nonmenu_event);
7197
7198 staticpro (&Vprocess_alist);
7199#ifdef SIGCHLD
7200 staticpro (&deleted_pid_list);
7201#endif
7202
7203 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
7204 doc: /* *Non-nil means delete processes immediately when they exit.
7205A value of nil means don't delete them until `list-processes' is run. */);
7206
7207 delete_exited_processes = 1;
7208
7209 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
7210 doc: /* Control type of device used to communicate with subprocesses.
7211Values are nil to use a pipe, or t or `pty' to use a pty.
7212The value has no effect if the system has no ptys or if all ptys are busy:
7213then a pipe is used in any case.
7214The value takes effect when `start-process' is called. */);
7215 Vprocess_connection_type = Qt;
7216
7217#ifdef ADAPTIVE_READ_BUFFERING
7218 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering,
7219 doc: /* If non-nil, improve receive buffering by delaying after short reads.
7220On some systems, when Emacs reads the output from a subprocess, the output data
7221is read in very small blocks, potentially resulting in very poor performance.
7222This behavior can be remedied to some extent by setting this variable to a
7223non-nil value, as it will automatically delay reading from such processes, to
7224allow them to produce more output before Emacs tries to read it.
7225If the value is t, the delay is reset after each write to the process; any other
7226non-nil value means that the delay is not reset on write.
7227The variable takes effect when `start-process' is called. */);
7228 Vprocess_adaptive_read_buffering = Qt;
7229#endif
7230
7231 defsubr (&Sprocessp);
7232 defsubr (&Sget_process);
7233 defsubr (&Sget_buffer_process);
7234 defsubr (&Sdelete_process);
7235 defsubr (&Sprocess_status);
7236 defsubr (&Sprocess_exit_status);
7237 defsubr (&Sprocess_id);
7238 defsubr (&Sprocess_name);
7239 defsubr (&Sprocess_tty_name);
7240 defsubr (&Sprocess_command);
7241 defsubr (&Sset_process_buffer);
7242 defsubr (&Sprocess_buffer);
7243 defsubr (&Sprocess_mark);
7244 defsubr (&Sset_process_filter);
7245 defsubr (&Sprocess_filter);
7246 defsubr (&Sset_process_sentinel);
7247 defsubr (&Sprocess_sentinel);
7248 defsubr (&Sset_process_window_size);
7249 defsubr (&Sset_process_inherit_coding_system_flag);
7250 defsubr (&Sprocess_inherit_coding_system_flag);
7251 defsubr (&Sset_process_query_on_exit_flag);
7252 defsubr (&Sprocess_query_on_exit_flag);
7253 defsubr (&Sprocess_contact);
7254 defsubr (&Sprocess_plist);
7255 defsubr (&Sset_process_plist);
7256 defsubr (&Slist_processes);
7257 defsubr (&Sprocess_list);
7258 defsubr (&Sstart_process);
7259#ifdef HAVE_SOCKETS
7260 defsubr (&Sset_network_process_option);
7261 defsubr (&Smake_network_process);
7262 defsubr (&Sformat_network_address);
7263#endif /* HAVE_SOCKETS */
7264#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7265#ifdef SIOCGIFCONF
7266 defsubr (&Snetwork_interface_list);
7267#endif
7268#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7269 defsubr (&Snetwork_interface_info);
7270#endif
7271#endif /* HAVE_SOCKETS ... */
7272#ifdef DATAGRAM_SOCKETS
7273 defsubr (&Sprocess_datagram_address);
7274 defsubr (&Sset_process_datagram_address);
7275#endif
7276 defsubr (&Saccept_process_output);
7277 defsubr (&Sprocess_send_region);
7278 defsubr (&Sprocess_send_string);
7279 defsubr (&Sinterrupt_process);
7280 defsubr (&Skill_process);
7281 defsubr (&Squit_process);
7282 defsubr (&Sstop_process);
7283 defsubr (&Scontinue_process);
7284 defsubr (&Sprocess_running_child_p);
7285 defsubr (&Sprocess_send_eof);
7286 defsubr (&Ssignal_process);
7287 defsubr (&Swaiting_for_user_input_p);
7288/* defsubr (&Sprocess_connection); */
7289 defsubr (&Sset_process_coding_system);
7290 defsubr (&Sprocess_coding_system);
7291 defsubr (&Sset_process_filter_multibyte);
7292 defsubr (&Sprocess_filter_multibyte_p);
7293}
7294
7295\f
7296#else /* not subprocesses */
7297
7298#include <sys/types.h>
7299#include <errno.h>
7300
7301#include "lisp.h"
7302#include "systime.h"
7303#include "charset.h"
7304#include "coding.h"
7305#include "termopts.h"
7306#include "sysselect.h"
7307
7308extern int frame_garbaged;
7309
7310extern EMACS_TIME timer_check ();
7311extern int timers_run;
7312
7313Lisp_Object QCtype;
7314
7315/* As described above, except assuming that there are no subprocesses:
7316
7317 Wait for timeout to elapse and/or keyboard input to be available.
7318
7319 time_limit is:
7320 timeout in seconds, or
7321 zero for no limit, or
7322 -1 means gobble data immediately available but don't wait for any.
7323
7324 read_kbd is a Lisp_Object:
7325 0 to ignore keyboard input, or
7326 1 to return when input is available, or
7327 -1 means caller will actually read the input, so don't throw to
7328 the quit handler.
7329
7330 see full version for other parameters. We know that wait_proc will
7331 always be NULL, since `subprocesses' isn't defined.
7332
7333 do_display != 0 means redisplay should be done to show subprocess
7334 output that arrives.
7335
7336 Return true if we received input from any process. */
7337
7338int
7339wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
7340 wait_for_cell, wait_proc, just_wait_proc)
7341 int time_limit, microsecs, read_kbd, do_display;
7342 Lisp_Object wait_for_cell;
7343 struct Lisp_Process *wait_proc;
7344 int just_wait_proc;
7345{
7346 register int nfds;
7347 EMACS_TIME end_time, timeout;
7348 SELECT_TYPE waitchannels;
7349 int xerrno;
7350
7351 /* What does time_limit really mean? */
7352 if (time_limit || microsecs)
7353 {
7354 EMACS_GET_TIME (end_time);
7355 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
7356 EMACS_ADD_TIME (end_time, end_time, timeout);
7357 }
7358
7359 /* Turn off periodic alarms (in case they are in use)
7360 and then turn off any other atimers,
7361 because the select emulator uses alarms. */
7362 stop_polling ();
7363 turn_on_atimers (0);
7364
7365 while (1)
7366 {
7367 int timeout_reduced_for_timers = 0;
7368
7369 /* If calling from keyboard input, do not quit
7370 since we want to return C-g as an input character.
7371 Otherwise, do pending quit if requested. */
7372 if (read_kbd >= 0)
7373 QUIT;
7374
7375 /* Exit now if the cell we're waiting for became non-nil. */
7376 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7377 break;
7378
7379 /* Compute time from now till when time limit is up */
7380 /* Exit if already run out */
7381 if (time_limit == -1)
7382 {
7383 /* -1 specified for timeout means
7384 gobble output available now
7385 but don't wait at all. */
7386
7387 EMACS_SET_SECS_USECS (timeout, 0, 0);
7388 }
7389 else if (time_limit || microsecs)
7390 {
7391 EMACS_GET_TIME (timeout);
7392 EMACS_SUB_TIME (timeout, end_time, timeout);
7393 if (EMACS_TIME_NEG_P (timeout))
7394 break;
7395 }
7396 else
7397 {
7398 EMACS_SET_SECS_USECS (timeout, 100000, 0);
7399 }
7400
7401 /* If our caller will not immediately handle keyboard events,
7402 run timer events directly.
7403 (Callers that will immediately read keyboard events
7404 call timer_delay on their own.) */
7405 if (NILP (wait_for_cell))
7406 {
7407 EMACS_TIME timer_delay;
7408
7409 do
7410 {
7411 int old_timers_run = timers_run;
7412 timer_delay = timer_check (1);
7413 if (timers_run != old_timers_run && do_display)
7414 /* We must retry, since a timer may have requeued itself
7415 and that could alter the time delay. */
7416 redisplay_preserve_echo_area (14);
7417 else
7418 break;
7419 }
7420 while (!detect_input_pending ());
7421
7422 /* If there is unread keyboard input, also return. */
7423 if (read_kbd != 0
7424 && requeued_events_pending_p ())
7425 break;
7426
7427 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
7428 {
7429 EMACS_TIME difference;
7430 EMACS_SUB_TIME (difference, timer_delay, timeout);
7431 if (EMACS_TIME_NEG_P (difference))
7432 {
7433 timeout = timer_delay;
7434 timeout_reduced_for_timers = 1;
7435 }
7436 }
7437 }
7438
7439 /* Cause C-g and alarm signals to take immediate action,
7440 and cause input available signals to zero out timeout. */
7441 if (read_kbd < 0)
7442 set_waiting_for_input (&timeout);
7443
7444 /* Wait till there is something to do. */
7445
7446 if (! read_kbd && NILP (wait_for_cell))
7447 FD_ZERO (&waitchannels);
7448 else
7449 FD_SET (0, &waitchannels);
7450
7451 /* If a frame has been newly mapped and needs updating,
7452 reprocess its display stuff. */
7453 if (frame_garbaged && do_display)
7454 {
7455 clear_waiting_for_input ();
7456 redisplay_preserve_echo_area (15);
7457 if (read_kbd < 0)
7458 set_waiting_for_input (&timeout);
7459 }
7460
7461 if (read_kbd && detect_input_pending ())
7462 {
7463 nfds = 0;
7464 FD_ZERO (&waitchannels);
7465 }
7466 else
7467 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
7468 &timeout);
7469
7470 xerrno = errno;
7471
7472 /* Make C-g and alarm signals set flags again */
7473 clear_waiting_for_input ();
7474
7475 /* If we woke up due to SIGWINCH, actually change size now. */
7476 do_pending_window_change (0);
7477
7478 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
7479 /* We waited the full specified time, so return now. */
7480 break;
7481
7482 if (nfds == -1)
7483 {
7484 /* If the system call was interrupted, then go around the
7485 loop again. */
7486 if (xerrno == EINTR)
7487 FD_ZERO (&waitchannels);
7488 else
7489 error ("select error: %s", emacs_strerror (xerrno));
7490 }
7491#ifdef sun
7492 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
7493 /* System sometimes fails to deliver SIGIO. */
7494 kill (getpid (), SIGIO);
7495#endif
7496#ifdef SIGIO
7497 if (read_kbd && interrupt_input && (waitchannels & 1))
7498 kill (getpid (), SIGIO);
7499#endif
7500
7501 /* Check for keyboard input */
7502
7503 if (read_kbd
7504 && detect_input_pending_run_timers (do_display))
7505 {
7506 swallow_events (do_display);
7507 if (detect_input_pending_run_timers (do_display))
7508 break;
7509 }
7510
7511 /* If there is unread keyboard input, also return. */
7512 if (read_kbd
7513 && requeued_events_pending_p ())
7514 break;
7515
7516 /* If wait_for_cell. check for keyboard input
7517 but don't run any timers.
7518 ??? (It seems wrong to me to check for keyboard
7519 input at all when wait_for_cell, but the code
7520 has been this way since July 1994.
7521 Try changing this after version 19.31.) */
7522 if (! NILP (wait_for_cell)
7523 && detect_input_pending ())
7524 {
7525 swallow_events (do_display);
7526 if (detect_input_pending ())
7527 break;
7528 }
7529
7530 /* Exit now if the cell we're waiting for became non-nil. */
7531 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7532 break;
7533 }
7534
7535 start_polling ();
7536
7537 return 0;
7538}
7539
7540
7541/* Don't confuse make-docfile by having two doc strings for this function.
7542 make-docfile does not pay attention to #if, for good reason! */
7543DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7544 0)
7545 (name)
7546 register Lisp_Object name;
7547{
7548 return Qnil;
7549}
7550
7551 /* Don't confuse make-docfile by having two doc strings for this function.
7552 make-docfile does not pay attention to #if, for good reason! */
7553DEFUN ("process-inherit-coding-system-flag",
7554 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7555 1, 1, 0,
7556 0)
7557 (process)
7558 register Lisp_Object process;
7559{
7560 /* Ignore the argument and return the value of
7561 inherit-process-coding-system. */
7562 return inherit_process_coding_system ? Qt : Qnil;
7563}
7564
7565/* Kill all processes associated with `buffer'.
7566 If `buffer' is nil, kill all processes.
7567 Since we have no subprocesses, this does nothing. */
7568
7569void
7570kill_buffer_processes (buffer)
7571 Lisp_Object buffer;
7572{
7573}
7574
7575void
7576init_process ()
7577{
7578}
7579
7580void
7581syms_of_process ()
7582{
7583 QCtype = intern (":type");
7584 staticpro (&QCtype);
7585
7586 defsubr (&Sget_buffer_process);
7587 defsubr (&Sprocess_inherit_coding_system_flag);
7588}
7589
7590\f
7591#endif /* not subprocesses */
7592
7593/* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7594 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.