(sh-mode-map): Don't remap
[emacs.git] / src / process.c
blobfbe3ae6932943a7a4fc86c0a4b4142dbcee948b2
1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
3 2001, 2002 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #include <config.h>
24 #include <signal.h>
26 /* This file is split into two parts by the following preprocessor
27 conditional. The 'then' clause contains all of the support for
28 asynchronous subprocesses. The 'else' clause contains stub
29 versions of some of the asynchronous subprocess routines that are
30 often called elsewhere in Emacs, so we don't have to #ifdef the
31 sections that call them. */
34 #ifdef subprocesses
36 #include <stdio.h>
37 #include <errno.h>
38 #include <setjmp.h>
39 #include <sys/types.h> /* some typedefs are used in sys/file.h */
40 #include <sys/file.h>
41 #include <sys/stat.h>
42 #ifdef HAVE_UNISTD_H
43 #include <unistd.h>
44 #endif
46 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
47 #include <stdlib.h>
48 #include <fcntl.h>
49 #endif /* not WINDOWSNT */
51 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
52 #include <sys/socket.h>
53 #include <netdb.h>
54 #include <netinet/in.h>
55 #include <arpa/inet.h>
56 #ifdef NEED_NET_ERRNO_H
57 #include <net/errno.h>
58 #endif /* NEED_NET_ERRNO_H */
60 /* Are local (unix) sockets supported? */
61 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
62 #if !defined (AF_LOCAL) && defined (AF_UNIX)
63 #define AF_LOCAL AF_UNIX
64 #endif
65 #ifdef AF_LOCAL
66 #define HAVE_LOCAL_SOCKETS
67 #include <sys/un.h>
68 #endif
69 #endif
70 #endif /* HAVE_SOCKETS */
72 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
73 #ifdef TERM
74 #include <client.h>
75 #endif
77 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
78 #ifdef HAVE_BROKEN_INET_ADDR
79 #define IN_ADDR struct in_addr
80 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
81 #else
82 #define IN_ADDR unsigned long
83 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
84 #endif
86 #if defined(BSD_SYSTEM) || defined(STRIDE)
87 #include <sys/ioctl.h>
88 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
89 #include <fcntl.h>
90 #endif /* HAVE_PTYS and no O_NDELAY */
91 #endif /* BSD_SYSTEM || STRIDE */
93 #ifdef BROKEN_O_NONBLOCK
94 #undef O_NONBLOCK
95 #endif /* BROKEN_O_NONBLOCK */
97 #ifdef NEED_BSDTTY
98 #include <bsdtty.h>
99 #endif
101 #ifdef IRIS
102 #include <sys/sysmacros.h> /* for "minor" */
103 #endif /* not IRIS */
105 #ifdef HAVE_SYS_WAIT
106 #include <sys/wait.h>
107 #endif
109 #include "systime.h"
110 #include "systty.h"
112 #include "lisp.h"
113 #include "window.h"
114 #include "buffer.h"
115 #include "charset.h"
116 #include "coding.h"
117 #include "process.h"
118 #include "termhooks.h"
119 #include "termopts.h"
120 #include "commands.h"
121 #include "keyboard.h"
122 #include "frame.h"
123 #include "blockinput.h"
124 #include "dispextern.h"
125 #include "composite.h"
126 #include "atimer.h"
128 Lisp_Object Qprocessp;
129 Lisp_Object Qrun, Qstop, Qsignal;
130 Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
131 Lisp_Object Qlocal, Qdatagram;
132 Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
133 Lisp_Object QClocal, QCremote, QCcoding;
134 Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
135 Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
136 Lisp_Object QCfilter_multibyte;
137 Lisp_Object Qlast_nonmenu_event;
138 /* QCfamily is declared and initialized in xfaces.c,
139 QCfilter in keyboard.c. */
140 extern Lisp_Object QCfamily, QCfilter;
142 /* Qexit is declared and initialized in eval.c. */
144 /* QCfamily is defined in xfaces.c. */
145 extern Lisp_Object QCfamily;
146 /* QCfilter is defined in keyboard.c. */
147 extern Lisp_Object QCfilter;
149 /* a process object is a network connection when its childp field is neither
150 Qt nor Qnil but is instead a property list (KEY VAL ...). */
152 #ifdef HAVE_SOCKETS
153 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
154 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
155 #else
156 #define NETCONN_P(p) 0
157 #define NETCONN1_P(p) 0
158 #endif /* HAVE_SOCKETS */
160 /* Define first descriptor number available for subprocesses. */
161 #ifdef VMS
162 #define FIRST_PROC_DESC 1
163 #else /* Not VMS */
164 #define FIRST_PROC_DESC 3
165 #endif
167 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
168 testing SIGCHLD. */
170 #if !defined (SIGCHLD) && defined (SIGCLD)
171 #define SIGCHLD SIGCLD
172 #endif /* SIGCLD */
174 #include "syssignal.h"
176 #include "syswait.h"
178 extern void set_waiting_for_input P_ ((EMACS_TIME *));
180 #ifndef USE_CRT_DLL
181 extern int errno;
182 #endif
183 #ifdef VMS
184 extern char *sys_errlist[];
185 #endif
187 #ifndef HAVE_H_ERRNO
188 extern int h_errno;
189 #endif
191 /* t means use pty, nil means use a pipe,
192 maybe other values to come. */
193 static Lisp_Object Vprocess_connection_type;
195 #ifdef SKTPAIR
196 #ifndef HAVE_SOCKETS
197 #include <sys/socket.h>
198 #endif
199 #endif /* SKTPAIR */
201 /* These next two vars are non-static since sysdep.c uses them in the
202 emulation of `select'. */
203 /* Number of events of change of status of a process. */
204 int process_tick;
205 /* Number of events for which the user or sentinel has been notified. */
206 int update_tick;
208 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
210 #ifdef BROKEN_NON_BLOCKING_CONNECT
211 #undef NON_BLOCKING_CONNECT
212 #else
213 #ifndef NON_BLOCKING_CONNECT
214 #ifdef HAVE_SOCKETS
215 #ifdef HAVE_SELECT
216 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
217 #if defined (O_NONBLOCK) || defined (O_NDELAY)
218 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
219 #define NON_BLOCKING_CONNECT
220 #endif /* EWOULDBLOCK || EINPROGRESS */
221 #endif /* O_NONBLOCK || O_NDELAY */
222 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
223 #endif /* HAVE_SELECT */
224 #endif /* HAVE_SOCKETS */
225 #endif /* NON_BLOCKING_CONNECT */
226 #endif /* BROKEN_NON_BLOCKING_CONNECT */
228 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
229 this system. We need to read full packets, so we need a
230 "non-destructive" select. So we require either native select,
231 or emulation of select using FIONREAD. */
233 #ifdef BROKEN_DATAGRAM_SOCKETS
234 #undef DATAGRAM_SOCKETS
235 #else
236 #ifndef DATAGRAM_SOCKETS
237 #ifdef HAVE_SOCKETS
238 #if defined (HAVE_SELECT) || defined (FIONREAD)
239 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
240 #define DATAGRAM_SOCKETS
241 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
242 #endif /* HAVE_SELECT || FIONREAD */
243 #endif /* HAVE_SOCKETS */
244 #endif /* DATAGRAM_SOCKETS */
245 #endif /* BROKEN_DATAGRAM_SOCKETS */
247 #ifdef TERM
248 #undef NON_BLOCKING_CONNECT
249 #undef DATAGRAM_SOCKETS
250 #endif
253 #include "sysselect.h"
255 extern int keyboard_bit_set P_ ((SELECT_TYPE *));
257 /* If we support a window system, turn on the code to poll periodically
258 to detect C-g. It isn't actually used when doing interrupt input. */
259 #ifdef HAVE_WINDOW_SYSTEM
260 #define POLL_FOR_INPUT
261 #endif
263 /* Mask of bits indicating the descriptors that we wait for input on. */
265 static SELECT_TYPE input_wait_mask;
267 /* Mask that excludes keyboard input descriptor (s). */
269 static SELECT_TYPE non_keyboard_wait_mask;
271 /* Mask that excludes process input descriptor (s). */
273 static SELECT_TYPE non_process_wait_mask;
275 /* Mask of bits indicating the descriptors that we wait for connect to
276 complete on. Once they complete, they are removed from this mask
277 and added to the input_wait_mask and non_keyboard_wait_mask. */
279 static SELECT_TYPE connect_wait_mask;
281 /* Number of bits set in connect_wait_mask. */
282 static int num_pending_connects;
284 /* The largest descriptor currently in use for a process object. */
285 static int max_process_desc;
287 /* The largest descriptor currently in use for keyboard input. */
288 static int max_keyboard_desc;
290 /* Nonzero means delete a process right away if it exits. */
291 static int delete_exited_processes;
293 /* Indexed by descriptor, gives the process (if any) for that descriptor */
294 Lisp_Object chan_process[MAXDESC];
296 /* Alist of elements (NAME . PROCESS) */
297 Lisp_Object Vprocess_alist;
299 /* Buffered-ahead input char from process, indexed by channel.
300 -1 means empty (no char is buffered).
301 Used on sys V where the only way to tell if there is any
302 output from the process is to read at least one char.
303 Always -1 on systems that support FIONREAD. */
305 /* Don't make static; need to access externally. */
306 int proc_buffered_char[MAXDESC];
308 /* Table of `struct coding-system' for each process. */
309 static struct coding_system *proc_decode_coding_system[MAXDESC];
310 static struct coding_system *proc_encode_coding_system[MAXDESC];
312 #ifdef DATAGRAM_SOCKETS
313 /* Table of `partner address' for datagram sockets. */
314 struct sockaddr_and_len {
315 struct sockaddr *sa;
316 int len;
317 } datagram_address[MAXDESC];
318 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
319 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
320 #else
321 #define DATAGRAM_CHAN_P(chan) (0)
322 #define DATAGRAM_CONN_P(proc) (0)
323 #endif
325 static Lisp_Object get_process ();
326 static void exec_sentinel ();
328 extern EMACS_TIME timer_check ();
329 extern int timers_run;
331 /* Maximum number of bytes to send to a pty without an eof. */
332 static int pty_max_bytes;
334 extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
336 #ifdef HAVE_PTYS
337 #ifdef HAVE_PTY_H
338 #include <pty.h>
339 #endif
340 /* The file name of the pty opened by allocate_pty. */
342 static char pty_name[24];
343 #endif
345 /* Compute the Lisp form of the process status, p->status, from
346 the numeric status that was returned by `wait'. */
348 Lisp_Object status_convert ();
350 void
351 update_status (p)
352 struct Lisp_Process *p;
354 union { int i; WAITTYPE wt; } u;
355 u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
356 p->status = status_convert (u.wt);
357 p->raw_status_low = Qnil;
358 p->raw_status_high = Qnil;
361 /* Convert a process status word in Unix format to
362 the list that we use internally. */
364 Lisp_Object
365 status_convert (w)
366 WAITTYPE w;
368 if (WIFSTOPPED (w))
369 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
370 else if (WIFEXITED (w))
371 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
372 WCOREDUMP (w) ? Qt : Qnil));
373 else if (WIFSIGNALED (w))
374 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
375 WCOREDUMP (w) ? Qt : Qnil));
376 else
377 return Qrun;
380 /* Given a status-list, extract the three pieces of information
381 and store them individually through the three pointers. */
383 void
384 decode_status (l, symbol, code, coredump)
385 Lisp_Object l;
386 Lisp_Object *symbol;
387 int *code;
388 int *coredump;
390 Lisp_Object tem;
392 if (SYMBOLP (l))
394 *symbol = l;
395 *code = 0;
396 *coredump = 0;
398 else
400 *symbol = XCAR (l);
401 tem = XCDR (l);
402 *code = XFASTINT (XCAR (tem));
403 tem = XCDR (tem);
404 *coredump = !NILP (tem);
408 /* Return a string describing a process status list. */
410 Lisp_Object
411 status_message (status)
412 Lisp_Object status;
414 Lisp_Object symbol;
415 int code, coredump;
416 Lisp_Object string, string2;
418 decode_status (status, &symbol, &code, &coredump);
420 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
422 char *signame;
423 synchronize_system_messages_locale ();
424 signame = strsignal (code);
425 if (signame == 0)
426 signame = "unknown";
427 string = build_string (signame);
428 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
429 SSET (string, 0, DOWNCASE (SREF (string, 0)));
430 return concat2 (string, string2);
432 else if (EQ (symbol, Qexit))
434 if (code == 0)
435 return build_string ("finished\n");
436 string = Fnumber_to_string (make_number (code));
437 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
438 return concat3 (build_string ("exited abnormally with code "),
439 string, string2);
441 else if (EQ (symbol, Qfailed))
443 string = Fnumber_to_string (make_number (code));
444 string2 = build_string ("\n");
445 return concat3 (build_string ("failed with code "),
446 string, string2);
448 else
449 return Fcopy_sequence (Fsymbol_name (symbol));
452 #ifdef HAVE_PTYS
454 /* Open an available pty, returning a file descriptor.
455 Return -1 on failure.
456 The file name of the terminal corresponding to the pty
457 is left in the variable pty_name. */
460 allocate_pty ()
462 struct stat stb;
463 register int c, i;
464 int fd;
466 /* Some systems name their pseudoterminals so that there are gaps in
467 the usual sequence - for example, on HP9000/S700 systems, there
468 are no pseudoterminals with names ending in 'f'. So we wait for
469 three failures in a row before deciding that we've reached the
470 end of the ptys. */
471 int failed_count = 0;
473 #ifdef PTY_ITERATION
474 PTY_ITERATION
475 #else
476 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
477 for (i = 0; i < 16; i++)
478 #endif
480 #ifdef PTY_NAME_SPRINTF
481 PTY_NAME_SPRINTF
482 #else
483 sprintf (pty_name, "/dev/pty%c%x", c, i);
484 #endif /* no PTY_NAME_SPRINTF */
486 #ifdef PTY_OPEN
487 PTY_OPEN;
488 #else /* no PTY_OPEN */
489 #ifdef IRIS
490 /* Unusual IRIS code */
491 *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
492 if (fd < 0)
493 return -1;
494 if (fstat (fd, &stb) < 0)
495 return -1;
496 #else /* not IRIS */
497 if (stat (pty_name, &stb) < 0)
499 failed_count++;
500 if (failed_count >= 3)
501 return -1;
503 else
504 failed_count = 0;
505 #ifdef O_NONBLOCK
506 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
507 #else
508 fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
509 #endif
510 #endif /* not IRIS */
511 #endif /* no PTY_OPEN */
513 if (fd >= 0)
515 /* check to make certain that both sides are available
516 this avoids a nasty yet stupid bug in rlogins */
517 #ifdef PTY_TTY_NAME_SPRINTF
518 PTY_TTY_NAME_SPRINTF
519 #else
520 sprintf (pty_name, "/dev/tty%c%x", c, i);
521 #endif /* no PTY_TTY_NAME_SPRINTF */
522 #ifndef UNIPLUS
523 if (access (pty_name, 6) != 0)
525 emacs_close (fd);
526 #if !defined(IRIS) && !defined(__sgi)
527 continue;
528 #else
529 return -1;
530 #endif /* IRIS */
532 #endif /* not UNIPLUS */
533 setup_pty (fd);
534 return fd;
537 return -1;
539 #endif /* HAVE_PTYS */
541 Lisp_Object
542 make_process (name)
543 Lisp_Object name;
545 register Lisp_Object val, tem, name1;
546 register struct Lisp_Process *p;
547 char suffix[10];
548 register int i;
550 p = allocate_process ();
552 XSETINT (p->infd, -1);
553 XSETINT (p->outfd, -1);
554 XSETFASTINT (p->pid, 0);
555 XSETFASTINT (p->tick, 0);
556 XSETFASTINT (p->update_tick, 0);
557 p->raw_status_low = Qnil;
558 p->raw_status_high = Qnil;
559 p->status = Qrun;
560 p->mark = Fmake_marker ();
562 /* If name is already in use, modify it until it is unused. */
564 name1 = name;
565 for (i = 1; ; i++)
567 tem = Fget_process (name1);
568 if (NILP (tem)) break;
569 sprintf (suffix, "<%d>", i);
570 name1 = concat2 (name, build_string (suffix));
572 name = name1;
573 p->name = name;
574 XSETPROCESS (val, p);
575 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
576 return val;
579 void
580 remove_process (proc)
581 register Lisp_Object proc;
583 register Lisp_Object pair;
585 pair = Frassq (proc, Vprocess_alist);
586 Vprocess_alist = Fdelq (pair, Vprocess_alist);
588 deactivate_process (proc);
591 /* Setup coding systems of PROCESS. */
593 void
594 setup_process_coding_systems (process)
595 Lisp_Object process;
597 struct Lisp_Process *p = XPROCESS (process);
598 int inch = XINT (p->infd);
599 int outch = XINT (p->outfd);
601 if (!proc_decode_coding_system[inch])
602 proc_decode_coding_system[inch]
603 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
604 setup_coding_system (p->decode_coding_system,
605 proc_decode_coding_system[inch]);
606 if (! NILP (p->filter))
608 if (NILP (p->filter_multibyte))
609 setup_raw_text_coding_system (proc_decode_coding_system[inch]);
611 else if (BUFFERP (p->buffer))
613 if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
614 setup_raw_text_coding_system (proc_decode_coding_system[inch]);
617 if (!proc_encode_coding_system[outch])
618 proc_encode_coding_system[outch]
619 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
620 setup_coding_system (p->encode_coding_system,
621 proc_encode_coding_system[outch]);
624 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
625 doc: /* Return t if OBJECT is a process. */)
626 (object)
627 Lisp_Object object;
629 return PROCESSP (object) ? Qt : Qnil;
632 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
633 doc: /* Return the process named NAME, or nil if there is none. */)
634 (name)
635 register Lisp_Object name;
637 if (PROCESSP (name))
638 return name;
639 CHECK_STRING (name);
640 return Fcdr (Fassoc (name, Vprocess_alist));
643 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
644 doc: /* Return the (or a) process associated with BUFFER.
645 BUFFER may be a buffer or the name of one. */)
646 (buffer)
647 register Lisp_Object buffer;
649 register Lisp_Object buf, tail, proc;
651 if (NILP (buffer)) return Qnil;
652 buf = Fget_buffer (buffer);
653 if (NILP (buf)) return Qnil;
655 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
657 proc = Fcdr (Fcar (tail));
658 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
659 return proc;
661 return Qnil;
664 /* This is how commands for the user decode process arguments. It
665 accepts a process, a process name, a buffer, a buffer name, or nil.
666 Buffers denote the first process in the buffer, and nil denotes the
667 current buffer. */
669 static Lisp_Object
670 get_process (name)
671 register Lisp_Object name;
673 register Lisp_Object proc, obj;
674 if (STRINGP (name))
676 obj = Fget_process (name);
677 if (NILP (obj))
678 obj = Fget_buffer (name);
679 if (NILP (obj))
680 error ("Process %s does not exist", SDATA (name));
682 else if (NILP (name))
683 obj = Fcurrent_buffer ();
684 else
685 obj = name;
687 /* Now obj should be either a buffer object or a process object.
689 if (BUFFERP (obj))
691 proc = Fget_buffer_process (obj);
692 if (NILP (proc))
693 error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
695 else
697 CHECK_PROCESS (obj);
698 proc = obj;
700 return proc;
703 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
704 doc: /* Delete PROCESS: kill it and forget about it immediately.
705 PROCESS may be a process, a buffer, the name of a process or buffer, or
706 nil, indicating the current buffer's process. */)
707 (process)
708 register Lisp_Object process;
710 process = get_process (process);
711 XPROCESS (process)->raw_status_low = Qnil;
712 XPROCESS (process)->raw_status_high = Qnil;
713 if (NETCONN_P (process))
715 XPROCESS (process)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
716 XSETINT (XPROCESS (process)->tick, ++process_tick);
718 else if (XINT (XPROCESS (process)->infd) >= 0)
720 Fkill_process (process, Qnil);
721 /* Do this now, since remove_process will make sigchld_handler do nothing. */
722 XPROCESS (process)->status
723 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
724 XSETINT (XPROCESS (process)->tick, ++process_tick);
725 status_notify ();
727 remove_process (process);
728 return Qnil;
731 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
732 doc: /* Return the status of PROCESS.
733 The returned value is one of the following symbols:
734 run -- for a process that is running.
735 stop -- for a process stopped but continuable.
736 exit -- for a process that has exited.
737 signal -- for a process that has got a fatal signal.
738 open -- for a network stream connection that is open.
739 listen -- for a network stream server that is listening.
740 closed -- for a network stream connection that is closed.
741 connect -- when waiting for a non-blocking connection to complete.
742 failed -- when a non-blocking connection has failed.
743 nil -- if arg is a process name and no such process exists.
744 PROCESS may be a process, a buffer, the name of a process, or
745 nil, indicating the current buffer's process. */)
746 (process)
747 register Lisp_Object process;
749 register struct Lisp_Process *p;
750 register Lisp_Object status;
752 if (STRINGP (process))
753 process = Fget_process (process);
754 else
755 process = get_process (process);
757 if (NILP (process))
758 return process;
760 p = XPROCESS (process);
761 if (!NILP (p->raw_status_low))
762 update_status (p);
763 status = p->status;
764 if (CONSP (status))
765 status = XCAR (status);
766 if (NETCONN1_P (p))
768 if (EQ (status, Qexit))
769 status = Qclosed;
770 else if (EQ (p->command, Qt))
771 status = Qstop;
772 else if (EQ (status, Qrun))
773 status = Qopen;
775 return status;
778 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
779 1, 1, 0,
780 doc: /* Return the exit status of PROCESS or the signal number that killed it.
781 If PROCESS has not yet exited or died, return 0. */)
782 (process)
783 register Lisp_Object process;
785 CHECK_PROCESS (process);
786 if (!NILP (XPROCESS (process)->raw_status_low))
787 update_status (XPROCESS (process));
788 if (CONSP (XPROCESS (process)->status))
789 return XCAR (XCDR (XPROCESS (process)->status));
790 return make_number (0);
793 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
794 doc: /* Return the process id of PROCESS.
795 This is the pid of the Unix process which PROCESS uses or talks to.
796 For a network connection, this value is nil. */)
797 (process)
798 register Lisp_Object process;
800 CHECK_PROCESS (process);
801 return XPROCESS (process)->pid;
804 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
805 doc: /* Return the name of PROCESS, as a string.
806 This is the name of the program invoked in PROCESS,
807 possibly modified to make it unique among process names. */)
808 (process)
809 register Lisp_Object process;
811 CHECK_PROCESS (process);
812 return XPROCESS (process)->name;
815 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
816 doc: /* Return the command that was executed to start PROCESS.
817 This is a list of strings, the first string being the program executed
818 and the rest of the strings being the arguments given to it.
819 For a non-child channel, this is nil. */)
820 (process)
821 register Lisp_Object process;
823 CHECK_PROCESS (process);
824 return XPROCESS (process)->command;
827 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
828 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
829 This is the terminal that the process itself reads and writes on,
830 not the name of the pty that Emacs uses to talk with that terminal. */)
831 (process)
832 register Lisp_Object process;
834 CHECK_PROCESS (process);
835 return XPROCESS (process)->tty_name;
838 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
839 2, 2, 0,
840 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
841 (process, buffer)
842 register Lisp_Object process, buffer;
844 struct Lisp_Process *p;
846 CHECK_PROCESS (process);
847 if (!NILP (buffer))
848 CHECK_BUFFER (buffer);
849 p = XPROCESS (process);
850 p->buffer = buffer;
851 if (NETCONN1_P (p))
852 p->childp = Fplist_put (p->childp, QCbuffer, buffer);
853 setup_process_coding_systems (process);
854 return buffer;
857 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
858 1, 1, 0,
859 doc: /* Return the buffer PROCESS is associated with.
860 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
861 (process)
862 register Lisp_Object process;
864 CHECK_PROCESS (process);
865 return XPROCESS (process)->buffer;
868 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
869 1, 1, 0,
870 doc: /* Return the marker for the end of the last output from PROCESS. */)
871 (process)
872 register Lisp_Object process;
874 CHECK_PROCESS (process);
875 return XPROCESS (process)->mark;
878 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
879 2, 2, 0,
880 doc: /* Give PROCESS the filter function FILTER; nil means no filter.
881 t means stop accepting output from the process.
883 When a process has a filter, its buffer is not used for output.
884 Instead, each time it does output, the entire string of output is
885 passed to the filter.
887 The filter gets two arguments: the process and the string of output.
888 The string argument is normally a multibyte string, except:
889 - if the process' input coding system is no-conversion or raw-text,
890 it is a unibyte string (the non-converted input), or else
891 - if `default-enable-multibyte-characters' is nil, it is a unibyte
892 string (the result of converting the decoded input multibyte
893 string to unibyte with `string-make-unibyte'). */)
894 (process, filter)
895 register Lisp_Object process, filter;
897 struct Lisp_Process *p;
899 CHECK_PROCESS (process);
900 p = XPROCESS (process);
902 /* Don't signal an error if the process' input file descriptor
903 is closed. This could make debugging Lisp more difficult,
904 for example when doing something like
906 (setq process (start-process ...))
907 (debug)
908 (set-process-filter process ...) */
910 if (XINT (p->infd) >= 0)
912 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
914 FD_CLR (XINT (p->infd), &input_wait_mask);
915 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
917 else if (EQ (p->filter, Qt)
918 && !EQ (p->command, Qt)) /* Network process not stopped. */
920 FD_SET (XINT (p->infd), &input_wait_mask);
921 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
925 p->filter = filter;
926 if (NETCONN1_P (p))
927 p->childp = Fplist_put (p->childp, QCfilter, filter);
928 setup_process_coding_systems (process);
929 return filter;
932 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
933 1, 1, 0,
934 doc: /* Returns the filter function of PROCESS; nil if none.
935 See `set-process-filter' for more info on filter functions. */)
936 (process)
937 register Lisp_Object process;
939 CHECK_PROCESS (process);
940 return XPROCESS (process)->filter;
943 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
944 2, 2, 0,
945 doc: /* Give PROCESS the sentinel SENTINEL; nil for none.
946 The sentinel is called as a function when the process changes state.
947 It gets two arguments: the process, and a string describing the change. */)
948 (process, sentinel)
949 register Lisp_Object process, sentinel;
951 CHECK_PROCESS (process);
952 XPROCESS (process)->sentinel = sentinel;
953 return sentinel;
956 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
957 1, 1, 0,
958 doc: /* Return the sentinel of PROCESS; nil if none.
959 See `set-process-sentinel' for more info on sentinels. */)
960 (process)
961 register Lisp_Object process;
963 CHECK_PROCESS (process);
964 return XPROCESS (process)->sentinel;
967 DEFUN ("set-process-window-size", Fset_process_window_size,
968 Sset_process_window_size, 3, 3, 0,
969 doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
970 (process, height, width)
971 register Lisp_Object process, height, width;
973 CHECK_PROCESS (process);
974 CHECK_NATNUM (height);
975 CHECK_NATNUM (width);
977 if (XINT (XPROCESS (process)->infd) < 0
978 || set_window_size (XINT (XPROCESS (process)->infd),
979 XINT (height), XINT (width)) <= 0)
980 return Qnil;
981 else
982 return Qt;
985 DEFUN ("set-process-inherit-coding-system-flag",
986 Fset_process_inherit_coding_system_flag,
987 Sset_process_inherit_coding_system_flag, 2, 2, 0,
988 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
989 If the second argument FLAG is non-nil, then the variable
990 `buffer-file-coding-system' of the buffer associated with PROCESS
991 will be bound to the value of the coding system used to decode
992 the process output.
994 This is useful when the coding system specified for the process buffer
995 leaves either the character code conversion or the end-of-line conversion
996 unspecified, or if the coding system used to decode the process output
997 is more appropriate for saving the process buffer.
999 Binding the variable `inherit-process-coding-system' to non-nil before
1000 starting the process is an alternative way of setting the inherit flag
1001 for the process which will run. */)
1002 (process, flag)
1003 register Lisp_Object process, flag;
1005 CHECK_PROCESS (process);
1006 XPROCESS (process)->inherit_coding_system_flag = flag;
1007 return flag;
1010 DEFUN ("process-inherit-coding-system-flag",
1011 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
1012 1, 1, 0,
1013 doc: /* Return the value of inherit-coding-system flag for PROCESS.
1014 If this flag is t, `buffer-file-coding-system' of the buffer
1015 associated with PROCESS will inherit the coding system used to decode
1016 the process output. */)
1017 (process)
1018 register Lisp_Object process;
1020 CHECK_PROCESS (process);
1021 return XPROCESS (process)->inherit_coding_system_flag;
1024 DEFUN ("set-process-query-on-exit-flag",
1025 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1026 2, 2, 0,
1027 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1028 If the second argument FLAG is non-nil, emacs will query the user before
1029 exiting if PROCESS is running. */)
1030 (process, flag)
1031 register Lisp_Object process, flag;
1033 CHECK_PROCESS (process);
1034 XPROCESS (process)->kill_without_query = Fnull (flag);
1035 return flag;
1038 DEFUN ("process-query-on-exit-flag",
1039 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1040 1, 1, 0,
1041 doc: /* Return the current value of query on exit flag for PROCESS. */)
1042 (process)
1043 register Lisp_Object process;
1045 CHECK_PROCESS (process);
1046 return Fnull (XPROCESS (process)->kill_without_query);
1049 #ifdef DATAGRAM_SOCKETS
1050 Lisp_Object Fprocess_datagram_address ();
1051 #endif
1053 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1054 1, 2, 0,
1055 doc: /* Return the contact info of PROCESS; t for a real child.
1056 For a net connection, the value depends on the optional KEY arg.
1057 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1058 if KEY is t, the complete contact information for the connection is
1059 returned, else the specific value for the keyword KEY is returned.
1060 See `make-network-process' for a list of keywords. */)
1061 (process, key)
1062 register Lisp_Object process, key;
1064 Lisp_Object contact;
1066 CHECK_PROCESS (process);
1067 contact = XPROCESS (process)->childp;
1069 #ifdef DATAGRAM_SOCKETS
1070 if (DATAGRAM_CONN_P (process)
1071 && (EQ (key, Qt) || EQ (key, QCremote)))
1072 contact = Fplist_put (contact, QCremote,
1073 Fprocess_datagram_address (process));
1074 #endif
1076 if (!NETCONN_P (process) || EQ (key, Qt))
1077 return contact;
1078 if (NILP (key))
1079 return Fcons (Fplist_get (contact, QChost),
1080 Fcons (Fplist_get (contact, QCservice), Qnil));
1081 return Fplist_get (contact, key);
1084 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1085 1, 1, 0,
1086 doc: /* Return the plist of PROCESS. */)
1087 (process)
1088 register Lisp_Object process;
1090 CHECK_PROCESS (process);
1091 return XPROCESS (process)->plist;
1094 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1095 2, 2, 0,
1096 doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1097 (process, plist)
1098 register Lisp_Object process, plist;
1100 CHECK_PROCESS (process);
1101 CHECK_LIST (plist);
1103 XPROCESS (process)->plist = plist;
1104 return plist;
1107 #if 0 /* Turned off because we don't currently record this info
1108 in the process. Perhaps add it. */
1109 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1110 doc: /* Return the connection type of PROCESS.
1111 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1112 a socket connection. */)
1113 (process)
1114 Lisp_Object process;
1116 return XPROCESS (process)->type;
1118 #endif
1120 #ifdef HAVE_SOCKETS
1121 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1122 1, 2, 0,
1123 doc: /* Convert network ADDRESS from internal format to a string.
1124 If optional second argument OMIT-PORT is non-nil, don't include a port
1125 number in the string; in this case, interpret a 4 element vector as an
1126 IP address. Returns nil if format of ADDRESS is invalid. */)
1127 (address, omit_port)
1128 Lisp_Object address, omit_port;
1130 if (NILP (address))
1131 return Qnil;
1133 if (STRINGP (address)) /* AF_LOCAL */
1134 return address;
1136 if (VECTORP (address)) /* AF_INET */
1138 register struct Lisp_Vector *p = XVECTOR (address);
1139 Lisp_Object args[6];
1140 int nargs, i;
1142 if (!NILP (omit_port) && (p->size == 4 || p->size == 5))
1144 args[0] = build_string ("%d.%d.%d.%d");
1145 nargs = 4;
1147 else if (p->size == 5)
1149 args[0] = build_string ("%d.%d.%d.%d:%d");
1150 nargs = 5;
1152 else
1153 return Qnil;
1155 for (i = 0; i < nargs; i++)
1156 args[i+1] = p->contents[i];
1157 return Fformat (nargs+1, args);
1160 if (CONSP (address))
1162 Lisp_Object args[2];
1163 args[0] = build_string ("<Family %d>");
1164 args[1] = Fcar (address);
1165 return Fformat (2, args);
1169 return Qnil;
1171 #endif
1173 Lisp_Object
1174 list_processes_1 (query_only)
1175 Lisp_Object query_only;
1177 register Lisp_Object tail, tem;
1178 Lisp_Object proc, minspace, tem1;
1179 register struct Lisp_Process *p;
1180 char tembuf[300];
1181 int w_proc, w_buffer, w_tty;
1182 Lisp_Object i_status, i_buffer, i_tty, i_command;
1184 w_proc = 4; /* Proc */
1185 w_buffer = 6; /* Buffer */
1186 w_tty = 0; /* Omit if no ttys */
1188 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
1190 int i;
1192 proc = Fcdr (Fcar (tail));
1193 p = XPROCESS (proc);
1194 if (NILP (p->childp))
1195 continue;
1196 if (!NILP (query_only) && !NILP (p->kill_without_query))
1197 continue;
1198 if (STRINGP (p->name)
1199 && ( i = SCHARS (p->name), (i > w_proc)))
1200 w_proc = i;
1201 if (!NILP (p->buffer))
1203 if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
1204 w_buffer = 8; /* (Killed) */
1205 else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
1206 w_buffer = i;
1208 if (STRINGP (p->tty_name)
1209 && (i = SCHARS (p->tty_name), (i > w_tty)))
1210 w_tty = i;
1213 XSETFASTINT (i_status, w_proc + 1);
1214 XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
1215 if (w_tty)
1217 XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
1218 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1);
1219 } else {
1220 i_tty = Qnil;
1221 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
1224 XSETFASTINT (minspace, 1);
1226 set_buffer_internal (XBUFFER (Vstandard_output));
1227 Fbuffer_disable_undo (Vstandard_output);
1229 current_buffer->truncate_lines = Qt;
1231 write_string ("Proc", -1);
1232 Findent_to (i_status, minspace); write_string ("Status", -1);
1233 Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
1234 if (!NILP (i_tty))
1236 Findent_to (i_tty, minspace); write_string ("Tty", -1);
1238 Findent_to (i_command, minspace); write_string ("Command", -1);
1239 write_string ("\n", -1);
1241 write_string ("----", -1);
1242 Findent_to (i_status, minspace); write_string ("------", -1);
1243 Findent_to (i_buffer, minspace); write_string ("------", -1);
1244 if (!NILP (i_tty))
1246 Findent_to (i_tty, minspace); write_string ("---", -1);
1248 Findent_to (i_command, minspace); write_string ("-------", -1);
1249 write_string ("\n", -1);
1251 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
1253 Lisp_Object symbol;
1255 proc = Fcdr (Fcar (tail));
1256 p = XPROCESS (proc);
1257 if (NILP (p->childp))
1258 continue;
1259 if (!NILP (query_only) && !NILP (p->kill_without_query))
1260 continue;
1262 Finsert (1, &p->name);
1263 Findent_to (i_status, minspace);
1265 if (!NILP (p->raw_status_low))
1266 update_status (p);
1267 symbol = p->status;
1268 if (CONSP (p->status))
1269 symbol = XCAR (p->status);
1272 if (EQ (symbol, Qsignal))
1274 Lisp_Object tem;
1275 tem = Fcar (Fcdr (p->status));
1276 #ifdef VMS
1277 if (XINT (tem) < NSIG)
1278 write_string (sys_errlist [XINT (tem)], -1);
1279 else
1280 #endif
1281 Fprinc (symbol, Qnil);
1283 else if (NETCONN1_P (p))
1285 if (EQ (symbol, Qexit))
1286 write_string ("closed", -1);
1287 else if (EQ (p->command, Qt))
1288 write_string ("stopped", -1);
1289 else if (EQ (symbol, Qrun))
1290 write_string ("open", -1);
1291 else
1292 Fprinc (symbol, Qnil);
1294 else
1295 Fprinc (symbol, Qnil);
1297 if (EQ (symbol, Qexit))
1299 Lisp_Object tem;
1300 tem = Fcar (Fcdr (p->status));
1301 if (XFASTINT (tem))
1303 sprintf (tembuf, " %d", (int) XFASTINT (tem));
1304 write_string (tembuf, -1);
1308 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
1309 remove_process (proc);
1311 Findent_to (i_buffer, minspace);
1312 if (NILP (p->buffer))
1313 insert_string ("(none)");
1314 else if (NILP (XBUFFER (p->buffer)->name))
1315 insert_string ("(Killed)");
1316 else
1317 Finsert (1, &XBUFFER (p->buffer)->name);
1319 if (!NILP (i_tty))
1321 Findent_to (i_tty, minspace);
1322 if (STRINGP (p->tty_name))
1323 Finsert (1, &p->tty_name);
1326 Findent_to (i_command, minspace);
1328 if (EQ (p->status, Qlisten))
1330 Lisp_Object port = Fplist_get (p->childp, QCservice);
1331 if (INTEGERP (port))
1332 port = Fnumber_to_string (port);
1333 if (NILP (port))
1334 port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
1335 sprintf (tembuf, "(network %s server on %s)\n",
1336 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
1337 (STRINGP (port) ? (char *)SDATA (port) : "?"));
1338 insert_string (tembuf);
1340 else if (NETCONN1_P (p))
1342 /* For a local socket, there is no host name,
1343 so display service instead. */
1344 Lisp_Object host = Fplist_get (p->childp, QChost);
1345 if (!STRINGP (host))
1347 host = Fplist_get (p->childp, QCservice);
1348 if (INTEGERP (host))
1349 host = Fnumber_to_string (host);
1351 if (NILP (host))
1352 host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
1353 sprintf (tembuf, "(network %s connection to %s)\n",
1354 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
1355 (STRINGP (host) ? (char *)SDATA (host) : "?"));
1356 insert_string (tembuf);
1358 else
1360 tem = p->command;
1361 while (1)
1363 tem1 = Fcar (tem);
1364 Finsert (1, &tem1);
1365 tem = Fcdr (tem);
1366 if (NILP (tem))
1367 break;
1368 insert_string (" ");
1370 insert_string ("\n");
1373 return Qnil;
1376 DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
1377 doc: /* Display a list of all processes.
1378 If optional argument QUERY-ONLY is non-nil, only processes with
1379 the query-on-exit flag set will be listed.
1380 Any process listed as exited or signaled is actually eliminated
1381 after the listing is made. */)
1382 (query_only)
1383 Lisp_Object query_only;
1385 internal_with_output_to_temp_buffer ("*Process List*",
1386 list_processes_1, query_only);
1387 return Qnil;
1390 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1391 doc: /* Return a list of all processes. */)
1394 return Fmapcar (Qcdr, Vprocess_alist);
1397 /* Starting asynchronous inferior processes. */
1399 static Lisp_Object start_process_unwind ();
1401 DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
1402 doc: /* Start a program in a subprocess. Return the process object for it.
1403 NAME is name for process. It is modified if necessary to make it unique.
1404 BUFFER is the buffer or (buffer-name) to associate with the process.
1405 Process output goes at end of that buffer, unless you specify
1406 an output stream or filter function to handle the output.
1407 BUFFER may be also nil, meaning that this process is not associated
1408 with any buffer.
1409 Third arg is program file name. It is searched for in PATH.
1410 Remaining arguments are strings to give program as arguments.
1412 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1413 (nargs, args)
1414 int nargs;
1415 register Lisp_Object *args;
1417 Lisp_Object buffer, name, program, proc, current_dir, tem;
1418 #ifdef VMS
1419 register unsigned char *new_argv;
1420 int len;
1421 #else
1422 register unsigned char **new_argv;
1423 #endif
1424 register int i;
1425 int count = SPECPDL_INDEX ();
1427 buffer = args[1];
1428 if (!NILP (buffer))
1429 buffer = Fget_buffer_create (buffer);
1431 /* Make sure that the child will be able to chdir to the current
1432 buffer's current directory, or its unhandled equivalent. We
1433 can't just have the child check for an error when it does the
1434 chdir, since it's in a vfork.
1436 We have to GCPRO around this because Fexpand_file_name and
1437 Funhandled_file_name_directory might call a file name handling
1438 function. The argument list is protected by the caller, so all
1439 we really have to worry about is buffer. */
1441 struct gcpro gcpro1, gcpro2;
1443 current_dir = current_buffer->directory;
1445 GCPRO2 (buffer, current_dir);
1447 current_dir
1448 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
1449 Qnil);
1450 if (NILP (Ffile_accessible_directory_p (current_dir)))
1451 report_file_error ("Setting current directory",
1452 Fcons (current_buffer->directory, Qnil));
1454 UNGCPRO;
1457 name = args[0];
1458 CHECK_STRING (name);
1460 program = args[2];
1462 CHECK_STRING (program);
1464 proc = make_process (name);
1465 /* If an error occurs and we can't start the process, we want to
1466 remove it from the process list. This means that each error
1467 check in create_process doesn't need to call remove_process
1468 itself; it's all taken care of here. */
1469 record_unwind_protect (start_process_unwind, proc);
1471 XPROCESS (proc)->childp = Qt;
1472 XPROCESS (proc)->plist = Qnil;
1473 XPROCESS (proc)->command_channel_p = Qnil;
1474 XPROCESS (proc)->buffer = buffer;
1475 XPROCESS (proc)->sentinel = Qnil;
1476 XPROCESS (proc)->filter = Qnil;
1477 XPROCESS (proc)->filter_multibyte
1478 = buffer_defaults.enable_multibyte_characters;
1479 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1481 /* Make the process marker point into the process buffer (if any). */
1482 if (!NILP (buffer))
1483 set_marker_both (XPROCESS (proc)->mark, buffer,
1484 BUF_ZV (XBUFFER (buffer)),
1485 BUF_ZV_BYTE (XBUFFER (buffer)));
1488 /* Decide coding systems for communicating with the process. Here
1489 we don't setup the structure coding_system nor pay attention to
1490 unibyte mode. They are done in create_process. */
1492 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1493 Lisp_Object coding_systems = Qt;
1494 Lisp_Object val, *args2;
1495 struct gcpro gcpro1, gcpro2;
1497 val = Vcoding_system_for_read;
1498 if (NILP (val))
1500 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1501 args2[0] = Qstart_process;
1502 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1503 GCPRO2 (proc, current_dir);
1504 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1505 UNGCPRO;
1506 if (CONSP (coding_systems))
1507 val = XCAR (coding_systems);
1508 else if (CONSP (Vdefault_process_coding_system))
1509 val = XCAR (Vdefault_process_coding_system);
1511 XPROCESS (proc)->decode_coding_system = val;
1513 val = Vcoding_system_for_write;
1514 if (NILP (val))
1516 if (EQ (coding_systems, Qt))
1518 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
1519 args2[0] = Qstart_process;
1520 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1521 GCPRO2 (proc, current_dir);
1522 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1523 UNGCPRO;
1525 if (CONSP (coding_systems))
1526 val = XCDR (coding_systems);
1527 else if (CONSP (Vdefault_process_coding_system))
1528 val = XCDR (Vdefault_process_coding_system);
1530 XPROCESS (proc)->encode_coding_system = val;
1533 #ifdef VMS
1534 /* Make a one member argv with all args concatenated
1535 together separated by a blank. */
1536 len = SBYTES (program) + 2;
1537 for (i = 3; i < nargs; i++)
1539 tem = args[i];
1540 CHECK_STRING (tem);
1541 len += SBYTES (tem) + 1; /* count the blank */
1543 new_argv = (unsigned char *) alloca (len);
1544 strcpy (new_argv, SDATA (program));
1545 for (i = 3; i < nargs; i++)
1547 tem = args[i];
1548 CHECK_STRING (tem);
1549 strcat (new_argv, " ");
1550 strcat (new_argv, SDATA (tem));
1552 /* Need to add code here to check for program existence on VMS */
1554 #else /* not VMS */
1555 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1557 /* If program file name is not absolute, search our path for it.
1558 Put the name we will really use in TEM. */
1559 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1560 && !(SCHARS (program) > 1
1561 && IS_DEVICE_SEP (SREF (program, 1))))
1563 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1565 tem = Qnil;
1566 GCPRO4 (name, program, buffer, current_dir);
1567 openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
1568 UNGCPRO;
1569 if (NILP (tem))
1570 report_file_error ("Searching for program", Fcons (program, Qnil));
1571 tem = Fexpand_file_name (tem, Qnil);
1573 else
1575 if (!NILP (Ffile_directory_p (program)))
1576 error ("Specified program for new process is a directory");
1577 tem = program;
1580 /* If program file name starts with /: for quoting a magic name,
1581 discard that. */
1582 if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
1583 && SREF (tem, 1) == ':')
1584 tem = Fsubstring (tem, make_number (2), Qnil);
1586 /* Encode the file name and put it in NEW_ARGV.
1587 That's where the child will use it to execute the program. */
1588 tem = ENCODE_FILE (tem);
1589 new_argv[0] = SDATA (tem);
1591 /* Here we encode arguments by the coding system used for sending
1592 data to the process. We don't support using different coding
1593 systems for encoding arguments and for encoding data sent to the
1594 process. */
1596 for (i = 3; i < nargs; i++)
1598 tem = args[i];
1599 CHECK_STRING (tem);
1600 if (STRING_MULTIBYTE (tem))
1601 tem = (code_convert_string_norecord
1602 (tem, XPROCESS (proc)->encode_coding_system, 1));
1603 new_argv[i - 2] = SDATA (tem);
1605 new_argv[i - 2] = 0;
1606 #endif /* not VMS */
1608 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
1609 XPROCESS (proc)->decoding_carryover = make_number (0);
1610 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
1611 XPROCESS (proc)->encoding_carryover = make_number (0);
1613 XPROCESS (proc)->inherit_coding_system_flag
1614 = (NILP (buffer) || !inherit_process_coding_system
1615 ? Qnil : Qt);
1617 create_process (proc, (char **) new_argv, current_dir);
1619 return unbind_to (count, proc);
1622 /* This function is the unwind_protect form for Fstart_process. If
1623 PROC doesn't have its pid set, then we know someone has signaled
1624 an error and the process wasn't started successfully, so we should
1625 remove it from the process list. */
1626 static Lisp_Object
1627 start_process_unwind (proc)
1628 Lisp_Object proc;
1630 if (!PROCESSP (proc))
1631 abort ();
1633 /* Was PROC started successfully? */
1634 if (XINT (XPROCESS (proc)->pid) <= 0)
1635 remove_process (proc);
1637 return Qnil;
1640 void
1641 create_process_1 (timer)
1642 struct atimer *timer;
1644 /* Nothing to do. */
1648 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1649 #ifdef USG
1650 #ifdef SIGCHLD
1651 /* Mimic blocking of signals on system V, which doesn't really have it. */
1653 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1654 int sigchld_deferred;
1656 SIGTYPE
1657 create_process_sigchld ()
1659 signal (SIGCHLD, create_process_sigchld);
1661 sigchld_deferred = 1;
1663 #endif
1664 #endif
1665 #endif
1667 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1668 void
1669 create_process (process, new_argv, current_dir)
1670 Lisp_Object process;
1671 char **new_argv;
1672 Lisp_Object current_dir;
1674 int pid, inchannel, outchannel;
1675 int sv[2];
1676 #ifdef POSIX_SIGNALS
1677 sigset_t procmask;
1678 sigset_t blocked;
1679 struct sigaction sigint_action;
1680 struct sigaction sigquit_action;
1681 #ifdef AIX
1682 struct sigaction sighup_action;
1683 #endif
1684 #else /* !POSIX_SIGNALS */
1685 #if 0
1686 #ifdef SIGCHLD
1687 SIGTYPE (*sigchld)();
1688 #endif
1689 #endif /* 0 */
1690 #endif /* !POSIX_SIGNALS */
1691 /* Use volatile to protect variables from being clobbered by longjmp. */
1692 volatile int forkin, forkout;
1693 volatile int pty_flag = 0;
1694 #ifndef USE_CRT_DLL
1695 extern char **environ;
1696 #endif
1698 inchannel = outchannel = -1;
1700 #ifdef HAVE_PTYS
1701 if (!NILP (Vprocess_connection_type))
1702 outchannel = inchannel = allocate_pty ();
1704 if (inchannel >= 0)
1706 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1707 /* On most USG systems it does not work to open the pty's tty here,
1708 then close it and reopen it in the child. */
1709 #ifdef O_NOCTTY
1710 /* Don't let this terminal become our controlling terminal
1711 (in case we don't have one). */
1712 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1713 #else
1714 forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
1715 #endif
1716 if (forkin < 0)
1717 report_file_error ("Opening pty", Qnil);
1718 #else
1719 forkin = forkout = -1;
1720 #endif /* not USG, or USG_SUBTTY_WORKS */
1721 pty_flag = 1;
1723 else
1724 #endif /* HAVE_PTYS */
1725 #ifdef SKTPAIR
1727 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1728 report_file_error ("Opening socketpair", Qnil);
1729 outchannel = inchannel = sv[0];
1730 forkout = forkin = sv[1];
1732 #else /* not SKTPAIR */
1734 int tem;
1735 tem = pipe (sv);
1736 if (tem < 0)
1737 report_file_error ("Creating pipe", Qnil);
1738 inchannel = sv[0];
1739 forkout = sv[1];
1740 tem = pipe (sv);
1741 if (tem < 0)
1743 emacs_close (inchannel);
1744 emacs_close (forkout);
1745 report_file_error ("Creating pipe", Qnil);
1747 outchannel = sv[1];
1748 forkin = sv[0];
1750 #endif /* not SKTPAIR */
1752 #if 0
1753 /* Replaced by close_process_descs */
1754 set_exclusive_use (inchannel);
1755 set_exclusive_use (outchannel);
1756 #endif
1758 /* Stride people say it's a mystery why this is needed
1759 as well as the O_NDELAY, but that it fails without this. */
1760 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1762 int one = 1;
1763 ioctl (inchannel, FIONBIO, &one);
1765 #endif
1767 #ifdef O_NONBLOCK
1768 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1769 fcntl (outchannel, F_SETFL, O_NONBLOCK);
1770 #else
1771 #ifdef O_NDELAY
1772 fcntl (inchannel, F_SETFL, O_NDELAY);
1773 fcntl (outchannel, F_SETFL, O_NDELAY);
1774 #endif
1775 #endif
1777 /* Record this as an active process, with its channels.
1778 As a result, child_setup will close Emacs's side of the pipes. */
1779 chan_process[inchannel] = process;
1780 XSETINT (XPROCESS (process)->infd, inchannel);
1781 XSETINT (XPROCESS (process)->outfd, outchannel);
1782 /* Record the tty descriptor used in the subprocess. */
1783 if (forkin < 0)
1784 XPROCESS (process)->subtty = Qnil;
1785 else
1786 XSETFASTINT (XPROCESS (process)->subtty, forkin);
1787 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1788 XPROCESS (process)->status = Qrun;
1789 setup_process_coding_systems (process);
1791 /* Delay interrupts until we have a chance to store
1792 the new fork's pid in its process structure */
1793 #ifdef POSIX_SIGNALS
1794 sigemptyset (&blocked);
1795 #ifdef SIGCHLD
1796 sigaddset (&blocked, SIGCHLD);
1797 #endif
1798 #ifdef HAVE_WORKING_VFORK
1799 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1800 this sets the parent's signal handlers as well as the child's.
1801 So delay all interrupts whose handlers the child might munge,
1802 and record the current handlers so they can be restored later. */
1803 sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
1804 sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
1805 #ifdef AIX
1806 sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
1807 #endif
1808 #endif /* HAVE_WORKING_VFORK */
1809 sigprocmask (SIG_BLOCK, &blocked, &procmask);
1810 #else /* !POSIX_SIGNALS */
1811 #ifdef SIGCHLD
1812 #ifdef BSD4_1
1813 sighold (SIGCHLD);
1814 #else /* not BSD4_1 */
1815 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1816 sigsetmask (sigmask (SIGCHLD));
1817 #else /* ordinary USG */
1818 #if 0
1819 sigchld_deferred = 0;
1820 sigchld = signal (SIGCHLD, create_process_sigchld);
1821 #endif
1822 #endif /* ordinary USG */
1823 #endif /* not BSD4_1 */
1824 #endif /* SIGCHLD */
1825 #endif /* !POSIX_SIGNALS */
1827 FD_SET (inchannel, &input_wait_mask);
1828 FD_SET (inchannel, &non_keyboard_wait_mask);
1829 if (inchannel > max_process_desc)
1830 max_process_desc = inchannel;
1832 /* Until we store the proper pid, enable sigchld_handler
1833 to recognize an unknown pid as standing for this process.
1834 It is very important not to let this `marker' value stay
1835 in the table after this function has returned; if it does
1836 it might cause call-process to hang and subsequent asynchronous
1837 processes to get their return values scrambled. */
1838 XSETINT (XPROCESS (process)->pid, -1);
1840 BLOCK_INPUT;
1843 /* child_setup must clobber environ on systems with true vfork.
1844 Protect it from permanent change. */
1845 char **save_environ = environ;
1847 current_dir = ENCODE_FILE (current_dir);
1849 #ifndef WINDOWSNT
1850 pid = vfork ();
1851 if (pid == 0)
1852 #endif /* not WINDOWSNT */
1854 int xforkin = forkin;
1855 int xforkout = forkout;
1857 #if 0 /* This was probably a mistake--it duplicates code later on,
1858 but fails to handle all the cases. */
1859 /* Make sure SIGCHLD is not blocked in the child. */
1860 sigsetmask (SIGEMPTYMASK);
1861 #endif
1863 /* Make the pty be the controlling terminal of the process. */
1864 #ifdef HAVE_PTYS
1865 /* First, disconnect its current controlling terminal. */
1866 #ifdef HAVE_SETSID
1867 /* We tried doing setsid only if pty_flag, but it caused
1868 process_set_signal to fail on SGI when using a pipe. */
1869 setsid ();
1870 /* Make the pty's terminal the controlling terminal. */
1871 if (pty_flag)
1873 #ifdef TIOCSCTTY
1874 /* We ignore the return value
1875 because faith@cs.unc.edu says that is necessary on Linux. */
1876 ioctl (xforkin, TIOCSCTTY, 0);
1877 #endif
1879 #else /* not HAVE_SETSID */
1880 #ifdef USG
1881 /* It's very important to call setpgrp here and no time
1882 afterwards. Otherwise, we lose our controlling tty which
1883 is set when we open the pty. */
1884 setpgrp ();
1885 #endif /* USG */
1886 #endif /* not HAVE_SETSID */
1887 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1888 if (pty_flag && xforkin >= 0)
1890 struct termios t;
1891 tcgetattr (xforkin, &t);
1892 t.c_lflag = LDISC1;
1893 if (tcsetattr (xforkin, TCSANOW, &t) < 0)
1894 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1896 #else
1897 #if defined (NTTYDISC) && defined (TIOCSETD)
1898 if (pty_flag && xforkin >= 0)
1900 /* Use new line discipline. */
1901 int ldisc = NTTYDISC;
1902 ioctl (xforkin, TIOCSETD, &ldisc);
1904 #endif
1905 #endif
1906 #ifdef TIOCNOTTY
1907 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1908 can do TIOCSPGRP only to the process's controlling tty. */
1909 if (pty_flag)
1911 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1912 I can't test it since I don't have 4.3. */
1913 int j = emacs_open ("/dev/tty", O_RDWR, 0);
1914 ioctl (j, TIOCNOTTY, 0);
1915 emacs_close (j);
1916 #ifndef USG
1917 /* In order to get a controlling terminal on some versions
1918 of BSD, it is necessary to put the process in pgrp 0
1919 before it opens the terminal. */
1920 #ifdef HAVE_SETPGID
1921 setpgid (0, 0);
1922 #else
1923 setpgrp (0, 0);
1924 #endif
1925 #endif
1927 #endif /* TIOCNOTTY */
1929 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1930 /*** There is a suggestion that this ought to be a
1931 conditional on TIOCSPGRP,
1932 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1933 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1934 that system does seem to need this code, even though
1935 both HAVE_SETSID and TIOCSCTTY are defined. */
1936 /* Now close the pty (if we had it open) and reopen it.
1937 This makes the pty the controlling terminal of the subprocess. */
1938 if (pty_flag)
1940 #ifdef SET_CHILD_PTY_PGRP
1941 int pgrp = getpid ();
1942 #endif
1944 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1945 would work? */
1946 if (xforkin >= 0)
1947 emacs_close (xforkin);
1948 xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
1950 if (xforkin < 0)
1952 emacs_write (1, "Couldn't open the pty terminal ", 31);
1953 emacs_write (1, pty_name, strlen (pty_name));
1954 emacs_write (1, "\n", 1);
1955 _exit (1);
1958 #ifdef SET_CHILD_PTY_PGRP
1959 ioctl (xforkin, TIOCSPGRP, &pgrp);
1960 ioctl (xforkout, TIOCSPGRP, &pgrp);
1961 #endif
1963 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1965 #ifdef SETUP_SLAVE_PTY
1966 if (pty_flag)
1968 SETUP_SLAVE_PTY;
1970 #endif /* SETUP_SLAVE_PTY */
1971 #ifdef AIX
1972 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1973 Now reenable it in the child, so it will die when we want it to. */
1974 if (pty_flag)
1975 signal (SIGHUP, SIG_DFL);
1976 #endif
1977 #endif /* HAVE_PTYS */
1979 signal (SIGINT, SIG_DFL);
1980 signal (SIGQUIT, SIG_DFL);
1982 /* Stop blocking signals in the child. */
1983 #ifdef POSIX_SIGNALS
1984 sigprocmask (SIG_SETMASK, &procmask, 0);
1985 #else /* !POSIX_SIGNALS */
1986 #ifdef SIGCHLD
1987 #ifdef BSD4_1
1988 sigrelse (SIGCHLD);
1989 #else /* not BSD4_1 */
1990 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1991 sigsetmask (SIGEMPTYMASK);
1992 #else /* ordinary USG */
1993 #if 0
1994 signal (SIGCHLD, sigchld);
1995 #endif
1996 #endif /* ordinary USG */
1997 #endif /* not BSD4_1 */
1998 #endif /* SIGCHLD */
1999 #endif /* !POSIX_SIGNALS */
2001 if (pty_flag)
2002 child_setup_tty (xforkout);
2003 #ifdef WINDOWSNT
2004 pid = child_setup (xforkin, xforkout, xforkout,
2005 new_argv, 1, current_dir);
2006 #else /* not WINDOWSNT */
2007 child_setup (xforkin, xforkout, xforkout,
2008 new_argv, 1, current_dir);
2009 #endif /* not WINDOWSNT */
2011 environ = save_environ;
2014 UNBLOCK_INPUT;
2016 /* This runs in the Emacs process. */
2017 if (pid < 0)
2019 if (forkin >= 0)
2020 emacs_close (forkin);
2021 if (forkin != forkout && forkout >= 0)
2022 emacs_close (forkout);
2024 else
2026 /* vfork succeeded. */
2027 XSETFASTINT (XPROCESS (process)->pid, pid);
2029 #ifdef WINDOWSNT
2030 register_child (pid, inchannel);
2031 #endif /* WINDOWSNT */
2033 /* If the subfork execv fails, and it exits,
2034 this close hangs. I don't know why.
2035 So have an interrupt jar it loose. */
2037 struct atimer *timer;
2038 EMACS_TIME offset;
2040 stop_polling ();
2041 EMACS_SET_SECS_USECS (offset, 1, 0);
2042 timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
2044 XPROCESS (process)->subtty = Qnil;
2045 if (forkin >= 0)
2046 emacs_close (forkin);
2048 cancel_atimer (timer);
2049 start_polling ();
2052 if (forkin != forkout && forkout >= 0)
2053 emacs_close (forkout);
2055 #ifdef HAVE_PTYS
2056 if (pty_flag)
2057 XPROCESS (process)->tty_name = build_string (pty_name);
2058 else
2059 #endif
2060 XPROCESS (process)->tty_name = Qnil;
2063 /* Restore the signal state whether vfork succeeded or not.
2064 (We will signal an error, below, if it failed.) */
2065 #ifdef POSIX_SIGNALS
2066 #ifdef HAVE_WORKING_VFORK
2067 /* Restore the parent's signal handlers. */
2068 sigaction (SIGINT, &sigint_action, 0);
2069 sigaction (SIGQUIT, &sigquit_action, 0);
2070 #ifdef AIX
2071 sigaction (SIGHUP, &sighup_action, 0);
2072 #endif
2073 #endif /* HAVE_WORKING_VFORK */
2074 /* Stop blocking signals in the parent. */
2075 sigprocmask (SIG_SETMASK, &procmask, 0);
2076 #else /* !POSIX_SIGNALS */
2077 #ifdef SIGCHLD
2078 #ifdef BSD4_1
2079 sigrelse (SIGCHLD);
2080 #else /* not BSD4_1 */
2081 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2082 sigsetmask (SIGEMPTYMASK);
2083 #else /* ordinary USG */
2084 #if 0
2085 signal (SIGCHLD, sigchld);
2086 /* Now really handle any of these signals
2087 that came in during this function. */
2088 if (sigchld_deferred)
2089 kill (getpid (), SIGCHLD);
2090 #endif
2091 #endif /* ordinary USG */
2092 #endif /* not BSD4_1 */
2093 #endif /* SIGCHLD */
2094 #endif /* !POSIX_SIGNALS */
2096 /* Now generate the error if vfork failed. */
2097 if (pid < 0)
2098 report_file_error ("Doing vfork", Qnil);
2100 #endif /* not VMS */
2103 #ifdef HAVE_SOCKETS
2105 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2106 The address family of sa is not included in the result. */
2108 static Lisp_Object
2109 conv_sockaddr_to_lisp (sa, len)
2110 struct sockaddr *sa;
2111 int len;
2113 Lisp_Object address;
2114 int i;
2115 unsigned char *cp;
2116 register struct Lisp_Vector *p;
2118 switch (sa->sa_family)
2120 case AF_INET:
2122 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2123 len = sizeof (sin->sin_addr) + 1;
2124 address = Fmake_vector (make_number (len), Qnil);
2125 p = XVECTOR (address);
2126 p->contents[--len] = make_number (ntohs (sin->sin_port));
2127 cp = (unsigned char *)&sin->sin_addr;
2128 break;
2130 #ifdef HAVE_LOCAL_SOCKETS
2131 case AF_LOCAL:
2133 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2134 for (i = 0; i < sizeof (sockun->sun_path); i++)
2135 if (sockun->sun_path[i] == 0)
2136 break;
2137 return make_unibyte_string (sockun->sun_path, i);
2139 #endif
2140 default:
2141 len -= sizeof (sa->sa_family);
2142 address = Fcons (make_number (sa->sa_family),
2143 Fmake_vector (make_number (len), Qnil));
2144 p = XVECTOR (XCDR (address));
2145 cp = (unsigned char *) sa + sizeof (sa->sa_family);
2146 break;
2149 i = 0;
2150 while (i < len)
2151 p->contents[i++] = make_number (*cp++);
2153 return address;
2157 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2159 static int
2160 get_lisp_to_sockaddr_size (address, familyp)
2161 Lisp_Object address;
2162 int *familyp;
2164 register struct Lisp_Vector *p;
2166 if (VECTORP (address))
2168 p = XVECTOR (address);
2169 if (p->size == 5)
2171 *familyp = AF_INET;
2172 return sizeof (struct sockaddr_in);
2175 #ifdef HAVE_LOCAL_SOCKETS
2176 else if (STRINGP (address))
2178 *familyp = AF_LOCAL;
2179 return sizeof (struct sockaddr_un);
2181 #endif
2182 else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
2184 struct sockaddr *sa;
2185 *familyp = XINT (XCAR (address));
2186 p = XVECTOR (XCDR (address));
2187 return p->size + sizeof (sa->sa_family);
2189 return 0;
2192 /* Convert an address object (vector or string) to an internal sockaddr.
2193 Format of address has already been validated by size_lisp_to_sockaddr. */
2195 static void
2196 conv_lisp_to_sockaddr (family, address, sa, len)
2197 int family;
2198 Lisp_Object address;
2199 struct sockaddr *sa;
2200 int len;
2202 register struct Lisp_Vector *p;
2203 register unsigned char *cp;
2204 register int i;
2206 bzero (sa, len);
2207 sa->sa_family = family;
2209 if (VECTORP (address))
2211 p = XVECTOR (address);
2212 if (family == AF_INET)
2214 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2215 len = sizeof (sin->sin_addr) + 1;
2216 i = XINT (p->contents[--len]);
2217 sin->sin_port = htons (i);
2218 cp = (unsigned char *)&sin->sin_addr;
2221 else if (STRINGP (address))
2223 #ifdef HAVE_LOCAL_SOCKETS
2224 if (family == AF_LOCAL)
2226 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2227 cp = SDATA (address);
2228 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2229 sockun->sun_path[i] = *cp++;
2231 #endif
2232 return;
2234 else
2236 p = XVECTOR (XCDR (address));
2237 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2240 for (i = 0; i < len; i++)
2241 if (INTEGERP (p->contents[i]))
2242 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2245 #ifdef DATAGRAM_SOCKETS
2246 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2247 1, 1, 0,
2248 doc: /* Get the current datagram address associated with PROCESS. */)
2249 (process)
2250 Lisp_Object process;
2252 int channel;
2254 CHECK_PROCESS (process);
2256 if (!DATAGRAM_CONN_P (process))
2257 return Qnil;
2259 channel = XINT (XPROCESS (process)->infd);
2260 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2261 datagram_address[channel].len);
2264 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2265 2, 2, 0,
2266 doc: /* Set the datagram address for PROCESS to ADDRESS.
2267 Returns nil upon error setting address, ADDRESS otherwise. */)
2268 (process, address)
2269 Lisp_Object process, address;
2271 int channel;
2272 int family, len;
2274 CHECK_PROCESS (process);
2276 if (!DATAGRAM_CONN_P (process))
2277 return Qnil;
2279 channel = XINT (XPROCESS (process)->infd);
2281 len = get_lisp_to_sockaddr_size (address, &family);
2282 if (datagram_address[channel].len != len)
2283 return Qnil;
2284 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2285 return address;
2287 #endif
2290 static struct socket_options {
2291 /* The name of this option. Should be lowercase version of option
2292 name without SO_ prefix. */
2293 char *name;
2294 /* Length of name. */
2295 int nlen;
2296 /* Option level SOL_... */
2297 int optlevel;
2298 /* Option number SO_... */
2299 int optnum;
2300 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype;
2301 } socket_options[] =
2303 #ifdef SO_BINDTODEVICE
2304 { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
2305 #endif
2306 #ifdef SO_BROADCAST
2307 { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
2308 #endif
2309 #ifdef SO_DONTROUTE
2310 { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
2311 #endif
2312 #ifdef SO_KEEPALIVE
2313 { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
2314 #endif
2315 #ifdef SO_LINGER
2316 { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
2317 #endif
2318 #ifdef SO_OOBINLINE
2319 { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
2320 #endif
2321 #ifdef SO_PRIORITY
2322 { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
2323 #endif
2324 #ifdef SO_REUSEADDR
2325 { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
2326 #endif
2327 { 0, 0, 0, 0, SOPT_UNKNOWN }
2330 /* Process list of socket options OPTS on socket S.
2331 Only check if options are supported is S < 0.
2332 If NO_ERROR is non-zero, continue silently if an option
2333 cannot be set.
2335 Each element specifies one option. An element is either a string
2336 "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
2337 or a symbol. */
2339 static int
2340 set_socket_options (s, opts, no_error)
2341 int s;
2342 Lisp_Object opts;
2343 int no_error;
2345 if (!CONSP (opts))
2346 opts = Fcons (opts, Qnil);
2348 while (CONSP (opts))
2350 Lisp_Object opt;
2351 Lisp_Object val;
2352 char *name, *arg;
2353 struct socket_options *sopt;
2354 int ret = 0;
2356 opt = XCAR (opts);
2357 opts = XCDR (opts);
2359 name = 0;
2360 val = Qt;
2361 if (CONSP (opt))
2363 val = XCDR (opt);
2364 opt = XCAR (opt);
2366 if (STRINGP (opt))
2367 name = (char *) SDATA (opt);
2368 else if (SYMBOLP (opt))
2369 name = (char *) SDATA (SYMBOL_NAME (opt));
2370 else {
2371 error ("Mal-formed option list");
2372 return 0;
2375 if (strncmp (name, "no", 2) == 0)
2377 val = Qnil;
2378 name += 2;
2381 arg = 0;
2382 for (sopt = socket_options; sopt->name; sopt++)
2383 if (strncmp (name, sopt->name, sopt->nlen) == 0)
2385 if (name[sopt->nlen] == 0)
2386 break;
2387 if (name[sopt->nlen] == '=')
2389 arg = name + sopt->nlen + 1;
2390 break;
2394 switch (sopt->opttype)
2396 case SOPT_BOOL:
2398 int optval;
2399 if (s < 0)
2400 return 1;
2401 if (arg)
2402 optval = (*arg == '0' || *arg == 'n') ? 0 : 1;
2403 else if (INTEGERP (val))
2404 optval = XINT (val) == 0 ? 0 : 1;
2405 else
2406 optval = NILP (val) ? 0 : 1;
2407 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2408 &optval, sizeof (optval));
2409 break;
2412 case SOPT_INT:
2414 int optval;
2415 if (arg)
2416 optval = atoi(arg);
2417 else if (INTEGERP (val))
2418 optval = XINT (val);
2419 else
2420 error ("Bad option argument for %s", name);
2421 if (s < 0)
2422 return 1;
2423 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2424 &optval, sizeof (optval));
2425 break;
2428 case SOPT_STR:
2430 if (!arg)
2432 if (NILP (val))
2433 arg = "";
2434 else if (STRINGP (val))
2435 arg = (char *) SDATA (val);
2436 else if (XSYMBOL (val))
2437 arg = (char *) SDATA (SYMBOL_NAME (val));
2438 else
2439 error ("Invalid argument to %s option", name);
2441 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2442 arg, strlen (arg));
2445 #ifdef SO_LINGER
2446 case SOPT_LINGER:
2448 struct linger linger;
2450 linger.l_onoff = 1;
2451 linger.l_linger = 0;
2453 if (s < 0)
2454 return 1;
2456 if (arg)
2458 if (*arg == 'n' || *arg == 't' || *arg == 'y')
2459 linger.l_onoff = (*arg == 'n') ? 0 : 1;
2460 else
2461 linger.l_linger = atoi(arg);
2463 else if (INTEGERP (val))
2464 linger.l_linger = XINT (val);
2465 else
2466 linger.l_onoff = NILP (val) ? 0 : 1;
2467 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2468 &linger, sizeof (linger));
2469 break;
2471 #endif
2472 default:
2473 if (s < 0)
2474 return 0;
2475 if (no_error)
2476 continue;
2477 error ("Unsupported option: %s", name);
2479 if (ret < 0 && ! no_error)
2480 report_file_error ("Cannot set network option: %s", opt);
2482 return 1;
2485 DEFUN ("set-network-process-options",
2486 Fset_network_process_options, Sset_network_process_options,
2487 1, MANY, 0,
2488 doc: /* Set one or more options for network process PROCESS.
2489 Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
2490 A boolean value is false if it either zero or nil, true otherwise.
2492 The following options are known. Consult the relevant system manual
2493 pages for more information.
2495 bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
2496 broadcast=BOOL -- Allow send and receive of datagram broadcasts.
2497 dontroute=BOOL -- Only send to directly connected hosts.
2498 keepalive=BOOL -- Send keep-alive messages on network stream.
2499 linger=BOOL or TIMEOUT -- Send queued messages before closing.
2500 oobinline=BOOL -- Place out-of-band data in receive data stream.
2501 priority=INT -- Set protocol defined priority for sent packets.
2502 reuseaddr=BOOL -- Allow reusing a recently used address.
2504 usage: (set-network-process-options PROCESS &rest OPTIONS) */)
2505 (nargs, args)
2506 int nargs;
2507 Lisp_Object *args;
2509 Lisp_Object process;
2510 Lisp_Object opts;
2512 process = args[0];
2513 CHECK_PROCESS (process);
2514 if (nargs > 1 && XINT (XPROCESS (process)->infd) >= 0)
2516 opts = Flist (nargs, args);
2517 set_socket_options (XINT (XPROCESS (process)->infd), opts, 0);
2519 return process;
2522 /* A version of request_sigio suitable for a record_unwind_protect. */
2524 Lisp_Object
2525 unwind_request_sigio (dummy)
2526 Lisp_Object dummy;
2528 if (interrupt_input)
2529 request_sigio ();
2530 return Qnil;
2533 /* Create a network stream/datagram client/server process. Treated
2534 exactly like a normal process when reading and writing. Primary
2535 differences are in status display and process deletion. A network
2536 connection has no PID; you cannot signal it. All you can do is
2537 stop/continue it and deactivate/close it via delete-process */
2539 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
2540 0, MANY, 0,
2541 doc: /* Create and return a network server or client process.
2543 In Emacs, network connections are represented by process objects, so
2544 input and output work as for subprocesses and `delete-process' closes
2545 a network connection. However, a network process has no process id,
2546 it cannot be signalled, and the status codes are different from normal
2547 processes.
2549 Arguments are specified as keyword/argument pairs. The following
2550 arguments are defined:
2552 :name NAME -- NAME is name for process. It is modified if necessary
2553 to make it unique.
2555 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2556 with the process. Process output goes at end of that buffer, unless
2557 you specify an output stream or filter function to handle the output.
2558 BUFFER may be also nil, meaning that this process is not associated
2559 with any buffer.
2561 :host HOST -- HOST is name of the host to connect to, or its IP
2562 address. The symbol `local' specifies the local host. If specified
2563 for a server process, it must be a valid name or address for the local
2564 host, and only clients connecting to that address will be accepted.
2566 :service SERVICE -- SERVICE is name of the service desired, or an
2567 integer specifying a port number to connect to. If SERVICE is t,
2568 a random port number is selected for the server.
2570 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2571 stream type connection, `datagram' creates a datagram type connection.
2573 :family FAMILY -- FAMILY is the address (and protocol) family for the
2574 service specified by HOST and SERVICE. The default address family is
2575 Inet (or IPv4) for the host and port number specified by HOST and
2576 SERVICE. Other address families supported are:
2577 local -- for a local (i.e. UNIX) address specified by SERVICE.
2579 :local ADDRESS -- ADDRESS is the local address used for the connection.
2580 This parameter is ignored when opening a client process. When specified
2581 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2583 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2584 connection. This parameter is ignored when opening a stream server
2585 process. For a datagram server process, it specifies the initial
2586 setting of the remote datagram address. When specified for a client
2587 process, the FAMILY, HOST, and SERVICE args are ignored.
2589 The format of ADDRESS depends on the address family:
2590 - An IPv4 address is represented as an vector of integers [A B C D P]
2591 corresponding to numeric IP address A.B.C.D and port number P.
2592 - A local address is represented as a string with the address in the
2593 local address space.
2594 - An "unsupported family" address is represented by a cons (F . AV)
2595 where F is the family number and AV is a vector containing the socket
2596 address data with one element per address data byte. Do not rely on
2597 this format in portable code, as it may depend on implementation
2598 defined constants, data sizes, and data structure alignment.
2600 :coding CODING -- CODING is coding system for this process.
2602 :options OPTIONS -- Set the specified options for the network process.
2603 See `set-network-process-options' for details.
2605 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2606 return without waiting for the connection to complete; instead, the
2607 sentinel function will be called with second arg matching "open" (if
2608 successful) or "failed" when the connect completes. Default is to use
2609 a blocking connect (i.e. wait) for stream type connections.
2611 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2612 running when emacs is exited.
2614 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2615 In the stopped state, a server process does not accept new
2616 connections, and a client process does not handle incoming traffic.
2617 The stopped state is cleared by `continue-process' and set by
2618 `stop-process'.
2620 :filter FILTER -- Install FILTER as the process filter.
2622 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2623 process filter are multibyte, otherwise they are unibyte.
2624 If this keyword is not specified, the strings are multibyte iff
2625 `default-enable-multibyte-characters' is non-nil.
2627 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2629 :log LOG -- Install LOG as the server process log function. This
2630 function is called when the server accepts a network connection from a
2631 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2632 is the server process, CLIENT is the new process for the connection,
2633 and MESSAGE is a string.
2635 :plist PLIST -- Install PLIST as the new process' initial plist.
2637 :server BOOL -- if BOOL is non-nil, create a server process for the
2638 specified FAMILY, SERVICE, and connection type (stream or datagram).
2639 Default is a client process.
2641 A server process will listen for and accept connections from
2642 clients. When a client connection is accepted, a new network process
2643 is created for the connection with the following parameters:
2644 - The client's process name is constructed by concatenating the server
2645 process' NAME and a client identification string.
2646 - If the FILTER argument is non-nil, the client process will not get a
2647 separate process buffer; otherwise, the client's process buffer is a newly
2648 created buffer named after the server process' BUFFER name or process
2649 NAME concatenated with the client identification string.
2650 - The connection type and the process filter and sentinel parameters are
2651 inherited from the server process' TYPE, FILTER and SENTINEL.
2652 - The client process' contact info is set according to the client's
2653 addressing information (typically an IP address and a port number).
2654 - The client process' plist is initialized from the server's plist.
2656 Notice that the FILTER and SENTINEL args are never used directly by
2657 the server process. Also, the BUFFER argument is not used directly by
2658 the server process, but via the optional :log function, accepted (and
2659 failed) connections may be logged in the server process' buffer.
2661 The original argument list, modified with the actual connection
2662 information, is available via the `process-contact' function.
2664 usage: (make-network-process &rest ARGS) */)
2665 (nargs, args)
2666 int nargs;
2667 Lisp_Object *args;
2669 Lisp_Object proc;
2670 Lisp_Object contact;
2671 struct Lisp_Process *p;
2672 #ifdef HAVE_GETADDRINFO
2673 struct addrinfo ai, *res, *lres;
2674 struct addrinfo hints;
2675 char *portstring, portbuf[128];
2676 #else /* HAVE_GETADDRINFO */
2677 struct _emacs_addrinfo
2679 int ai_family;
2680 int ai_socktype;
2681 int ai_protocol;
2682 int ai_addrlen;
2683 struct sockaddr *ai_addr;
2684 struct _emacs_addrinfo *ai_next;
2685 } ai, *res, *lres;
2686 #endif /* HAVE_GETADDRINFO */
2687 struct sockaddr_in address_in;
2688 #ifdef HAVE_LOCAL_SOCKETS
2689 struct sockaddr_un address_un;
2690 #endif
2691 int port;
2692 int ret = 0;
2693 int xerrno = 0;
2694 int s = -1, outch, inch;
2695 struct gcpro gcpro1;
2696 int retry = 0;
2697 int count = SPECPDL_INDEX ();
2698 int count1;
2699 Lisp_Object QCaddress; /* one of QClocal or QCremote */
2700 Lisp_Object tem;
2701 Lisp_Object name, buffer, host, service, address;
2702 Lisp_Object filter, sentinel;
2703 int is_non_blocking_client = 0;
2704 int is_server = 0;
2705 int socktype;
2706 int family = -1;
2708 if (nargs == 0)
2709 return Qnil;
2711 /* Save arguments for process-contact and clone-process. */
2712 contact = Flist (nargs, args);
2713 GCPRO1 (contact);
2715 #ifdef WINDOWSNT
2716 /* Ensure socket support is loaded if available. */
2717 init_winsock (TRUE);
2718 #endif
2720 /* :type TYPE (nil: stream, datagram */
2721 tem = Fplist_get (contact, QCtype);
2722 if (NILP (tem))
2723 socktype = SOCK_STREAM;
2724 #ifdef DATAGRAM_SOCKETS
2725 else if (EQ (tem, Qdatagram))
2726 socktype = SOCK_DGRAM;
2727 #endif
2728 else
2729 error ("Unsupported connection type");
2731 /* :server BOOL */
2732 tem = Fplist_get (contact, QCserver);
2733 if (!NILP (tem))
2735 /* Don't support network sockets when non-blocking mode is
2736 not available, since a blocked Emacs is not useful. */
2737 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2738 error ("Network servers not supported");
2739 #else
2740 is_server = 1;
2741 #endif
2744 /* Make QCaddress an alias for :local (server) or :remote (client). */
2745 QCaddress = is_server ? QClocal : QCremote;
2747 /* :wait BOOL */
2748 if (!is_server && socktype == SOCK_STREAM
2749 && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
2751 #ifndef NON_BLOCKING_CONNECT
2752 error ("Non-blocking connect not supported");
2753 #else
2754 is_non_blocking_client = 1;
2755 #endif
2758 name = Fplist_get (contact, QCname);
2759 buffer = Fplist_get (contact, QCbuffer);
2760 filter = Fplist_get (contact, QCfilter);
2761 sentinel = Fplist_get (contact, QCsentinel);
2763 CHECK_STRING (name);
2765 #ifdef TERM
2766 /* Let's handle TERM before things get complicated ... */
2767 host = Fplist_get (contact, QChost);
2768 CHECK_STRING (host);
2770 service = Fplist_get (contact, QCservice);
2771 if (INTEGERP (service))
2772 port = htons ((unsigned short) XINT (service));
2773 else
2775 struct servent *svc_info;
2776 CHECK_STRING (service);
2777 svc_info = getservbyname (SDATA (service), "tcp");
2778 if (svc_info == 0)
2779 error ("Unknown service: %s", SDATA (service));
2780 port = svc_info->s_port;
2783 s = connect_server (0);
2784 if (s < 0)
2785 report_file_error ("error creating socket", Fcons (name, Qnil));
2786 send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port));
2787 send_command (s, C_DUMB, 1, 0);
2789 #else /* not TERM */
2791 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2792 ai.ai_socktype = socktype;
2793 ai.ai_protocol = 0;
2794 ai.ai_next = NULL;
2795 res = &ai;
2797 /* :local ADDRESS or :remote ADDRESS */
2798 address = Fplist_get (contact, QCaddress);
2799 if (!NILP (address))
2801 host = service = Qnil;
2803 if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
2804 error ("Malformed :address");
2805 ai.ai_family = family;
2806 ai.ai_addr = alloca (ai.ai_addrlen);
2807 conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
2808 goto open_socket;
2811 /* :family FAMILY -- nil (for Inet), local, or integer. */
2812 tem = Fplist_get (contact, QCfamily);
2813 if (INTEGERP (tem))
2814 family = XINT (tem);
2815 else
2817 if (NILP (tem))
2818 family = AF_INET;
2819 #ifdef HAVE_LOCAL_SOCKETS
2820 else if (EQ (tem, Qlocal))
2821 family = AF_LOCAL;
2822 #endif
2824 if (family < 0)
2825 error ("Unknown address family");
2826 ai.ai_family = family;
2828 /* :service SERVICE -- string, integer (port number), or t (random port). */
2829 service = Fplist_get (contact, QCservice);
2831 #ifdef HAVE_LOCAL_SOCKETS
2832 if (family == AF_LOCAL)
2834 /* Host is not used. */
2835 host = Qnil;
2836 CHECK_STRING (service);
2837 bzero (&address_un, sizeof address_un);
2838 address_un.sun_family = AF_LOCAL;
2839 strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path);
2840 ai.ai_addr = (struct sockaddr *) &address_un;
2841 ai.ai_addrlen = sizeof address_un;
2842 goto open_socket;
2844 #endif
2846 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2847 host = Fplist_get (contact, QChost);
2848 if (!NILP (host))
2850 if (EQ (host, Qlocal))
2851 host = build_string ("localhost");
2852 CHECK_STRING (host);
2855 /* Slow down polling to every ten seconds.
2856 Some kernels have a bug which causes retrying connect to fail
2857 after a connect. Polling can interfere with gethostbyname too. */
2858 #ifdef POLL_FOR_INPUT
2859 if (socktype == SOCK_STREAM)
2861 record_unwind_protect (unwind_stop_other_atimers, Qnil);
2862 bind_polling_period (10);
2864 #endif
2866 #ifdef HAVE_GETADDRINFO
2867 /* If we have a host, use getaddrinfo to resolve both host and service.
2868 Otherwise, use getservbyname to lookup the service. */
2869 if (!NILP (host))
2872 /* SERVICE can either be a string or int.
2873 Convert to a C string for later use by getaddrinfo. */
2874 if (EQ (service, Qt))
2875 portstring = "0";
2876 else if (INTEGERP (service))
2878 sprintf (portbuf, "%ld", (long) XINT (service));
2879 portstring = portbuf;
2881 else
2883 CHECK_STRING (service);
2884 portstring = SDATA (service);
2887 immediate_quit = 1;
2888 QUIT;
2889 memset (&hints, 0, sizeof (hints));
2890 hints.ai_flags = 0;
2891 hints.ai_family = NILP (Fplist_member (contact, QCfamily)) ? AF_UNSPEC : family;
2892 hints.ai_socktype = socktype;
2893 hints.ai_protocol = 0;
2894 ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
2895 if (ret)
2896 #ifdef HAVE_GAI_STRERROR
2897 error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
2898 #else
2899 error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
2900 #endif
2901 immediate_quit = 0;
2903 goto open_socket;
2905 #endif /* HAVE_GETADDRINFO */
2907 /* We end up here if getaddrinfo is not defined, or in case no hostname
2908 has been specified (e.g. for a local server process). */
2910 if (EQ (service, Qt))
2911 port = 0;
2912 else if (INTEGERP (service))
2913 port = htons ((unsigned short) XINT (service));
2914 else
2916 struct servent *svc_info;
2917 CHECK_STRING (service);
2918 svc_info = getservbyname (SDATA (service),
2919 (socktype == SOCK_DGRAM ? "udp" : "tcp"));
2920 if (svc_info == 0)
2921 error ("Unknown service: %s", SDATA (service));
2922 port = svc_info->s_port;
2925 bzero (&address_in, sizeof address_in);
2926 address_in.sin_family = family;
2927 address_in.sin_addr.s_addr = INADDR_ANY;
2928 address_in.sin_port = port;
2930 #ifndef HAVE_GETADDRINFO
2931 if (!NILP (host))
2933 struct hostent *host_info_ptr;
2935 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2936 as it may `hang' emacs for a very long time. */
2937 immediate_quit = 1;
2938 QUIT;
2939 host_info_ptr = gethostbyname (SDATA (host));
2940 immediate_quit = 0;
2942 if (host_info_ptr)
2944 bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
2945 host_info_ptr->h_length);
2946 family = host_info_ptr->h_addrtype;
2947 address_in.sin_family = family;
2949 else
2950 /* Attempt to interpret host as numeric inet address */
2952 IN_ADDR numeric_addr;
2953 numeric_addr = inet_addr ((char *) SDATA (host));
2954 if (NUMERIC_ADDR_ERROR)
2955 error ("Unknown host \"%s\"", SDATA (host));
2957 bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
2958 sizeof (address_in.sin_addr));
2962 #endif /* not HAVE_GETADDRINFO */
2964 ai.ai_family = family;
2965 ai.ai_addr = (struct sockaddr *) &address_in;
2966 ai.ai_addrlen = sizeof address_in;
2968 open_socket:
2970 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2971 when connect is interrupted. So let's not let it get interrupted.
2972 Note we do not turn off polling, because polling is only used
2973 when not interrupt_input, and thus not normally used on the systems
2974 which have this bug. On systems which use polling, there's no way
2975 to quit if polling is turned off. */
2976 if (interrupt_input
2977 && !is_server && socktype == SOCK_STREAM)
2979 /* Comment from KFS: The original open-network-stream code
2980 didn't unwind protect this, but it seems like the proper
2981 thing to do. In any case, I don't see how it could harm to
2982 do this -- and it makes cleanup (using unbind_to) easier. */
2983 record_unwind_protect (unwind_request_sigio, Qnil);
2984 unrequest_sigio ();
2987 /* Do this in case we never enter the for-loop below. */
2988 count1 = SPECPDL_INDEX ();
2989 s = -1;
2991 for (lres = res; lres; lres = lres->ai_next)
2993 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
2994 if (s < 0)
2996 xerrno = errno;
2997 continue;
3000 #ifdef DATAGRAM_SOCKETS
3001 if (!is_server && socktype == SOCK_DGRAM)
3002 break;
3003 #endif /* DATAGRAM_SOCKETS */
3005 #ifdef NON_BLOCKING_CONNECT
3006 if (is_non_blocking_client)
3008 #ifdef O_NONBLOCK
3009 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3010 #else
3011 ret = fcntl (s, F_SETFL, O_NDELAY);
3012 #endif
3013 if (ret < 0)
3015 xerrno = errno;
3016 emacs_close (s);
3017 s = -1;
3018 continue;
3021 #endif
3023 /* Make us close S if quit. */
3024 record_unwind_protect (close_file_unwind, make_number (s));
3026 if (is_server)
3028 /* Configure as a server socket. */
3029 #ifdef HAVE_LOCAL_SOCKETS
3030 if (family != AF_LOCAL)
3031 #endif
3033 int optval = 1;
3034 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3035 report_file_error ("Cannot set reuse option on server socket.", Qnil);
3038 if (bind (s, lres->ai_addr, lres->ai_addrlen))
3039 report_file_error ("Cannot bind server socket", Qnil);
3041 #ifdef HAVE_GETSOCKNAME
3042 if (EQ (service, Qt))
3044 struct sockaddr_in sa1;
3045 int len1 = sizeof (sa1);
3046 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3048 ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
3049 service = make_number (ntohs (sa1.sin_port));
3050 contact = Fplist_put (contact, QCservice, service);
3053 #endif
3055 if (socktype == SOCK_STREAM && listen (s, 5))
3056 report_file_error ("Cannot listen on server socket", Qnil);
3058 break;
3061 retry_connect:
3063 immediate_quit = 1;
3064 QUIT;
3066 /* This turns off all alarm-based interrupts; the
3067 bind_polling_period call above doesn't always turn all the
3068 short-interval ones off, especially if interrupt_input is
3069 set.
3071 It'd be nice to be able to control the connect timeout
3072 though. Would non-blocking connect calls be portable?
3074 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3076 turn_on_atimers (0);
3078 ret = connect (s, lres->ai_addr, lres->ai_addrlen);
3079 xerrno = errno;
3081 turn_on_atimers (1);
3083 if (ret == 0 || xerrno == EISCONN)
3085 /* The unwind-protect will be discarded afterwards.
3086 Likewise for immediate_quit. */
3087 break;
3090 #ifdef NON_BLOCKING_CONNECT
3091 #ifdef EINPROGRESS
3092 if (is_non_blocking_client && xerrno == EINPROGRESS)
3093 break;
3094 #else
3095 #ifdef EWOULDBLOCK
3096 if (is_non_blocking_client && xerrno == EWOULDBLOCK)
3097 break;
3098 #endif
3099 #endif
3100 #endif
3102 immediate_quit = 0;
3104 if (xerrno == EINTR)
3105 goto retry_connect;
3106 if (xerrno == EADDRINUSE && retry < 20)
3108 /* A delay here is needed on some FreeBSD systems,
3109 and it is harmless, since this retrying takes time anyway
3110 and should be infrequent. */
3111 Fsleep_for (make_number (1), Qnil);
3112 retry++;
3113 goto retry_connect;
3116 /* Discard the unwind protect closing S. */
3117 specpdl_ptr = specpdl + count1;
3118 emacs_close (s);
3119 s = -1;
3122 if (s >= 0)
3124 #ifdef DATAGRAM_SOCKETS
3125 if (socktype == SOCK_DGRAM)
3127 if (datagram_address[s].sa)
3128 abort ();
3129 datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
3130 datagram_address[s].len = lres->ai_addrlen;
3131 if (is_server)
3133 Lisp_Object remote;
3134 bzero (datagram_address[s].sa, lres->ai_addrlen);
3135 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3137 int rfamily, rlen;
3138 rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3139 if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
3140 conv_lisp_to_sockaddr (rfamily, remote,
3141 datagram_address[s].sa, rlen);
3144 else
3145 bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
3147 #endif
3148 contact = Fplist_put (contact, QCaddress,
3149 conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
3150 #ifdef HAVE_GETSOCKNAME
3151 if (!is_server)
3153 struct sockaddr_in sa1;
3154 int len1 = sizeof (sa1);
3155 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3156 contact = Fplist_put (contact, QClocal,
3157 conv_sockaddr_to_lisp (&sa1, len1));
3159 #endif
3162 #ifdef HAVE_GETADDRINFO
3163 if (res != &ai)
3164 freeaddrinfo (res);
3165 #endif
3167 immediate_quit = 0;
3169 /* Discard the unwind protect for closing S, if any. */
3170 specpdl_ptr = specpdl + count1;
3172 /* Unwind bind_polling_period and request_sigio. */
3173 unbind_to (count, Qnil);
3175 if (s < 0)
3177 /* If non-blocking got this far - and failed - assume non-blocking is
3178 not supported after all. This is probably a wrong assumption, but
3179 the normal blocking calls to open-network-stream handles this error
3180 better. */
3181 if (is_non_blocking_client)
3182 return Qnil;
3184 errno = xerrno;
3185 if (is_server)
3186 report_file_error ("make server process failed", contact);
3187 else
3188 report_file_error ("make client process failed", contact);
3191 tem = Fplist_get (contact, QCoptions);
3192 if (!NILP (tem))
3193 set_socket_options (s, tem, 1);
3195 #endif /* not TERM */
3197 inch = s;
3198 outch = s;
3200 if (!NILP (buffer))
3201 buffer = Fget_buffer_create (buffer);
3202 proc = make_process (name);
3204 chan_process[inch] = proc;
3206 #ifdef O_NONBLOCK
3207 fcntl (inch, F_SETFL, O_NONBLOCK);
3208 #else
3209 #ifdef O_NDELAY
3210 fcntl (inch, F_SETFL, O_NDELAY);
3211 #endif
3212 #endif
3214 p = XPROCESS (proc);
3216 p->childp = contact;
3217 p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
3219 p->buffer = buffer;
3220 p->sentinel = sentinel;
3221 p->filter = filter;
3222 p->filter_multibyte = buffer_defaults.enable_multibyte_characters;
3223 /* Override the above only if :filter-multibyte is specified. */
3224 if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
3225 p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte);
3226 p->log = Fplist_get (contact, QClog);
3227 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3228 p->kill_without_query = Qt;
3229 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3230 p->command = Qt;
3231 p->pid = Qnil;
3232 XSETINT (p->infd, inch);
3233 XSETINT (p->outfd, outch);
3234 if (is_server && socktype == SOCK_STREAM)
3235 p->status = Qlisten;
3237 #ifdef NON_BLOCKING_CONNECT
3238 if (is_non_blocking_client)
3240 /* We may get here if connect did succeed immediately. However,
3241 in that case, we still need to signal this like a non-blocking
3242 connection. */
3243 p->status = Qconnect;
3244 if (!FD_ISSET (inch, &connect_wait_mask))
3246 FD_SET (inch, &connect_wait_mask);
3247 num_pending_connects++;
3250 else
3251 #endif
3252 /* A server may have a client filter setting of Qt, but it must
3253 still listen for incoming connects unless it is stopped. */
3254 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3255 || (EQ (p->status, Qlisten) && NILP (p->command)))
3257 FD_SET (inch, &input_wait_mask);
3258 FD_SET (inch, &non_keyboard_wait_mask);
3261 if (inch > max_process_desc)
3262 max_process_desc = inch;
3264 tem = Fplist_member (contact, QCcoding);
3265 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3266 tem = Qnil; /* No error message (too late!). */
3269 /* Setup coding systems for communicating with the network stream. */
3270 struct gcpro gcpro1;
3271 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3272 Lisp_Object coding_systems = Qt;
3273 Lisp_Object args[5], val;
3275 if (!NILP (tem))
3276 val = XCAR (XCDR (tem));
3277 else if (!NILP (Vcoding_system_for_read))
3278 val = Vcoding_system_for_read;
3279 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
3280 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
3281 /* We dare not decode end-of-line format by setting VAL to
3282 Qraw_text, because the existing Emacs Lisp libraries
3283 assume that they receive bare code including a sequene of
3284 CR LF. */
3285 val = Qnil;
3286 else
3288 if (NILP (host) || NILP (service))
3289 coding_systems = Qnil;
3290 else
3292 args[0] = Qopen_network_stream, args[1] = name,
3293 args[2] = buffer, args[3] = host, args[4] = service;
3294 GCPRO1 (proc);
3295 coding_systems = Ffind_operation_coding_system (5, args);
3296 UNGCPRO;
3298 if (CONSP (coding_systems))
3299 val = XCAR (coding_systems);
3300 else if (CONSP (Vdefault_process_coding_system))
3301 val = XCAR (Vdefault_process_coding_system);
3302 else
3303 val = Qnil;
3305 p->decode_coding_system = val;
3307 if (!NILP (tem))
3308 val = XCAR (XCDR (tem));
3309 else if (!NILP (Vcoding_system_for_write))
3310 val = Vcoding_system_for_write;
3311 else if (NILP (current_buffer->enable_multibyte_characters))
3312 val = Qnil;
3313 else
3315 if (EQ (coding_systems, Qt))
3317 if (NILP (host) || NILP (service))
3318 coding_systems = Qnil;
3319 else
3321 args[0] = Qopen_network_stream, args[1] = name,
3322 args[2] = buffer, args[3] = host, args[4] = service;
3323 GCPRO1 (proc);
3324 coding_systems = Ffind_operation_coding_system (5, args);
3325 UNGCPRO;
3328 if (CONSP (coding_systems))
3329 val = XCDR (coding_systems);
3330 else if (CONSP (Vdefault_process_coding_system))
3331 val = XCDR (Vdefault_process_coding_system);
3332 else
3333 val = Qnil;
3335 p->encode_coding_system = val;
3337 setup_process_coding_systems (proc);
3339 p->decoding_buf = make_uninit_string (0);
3340 p->decoding_carryover = make_number (0);
3341 p->encoding_buf = make_uninit_string (0);
3342 p->encoding_carryover = make_number (0);
3344 p->inherit_coding_system_flag
3345 = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system
3346 ? Qnil : Qt);
3348 UNGCPRO;
3349 return proc;
3351 #endif /* HAVE_SOCKETS */
3353 void
3354 deactivate_process (proc)
3355 Lisp_Object proc;
3357 register int inchannel, outchannel;
3358 register struct Lisp_Process *p = XPROCESS (proc);
3360 inchannel = XINT (p->infd);
3361 outchannel = XINT (p->outfd);
3363 if (inchannel >= 0)
3365 /* Beware SIGCHLD hereabouts. */
3366 flush_pending_output (inchannel);
3367 #ifdef VMS
3369 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
3370 sys$dassgn (outchannel);
3371 vs = get_vms_process_pointer (p->pid);
3372 if (vs)
3373 give_back_vms_process_stuff (vs);
3375 #else
3376 emacs_close (inchannel);
3377 if (outchannel >= 0 && outchannel != inchannel)
3378 emacs_close (outchannel);
3379 #endif
3381 XSETINT (p->infd, -1);
3382 XSETINT (p->outfd, -1);
3383 #ifdef DATAGRAM_SOCKETS
3384 if (DATAGRAM_CHAN_P (inchannel))
3386 xfree (datagram_address[inchannel].sa);
3387 datagram_address[inchannel].sa = 0;
3388 datagram_address[inchannel].len = 0;
3390 #endif
3391 chan_process[inchannel] = Qnil;
3392 FD_CLR (inchannel, &input_wait_mask);
3393 FD_CLR (inchannel, &non_keyboard_wait_mask);
3394 if (FD_ISSET (inchannel, &connect_wait_mask))
3396 FD_CLR (inchannel, &connect_wait_mask);
3397 if (--num_pending_connects < 0)
3398 abort ();
3400 if (inchannel == max_process_desc)
3402 int i;
3403 /* We just closed the highest-numbered process input descriptor,
3404 so recompute the highest-numbered one now. */
3405 max_process_desc = 0;
3406 for (i = 0; i < MAXDESC; i++)
3407 if (!NILP (chan_process[i]))
3408 max_process_desc = i;
3413 /* Close all descriptors currently in use for communication
3414 with subprocess. This is used in a newly-forked subprocess
3415 to get rid of irrelevant descriptors. */
3417 void
3418 close_process_descs ()
3420 #ifndef WINDOWSNT
3421 int i;
3422 for (i = 0; i < MAXDESC; i++)
3424 Lisp_Object process;
3425 process = chan_process[i];
3426 if (!NILP (process))
3428 int in = XINT (XPROCESS (process)->infd);
3429 int out = XINT (XPROCESS (process)->outfd);
3430 if (in >= 0)
3431 emacs_close (in);
3432 if (out >= 0 && in != out)
3433 emacs_close (out);
3436 #endif
3439 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
3440 0, 3, 0,
3441 doc: /* Allow any pending output from subprocesses to be read by Emacs.
3442 It is read into the process' buffers or given to their filter functions.
3443 Non-nil arg PROCESS means do not return until some output has been received
3444 from PROCESS.
3445 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3446 seconds and microseconds to wait; return after that much time whether
3447 or not there is input.
3448 Return non-nil iff we received any output before the timeout expired. */)
3449 (process, timeout, timeout_msecs)
3450 register Lisp_Object process, timeout, timeout_msecs;
3452 int seconds;
3453 int useconds;
3455 if (! NILP (process))
3456 CHECK_PROCESS (process);
3458 if (! NILP (timeout_msecs))
3460 CHECK_NUMBER (timeout_msecs);
3461 useconds = XINT (timeout_msecs);
3462 if (!INTEGERP (timeout))
3463 XSETINT (timeout, 0);
3466 int carry = useconds / 1000000;
3468 XSETINT (timeout, XINT (timeout) + carry);
3469 useconds -= carry * 1000000;
3471 /* I think this clause is necessary because C doesn't
3472 guarantee a particular rounding direction for negative
3473 integers. */
3474 if (useconds < 0)
3476 XSETINT (timeout, XINT (timeout) - 1);
3477 useconds += 1000000;
3481 else
3482 useconds = 0;
3484 if (! NILP (timeout))
3486 CHECK_NUMBER (timeout);
3487 seconds = XINT (timeout);
3488 if (seconds < 0 || (seconds == 0 && useconds == 0))
3489 seconds = -1;
3491 else
3493 if (NILP (process))
3494 seconds = -1;
3495 else
3496 seconds = 0;
3499 if (NILP (process))
3500 XSETFASTINT (process, 0);
3502 return
3503 (wait_reading_process_input (seconds, useconds, process, 0)
3504 ? Qt : Qnil);
3507 /* Accept a connection for server process SERVER on CHANNEL. */
3509 static int connect_counter = 0;
3511 static void
3512 server_accept_connection (server, channel)
3513 Lisp_Object server;
3514 int channel;
3516 Lisp_Object proc, caller, name, buffer;
3517 Lisp_Object contact, host, service;
3518 struct Lisp_Process *ps= XPROCESS (server);
3519 struct Lisp_Process *p;
3520 int s;
3521 union u_sockaddr {
3522 struct sockaddr sa;
3523 struct sockaddr_in in;
3524 #ifdef HAVE_LOCAL_SOCKETS
3525 struct sockaddr_un un;
3526 #endif
3527 } saddr;
3528 int len = sizeof saddr;
3530 s = accept (channel, &saddr.sa, &len);
3532 if (s < 0)
3534 int code = errno;
3536 if (code == EAGAIN)
3537 return;
3538 #ifdef EWOULDBLOCK
3539 if (code == EWOULDBLOCK)
3540 return;
3541 #endif
3543 if (!NILP (ps->log))
3544 call3 (ps->log, server, Qnil,
3545 concat3 (build_string ("accept failed with code"),
3546 Fnumber_to_string (make_number (code)),
3547 build_string ("\n")));
3548 return;
3551 connect_counter++;
3553 /* Setup a new process to handle the connection. */
3555 /* Generate a unique identification of the caller, and build contact
3556 information for this process. */
3557 host = Qt;
3558 service = Qnil;
3559 switch (saddr.sa.sa_family)
3561 case AF_INET:
3563 Lisp_Object args[5];
3564 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
3565 args[0] = build_string ("%d.%d.%d.%d");
3566 args[1] = make_number (*ip++);
3567 args[2] = make_number (*ip++);
3568 args[3] = make_number (*ip++);
3569 args[4] = make_number (*ip++);
3570 host = Fformat (5, args);
3571 service = make_number (ntohs (saddr.in.sin_port));
3573 args[0] = build_string (" <%s:%d>");
3574 args[1] = host;
3575 args[2] = service;
3576 caller = Fformat (3, args);
3578 break;
3580 #ifdef HAVE_LOCAL_SOCKETS
3581 case AF_LOCAL:
3582 #endif
3583 default:
3584 caller = Fnumber_to_string (make_number (connect_counter));
3585 caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
3586 break;
3589 /* Create a new buffer name for this process if it doesn't have a
3590 filter. The new buffer name is based on the buffer name or
3591 process name of the server process concatenated with the caller
3592 identification. */
3594 if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
3595 buffer = Qnil;
3596 else
3598 buffer = ps->buffer;
3599 if (!NILP (buffer))
3600 buffer = Fbuffer_name (buffer);
3601 else
3602 buffer = ps->name;
3603 if (!NILP (buffer))
3605 buffer = concat2 (buffer, caller);
3606 buffer = Fget_buffer_create (buffer);
3610 /* Generate a unique name for the new server process. Combine the
3611 server process name with the caller identification. */
3613 name = concat2 (ps->name, caller);
3614 proc = make_process (name);
3616 chan_process[s] = proc;
3618 #ifdef O_NONBLOCK
3619 fcntl (s, F_SETFL, O_NONBLOCK);
3620 #else
3621 #ifdef O_NDELAY
3622 fcntl (s, F_SETFL, O_NDELAY);
3623 #endif
3624 #endif
3626 p = XPROCESS (proc);
3628 /* Build new contact information for this setup. */
3629 contact = Fcopy_sequence (ps->childp);
3630 contact = Fplist_put (contact, QCserver, Qnil);
3631 contact = Fplist_put (contact, QChost, host);
3632 if (!NILP (service))
3633 contact = Fplist_put (contact, QCservice, service);
3634 contact = Fplist_put (contact, QCremote,
3635 conv_sockaddr_to_lisp (&saddr.sa, len));
3636 #ifdef HAVE_GETSOCKNAME
3637 len = sizeof saddr;
3638 if (getsockname (s, &saddr.sa, &len) == 0)
3639 contact = Fplist_put (contact, QClocal,
3640 conv_sockaddr_to_lisp (&saddr.sa, len));
3641 #endif
3643 p->childp = contact;
3644 p->plist = Fcopy_sequence (ps->plist);
3646 p->buffer = buffer;
3647 p->sentinel = ps->sentinel;
3648 p->filter = ps->filter;
3649 p->command = Qnil;
3650 p->pid = Qnil;
3651 XSETINT (p->infd, s);
3652 XSETINT (p->outfd, s);
3653 p->status = Qrun;
3655 /* Client processes for accepted connections are not stopped initially. */
3656 if (!EQ (p->filter, Qt))
3658 FD_SET (s, &input_wait_mask);
3659 FD_SET (s, &non_keyboard_wait_mask);
3662 if (s > max_process_desc)
3663 max_process_desc = s;
3665 /* Setup coding system for new process based on server process.
3666 This seems to be the proper thing to do, as the coding system
3667 of the new process should reflect the settings at the time the
3668 server socket was opened; not the current settings. */
3670 p->decode_coding_system = ps->decode_coding_system;
3671 p->encode_coding_system = ps->encode_coding_system;
3672 setup_process_coding_systems (proc);
3674 p->decoding_buf = make_uninit_string (0);
3675 p->decoding_carryover = make_number (0);
3676 p->encoding_buf = make_uninit_string (0);
3677 p->encoding_carryover = make_number (0);
3679 p->inherit_coding_system_flag
3680 = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
3682 if (!NILP (ps->log))
3683 call3 (ps->log, server, proc,
3684 concat3 (build_string ("accept from "),
3685 (STRINGP (host) ? host : build_string ("-")),
3686 build_string ("\n")));
3688 if (!NILP (p->sentinel))
3689 exec_sentinel (proc,
3690 concat3 (build_string ("open from "),
3691 (STRINGP (host) ? host : build_string ("-")),
3692 build_string ("\n")));
3695 /* This variable is different from waiting_for_input in keyboard.c.
3696 It is used to communicate to a lisp process-filter/sentinel (via the
3697 function Fwaiting_for_user_input_p below) whether emacs was waiting
3698 for user-input when that process-filter was called.
3699 waiting_for_input cannot be used as that is by definition 0 when
3700 lisp code is being evalled.
3701 This is also used in record_asynch_buffer_change.
3702 For that purpose, this must be 0
3703 when not inside wait_reading_process_input. */
3704 static int waiting_for_user_input_p;
3706 /* This is here so breakpoints can be put on it. */
3707 static void
3708 wait_reading_process_input_1 ()
3712 /* Read and dispose of subprocess output while waiting for timeout to
3713 elapse and/or keyboard input to be available.
3715 TIME_LIMIT is:
3716 timeout in seconds, or
3717 zero for no limit, or
3718 -1 means gobble data immediately available but don't wait for any.
3720 MICROSECS is:
3721 an additional duration to wait, measured in microseconds.
3722 If this is nonzero and time_limit is 0, then the timeout
3723 consists of MICROSECS only.
3725 READ_KBD is a lisp value:
3726 0 to ignore keyboard input, or
3727 1 to return when input is available, or
3728 -1 meaning caller will actually read the input, so don't throw to
3729 the quit handler, or
3730 a cons cell, meaning wait until its car is non-nil
3731 (and gobble terminal input into the buffer if any arrives), or
3732 a process object, meaning wait until something arrives from that
3733 process. The return value is true iff we read some input from
3734 that process.
3736 DO_DISPLAY != 0 means redisplay should be done to show subprocess
3737 output that arrives.
3739 If READ_KBD is a pointer to a struct Lisp_Process, then the
3740 function returns true iff we received input from that process
3741 before the timeout elapsed.
3742 Otherwise, return true iff we received input from any process. */
3745 wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
3746 int time_limit, microsecs;
3747 Lisp_Object read_kbd;
3748 int do_display;
3750 register int channel, nfds;
3751 static SELECT_TYPE Available;
3752 static SELECT_TYPE Connecting;
3753 int check_connect, no_avail;
3754 int xerrno;
3755 Lisp_Object proc;
3756 EMACS_TIME timeout, end_time;
3757 int wait_channel = -1;
3758 struct Lisp_Process *wait_proc = 0;
3759 int got_some_input = 0;
3760 /* Either nil or a cons cell, the car of which is of interest and
3761 may be changed outside of this routine. */
3762 Lisp_Object wait_for_cell = Qnil;
3764 FD_ZERO (&Available);
3765 FD_ZERO (&Connecting);
3767 /* If read_kbd is a process to watch, set wait_proc and wait_channel
3768 accordingly. */
3769 if (PROCESSP (read_kbd))
3771 wait_proc = XPROCESS (read_kbd);
3772 wait_channel = XINT (wait_proc->infd);
3773 XSETFASTINT (read_kbd, 0);
3776 /* If waiting for non-nil in a cell, record where. */
3777 if (CONSP (read_kbd))
3779 wait_for_cell = read_kbd;
3780 XSETFASTINT (read_kbd, 0);
3783 waiting_for_user_input_p = XINT (read_kbd);
3785 /* Since we may need to wait several times,
3786 compute the absolute time to return at. */
3787 if (time_limit || microsecs)
3789 EMACS_GET_TIME (end_time);
3790 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
3791 EMACS_ADD_TIME (end_time, end_time, timeout);
3793 #ifdef POLLING_PROBLEM_IN_SELECT
3794 /* AlainF 5-Jul-1996
3795 HP-UX 10.10 seem to have problems with signals coming in
3796 Causes "poll: interrupted system call" messages when Emacs is run
3797 in an X window
3798 Turn off periodic alarms (in case they are in use),
3799 and then turn off any other atimers. */
3800 stop_polling ();
3801 turn_on_atimers (0);
3802 #endif
3804 while (1)
3806 int timeout_reduced_for_timers = 0;
3808 /* If calling from keyboard input, do not quit
3809 since we want to return C-g as an input character.
3810 Otherwise, do pending quit if requested. */
3811 if (XINT (read_kbd) >= 0)
3812 QUIT;
3814 /* Exit now if the cell we're waiting for became non-nil. */
3815 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
3816 break;
3818 /* Compute time from now till when time limit is up */
3819 /* Exit if already run out */
3820 if (time_limit == -1)
3822 /* -1 specified for timeout means
3823 gobble output available now
3824 but don't wait at all. */
3826 EMACS_SET_SECS_USECS (timeout, 0, 0);
3828 else if (time_limit || microsecs)
3830 EMACS_GET_TIME (timeout);
3831 EMACS_SUB_TIME (timeout, end_time, timeout);
3832 if (EMACS_TIME_NEG_P (timeout))
3833 break;
3835 else
3837 EMACS_SET_SECS_USECS (timeout, 100000, 0);
3840 /* Normally we run timers here.
3841 But not if wait_for_cell; in those cases,
3842 the wait is supposed to be short,
3843 and those callers cannot handle running arbitrary Lisp code here. */
3844 if (NILP (wait_for_cell))
3846 EMACS_TIME timer_delay;
3850 int old_timers_run = timers_run;
3851 struct buffer *old_buffer = current_buffer;
3853 timer_delay = timer_check (1);
3855 /* If a timer has run, this might have changed buffers
3856 an alike. Make read_key_sequence aware of that. */
3857 if (timers_run != old_timers_run
3858 && old_buffer != current_buffer
3859 && waiting_for_user_input_p == -1)
3860 record_asynch_buffer_change ();
3862 if (timers_run != old_timers_run && do_display)
3863 /* We must retry, since a timer may have requeued itself
3864 and that could alter the time_delay. */
3865 redisplay_preserve_echo_area (9);
3866 else
3867 break;
3869 while (!detect_input_pending ());
3871 /* If there is unread keyboard input, also return. */
3872 if (XINT (read_kbd) != 0
3873 && requeued_events_pending_p ())
3874 break;
3876 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
3878 EMACS_TIME difference;
3879 EMACS_SUB_TIME (difference, timer_delay, timeout);
3880 if (EMACS_TIME_NEG_P (difference))
3882 timeout = timer_delay;
3883 timeout_reduced_for_timers = 1;
3886 /* If time_limit is -1, we are not going to wait at all. */
3887 else if (time_limit != -1)
3889 /* This is so a breakpoint can be put here. */
3890 wait_reading_process_input_1 ();
3894 /* Cause C-g and alarm signals to take immediate action,
3895 and cause input available signals to zero out timeout.
3897 It is important that we do this before checking for process
3898 activity. If we get a SIGCHLD after the explicit checks for
3899 process activity, timeout is the only way we will know. */
3900 if (XINT (read_kbd) < 0)
3901 set_waiting_for_input (&timeout);
3903 /* If status of something has changed, and no input is
3904 available, notify the user of the change right away. After
3905 this explicit check, we'll let the SIGCHLD handler zap
3906 timeout to get our attention. */
3907 if (update_tick != process_tick && do_display)
3909 SELECT_TYPE Atemp, Ctemp;
3911 Atemp = input_wait_mask;
3912 #ifdef MAC_OSX
3913 /* On Mac OS X, the SELECT system call always says input is
3914 present (for reading) at stdin, even when none is. This
3915 causes the call to SELECT below to return 1 and
3916 status_notify not to be called. As a result output of
3917 subprocesses are incorrectly discarded. */
3918 FD_CLR (0, &Atemp);
3919 #endif
3920 Ctemp = connect_wait_mask;
3921 EMACS_SET_SECS_USECS (timeout, 0, 0);
3922 if ((select (max (max_process_desc, max_keyboard_desc) + 1,
3923 &Atemp,
3924 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
3925 (SELECT_TYPE *)0, &timeout)
3926 <= 0))
3928 /* It's okay for us to do this and then continue with
3929 the loop, since timeout has already been zeroed out. */
3930 clear_waiting_for_input ();
3931 status_notify ();
3935 /* Don't wait for output from a non-running process. Just
3936 read whatever data has already been received. */
3937 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
3938 update_status (wait_proc);
3939 if (wait_proc != 0
3940 && ! EQ (wait_proc->status, Qrun)
3941 && ! EQ (wait_proc->status, Qconnect))
3943 int nread, total_nread = 0;
3945 clear_waiting_for_input ();
3946 XSETPROCESS (proc, wait_proc);
3948 /* Read data from the process, until we exhaust it. */
3949 while (XINT (wait_proc->infd) >= 0)
3951 nread = read_process_output (proc, XINT (wait_proc->infd));
3953 if (nread == 0)
3954 break;
3956 if (0 < nread)
3957 total_nread += nread;
3958 #ifdef EIO
3959 else if (nread == -1 && EIO == errno)
3960 break;
3961 #endif
3962 #ifdef EAGAIN
3963 else if (nread == -1 && EAGAIN == errno)
3964 break;
3965 #endif
3966 #ifdef EWOULDBLOCK
3967 else if (nread == -1 && EWOULDBLOCK == errno)
3968 break;
3969 #endif
3971 if (total_nread > 0 && do_display)
3972 redisplay_preserve_echo_area (10);
3974 break;
3977 /* Wait till there is something to do */
3979 if (!NILP (wait_for_cell))
3981 Available = non_process_wait_mask;
3982 check_connect = 0;
3984 else
3986 if (! XINT (read_kbd))
3987 Available = non_keyboard_wait_mask;
3988 else
3989 Available = input_wait_mask;
3990 check_connect = (num_pending_connects > 0);
3993 /* If frame size has changed or the window is newly mapped,
3994 redisplay now, before we start to wait. There is a race
3995 condition here; if a SIGIO arrives between now and the select
3996 and indicates that a frame is trashed, the select may block
3997 displaying a trashed screen. */
3998 if (frame_garbaged && do_display)
4000 clear_waiting_for_input ();
4001 redisplay_preserve_echo_area (11);
4002 if (XINT (read_kbd) < 0)
4003 set_waiting_for_input (&timeout);
4006 no_avail = 0;
4007 if (XINT (read_kbd) && detect_input_pending ())
4009 nfds = 0;
4010 no_avail = 1;
4012 else
4014 if (check_connect)
4015 Connecting = connect_wait_mask;
4016 nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
4017 &Available,
4018 (check_connect ? &Connecting : (SELECT_TYPE *)0),
4019 (SELECT_TYPE *)0, &timeout);
4022 xerrno = errno;
4024 /* Make C-g and alarm signals set flags again */
4025 clear_waiting_for_input ();
4027 /* If we woke up due to SIGWINCH, actually change size now. */
4028 do_pending_window_change (0);
4030 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4031 /* We wanted the full specified time, so return now. */
4032 break;
4033 if (nfds < 0)
4035 if (xerrno == EINTR)
4036 no_avail = 1;
4037 #ifdef ultrix
4038 /* Ultrix select seems to return ENOMEM when it is
4039 interrupted. Treat it just like EINTR. Bleah. Note
4040 that we want to test for the "ultrix" CPP symbol, not
4041 "__ultrix__"; the latter is only defined under GCC, but
4042 not by DEC's bundled CC. -JimB */
4043 else if (xerrno == ENOMEM)
4044 no_avail = 1;
4045 #endif
4046 #ifdef ALLIANT
4047 /* This happens for no known reason on ALLIANT.
4048 I am guessing that this is the right response. -- RMS. */
4049 else if (xerrno == EFAULT)
4050 no_avail = 1;
4051 #endif
4052 else if (xerrno == EBADF)
4054 #ifdef AIX
4055 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4056 the child's closure of the pts gives the parent a SIGHUP, and
4057 the ptc file descriptor is automatically closed,
4058 yielding EBADF here or at select() call above.
4059 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4060 in m/ibmrt-aix.h), and here we just ignore the select error.
4061 Cleanup occurs c/o status_notify after SIGCLD. */
4062 no_avail = 1; /* Cannot depend on values returned */
4063 #else
4064 abort ();
4065 #endif
4067 else
4068 error ("select error: %s", emacs_strerror (xerrno));
4071 if (no_avail)
4073 FD_ZERO (&Available);
4074 check_connect = 0;
4077 #if defined(sun) && !defined(USG5_4)
4078 if (nfds > 0 && keyboard_bit_set (&Available)
4079 && interrupt_input)
4080 /* System sometimes fails to deliver SIGIO.
4082 David J. Mackenzie says that Emacs doesn't compile under
4083 Solaris if this code is enabled, thus the USG5_4 in the CPP
4084 conditional. "I haven't noticed any ill effects so far.
4085 If you find a Solaris expert somewhere, they might know
4086 better." */
4087 kill (getpid (), SIGIO);
4088 #endif
4090 #if 0 /* When polling is used, interrupt_input is 0,
4091 so get_input_pending should read the input.
4092 So this should not be needed. */
4093 /* If we are using polling for input,
4094 and we see input available, make it get read now.
4095 Otherwise it might not actually get read for a second.
4096 And on hpux, since we turn off polling in wait_reading_process_input,
4097 it might never get read at all if we don't spend much time
4098 outside of wait_reading_process_input. */
4099 if (XINT (read_kbd) && interrupt_input
4100 && keyboard_bit_set (&Available)
4101 && input_polling_used ())
4102 kill (getpid (), SIGALRM);
4103 #endif
4105 /* Check for keyboard input */
4106 /* If there is any, return immediately
4107 to give it higher priority than subprocesses */
4109 if (XINT (read_kbd) != 0)
4111 int old_timers_run = timers_run;
4112 struct buffer *old_buffer = current_buffer;
4113 int leave = 0;
4115 if (detect_input_pending_run_timers (do_display))
4117 swallow_events (do_display);
4118 if (detect_input_pending_run_timers (do_display))
4119 leave = 1;
4122 /* If a timer has run, this might have changed buffers
4123 an alike. Make read_key_sequence aware of that. */
4124 if (timers_run != old_timers_run
4125 && waiting_for_user_input_p == -1
4126 && old_buffer != current_buffer)
4127 record_asynch_buffer_change ();
4129 if (leave)
4130 break;
4133 /* If there is unread keyboard input, also return. */
4134 if (XINT (read_kbd) != 0
4135 && requeued_events_pending_p ())
4136 break;
4138 /* If we are not checking for keyboard input now,
4139 do process events (but don't run any timers).
4140 This is so that X events will be processed.
4141 Otherwise they may have to wait until polling takes place.
4142 That would causes delays in pasting selections, for example.
4144 (We used to do this only if wait_for_cell.) */
4145 if (XINT (read_kbd) == 0 && detect_input_pending ())
4147 swallow_events (do_display);
4148 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4149 if (detect_input_pending ())
4150 break;
4151 #endif
4154 /* Exit now if the cell we're waiting for became non-nil. */
4155 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4156 break;
4158 #ifdef SIGIO
4159 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4160 go read it. This can happen with X on BSD after logging out.
4161 In that case, there really is no input and no SIGIO,
4162 but select says there is input. */
4164 if (XINT (read_kbd) && interrupt_input
4165 && keyboard_bit_set (&Available))
4166 kill (getpid (), SIGIO);
4167 #endif
4169 if (! wait_proc)
4170 got_some_input |= nfds > 0;
4172 /* If checking input just got us a size-change event from X,
4173 obey it now if we should. */
4174 if (XINT (read_kbd) || ! NILP (wait_for_cell))
4175 do_pending_window_change (0);
4177 /* Check for data from a process. */
4178 if (no_avail || nfds == 0)
4179 continue;
4181 /* Really FIRST_PROC_DESC should be 0 on Unix,
4182 but this is safer in the short run. */
4183 for (channel = 0; channel <= max_process_desc; channel++)
4185 if (FD_ISSET (channel, &Available)
4186 && FD_ISSET (channel, &non_keyboard_wait_mask))
4188 int nread;
4190 /* If waiting for this channel, arrange to return as
4191 soon as no more input to be processed. No more
4192 waiting. */
4193 if (wait_channel == channel)
4195 wait_channel = -1;
4196 time_limit = -1;
4197 got_some_input = 1;
4199 proc = chan_process[channel];
4200 if (NILP (proc))
4201 continue;
4203 /* If this is a server stream socket, accept connection. */
4204 if (EQ (XPROCESS (proc)->status, Qlisten))
4206 server_accept_connection (proc, channel);
4207 continue;
4210 /* Read data from the process, starting with our
4211 buffered-ahead character if we have one. */
4213 nread = read_process_output (proc, channel);
4214 if (nread > 0)
4216 /* Since read_process_output can run a filter,
4217 which can call accept-process-output,
4218 don't try to read from any other processes
4219 before doing the select again. */
4220 FD_ZERO (&Available);
4222 if (do_display)
4223 redisplay_preserve_echo_area (12);
4225 #ifdef EWOULDBLOCK
4226 else if (nread == -1 && errno == EWOULDBLOCK)
4228 #endif
4229 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4230 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4231 #ifdef O_NONBLOCK
4232 else if (nread == -1 && errno == EAGAIN)
4234 #else
4235 #ifdef O_NDELAY
4236 else if (nread == -1 && errno == EAGAIN)
4238 /* Note that we cannot distinguish between no input
4239 available now and a closed pipe.
4240 With luck, a closed pipe will be accompanied by
4241 subprocess termination and SIGCHLD. */
4242 else if (nread == 0 && !NETCONN_P (proc))
4244 #endif /* O_NDELAY */
4245 #endif /* O_NONBLOCK */
4246 #ifdef HAVE_PTYS
4247 /* On some OSs with ptys, when the process on one end of
4248 a pty exits, the other end gets an error reading with
4249 errno = EIO instead of getting an EOF (0 bytes read).
4250 Therefore, if we get an error reading and errno =
4251 EIO, just continue, because the child process has
4252 exited and should clean itself up soon (e.g. when we
4253 get a SIGCHLD).
4255 However, it has been known to happen that the SIGCHLD
4256 got lost. So raise the signl again just in case.
4257 It can't hurt. */
4258 else if (nread == -1 && errno == EIO)
4259 kill (getpid (), SIGCHLD);
4260 #endif /* HAVE_PTYS */
4261 /* If we can detect process termination, don't consider the process
4262 gone just because its pipe is closed. */
4263 #ifdef SIGCHLD
4264 else if (nread == 0 && !NETCONN_P (proc))
4266 #endif
4267 else
4269 /* Preserve status of processes already terminated. */
4270 XSETINT (XPROCESS (proc)->tick, ++process_tick);
4271 deactivate_process (proc);
4272 if (!NILP (XPROCESS (proc)->raw_status_low))
4273 update_status (XPROCESS (proc));
4274 if (EQ (XPROCESS (proc)->status, Qrun))
4275 XPROCESS (proc)->status
4276 = Fcons (Qexit, Fcons (make_number (256), Qnil));
4279 #ifdef NON_BLOCKING_CONNECT
4280 if (check_connect && FD_ISSET (channel, &Connecting))
4282 struct Lisp_Process *p;
4284 FD_CLR (channel, &connect_wait_mask);
4285 if (--num_pending_connects < 0)
4286 abort ();
4288 proc = chan_process[channel];
4289 if (NILP (proc))
4290 continue;
4292 p = XPROCESS (proc);
4294 #ifdef GNU_LINUX
4295 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4296 So only use it on systems where it is known to work. */
4298 int xlen = sizeof(xerrno);
4299 if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
4300 xerrno = errno;
4302 #else
4304 struct sockaddr pname;
4305 int pnamelen = sizeof(pname);
4307 /* If connection failed, getpeername will fail. */
4308 xerrno = 0;
4309 if (getpeername(channel, &pname, &pnamelen) < 0)
4311 /* Obtain connect failure code through error slippage. */
4312 char dummy;
4313 xerrno = errno;
4314 if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
4315 xerrno = errno;
4318 #endif
4319 if (xerrno)
4321 XSETINT (p->tick, ++process_tick);
4322 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
4323 deactivate_process (proc);
4325 else
4327 p->status = Qrun;
4328 /* Execute the sentinel here. If we had relied on
4329 status_notify to do it later, it will read input
4330 from the process before calling the sentinel. */
4331 exec_sentinel (proc, build_string ("open\n"));
4332 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
4334 FD_SET (XINT (p->infd), &input_wait_mask);
4335 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
4339 #endif /* NON_BLOCKING_CONNECT */
4340 } /* end for each file descriptor */
4341 } /* end while exit conditions not met */
4343 waiting_for_user_input_p = 0;
4345 /* If calling from keyboard input, do not quit
4346 since we want to return C-g as an input character.
4347 Otherwise, do pending quit if requested. */
4348 if (XINT (read_kbd) >= 0)
4350 /* Prevent input_pending from remaining set if we quit. */
4351 clear_input_pending ();
4352 QUIT;
4354 #ifdef hpux
4355 /* AlainF 5-Jul-1996
4356 HP-UX 10.10 seems to have problems with signals coming in
4357 Causes "poll: interrupted system call" messages when Emacs is run
4358 in an X window
4359 Turn periodic alarms back on */
4360 start_polling ();
4361 #endif
4363 return got_some_input;
4366 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4368 static Lisp_Object
4369 read_process_output_call (fun_and_args)
4370 Lisp_Object fun_and_args;
4372 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
4375 static Lisp_Object
4376 read_process_output_error_handler (error)
4377 Lisp_Object error;
4379 cmd_error_internal (error, "error in process filter: ");
4380 Vinhibit_quit = Qt;
4381 update_echo_area ();
4382 Fsleep_for (make_number (2), Qnil);
4383 return Qt;
4386 /* Read pending output from the process channel,
4387 starting with our buffered-ahead character if we have one.
4388 Yield number of decoded characters read.
4390 This function reads at most 1024 characters.
4391 If you want to read all available subprocess output,
4392 you must call it repeatedly until it returns zero.
4394 The characters read are decoded according to PROC's coding-system
4395 for decoding. */
4398 read_process_output (proc, channel)
4399 Lisp_Object proc;
4400 register int channel;
4402 register int nchars, nbytes;
4403 char *chars;
4404 register Lisp_Object outstream;
4405 register struct buffer *old = current_buffer;
4406 register struct Lisp_Process *p = XPROCESS (proc);
4407 register int opoint;
4408 struct coding_system *coding = proc_decode_coding_system[channel];
4409 int carryover = XINT (p->decoding_carryover);
4410 int readmax = 1024;
4412 #ifdef VMS
4413 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
4415 vs = get_vms_process_pointer (p->pid);
4416 if (vs)
4418 if (!vs->iosb[0])
4419 return (0); /* Really weird if it does this */
4420 if (!(vs->iosb[0] & 1))
4421 return -1; /* I/O error */
4423 else
4424 error ("Could not get VMS process pointer");
4425 chars = vs->inputBuffer;
4426 nbytes = clean_vms_buffer (chars, vs->iosb[1]);
4427 if (nbytes <= 0)
4429 start_vms_process_read (vs); /* Crank up the next read on the process */
4430 return 1; /* Nothing worth printing, say we got 1 */
4432 if (carryover > 0)
4434 /* The data carried over in the previous decoding (which are at
4435 the tail of decoding buffer) should be prepended to the new
4436 data read to decode all together. */
4437 chars = (char *) alloca (nbytes + carryover);
4438 bcopy (SDATA (p->decoding_buf), buf, carryover);
4439 bcopy (vs->inputBuffer, chars + carryover, nbytes);
4441 #else /* not VMS */
4443 #ifdef DATAGRAM_SOCKETS
4444 /* A datagram is one packet; allow at least 1500+ bytes of data
4445 corresponding to the typical Ethernet frame size. */
4446 if (DATAGRAM_CHAN_P (channel))
4448 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4449 readmax += 1024;
4451 #endif
4453 chars = (char *) alloca (carryover + readmax);
4454 if (carryover)
4455 /* See the comment above. */
4456 bcopy (SDATA (p->decoding_buf), chars, carryover);
4458 #ifdef DATAGRAM_SOCKETS
4459 /* We have a working select, so proc_buffered_char is always -1. */
4460 if (DATAGRAM_CHAN_P (channel))
4462 int len = datagram_address[channel].len;
4463 nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
4464 0, datagram_address[channel].sa, &len);
4466 else
4467 #endif
4468 if (proc_buffered_char[channel] < 0)
4469 nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
4470 else
4472 chars[carryover] = proc_buffered_char[channel];
4473 proc_buffered_char[channel] = -1;
4474 nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover);
4475 if (nbytes < 0)
4476 nbytes = 1;
4477 else
4478 nbytes = nbytes + 1;
4480 #endif /* not VMS */
4482 XSETINT (p->decoding_carryover, 0);
4484 /* At this point, NBYTES holds number of bytes just received
4485 (including the one in proc_buffered_char[channel]). */
4486 if (nbytes <= 0)
4488 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
4489 return nbytes;
4490 coding->mode |= CODING_MODE_LAST_BLOCK;
4493 /* Now set NBYTES how many bytes we must decode. */
4494 nbytes += carryover;
4496 /* Read and dispose of the process output. */
4497 outstream = p->filter;
4498 if (!NILP (outstream))
4500 /* We inhibit quit here instead of just catching it so that
4501 hitting ^G when a filter happens to be running won't screw
4502 it up. */
4503 int count = SPECPDL_INDEX ();
4504 Lisp_Object odeactivate;
4505 Lisp_Object obuffer, okeymap;
4506 Lisp_Object text;
4507 int outer_running_asynch_code = running_asynch_code;
4508 int waiting = waiting_for_user_input_p;
4510 /* No need to gcpro these, because all we do with them later
4511 is test them for EQness, and none of them should be a string. */
4512 odeactivate = Vdeactivate_mark;
4513 XSETBUFFER (obuffer, current_buffer);
4514 okeymap = current_buffer->keymap;
4516 specbind (Qinhibit_quit, Qt);
4517 specbind (Qlast_nonmenu_event, Qt);
4519 /* In case we get recursively called,
4520 and we already saved the match data nonrecursively,
4521 save the same match data in safely recursive fashion. */
4522 if (outer_running_asynch_code)
4524 Lisp_Object tem;
4525 /* Don't clobber the CURRENT match data, either! */
4526 tem = Fmatch_data (Qnil, Qnil);
4527 restore_match_data ();
4528 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
4529 Fset_match_data (tem);
4532 /* For speed, if a search happens within this code,
4533 save the match data in a special nonrecursive fashion. */
4534 running_asynch_code = 1;
4536 text = decode_coding_string (make_unibyte_string (chars, nbytes),
4537 coding, 0);
4538 Vlast_coding_system_used = coding->symbol;
4539 /* A new coding system might be found. */
4540 if (!EQ (p->decode_coding_system, coding->symbol))
4542 p->decode_coding_system = coding->symbol;
4544 /* Don't call setup_coding_system for
4545 proc_decode_coding_system[channel] here. It is done in
4546 detect_coding called via decode_coding above. */
4548 /* If a coding system for encoding is not yet decided, we set
4549 it as the same as coding-system for decoding.
4551 But, before doing that we must check if
4552 proc_encode_coding_system[p->outfd] surely points to a
4553 valid memory because p->outfd will be changed once EOF is
4554 sent to the process. */
4555 if (NILP (p->encode_coding_system)
4556 && proc_encode_coding_system[XINT (p->outfd)])
4558 p->encode_coding_system = coding->symbol;
4559 setup_coding_system (coding->symbol,
4560 proc_encode_coding_system[XINT (p->outfd)]);
4564 carryover = nbytes - coding->consumed;
4565 bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
4566 carryover);
4567 XSETINT (p->decoding_carryover, carryover);
4568 /* Adjust the multibyteness of TEXT to that of the filter. */
4569 if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text))
4570 text = (STRING_MULTIBYTE (text)
4571 ? Fstring_as_unibyte (text)
4572 : Fstring_to_multibyte (text));
4573 nbytes = SBYTES (text);
4574 nchars = SCHARS (text);
4575 if (nbytes > 0)
4576 internal_condition_case_1 (read_process_output_call,
4577 Fcons (outstream,
4578 Fcons (proc, Fcons (text, Qnil))),
4579 !NILP (Vdebug_on_error) ? Qnil : Qerror,
4580 read_process_output_error_handler);
4582 /* If we saved the match data nonrecursively, restore it now. */
4583 restore_match_data ();
4584 running_asynch_code = outer_running_asynch_code;
4586 /* Handling the process output should not deactivate the mark. */
4587 Vdeactivate_mark = odeactivate;
4589 /* Restore waiting_for_user_input_p as it was
4590 when we were called, in case the filter clobbered it. */
4591 waiting_for_user_input_p = waiting;
4593 #if 0 /* Call record_asynch_buffer_change unconditionally,
4594 because we might have changed minor modes or other things
4595 that affect key bindings. */
4596 if (! EQ (Fcurrent_buffer (), obuffer)
4597 || ! EQ (current_buffer->keymap, okeymap))
4598 #endif
4599 /* But do it only if the caller is actually going to read events.
4600 Otherwise there's no need to make him wake up, and it could
4601 cause trouble (for example it would make Fsit_for return). */
4602 if (waiting_for_user_input_p == -1)
4603 record_asynch_buffer_change ();
4605 #ifdef VMS
4606 start_vms_process_read (vs);
4607 #endif
4608 unbind_to (count, Qnil);
4609 return nchars;
4612 /* If no filter, write into buffer if it isn't dead. */
4613 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
4615 Lisp_Object old_read_only;
4616 int old_begv, old_zv;
4617 int old_begv_byte, old_zv_byte;
4618 Lisp_Object odeactivate;
4619 int before, before_byte;
4620 int opoint_byte;
4621 Lisp_Object text;
4622 struct buffer *b;
4624 odeactivate = Vdeactivate_mark;
4626 Fset_buffer (p->buffer);
4627 opoint = PT;
4628 opoint_byte = PT_BYTE;
4629 old_read_only = current_buffer->read_only;
4630 old_begv = BEGV;
4631 old_zv = ZV;
4632 old_begv_byte = BEGV_BYTE;
4633 old_zv_byte = ZV_BYTE;
4635 current_buffer->read_only = Qnil;
4637 /* Insert new output into buffer
4638 at the current end-of-output marker,
4639 thus preserving logical ordering of input and output. */
4640 if (XMARKER (p->mark)->buffer)
4641 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
4642 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
4643 ZV_BYTE));
4644 else
4645 SET_PT_BOTH (ZV, ZV_BYTE);
4646 before = PT;
4647 before_byte = PT_BYTE;
4649 /* If the output marker is outside of the visible region, save
4650 the restriction and widen. */
4651 if (! (BEGV <= PT && PT <= ZV))
4652 Fwiden ();
4654 text = decode_coding_string (make_unibyte_string (chars, nbytes),
4655 coding, 0);
4656 Vlast_coding_system_used = coding->symbol;
4657 /* A new coding system might be found. See the comment in the
4658 similar code in the previous `if' block. */
4659 if (!EQ (p->decode_coding_system, coding->symbol))
4661 p->decode_coding_system = coding->symbol;
4662 if (NILP (p->encode_coding_system)
4663 && proc_encode_coding_system[XINT (p->outfd)])
4665 p->encode_coding_system = coding->symbol;
4666 setup_coding_system (coding->symbol,
4667 proc_encode_coding_system[XINT (p->outfd)]);
4670 carryover = nbytes - coding->consumed;
4671 bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
4672 carryover);
4673 XSETINT (p->decoding_carryover, carryover);
4674 /* Adjust the multibyteness of TEXT to that of the buffer. */
4675 if (NILP (current_buffer->enable_multibyte_characters)
4676 != ! STRING_MULTIBYTE (text))
4677 text = (STRING_MULTIBYTE (text)
4678 ? Fstring_as_unibyte (text)
4679 : Fstring_to_multibyte (text));
4680 nbytes = SBYTES (text);
4681 nchars = SCHARS (text);
4682 /* Insert before markers in case we are inserting where
4683 the buffer's mark is, and the user's next command is Meta-y. */
4684 insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
4686 /* Make sure the process marker's position is valid when the
4687 process buffer is changed in the signal_after_change above.
4688 W3 is known to do that. */
4689 if (BUFFERP (p->buffer)
4690 && (b = XBUFFER (p->buffer), b != current_buffer))
4691 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
4692 else
4693 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
4695 update_mode_lines++;
4697 /* Make sure opoint and the old restrictions
4698 float ahead of any new text just as point would. */
4699 if (opoint >= before)
4701 opoint += PT - before;
4702 opoint_byte += PT_BYTE - before_byte;
4704 if (old_begv > before)
4706 old_begv += PT - before;
4707 old_begv_byte += PT_BYTE - before_byte;
4709 if (old_zv >= before)
4711 old_zv += PT - before;
4712 old_zv_byte += PT_BYTE - before_byte;
4715 /* If the restriction isn't what it should be, set it. */
4716 if (old_begv != BEGV || old_zv != ZV)
4717 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
4719 /* Handling the process output should not deactivate the mark. */
4720 Vdeactivate_mark = odeactivate;
4722 current_buffer->read_only = old_read_only;
4723 SET_PT_BOTH (opoint, opoint_byte);
4724 set_buffer_internal (old);
4726 #ifdef VMS
4727 start_vms_process_read (vs);
4728 #endif
4729 return nbytes;
4732 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
4733 0, 0, 0,
4734 doc: /* Returns non-nil if emacs is waiting for input from the user.
4735 This is intended for use by asynchronous process output filters and sentinels. */)
4738 return (waiting_for_user_input_p ? Qt : Qnil);
4741 /* Sending data to subprocess */
4743 jmp_buf send_process_frame;
4744 Lisp_Object process_sent_to;
4746 SIGTYPE
4747 send_process_trap ()
4749 #ifdef BSD4_1
4750 sigrelse (SIGPIPE);
4751 sigrelse (SIGALRM);
4752 #endif /* BSD4_1 */
4753 longjmp (send_process_frame, 1);
4756 /* Send some data to process PROC.
4757 BUF is the beginning of the data; LEN is the number of characters.
4758 OBJECT is the Lisp object that the data comes from. If OBJECT is
4759 nil or t, it means that the data comes from C string.
4761 If OBJECT is not nil, the data is encoded by PROC's coding-system
4762 for encoding before it is sent.
4764 This function can evaluate Lisp code and can garbage collect. */
4766 void
4767 send_process (proc, buf, len, object)
4768 volatile Lisp_Object proc;
4769 unsigned char *volatile buf;
4770 volatile int len;
4771 volatile Lisp_Object object;
4773 /* Use volatile to protect variables from being clobbered by longjmp. */
4774 int rv;
4775 struct coding_system *coding;
4776 struct gcpro gcpro1;
4778 GCPRO1 (object);
4780 #ifdef VMS
4781 struct Lisp_Process *p = XPROCESS (proc);
4782 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
4783 #endif /* VMS */
4785 if (! NILP (XPROCESS (proc)->raw_status_low))
4786 update_status (XPROCESS (proc));
4787 if (! EQ (XPROCESS (proc)->status, Qrun))
4788 error ("Process %s not running",
4789 SDATA (XPROCESS (proc)->name));
4790 if (XINT (XPROCESS (proc)->outfd) < 0)
4791 error ("Output file descriptor of %s is closed",
4792 SDATA (XPROCESS (proc)->name));
4794 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
4795 Vlast_coding_system_used = coding->symbol;
4797 if ((STRINGP (object) && STRING_MULTIBYTE (object))
4798 || (BUFFERP (object)
4799 && !NILP (XBUFFER (object)->enable_multibyte_characters))
4800 || EQ (object, Qt))
4802 if (!EQ (coding->symbol, XPROCESS (proc)->encode_coding_system))
4803 /* The coding system for encoding was changed to raw-text
4804 because we sent a unibyte text previously. Now we are
4805 sending a multibyte text, thus we must encode it by the
4806 original coding system specified for the current
4807 process. */
4808 setup_coding_system (XPROCESS (proc)->encode_coding_system, coding);
4809 /* src_multibyte should be set to 1 _after_ a call to
4810 setup_coding_system, since it resets src_multibyte to
4811 zero. */
4812 coding->src_multibyte = 1;
4814 else
4816 /* For sending a unibyte text, character code conversion should
4817 not take place but EOL conversion should. So, setup raw-text
4818 or one of the subsidiary if we have not yet done it. */
4819 if (coding->type != coding_type_raw_text)
4821 if (CODING_REQUIRE_FLUSHING (coding))
4823 /* But, before changing the coding, we must flush out data. */
4824 coding->mode |= CODING_MODE_LAST_BLOCK;
4825 send_process (proc, "", 0, Qt);
4827 coding->src_multibyte = 0;
4828 setup_raw_text_coding_system (coding);
4831 coding->dst_multibyte = 0;
4833 if (CODING_REQUIRE_ENCODING (coding))
4835 int require = encoding_buffer_size (coding, len);
4836 int from_byte = -1, from = -1, to = -1;
4837 unsigned char *temp_buf = NULL;
4839 if (BUFFERP (object))
4841 from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
4842 from = buf_bytepos_to_charpos (XBUFFER (object), from_byte);
4843 to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len);
4845 else if (STRINGP (object))
4847 from_byte = buf - SDATA (object);
4848 from = string_byte_to_char (object, from_byte);
4849 to = string_byte_to_char (object, from_byte + len);
4852 if (coding->composing != COMPOSITION_DISABLED)
4854 if (from_byte >= 0)
4855 coding_save_composition (coding, from, to, object);
4856 else
4857 coding->composing = COMPOSITION_DISABLED;
4860 if (SBYTES (XPROCESS (proc)->encoding_buf) < require)
4861 XPROCESS (proc)->encoding_buf = make_uninit_string (require);
4863 if (from_byte >= 0)
4864 buf = (BUFFERP (object)
4865 ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
4866 : SDATA (object) + from_byte);
4868 object = XPROCESS (proc)->encoding_buf;
4869 encode_coding (coding, (char *) buf, SDATA (object),
4870 len, SBYTES (object));
4871 len = coding->produced;
4872 buf = SDATA (object);
4873 if (temp_buf)
4874 xfree (temp_buf);
4877 #ifdef VMS
4878 vs = get_vms_process_pointer (p->pid);
4879 if (vs == 0)
4880 error ("Could not find this process: %x", p->pid);
4881 else if (write_to_vms_process (vs, buf, len))
4883 #else /* not VMS */
4885 if (pty_max_bytes == 0)
4887 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
4888 pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd),
4889 _PC_MAX_CANON);
4890 if (pty_max_bytes < 0)
4891 pty_max_bytes = 250;
4892 #else
4893 pty_max_bytes = 250;
4894 #endif
4895 /* Deduct one, to leave space for the eof. */
4896 pty_max_bytes--;
4899 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
4900 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
4901 when returning with longjmp despite being declared volatile. */
4902 if (!setjmp (send_process_frame))
4904 process_sent_to = proc;
4905 while (len > 0)
4907 int this = len;
4908 SIGTYPE (*old_sigpipe)();
4910 /* Decide how much data we can send in one batch.
4911 Long lines need to be split into multiple batches. */
4912 if (!NILP (XPROCESS (proc)->pty_flag))
4914 /* Starting this at zero is always correct when not the first
4915 iteration because the previous iteration ended by sending C-d.
4916 It may not be correct for the first iteration
4917 if a partial line was sent in a separate send_process call.
4918 If that proves worth handling, we need to save linepos
4919 in the process object. */
4920 int linepos = 0;
4921 unsigned char *ptr = (unsigned char *) buf;
4922 unsigned char *end = (unsigned char *) buf + len;
4924 /* Scan through this text for a line that is too long. */
4925 while (ptr != end && linepos < pty_max_bytes)
4927 if (*ptr == '\n')
4928 linepos = 0;
4929 else
4930 linepos++;
4931 ptr++;
4933 /* If we found one, break the line there
4934 and put in a C-d to force the buffer through. */
4935 this = ptr - buf;
4938 /* Send this batch, using one or more write calls. */
4939 while (this > 0)
4941 int outfd = XINT (XPROCESS (proc)->outfd);
4942 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
4943 #ifdef DATAGRAM_SOCKETS
4944 if (DATAGRAM_CHAN_P (outfd))
4946 rv = sendto (outfd, (char *) buf, this,
4947 0, datagram_address[outfd].sa,
4948 datagram_address[outfd].len);
4949 if (rv < 0 && errno == EMSGSIZE)
4950 report_file_error ("sending datagram", Fcons (proc, Qnil));
4952 else
4953 #endif
4954 rv = emacs_write (outfd, (char *) buf, this);
4955 signal (SIGPIPE, old_sigpipe);
4957 if (rv < 0)
4959 if (0
4960 #ifdef EWOULDBLOCK
4961 || errno == EWOULDBLOCK
4962 #endif
4963 #ifdef EAGAIN
4964 || errno == EAGAIN
4965 #endif
4967 /* Buffer is full. Wait, accepting input;
4968 that may allow the program
4969 to finish doing output and read more. */
4971 Lisp_Object zero;
4972 int offset = 0;
4974 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
4975 /* A gross hack to work around a bug in FreeBSD.
4976 In the following sequence, read(2) returns
4977 bogus data:
4979 write(2) 1022 bytes
4980 write(2) 954 bytes, get EAGAIN
4981 read(2) 1024 bytes in process_read_output
4982 read(2) 11 bytes in process_read_output
4984 That is, read(2) returns more bytes than have
4985 ever been written successfully. The 1033 bytes
4986 read are the 1022 bytes written successfully
4987 after processing (for example with CRs added if
4988 the terminal is set up that way which it is
4989 here). The same bytes will be seen again in a
4990 later read(2), without the CRs. */
4992 if (errno == EAGAIN)
4994 int flags = FWRITE;
4995 ioctl (XINT (XPROCESS (proc)->outfd), TIOCFLUSH,
4996 &flags);
4998 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5000 /* Running filters might relocate buffers or strings.
5001 Arrange to relocate BUF. */
5002 if (BUFFERP (object))
5003 offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
5004 else if (STRINGP (object))
5005 offset = buf - SDATA (object);
5007 XSETFASTINT (zero, 0);
5008 #ifdef EMACS_HAS_USECS
5009 wait_reading_process_input (0, 20000, zero, 0);
5010 #else
5011 wait_reading_process_input (1, 0, zero, 0);
5012 #endif
5014 if (BUFFERP (object))
5015 buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
5016 else if (STRINGP (object))
5017 buf = offset + SDATA (object);
5019 rv = 0;
5021 else
5022 /* This is a real error. */
5023 report_file_error ("writing to process", Fcons (proc, Qnil));
5025 buf += rv;
5026 len -= rv;
5027 this -= rv;
5030 /* If we sent just part of the string, put in an EOF
5031 to force it through, before we send the rest. */
5032 if (len > 0)
5033 Fprocess_send_eof (proc);
5036 #endif /* not VMS */
5037 else
5039 #ifndef VMS
5040 proc = process_sent_to;
5041 #endif
5042 XPROCESS (proc)->raw_status_low = Qnil;
5043 XPROCESS (proc)->raw_status_high = Qnil;
5044 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
5045 XSETINT (XPROCESS (proc)->tick, ++process_tick);
5046 deactivate_process (proc);
5047 #ifdef VMS
5048 error ("Error writing to process %s; closed it",
5049 SDATA (XPROCESS (proc)->name));
5050 #else
5051 error ("SIGPIPE raised on process %s; closed it",
5052 SDATA (XPROCESS (proc)->name));
5053 #endif
5056 UNGCPRO;
5059 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
5060 3, 3, 0,
5061 doc: /* Send current contents of region as input to PROCESS.
5062 PROCESS may be a process, a buffer, the name of a process or buffer, or
5063 nil, indicating the current buffer's process.
5064 Called from program, takes three arguments, PROCESS, START and END.
5065 If the region is more than 500 characters long,
5066 it is sent in several bunches. This may happen even for shorter regions.
5067 Output from processes can arrive in between bunches. */)
5068 (process, start, end)
5069 Lisp_Object process, start, end;
5071 Lisp_Object proc;
5072 int start1, end1;
5074 proc = get_process (process);
5075 validate_region (&start, &end);
5077 if (XINT (start) < GPT && XINT (end) > GPT)
5078 move_gap (XINT (start));
5080 start1 = CHAR_TO_BYTE (XINT (start));
5081 end1 = CHAR_TO_BYTE (XINT (end));
5082 send_process (proc, BYTE_POS_ADDR (start1), end1 - start1,
5083 Fcurrent_buffer ());
5085 return Qnil;
5088 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
5089 2, 2, 0,
5090 doc: /* Send PROCESS the contents of STRING as input.
5091 PROCESS may be a process, a buffer, the name of a process or buffer, or
5092 nil, indicating the current buffer's process.
5093 If STRING is more than 500 characters long,
5094 it is sent in several bunches. This may happen even for shorter strings.
5095 Output from processes can arrive in between bunches. */)
5096 (process, string)
5097 Lisp_Object process, string;
5099 Lisp_Object proc;
5100 CHECK_STRING (string);
5101 proc = get_process (process);
5102 send_process (proc, SDATA (string),
5103 SBYTES (string), string);
5104 return Qnil;
5107 DEFUN ("process-running-child-p", Fprocess_running_child_p,
5108 Sprocess_running_child_p, 0, 1, 0,
5109 doc: /* Return t if PROCESS has given the terminal to a child.
5110 If the operating system does not make it possible to find out,
5111 return t unconditionally. */)
5112 (process)
5113 Lisp_Object process;
5115 /* Initialize in case ioctl doesn't exist or gives an error,
5116 in a way that will cause returning t. */
5117 int gid = 0;
5118 Lisp_Object proc;
5119 struct Lisp_Process *p;
5121 proc = get_process (process);
5122 p = XPROCESS (proc);
5124 if (!EQ (p->childp, Qt))
5125 error ("Process %s is not a subprocess",
5126 SDATA (p->name));
5127 if (XINT (p->infd) < 0)
5128 error ("Process %s is not active",
5129 SDATA (p->name));
5131 #ifdef TIOCGPGRP
5132 if (!NILP (p->subtty))
5133 ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
5134 else
5135 ioctl (XINT (p->infd), TIOCGPGRP, &gid);
5136 #endif /* defined (TIOCGPGRP ) */
5138 if (gid == XFASTINT (p->pid))
5139 return Qnil;
5140 return Qt;
5143 /* send a signal number SIGNO to PROCESS.
5144 If CURRENT_GROUP is t, that means send to the process group
5145 that currently owns the terminal being used to communicate with PROCESS.
5146 This is used for various commands in shell mode.
5147 If CURRENT_GROUP is lambda, that means send to the process group
5148 that currently owns the terminal, but only if it is NOT the shell itself.
5150 If NOMSG is zero, insert signal-announcements into process's buffers
5151 right away.
5153 If we can, we try to signal PROCESS by sending control characters
5154 down the pty. This allows us to signal inferiors who have changed
5155 their uid, for which killpg would return an EPERM error. */
5157 static void
5158 process_send_signal (process, signo, current_group, nomsg)
5159 Lisp_Object process;
5160 int signo;
5161 Lisp_Object current_group;
5162 int nomsg;
5164 Lisp_Object proc;
5165 register struct Lisp_Process *p;
5166 int gid;
5167 int no_pgrp = 0;
5169 proc = get_process (process);
5170 p = XPROCESS (proc);
5172 if (!EQ (p->childp, Qt))
5173 error ("Process %s is not a subprocess",
5174 SDATA (p->name));
5175 if (XINT (p->infd) < 0)
5176 error ("Process %s is not active",
5177 SDATA (p->name));
5179 if (NILP (p->pty_flag))
5180 current_group = Qnil;
5182 /* If we are using pgrps, get a pgrp number and make it negative. */
5183 if (NILP (current_group))
5184 /* Send the signal to the shell's process group. */
5185 gid = XFASTINT (p->pid);
5186 else
5188 #ifdef SIGNALS_VIA_CHARACTERS
5189 /* If possible, send signals to the entire pgrp
5190 by sending an input character to it. */
5192 /* TERMIOS is the latest and bestest, and seems most likely to
5193 work. If the system has it, use it. */
5194 #ifdef HAVE_TERMIOS
5195 struct termios t;
5197 switch (signo)
5199 case SIGINT:
5200 tcgetattr (XINT (p->infd), &t);
5201 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
5202 return;
5204 case SIGQUIT:
5205 tcgetattr (XINT (p->infd), &t);
5206 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
5207 return;
5209 case SIGTSTP:
5210 tcgetattr (XINT (p->infd), &t);
5211 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5212 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
5213 #else
5214 send_process (proc, &t.c_cc[VSUSP], 1, Qnil);
5215 #endif
5216 return;
5219 #else /* ! HAVE_TERMIOS */
5221 /* On Berkeley descendants, the following IOCTL's retrieve the
5222 current control characters. */
5223 #if defined (TIOCGLTC) && defined (TIOCGETC)
5225 struct tchars c;
5226 struct ltchars lc;
5228 switch (signo)
5230 case SIGINT:
5231 ioctl (XINT (p->infd), TIOCGETC, &c);
5232 send_process (proc, &c.t_intrc, 1, Qnil);
5233 return;
5234 case SIGQUIT:
5235 ioctl (XINT (p->infd), TIOCGETC, &c);
5236 send_process (proc, &c.t_quitc, 1, Qnil);
5237 return;
5238 #ifdef SIGTSTP
5239 case SIGTSTP:
5240 ioctl (XINT (p->infd), TIOCGLTC, &lc);
5241 send_process (proc, &lc.t_suspc, 1, Qnil);
5242 return;
5243 #endif /* ! defined (SIGTSTP) */
5246 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5248 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5249 characters. */
5250 #ifdef TCGETA
5251 struct termio t;
5252 switch (signo)
5254 case SIGINT:
5255 ioctl (XINT (p->infd), TCGETA, &t);
5256 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
5257 return;
5258 case SIGQUIT:
5259 ioctl (XINT (p->infd), TCGETA, &t);
5260 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
5261 return;
5262 #ifdef SIGTSTP
5263 case SIGTSTP:
5264 ioctl (XINT (p->infd), TCGETA, &t);
5265 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
5266 return;
5267 #endif /* ! defined (SIGTSTP) */
5269 #else /* ! defined (TCGETA) */
5270 Your configuration files are messed up.
5271 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5272 you'd better be using one of the alternatives above! */
5273 #endif /* ! defined (TCGETA) */
5274 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5275 #endif /* ! defined HAVE_TERMIOS */
5276 abort ();
5277 /* The code above always returns from the function. */
5278 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5280 #ifdef TIOCGPGRP
5281 /* Get the current pgrp using the tty itself, if we have that.
5282 Otherwise, use the pty to get the pgrp.
5283 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5284 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5285 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5286 His patch indicates that if TIOCGPGRP returns an error, then
5287 we should just assume that p->pid is also the process group id. */
5289 int err;
5291 if (!NILP (p->subtty))
5292 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
5293 else
5294 err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
5296 if (err == -1)
5297 /* If we can't get the information, assume
5298 the shell owns the tty. */
5299 gid = XFASTINT (p->pid);
5302 /* It is not clear whether anything really can set GID to -1.
5303 Perhaps on some system one of those ioctls can or could do so.
5304 Or perhaps this is vestigial. */
5305 if (gid == -1)
5306 no_pgrp = 1;
5307 #else /* ! defined (TIOCGPGRP ) */
5308 /* Can't select pgrps on this system, so we know that
5309 the child itself heads the pgrp. */
5310 gid = XFASTINT (p->pid);
5311 #endif /* ! defined (TIOCGPGRP ) */
5313 /* If current_group is lambda, and the shell owns the terminal,
5314 don't send any signal. */
5315 if (EQ (current_group, Qlambda) && gid == XFASTINT (p->pid))
5316 return;
5319 switch (signo)
5321 #ifdef SIGCONT
5322 case SIGCONT:
5323 p->raw_status_low = Qnil;
5324 p->raw_status_high = Qnil;
5325 p->status = Qrun;
5326 XSETINT (p->tick, ++process_tick);
5327 if (!nomsg)
5328 status_notify ();
5329 break;
5330 #endif /* ! defined (SIGCONT) */
5331 case SIGINT:
5332 #ifdef VMS
5333 send_process (proc, "\003", 1, Qnil); /* ^C */
5334 goto whoosh;
5335 #endif
5336 case SIGQUIT:
5337 #ifdef VMS
5338 send_process (proc, "\031", 1, Qnil); /* ^Y */
5339 goto whoosh;
5340 #endif
5341 case SIGKILL:
5342 #ifdef VMS
5343 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
5344 whoosh:
5345 #endif
5346 flush_pending_output (XINT (p->infd));
5347 break;
5350 /* If we don't have process groups, send the signal to the immediate
5351 subprocess. That isn't really right, but it's better than any
5352 obvious alternative. */
5353 if (no_pgrp)
5355 kill (XFASTINT (p->pid), signo);
5356 return;
5359 /* gid may be a pid, or minus a pgrp's number */
5360 #ifdef TIOCSIGSEND
5361 if (!NILP (current_group))
5362 ioctl (XINT (p->infd), TIOCSIGSEND, signo);
5363 else
5365 gid = - XFASTINT (p->pid);
5366 kill (gid, signo);
5368 #else /* ! defined (TIOCSIGSEND) */
5369 EMACS_KILLPG (gid, signo);
5370 #endif /* ! defined (TIOCSIGSEND) */
5373 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
5374 doc: /* Interrupt process PROCESS.
5375 PROCESS may be a process, a buffer, or the name of a process or buffer.
5376 nil or no arg means current buffer's process.
5377 Second arg CURRENT-GROUP non-nil means send signal to
5378 the current process-group of the process's controlling terminal
5379 rather than to the process's own process group.
5380 If the process is a shell, this means interrupt current subjob
5381 rather than the shell.
5383 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5384 don't send the signal. */)
5385 (process, current_group)
5386 Lisp_Object process, current_group;
5388 process_send_signal (process, SIGINT, current_group, 0);
5389 return process;
5392 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
5393 doc: /* Kill process PROCESS. May be process or name of one.
5394 See function `interrupt-process' for more details on usage. */)
5395 (process, current_group)
5396 Lisp_Object process, current_group;
5398 process_send_signal (process, SIGKILL, current_group, 0);
5399 return process;
5402 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
5403 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
5404 See function `interrupt-process' for more details on usage. */)
5405 (process, current_group)
5406 Lisp_Object process, current_group;
5408 process_send_signal (process, SIGQUIT, current_group, 0);
5409 return process;
5412 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
5413 doc: /* Stop process PROCESS. May be process or name of one.
5414 See function `interrupt-process' for more details on usage.
5415 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5416 (process, current_group)
5417 Lisp_Object process, current_group;
5419 #ifdef HAVE_SOCKETS
5420 if (PROCESSP (process) && NETCONN_P (process))
5422 struct Lisp_Process *p;
5424 p = XPROCESS (process);
5425 if (NILP (p->command)
5426 && XINT (p->infd) >= 0)
5428 FD_CLR (XINT (p->infd), &input_wait_mask);
5429 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
5431 p->command = Qt;
5432 return process;
5434 #endif
5435 #ifndef SIGTSTP
5436 error ("no SIGTSTP support");
5437 #else
5438 process_send_signal (process, SIGTSTP, current_group, 0);
5439 #endif
5440 return process;
5443 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
5444 doc: /* Continue process PROCESS. May be process or name of one.
5445 See function `interrupt-process' for more details on usage.
5446 If PROCESS is a network process, resume handling of incoming traffic. */)
5447 (process, current_group)
5448 Lisp_Object process, current_group;
5450 #ifdef HAVE_SOCKETS
5451 if (PROCESSP (process) && NETCONN_P (process))
5453 struct Lisp_Process *p;
5455 p = XPROCESS (process);
5456 if (EQ (p->command, Qt)
5457 && XINT (p->infd) >= 0
5458 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
5460 FD_SET (XINT (p->infd), &input_wait_mask);
5461 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
5463 p->command = Qnil;
5464 return process;
5466 #endif
5467 #ifdef SIGCONT
5468 process_send_signal (process, SIGCONT, current_group, 0);
5469 #else
5470 error ("no SIGCONT support");
5471 #endif
5472 return process;
5475 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
5476 2, 2, "sProcess (name or number): \nnSignal code: ",
5477 doc: /* Send PROCESS the signal with code SIGCODE.
5478 PROCESS may also be an integer specifying the process id of the
5479 process to signal; in this case, the process need not be a child of
5480 this Emacs.
5481 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5482 (process, sigcode)
5483 Lisp_Object process, sigcode;
5485 Lisp_Object pid;
5487 if (INTEGERP (process))
5489 pid = process;
5490 goto got_it;
5493 if (STRINGP (process))
5495 Lisp_Object tem;
5496 if (tem = Fget_process (process), NILP (tem))
5498 pid = Fstring_to_number (process, make_number (10));
5499 if (XINT (pid) != 0)
5500 goto got_it;
5502 process = tem;
5504 else
5505 process = get_process (process);
5507 if (NILP (process))
5508 return process;
5510 CHECK_PROCESS (process);
5511 pid = XPROCESS (process)->pid;
5512 if (!INTEGERP (pid) || XINT (pid) <= 0)
5513 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
5515 got_it:
5517 #define handle_signal(NAME, VALUE) \
5518 else if (!strcmp (name, NAME)) \
5519 XSETINT (sigcode, VALUE)
5521 if (INTEGERP (sigcode))
5523 else
5525 unsigned char *name;
5527 CHECK_SYMBOL (sigcode);
5528 name = SDATA (SYMBOL_NAME (sigcode));
5530 if (0)
5532 #ifdef SIGHUP
5533 handle_signal ("SIGHUP", SIGHUP);
5534 #endif
5535 #ifdef SIGINT
5536 handle_signal ("SIGINT", SIGINT);
5537 #endif
5538 #ifdef SIGQUIT
5539 handle_signal ("SIGQUIT", SIGQUIT);
5540 #endif
5541 #ifdef SIGILL
5542 handle_signal ("SIGILL", SIGILL);
5543 #endif
5544 #ifdef SIGABRT
5545 handle_signal ("SIGABRT", SIGABRT);
5546 #endif
5547 #ifdef SIGEMT
5548 handle_signal ("SIGEMT", SIGEMT);
5549 #endif
5550 #ifdef SIGKILL
5551 handle_signal ("SIGKILL", SIGKILL);
5552 #endif
5553 #ifdef SIGFPE
5554 handle_signal ("SIGFPE", SIGFPE);
5555 #endif
5556 #ifdef SIGBUS
5557 handle_signal ("SIGBUS", SIGBUS);
5558 #endif
5559 #ifdef SIGSEGV
5560 handle_signal ("SIGSEGV", SIGSEGV);
5561 #endif
5562 #ifdef SIGSYS
5563 handle_signal ("SIGSYS", SIGSYS);
5564 #endif
5565 #ifdef SIGPIPE
5566 handle_signal ("SIGPIPE", SIGPIPE);
5567 #endif
5568 #ifdef SIGALRM
5569 handle_signal ("SIGALRM", SIGALRM);
5570 #endif
5571 #ifdef SIGTERM
5572 handle_signal ("SIGTERM", SIGTERM);
5573 #endif
5574 #ifdef SIGURG
5575 handle_signal ("SIGURG", SIGURG);
5576 #endif
5577 #ifdef SIGSTOP
5578 handle_signal ("SIGSTOP", SIGSTOP);
5579 #endif
5580 #ifdef SIGTSTP
5581 handle_signal ("SIGTSTP", SIGTSTP);
5582 #endif
5583 #ifdef SIGCONT
5584 handle_signal ("SIGCONT", SIGCONT);
5585 #endif
5586 #ifdef SIGCHLD
5587 handle_signal ("SIGCHLD", SIGCHLD);
5588 #endif
5589 #ifdef SIGTTIN
5590 handle_signal ("SIGTTIN", SIGTTIN);
5591 #endif
5592 #ifdef SIGTTOU
5593 handle_signal ("SIGTTOU", SIGTTOU);
5594 #endif
5595 #ifdef SIGIO
5596 handle_signal ("SIGIO", SIGIO);
5597 #endif
5598 #ifdef SIGXCPU
5599 handle_signal ("SIGXCPU", SIGXCPU);
5600 #endif
5601 #ifdef SIGXFSZ
5602 handle_signal ("SIGXFSZ", SIGXFSZ);
5603 #endif
5604 #ifdef SIGVTALRM
5605 handle_signal ("SIGVTALRM", SIGVTALRM);
5606 #endif
5607 #ifdef SIGPROF
5608 handle_signal ("SIGPROF", SIGPROF);
5609 #endif
5610 #ifdef SIGWINCH
5611 handle_signal ("SIGWINCH", SIGWINCH);
5612 #endif
5613 #ifdef SIGINFO
5614 handle_signal ("SIGINFO", SIGINFO);
5615 #endif
5616 #ifdef SIGUSR1
5617 handle_signal ("SIGUSR1", SIGUSR1);
5618 #endif
5619 #ifdef SIGUSR2
5620 handle_signal ("SIGUSR2", SIGUSR2);
5621 #endif
5622 else
5623 error ("Undefined signal name %s", name);
5626 #undef handle_signal
5628 return make_number (kill (XINT (pid), XINT (sigcode)));
5631 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
5632 doc: /* Make PROCESS see end-of-file in its input.
5633 EOF comes after any text already sent to it.
5634 PROCESS may be a process, a buffer, the name of a process or buffer, or
5635 nil, indicating the current buffer's process.
5636 If PROCESS is a network connection, or is a process communicating
5637 through a pipe (as opposed to a pty), then you cannot send any more
5638 text to PROCESS after you call this function. */)
5639 (process)
5640 Lisp_Object process;
5642 Lisp_Object proc;
5643 struct coding_system *coding;
5645 if (DATAGRAM_CONN_P (process))
5646 return process;
5648 proc = get_process (process);
5649 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
5651 /* Make sure the process is really alive. */
5652 if (! NILP (XPROCESS (proc)->raw_status_low))
5653 update_status (XPROCESS (proc));
5654 if (! EQ (XPROCESS (proc)->status, Qrun))
5655 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
5657 if (CODING_REQUIRE_FLUSHING (coding))
5659 coding->mode |= CODING_MODE_LAST_BLOCK;
5660 send_process (proc, "", 0, Qnil);
5663 #ifdef VMS
5664 send_process (proc, "\032", 1, Qnil); /* ^z */
5665 #else
5666 if (!NILP (XPROCESS (proc)->pty_flag))
5667 send_process (proc, "\004", 1, Qnil);
5668 else
5670 int old_outfd, new_outfd;
5672 #ifdef HAVE_SHUTDOWN
5673 /* If this is a network connection, or socketpair is used
5674 for communication with the subprocess, call shutdown to cause EOF.
5675 (In some old system, shutdown to socketpair doesn't work.
5676 Then we just can't win.) */
5677 if (NILP (XPROCESS (proc)->pid)
5678 || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd))
5679 shutdown (XINT (XPROCESS (proc)->outfd), 1);
5680 /* In case of socketpair, outfd == infd, so don't close it. */
5681 if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd))
5682 emacs_close (XINT (XPROCESS (proc)->outfd));
5683 #else /* not HAVE_SHUTDOWN */
5684 emacs_close (XINT (XPROCESS (proc)->outfd));
5685 #endif /* not HAVE_SHUTDOWN */
5686 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
5687 old_outfd = XINT (XPROCESS (proc)->outfd);
5689 if (!proc_encode_coding_system[new_outfd])
5690 proc_encode_coding_system[new_outfd]
5691 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
5692 bcopy (proc_encode_coding_system[old_outfd],
5693 proc_encode_coding_system[new_outfd],
5694 sizeof (struct coding_system));
5695 bzero (proc_encode_coding_system[old_outfd],
5696 sizeof (struct coding_system));
5698 XSETINT (XPROCESS (proc)->outfd, new_outfd);
5700 #endif /* VMS */
5701 return process;
5704 /* Kill all processes associated with `buffer'.
5705 If `buffer' is nil, kill all processes */
5707 void
5708 kill_buffer_processes (buffer)
5709 Lisp_Object buffer;
5711 Lisp_Object tail, proc;
5713 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
5715 proc = XCDR (XCAR (tail));
5716 if (GC_PROCESSP (proc)
5717 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
5719 if (NETCONN_P (proc))
5720 Fdelete_process (proc);
5721 else if (XINT (XPROCESS (proc)->infd) >= 0)
5722 process_send_signal (proc, SIGHUP, Qnil, 1);
5727 /* On receipt of a signal that a child status has changed, loop asking
5728 about children with changed statuses until the system says there
5729 are no more.
5731 All we do is change the status; we do not run sentinels or print
5732 notifications. That is saved for the next time keyboard input is
5733 done, in order to avoid timing errors.
5735 ** WARNING: this can be called during garbage collection.
5736 Therefore, it must not be fooled by the presence of mark bits in
5737 Lisp objects.
5739 ** USG WARNING: Although it is not obvious from the documentation
5740 in signal(2), on a USG system the SIGCLD handler MUST NOT call
5741 signal() before executing at least one wait(), otherwise the
5742 handler will be called again, resulting in an infinite loop. The
5743 relevant portion of the documentation reads "SIGCLD signals will be
5744 queued and the signal-catching function will be continually
5745 reentered until the queue is empty". Invoking signal() causes the
5746 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
5747 Inc. */
5749 SIGTYPE
5750 sigchld_handler (signo)
5751 int signo;
5753 int old_errno = errno;
5754 Lisp_Object proc;
5755 register struct Lisp_Process *p;
5756 extern EMACS_TIME *input_available_clear_time;
5758 #ifdef BSD4_1
5759 extern int sigheld;
5760 sigheld |= sigbit (SIGCHLD);
5761 #endif
5763 while (1)
5765 register int pid;
5766 WAITTYPE w;
5767 Lisp_Object tail;
5769 #ifdef WNOHANG
5770 #ifndef WUNTRACED
5771 #define WUNTRACED 0
5772 #endif /* no WUNTRACED */
5773 /* Keep trying to get a status until we get a definitive result. */
5776 errno = 0;
5777 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
5779 while (pid < 0 && errno == EINTR);
5781 if (pid <= 0)
5783 /* PID == 0 means no processes found, PID == -1 means a real
5784 failure. We have done all our job, so return. */
5786 /* USG systems forget handlers when they are used;
5787 must reestablish each time */
5788 #if defined (USG) && !defined (POSIX_SIGNALS)
5789 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
5790 #endif
5791 #ifdef BSD4_1
5792 sigheld &= ~sigbit (SIGCHLD);
5793 sigrelse (SIGCHLD);
5794 #endif
5795 errno = old_errno;
5796 return;
5798 #else
5799 pid = wait (&w);
5800 #endif /* no WNOHANG */
5802 /* Find the process that signaled us, and record its status. */
5804 p = 0;
5805 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
5807 proc = XCDR (XCAR (tail));
5808 p = XPROCESS (proc);
5809 if (GC_EQ (p->childp, Qt) && XINT (p->pid) == pid)
5810 break;
5811 p = 0;
5814 /* Look for an asynchronous process whose pid hasn't been filled
5815 in yet. */
5816 if (p == 0)
5817 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
5819 proc = XCDR (XCAR (tail));
5820 p = XPROCESS (proc);
5821 if (GC_INTEGERP (p->pid) && XINT (p->pid) == -1)
5822 break;
5823 p = 0;
5826 /* Change the status of the process that was found. */
5827 if (p != 0)
5829 union { int i; WAITTYPE wt; } u;
5830 int clear_desc_flag = 0;
5832 XSETINT (p->tick, ++process_tick);
5833 u.wt = w;
5834 XSETINT (p->raw_status_low, u.i & 0xffff);
5835 XSETINT (p->raw_status_high, u.i >> 16);
5837 /* If process has terminated, stop waiting for its output. */
5838 if ((WIFSIGNALED (w) || WIFEXITED (w))
5839 && XINT (p->infd) >= 0)
5840 clear_desc_flag = 1;
5842 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
5843 if (clear_desc_flag)
5845 FD_CLR (XINT (p->infd), &input_wait_mask);
5846 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
5849 /* Tell wait_reading_process_input that it needs to wake up and
5850 look around. */
5851 if (input_available_clear_time)
5852 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
5855 /* There was no asynchronous process found for that id. Check
5856 if we have a synchronous process. */
5857 else
5859 synch_process_alive = 0;
5861 /* Report the status of the synchronous process. */
5862 if (WIFEXITED (w))
5863 synch_process_retcode = WRETCODE (w);
5864 else if (WIFSIGNALED (w))
5866 int code = WTERMSIG (w);
5867 char *signame;
5869 synchronize_system_messages_locale ();
5870 signame = strsignal (code);
5872 if (signame == 0)
5873 signame = "unknown";
5875 synch_process_death = signame;
5878 /* Tell wait_reading_process_input that it needs to wake up and
5879 look around. */
5880 if (input_available_clear_time)
5881 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
5884 /* On some systems, we must return right away.
5885 If any more processes want to signal us, we will
5886 get another signal.
5887 Otherwise (on systems that have WNOHANG), loop around
5888 to use up all the processes that have something to tell us. */
5889 #if (defined WINDOWSNT \
5890 || (defined USG && !defined GNU_LINUX \
5891 && !(defined HPUX && defined WNOHANG)))
5892 #if defined (USG) && ! defined (POSIX_SIGNALS)
5893 signal (signo, sigchld_handler);
5894 #endif
5895 errno = old_errno;
5896 return;
5897 #endif /* USG, but not HPUX with WNOHANG */
5902 static Lisp_Object
5903 exec_sentinel_unwind (data)
5904 Lisp_Object data;
5906 XPROCESS (XCAR (data))->sentinel = XCDR (data);
5907 return Qnil;
5910 static Lisp_Object
5911 exec_sentinel_error_handler (error)
5912 Lisp_Object error;
5914 cmd_error_internal (error, "error in process sentinel: ");
5915 Vinhibit_quit = Qt;
5916 update_echo_area ();
5917 Fsleep_for (make_number (2), Qnil);
5918 return Qt;
5921 static void
5922 exec_sentinel (proc, reason)
5923 Lisp_Object proc, reason;
5925 Lisp_Object sentinel, obuffer, odeactivate, okeymap;
5926 register struct Lisp_Process *p = XPROCESS (proc);
5927 int count = SPECPDL_INDEX ();
5928 int outer_running_asynch_code = running_asynch_code;
5929 int waiting = waiting_for_user_input_p;
5931 /* No need to gcpro these, because all we do with them later
5932 is test them for EQness, and none of them should be a string. */
5933 odeactivate = Vdeactivate_mark;
5934 XSETBUFFER (obuffer, current_buffer);
5935 okeymap = current_buffer->keymap;
5937 sentinel = p->sentinel;
5938 if (NILP (sentinel))
5939 return;
5941 /* Zilch the sentinel while it's running, to avoid recursive invocations;
5942 assure that it gets restored no matter how the sentinel exits. */
5943 p->sentinel = Qnil;
5944 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
5945 /* Inhibit quit so that random quits don't screw up a running filter. */
5946 specbind (Qinhibit_quit, Qt);
5947 specbind (Qlast_nonmenu_event, Qt);
5949 /* In case we get recursively called,
5950 and we already saved the match data nonrecursively,
5951 save the same match data in safely recursive fashion. */
5952 if (outer_running_asynch_code)
5954 Lisp_Object tem;
5955 tem = Fmatch_data (Qnil, Qnil);
5956 restore_match_data ();
5957 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
5958 Fset_match_data (tem);
5961 /* For speed, if a search happens within this code,
5962 save the match data in a special nonrecursive fashion. */
5963 running_asynch_code = 1;
5965 internal_condition_case_1 (read_process_output_call,
5966 Fcons (sentinel,
5967 Fcons (proc, Fcons (reason, Qnil))),
5968 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5969 exec_sentinel_error_handler);
5971 /* If we saved the match data nonrecursively, restore it now. */
5972 restore_match_data ();
5973 running_asynch_code = outer_running_asynch_code;
5975 Vdeactivate_mark = odeactivate;
5977 /* Restore waiting_for_user_input_p as it was
5978 when we were called, in case the filter clobbered it. */
5979 waiting_for_user_input_p = waiting;
5981 #if 0
5982 if (! EQ (Fcurrent_buffer (), obuffer)
5983 || ! EQ (current_buffer->keymap, okeymap))
5984 #endif
5985 /* But do it only if the caller is actually going to read events.
5986 Otherwise there's no need to make him wake up, and it could
5987 cause trouble (for example it would make Fsit_for return). */
5988 if (waiting_for_user_input_p == -1)
5989 record_asynch_buffer_change ();
5991 unbind_to (count, Qnil);
5994 /* Report all recent events of a change in process status
5995 (either run the sentinel or output a message).
5996 This is usually done while Emacs is waiting for keyboard input
5997 but can be done at other times. */
5999 void
6000 status_notify ()
6002 register Lisp_Object proc, buffer;
6003 Lisp_Object tail, msg;
6004 struct gcpro gcpro1, gcpro2;
6006 tail = Qnil;
6007 msg = Qnil;
6008 /* We need to gcpro tail; if read_process_output calls a filter
6009 which deletes a process and removes the cons to which tail points
6010 from Vprocess_alist, and then causes a GC, tail is an unprotected
6011 reference. */
6012 GCPRO2 (tail, msg);
6014 /* Set this now, so that if new processes are created by sentinels
6015 that we run, we get called again to handle their status changes. */
6016 update_tick = process_tick;
6018 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
6020 Lisp_Object symbol;
6021 register struct Lisp_Process *p;
6023 proc = Fcdr (Fcar (tail));
6024 p = XPROCESS (proc);
6026 if (XINT (p->tick) != XINT (p->update_tick))
6028 XSETINT (p->update_tick, XINT (p->tick));
6030 /* If process is still active, read any output that remains. */
6031 while (! EQ (p->filter, Qt)
6032 && ! EQ (p->status, Qconnect)
6033 && ! EQ (p->status, Qlisten)
6034 && ! EQ (p->command, Qt) /* Network process not stopped. */
6035 && XINT (p->infd) >= 0
6036 && read_process_output (proc, XINT (p->infd)) > 0);
6038 buffer = p->buffer;
6040 /* Get the text to use for the message. */
6041 if (!NILP (p->raw_status_low))
6042 update_status (p);
6043 msg = status_message (p->status);
6045 /* If process is terminated, deactivate it or delete it. */
6046 symbol = p->status;
6047 if (CONSP (p->status))
6048 symbol = XCAR (p->status);
6050 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
6051 || EQ (symbol, Qclosed))
6053 if (delete_exited_processes)
6054 remove_process (proc);
6055 else
6056 deactivate_process (proc);
6059 /* The actions above may have further incremented p->tick.
6060 So set p->update_tick again
6061 so that an error in the sentinel will not cause
6062 this code to be run again. */
6063 XSETINT (p->update_tick, XINT (p->tick));
6064 /* Now output the message suitably. */
6065 if (!NILP (p->sentinel))
6066 exec_sentinel (proc, msg);
6067 /* Don't bother with a message in the buffer
6068 when a process becomes runnable. */
6069 else if (!EQ (symbol, Qrun) && !NILP (buffer))
6071 Lisp_Object ro, tem;
6072 struct buffer *old = current_buffer;
6073 int opoint, opoint_byte;
6074 int before, before_byte;
6076 ro = XBUFFER (buffer)->read_only;
6078 /* Avoid error if buffer is deleted
6079 (probably that's why the process is dead, too) */
6080 if (NILP (XBUFFER (buffer)->name))
6081 continue;
6082 Fset_buffer (buffer);
6084 opoint = PT;
6085 opoint_byte = PT_BYTE;
6086 /* Insert new output into buffer
6087 at the current end-of-output marker,
6088 thus preserving logical ordering of input and output. */
6089 if (XMARKER (p->mark)->buffer)
6090 Fgoto_char (p->mark);
6091 else
6092 SET_PT_BOTH (ZV, ZV_BYTE);
6094 before = PT;
6095 before_byte = PT_BYTE;
6097 tem = current_buffer->read_only;
6098 current_buffer->read_only = Qnil;
6099 insert_string ("\nProcess ");
6100 Finsert (1, &p->name);
6101 insert_string (" ");
6102 Finsert (1, &msg);
6103 current_buffer->read_only = tem;
6104 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6106 if (opoint >= before)
6107 SET_PT_BOTH (opoint + (PT - before),
6108 opoint_byte + (PT_BYTE - before_byte));
6109 else
6110 SET_PT_BOTH (opoint, opoint_byte);
6112 set_buffer_internal (old);
6115 } /* end for */
6117 update_mode_lines++; /* in case buffers use %s in mode-line-format */
6118 redisplay_preserve_echo_area (13);
6120 UNGCPRO;
6124 DEFUN ("set-process-coding-system", Fset_process_coding_system,
6125 Sset_process_coding_system, 1, 3, 0,
6126 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
6127 DECODING will be used to decode subprocess output and ENCODING to
6128 encode subprocess input. */)
6129 (proc, decoding, encoding)
6130 register Lisp_Object proc, decoding, encoding;
6132 register struct Lisp_Process *p;
6134 CHECK_PROCESS (proc);
6135 p = XPROCESS (proc);
6136 if (XINT (p->infd) < 0)
6137 error ("Input file descriptor of %s closed", SDATA (p->name));
6138 if (XINT (p->outfd) < 0)
6139 error ("Output file descriptor of %s closed", SDATA (p->name));
6140 Fcheck_coding_system (decoding);
6141 Fcheck_coding_system (encoding);
6143 p->decode_coding_system = decoding;
6144 p->encode_coding_system = encoding;
6145 setup_process_coding_systems (proc);
6147 return Qnil;
6150 DEFUN ("process-coding-system",
6151 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
6152 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6153 (proc)
6154 register Lisp_Object proc;
6156 CHECK_PROCESS (proc);
6157 return Fcons (XPROCESS (proc)->decode_coding_system,
6158 XPROCESS (proc)->encode_coding_system);
6161 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
6162 Sset_process_filter_multibyte, 2, 2, 0,
6163 doc: /* Set multibyteness of the strings given to PROCESS's filter.
6164 If FLAG is non-nil, the filter is given multibyte strings.
6165 If FLAG is nil, the filter is given unibyte strings. In this case,
6166 all character code conversion except for end-of-line conversion is
6167 suppressed. */)
6168 (proc, flag)
6169 Lisp_Object proc, flag;
6171 register struct Lisp_Process *p;
6173 CHECK_PROCESS (proc);
6174 p = XPROCESS (proc);
6175 p->filter_multibyte = flag;
6176 setup_process_coding_systems (proc);
6178 return Qnil;
6181 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
6182 Sprocess_filter_multibyte_p, 1, 1, 0,
6183 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6184 (proc)
6185 Lisp_Object proc;
6187 register struct Lisp_Process *p;
6189 CHECK_PROCESS (proc);
6190 p = XPROCESS (proc);
6192 return (NILP (p->filter_multibyte) ? Qnil : Qt);
6197 /* The first time this is called, assume keyboard input comes from DESC
6198 instead of from where we used to expect it.
6199 Subsequent calls mean assume input keyboard can come from DESC
6200 in addition to other places. */
6202 static int add_keyboard_wait_descriptor_called_flag;
6204 void
6205 add_keyboard_wait_descriptor (desc)
6206 int desc;
6208 if (! add_keyboard_wait_descriptor_called_flag)
6209 FD_CLR (0, &input_wait_mask);
6210 add_keyboard_wait_descriptor_called_flag = 1;
6211 FD_SET (desc, &input_wait_mask);
6212 FD_SET (desc, &non_process_wait_mask);
6213 if (desc > max_keyboard_desc)
6214 max_keyboard_desc = desc;
6217 /* From now on, do not expect DESC to give keyboard input. */
6219 void
6220 delete_keyboard_wait_descriptor (desc)
6221 int desc;
6223 int fd;
6224 int lim = max_keyboard_desc;
6226 FD_CLR (desc, &input_wait_mask);
6227 FD_CLR (desc, &non_process_wait_mask);
6229 if (desc == max_keyboard_desc)
6230 for (fd = 0; fd < lim; fd++)
6231 if (FD_ISSET (fd, &input_wait_mask)
6232 && !FD_ISSET (fd, &non_keyboard_wait_mask))
6233 max_keyboard_desc = fd;
6236 /* Return nonzero if *MASK has a bit set
6237 that corresponds to one of the keyboard input descriptors. */
6240 keyboard_bit_set (mask)
6241 SELECT_TYPE *mask;
6243 int fd;
6245 for (fd = 0; fd <= max_keyboard_desc; fd++)
6246 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
6247 && !FD_ISSET (fd, &non_keyboard_wait_mask))
6248 return 1;
6250 return 0;
6253 void
6254 init_process ()
6256 register int i;
6258 #ifdef SIGCHLD
6259 #ifndef CANNOT_DUMP
6260 if (! noninteractive || initialized)
6261 #endif
6262 signal (SIGCHLD, sigchld_handler);
6263 #endif
6265 FD_ZERO (&input_wait_mask);
6266 FD_ZERO (&non_keyboard_wait_mask);
6267 FD_ZERO (&non_process_wait_mask);
6268 max_process_desc = 0;
6270 FD_SET (0, &input_wait_mask);
6272 Vprocess_alist = Qnil;
6273 for (i = 0; i < MAXDESC; i++)
6275 chan_process[i] = Qnil;
6276 proc_buffered_char[i] = -1;
6278 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
6279 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
6280 #ifdef DATAGRAM_SOCKETS
6281 bzero (datagram_address, sizeof datagram_address);
6282 #endif
6284 #ifdef HAVE_SOCKETS
6286 Lisp_Object subfeatures = Qnil;
6287 #define ADD_SUBFEATURE(key, val) \
6288 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6290 #ifdef NON_BLOCKING_CONNECT
6291 ADD_SUBFEATURE (QCnowait, Qt);
6292 #endif
6293 #ifdef DATAGRAM_SOCKETS
6294 ADD_SUBFEATURE (QCtype, Qdatagram);
6295 #endif
6296 #ifdef HAVE_LOCAL_SOCKETS
6297 ADD_SUBFEATURE (QCfamily, Qlocal);
6298 #endif
6299 #ifdef HAVE_GETSOCKNAME
6300 ADD_SUBFEATURE (QCservice, Qt);
6301 #endif
6302 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6303 ADD_SUBFEATURE (QCserver, Qt);
6304 #endif
6305 #ifdef SO_BINDTODEVICE
6306 ADD_SUBFEATURE (QCoptions, intern ("bindtodevice"));
6307 #endif
6308 #ifdef SO_BROADCAST
6309 ADD_SUBFEATURE (QCoptions, intern ("broadcast"));
6310 #endif
6311 #ifdef SO_DONTROUTE
6312 ADD_SUBFEATURE (QCoptions, intern ("dontroute"));
6313 #endif
6314 #ifdef SO_KEEPALIVE
6315 ADD_SUBFEATURE (QCoptions, intern ("keepalive"));
6316 #endif
6317 #ifdef SO_LINGER
6318 ADD_SUBFEATURE (QCoptions, intern ("linger"));
6319 #endif
6320 #ifdef SO_OOBINLINE
6321 ADD_SUBFEATURE (QCoptions, intern ("oobinline"));
6322 #endif
6323 #ifdef SO_PRIORITY
6324 ADD_SUBFEATURE (QCoptions, intern ("priority"));
6325 #endif
6326 #ifdef SO_REUSEADDR
6327 ADD_SUBFEATURE (QCoptions, intern ("reuseaddr"));
6328 #endif
6329 Fprovide (intern ("make-network-process"), subfeatures);
6331 #endif /* HAVE_SOCKETS */
6334 void
6335 syms_of_process ()
6337 Qprocessp = intern ("processp");
6338 staticpro (&Qprocessp);
6339 Qrun = intern ("run");
6340 staticpro (&Qrun);
6341 Qstop = intern ("stop");
6342 staticpro (&Qstop);
6343 Qsignal = intern ("signal");
6344 staticpro (&Qsignal);
6346 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6347 here again.
6349 Qexit = intern ("exit");
6350 staticpro (&Qexit); */
6352 Qopen = intern ("open");
6353 staticpro (&Qopen);
6354 Qclosed = intern ("closed");
6355 staticpro (&Qclosed);
6356 Qconnect = intern ("connect");
6357 staticpro (&Qconnect);
6358 Qfailed = intern ("failed");
6359 staticpro (&Qfailed);
6360 Qlisten = intern ("listen");
6361 staticpro (&Qlisten);
6362 Qlocal = intern ("local");
6363 staticpro (&Qlocal);
6364 Qdatagram = intern ("datagram");
6365 staticpro (&Qdatagram);
6367 QCname = intern (":name");
6368 staticpro (&QCname);
6369 QCbuffer = intern (":buffer");
6370 staticpro (&QCbuffer);
6371 QChost = intern (":host");
6372 staticpro (&QChost);
6373 QCservice = intern (":service");
6374 staticpro (&QCservice);
6375 QCtype = intern (":type");
6376 staticpro (&QCtype);
6377 QClocal = intern (":local");
6378 staticpro (&QClocal);
6379 QCremote = intern (":remote");
6380 staticpro (&QCremote);
6381 QCcoding = intern (":coding");
6382 staticpro (&QCcoding);
6383 QCserver = intern (":server");
6384 staticpro (&QCserver);
6385 QCnowait = intern (":nowait");
6386 staticpro (&QCnowait);
6387 QCsentinel = intern (":sentinel");
6388 staticpro (&QCsentinel);
6389 QClog = intern (":log");
6390 staticpro (&QClog);
6391 QCnoquery = intern (":noquery");
6392 staticpro (&QCnoquery);
6393 QCstop = intern (":stop");
6394 staticpro (&QCstop);
6395 QCoptions = intern (":options");
6396 staticpro (&QCoptions);
6397 QCplist = intern (":plist");
6398 staticpro (&QCplist);
6399 QCfilter_multibyte = intern (":filter-multibyte");
6400 staticpro (&QCfilter_multibyte);
6402 Qlast_nonmenu_event = intern ("last-nonmenu-event");
6403 staticpro (&Qlast_nonmenu_event);
6405 staticpro (&Vprocess_alist);
6407 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
6408 doc: /* *Non-nil means delete processes immediately when they exit.
6409 nil means don't delete them until `list-processes' is run. */);
6411 delete_exited_processes = 1;
6413 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
6414 doc: /* Control type of device used to communicate with subprocesses.
6415 Values are nil to use a pipe, or t or `pty' to use a pty.
6416 The value has no effect if the system has no ptys or if all ptys are busy:
6417 then a pipe is used in any case.
6418 The value takes effect when `start-process' is called. */);
6419 Vprocess_connection_type = Qt;
6421 defsubr (&Sprocessp);
6422 defsubr (&Sget_process);
6423 defsubr (&Sget_buffer_process);
6424 defsubr (&Sdelete_process);
6425 defsubr (&Sprocess_status);
6426 defsubr (&Sprocess_exit_status);
6427 defsubr (&Sprocess_id);
6428 defsubr (&Sprocess_name);
6429 defsubr (&Sprocess_tty_name);
6430 defsubr (&Sprocess_command);
6431 defsubr (&Sset_process_buffer);
6432 defsubr (&Sprocess_buffer);
6433 defsubr (&Sprocess_mark);
6434 defsubr (&Sset_process_filter);
6435 defsubr (&Sprocess_filter);
6436 defsubr (&Sset_process_sentinel);
6437 defsubr (&Sprocess_sentinel);
6438 defsubr (&Sset_process_window_size);
6439 defsubr (&Sset_process_inherit_coding_system_flag);
6440 defsubr (&Sprocess_inherit_coding_system_flag);
6441 defsubr (&Sset_process_query_on_exit_flag);
6442 defsubr (&Sprocess_query_on_exit_flag);
6443 defsubr (&Sprocess_contact);
6444 defsubr (&Sprocess_plist);
6445 defsubr (&Sset_process_plist);
6446 defsubr (&Slist_processes);
6447 defsubr (&Sprocess_list);
6448 defsubr (&Sstart_process);
6449 #ifdef HAVE_SOCKETS
6450 defsubr (&Sset_network_process_options);
6451 defsubr (&Smake_network_process);
6452 defsubr (&Sformat_network_address);
6453 #endif /* HAVE_SOCKETS */
6454 #ifdef DATAGRAM_SOCKETS
6455 defsubr (&Sprocess_datagram_address);
6456 defsubr (&Sset_process_datagram_address);
6457 #endif
6458 defsubr (&Saccept_process_output);
6459 defsubr (&Sprocess_send_region);
6460 defsubr (&Sprocess_send_string);
6461 defsubr (&Sinterrupt_process);
6462 defsubr (&Skill_process);
6463 defsubr (&Squit_process);
6464 defsubr (&Sstop_process);
6465 defsubr (&Scontinue_process);
6466 defsubr (&Sprocess_running_child_p);
6467 defsubr (&Sprocess_send_eof);
6468 defsubr (&Ssignal_process);
6469 defsubr (&Swaiting_for_user_input_p);
6470 /* defsubr (&Sprocess_connection); */
6471 defsubr (&Sset_process_coding_system);
6472 defsubr (&Sprocess_coding_system);
6473 defsubr (&Sset_process_filter_multibyte);
6474 defsubr (&Sprocess_filter_multibyte_p);
6478 #else /* not subprocesses */
6480 #include <sys/types.h>
6481 #include <errno.h>
6483 #include "lisp.h"
6484 #include "systime.h"
6485 #include "charset.h"
6486 #include "coding.h"
6487 #include "termopts.h"
6488 #include "sysselect.h"
6490 extern int frame_garbaged;
6492 extern EMACS_TIME timer_check ();
6493 extern int timers_run;
6495 Lisp_Object QCtype;
6497 /* As described above, except assuming that there are no subprocesses:
6499 Wait for timeout to elapse and/or keyboard input to be available.
6501 time_limit is:
6502 timeout in seconds, or
6503 zero for no limit, or
6504 -1 means gobble data immediately available but don't wait for any.
6506 read_kbd is a Lisp_Object:
6507 0 to ignore keyboard input, or
6508 1 to return when input is available, or
6509 -1 means caller will actually read the input, so don't throw to
6510 the quit handler.
6511 a cons cell, meaning wait until its car is non-nil
6512 (and gobble terminal input into the buffer if any arrives), or
6513 We know that read_kbd will never be a Lisp_Process, since
6514 `subprocesses' isn't defined.
6516 do_display != 0 means redisplay should be done to show subprocess
6517 output that arrives.
6519 Return true iff we received input from any process. */
6522 wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
6523 int time_limit, microsecs;
6524 Lisp_Object read_kbd;
6525 int do_display;
6527 register int nfds;
6528 EMACS_TIME end_time, timeout;
6529 SELECT_TYPE waitchannels;
6530 int xerrno;
6531 /* Either nil or a cons cell, the car of which is of interest and
6532 may be changed outside of this routine. */
6533 Lisp_Object wait_for_cell;
6535 wait_for_cell = Qnil;
6537 /* If waiting for non-nil in a cell, record where. */
6538 if (CONSP (read_kbd))
6540 wait_for_cell = read_kbd;
6541 XSETFASTINT (read_kbd, 0);
6544 /* What does time_limit really mean? */
6545 if (time_limit || microsecs)
6547 EMACS_GET_TIME (end_time);
6548 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
6549 EMACS_ADD_TIME (end_time, end_time, timeout);
6552 /* Turn off periodic alarms (in case they are in use)
6553 and then turn off any other atimers,
6554 because the select emulator uses alarms. */
6555 stop_polling ();
6556 turn_on_atimers (0);
6558 while (1)
6560 int timeout_reduced_for_timers = 0;
6562 /* If calling from keyboard input, do not quit
6563 since we want to return C-g as an input character.
6564 Otherwise, do pending quit if requested. */
6565 if (XINT (read_kbd) >= 0)
6566 QUIT;
6568 /* Exit now if the cell we're waiting for became non-nil. */
6569 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
6570 break;
6572 /* Compute time from now till when time limit is up */
6573 /* Exit if already run out */
6574 if (time_limit == -1)
6576 /* -1 specified for timeout means
6577 gobble output available now
6578 but don't wait at all. */
6580 EMACS_SET_SECS_USECS (timeout, 0, 0);
6582 else if (time_limit || microsecs)
6584 EMACS_GET_TIME (timeout);
6585 EMACS_SUB_TIME (timeout, end_time, timeout);
6586 if (EMACS_TIME_NEG_P (timeout))
6587 break;
6589 else
6591 EMACS_SET_SECS_USECS (timeout, 100000, 0);
6594 /* If our caller will not immediately handle keyboard events,
6595 run timer events directly.
6596 (Callers that will immediately read keyboard events
6597 call timer_delay on their own.) */
6598 if (NILP (wait_for_cell))
6600 EMACS_TIME timer_delay;
6604 int old_timers_run = timers_run;
6605 timer_delay = timer_check (1);
6606 if (timers_run != old_timers_run && do_display)
6607 /* We must retry, since a timer may have requeued itself
6608 and that could alter the time delay. */
6609 redisplay_preserve_echo_area (14);
6610 else
6611 break;
6613 while (!detect_input_pending ());
6615 /* If there is unread keyboard input, also return. */
6616 if (XINT (read_kbd) != 0
6617 && requeued_events_pending_p ())
6618 break;
6620 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
6622 EMACS_TIME difference;
6623 EMACS_SUB_TIME (difference, timer_delay, timeout);
6624 if (EMACS_TIME_NEG_P (difference))
6626 timeout = timer_delay;
6627 timeout_reduced_for_timers = 1;
6632 /* Cause C-g and alarm signals to take immediate action,
6633 and cause input available signals to zero out timeout. */
6634 if (XINT (read_kbd) < 0)
6635 set_waiting_for_input (&timeout);
6637 /* Wait till there is something to do. */
6639 if (! XINT (read_kbd) && NILP (wait_for_cell))
6640 FD_ZERO (&waitchannels);
6641 else
6642 FD_SET (0, &waitchannels);
6644 /* If a frame has been newly mapped and needs updating,
6645 reprocess its display stuff. */
6646 if (frame_garbaged && do_display)
6648 clear_waiting_for_input ();
6649 redisplay_preserve_echo_area (15);
6650 if (XINT (read_kbd) < 0)
6651 set_waiting_for_input (&timeout);
6654 if (XINT (read_kbd) && detect_input_pending ())
6656 nfds = 0;
6657 FD_ZERO (&waitchannels);
6659 else
6660 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
6661 &timeout);
6663 xerrno = errno;
6665 /* Make C-g and alarm signals set flags again */
6666 clear_waiting_for_input ();
6668 /* If we woke up due to SIGWINCH, actually change size now. */
6669 do_pending_window_change (0);
6671 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
6672 /* We waited the full specified time, so return now. */
6673 break;
6675 if (nfds == -1)
6677 /* If the system call was interrupted, then go around the
6678 loop again. */
6679 if (xerrno == EINTR)
6680 FD_ZERO (&waitchannels);
6681 else
6682 error ("select error: %s", emacs_strerror (xerrno));
6684 #ifdef sun
6685 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
6686 /* System sometimes fails to deliver SIGIO. */
6687 kill (getpid (), SIGIO);
6688 #endif
6689 #ifdef SIGIO
6690 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
6691 kill (getpid (), SIGIO);
6692 #endif
6694 /* Check for keyboard input */
6696 if ((XINT (read_kbd) != 0)
6697 && detect_input_pending_run_timers (do_display))
6699 swallow_events (do_display);
6700 if (detect_input_pending_run_timers (do_display))
6701 break;
6704 /* If there is unread keyboard input, also return. */
6705 if (XINT (read_kbd) != 0
6706 && requeued_events_pending_p ())
6707 break;
6709 /* If wait_for_cell. check for keyboard input
6710 but don't run any timers.
6711 ??? (It seems wrong to me to check for keyboard
6712 input at all when wait_for_cell, but the code
6713 has been this way since July 1994.
6714 Try changing this after version 19.31.) */
6715 if (! NILP (wait_for_cell)
6716 && detect_input_pending ())
6718 swallow_events (do_display);
6719 if (detect_input_pending ())
6720 break;
6723 /* Exit now if the cell we're waiting for became non-nil. */
6724 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
6725 break;
6728 start_polling ();
6730 return 0;
6734 /* Don't confuse make-docfile by having two doc strings for this function.
6735 make-docfile does not pay attention to #if, for good reason! */
6736 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
6738 (name)
6739 register Lisp_Object name;
6741 return Qnil;
6744 /* Don't confuse make-docfile by having two doc strings for this function.
6745 make-docfile does not pay attention to #if, for good reason! */
6746 DEFUN ("process-inherit-coding-system-flag",
6747 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
6748 1, 1, 0,
6750 (process)
6751 register Lisp_Object process;
6753 /* Ignore the argument and return the value of
6754 inherit-process-coding-system. */
6755 return inherit_process_coding_system ? Qt : Qnil;
6758 /* Kill all processes associated with `buffer'.
6759 If `buffer' is nil, kill all processes.
6760 Since we have no subprocesses, this does nothing. */
6762 void
6763 kill_buffer_processes (buffer)
6764 Lisp_Object buffer;
6768 void
6769 init_process ()
6773 void
6774 syms_of_process ()
6776 QCtype = intern (":type");
6777 staticpro (&QCtype);
6779 defsubr (&Sget_buffer_process);
6780 defsubr (&Sprocess_inherit_coding_system_flag);
6784 #endif /* not subprocesses */