1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1996, 1998, 1999, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
27 /* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
40 #include <sys/types.h> /* some typedefs are used in sys/file.h */
43 #ifdef HAVE_INTTYPES_H
50 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
53 #endif /* not WINDOWSNT */
55 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
56 #include <sys/socket.h>
58 #include <netinet/in.h>
59 #include <arpa/inet.h>
60 #ifdef NEED_NET_ERRNO_H
61 #include <net/errno.h>
62 #endif /* NEED_NET_ERRNO_H */
64 /* Are local (unix) sockets supported? */
65 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
66 #if !defined (AF_LOCAL) && defined (AF_UNIX)
67 #define AF_LOCAL AF_UNIX
70 #define HAVE_LOCAL_SOCKETS
74 #endif /* HAVE_SOCKETS */
76 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
81 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
82 #ifdef HAVE_BROKEN_INET_ADDR
83 #define IN_ADDR struct in_addr
84 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
86 #define IN_ADDR unsigned long
87 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
90 #if defined(BSD_SYSTEM) || defined(STRIDE)
91 #include <sys/ioctl.h>
92 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
94 #endif /* HAVE_PTYS and no O_NDELAY */
95 #endif /* BSD_SYSTEM || STRIDE */
97 #ifdef BROKEN_O_NONBLOCK
99 #endif /* BROKEN_O_NONBLOCK */
105 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
107 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
108 /* sys/ioctl.h may have been included already */
110 #include <sys/ioctl.h>
117 #include <sys/sysmacros.h> /* for "minor" */
118 #endif /* not IRIS */
121 #include <sys/wait.h>
124 /* Disable IPv6 support for w32 until someone figures out how to do it
141 #include "termhooks.h"
142 #include "termopts.h"
143 #include "commands.h"
144 #include "keyboard.h"
146 #include "blockinput.h"
147 #include "dispextern.h"
148 #include "composite.h"
151 Lisp_Object Qprocessp
;
152 Lisp_Object Qrun
, Qstop
, Qsignal
;
153 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
154 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
158 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
159 Lisp_Object QClocal
, QCremote
, QCcoding
;
160 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
161 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
162 Lisp_Object QCfilter_multibyte
;
163 Lisp_Object Qlast_nonmenu_event
;
164 /* QCfamily is declared and initialized in xfaces.c,
165 QCfilter in keyboard.c. */
166 extern Lisp_Object QCfamily
, QCfilter
;
168 /* Qexit is declared and initialized in eval.c. */
170 /* QCfamily is defined in xfaces.c. */
171 extern Lisp_Object QCfamily
;
172 /* QCfilter is defined in keyboard.c. */
173 extern Lisp_Object QCfilter
;
175 /* a process object is a network connection when its childp field is neither
176 Qt nor Qnil but is instead a property list (KEY VAL ...). */
179 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
180 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
182 #define NETCONN_P(p) 0
183 #define NETCONN1_P(p) 0
184 #endif /* HAVE_SOCKETS */
186 /* Define first descriptor number available for subprocesses. */
188 #define FIRST_PROC_DESC 1
190 #define FIRST_PROC_DESC 3
193 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
196 #if !defined (SIGCHLD) && defined (SIGCLD)
197 #define SIGCHLD SIGCLD
200 #include "syssignal.h"
204 extern char *get_operating_system_release ();
210 extern char *sys_errlist
[];
217 /* t means use pty, nil means use a pipe,
218 maybe other values to come. */
219 static Lisp_Object Vprocess_connection_type
;
223 #include <sys/socket.h>
227 /* These next two vars are non-static since sysdep.c uses them in the
228 emulation of `select'. */
229 /* Number of events of change of status of a process. */
231 /* Number of events for which the user or sentinel has been notified. */
234 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
236 #ifdef BROKEN_NON_BLOCKING_CONNECT
237 #undef NON_BLOCKING_CONNECT
239 #ifndef NON_BLOCKING_CONNECT
242 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
243 #if defined (O_NONBLOCK) || defined (O_NDELAY)
244 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
245 #define NON_BLOCKING_CONNECT
246 #endif /* EWOULDBLOCK || EINPROGRESS */
247 #endif /* O_NONBLOCK || O_NDELAY */
248 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
249 #endif /* HAVE_SELECT */
250 #endif /* HAVE_SOCKETS */
251 #endif /* NON_BLOCKING_CONNECT */
252 #endif /* BROKEN_NON_BLOCKING_CONNECT */
254 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
255 this system. We need to read full packets, so we need a
256 "non-destructive" select. So we require either native select,
257 or emulation of select using FIONREAD. */
259 #ifdef BROKEN_DATAGRAM_SOCKETS
260 #undef DATAGRAM_SOCKETS
262 #ifndef DATAGRAM_SOCKETS
264 #if defined (HAVE_SELECT) || defined (FIONREAD)
265 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
266 #define DATAGRAM_SOCKETS
267 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
268 #endif /* HAVE_SELECT || FIONREAD */
269 #endif /* HAVE_SOCKETS */
270 #endif /* DATAGRAM_SOCKETS */
271 #endif /* BROKEN_DATAGRAM_SOCKETS */
274 #undef NON_BLOCKING_CONNECT
275 #undef DATAGRAM_SOCKETS
278 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
279 #ifdef EMACS_HAS_USECS
280 #define ADAPTIVE_READ_BUFFERING
284 #ifdef ADAPTIVE_READ_BUFFERING
285 #define READ_OUTPUT_DELAY_INCREMENT 10000
286 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
287 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
289 /* Number of processes which have a non-zero read_output_delay,
290 and therefore might be delayed for adaptive read buffering. */
292 static int process_output_delay_count
;
294 /* Non-zero if any process has non-nil read_output_skip. */
296 static int process_output_skip
;
298 /* Non-nil means to delay reading process output to improve buffering.
299 A value of t means that delay is reset after each send, any other
300 non-nil value does not reset the delay. A value of nil disables
301 adaptive read buffering completely. */
302 static Lisp_Object Vprocess_adaptive_read_buffering
;
304 #define process_output_delay_count 0
308 #include "sysselect.h"
310 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
311 static void deactivate_process
P_ ((Lisp_Object
));
312 static void status_notify
P_ ((struct Lisp_Process
*));
313 static int read_process_output
P_ ((Lisp_Object
, int));
315 /* If we support a window system, turn on the code to poll periodically
316 to detect C-g. It isn't actually used when doing interrupt input. */
317 #ifdef HAVE_WINDOW_SYSTEM
318 #define POLL_FOR_INPUT
321 /* Mask of bits indicating the descriptors that we wait for input on. */
323 static SELECT_TYPE input_wait_mask
;
325 /* Mask that excludes keyboard input descriptor (s). */
327 static SELECT_TYPE non_keyboard_wait_mask
;
329 /* Mask that excludes process input descriptor (s). */
331 static SELECT_TYPE non_process_wait_mask
;
333 #ifdef NON_BLOCKING_CONNECT
334 /* Mask of bits indicating the descriptors that we wait for connect to
335 complete on. Once they complete, they are removed from this mask
336 and added to the input_wait_mask and non_keyboard_wait_mask. */
338 static SELECT_TYPE connect_wait_mask
;
340 /* Number of bits set in connect_wait_mask. */
341 static int num_pending_connects
;
343 #define IF_NON_BLOCKING_CONNECT(s) s
345 #define IF_NON_BLOCKING_CONNECT(s)
348 /* The largest descriptor currently in use for a process object. */
349 static int max_process_desc
;
351 /* The largest descriptor currently in use for keyboard input. */
352 static int max_keyboard_desc
;
354 /* Nonzero means delete a process right away if it exits. */
355 static int delete_exited_processes
;
357 /* Indexed by descriptor, gives the process (if any) for that descriptor */
358 Lisp_Object chan_process
[MAXDESC
];
360 /* Alist of elements (NAME . PROCESS) */
361 Lisp_Object Vprocess_alist
;
363 /* Buffered-ahead input char from process, indexed by channel.
364 -1 means empty (no char is buffered).
365 Used on sys V where the only way to tell if there is any
366 output from the process is to read at least one char.
367 Always -1 on systems that support FIONREAD. */
369 /* Don't make static; need to access externally. */
370 int proc_buffered_char
[MAXDESC
];
372 /* Table of `struct coding-system' for each process. */
373 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
374 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
376 #ifdef DATAGRAM_SOCKETS
377 /* Table of `partner address' for datagram sockets. */
378 struct sockaddr_and_len
{
381 } datagram_address
[MAXDESC
];
382 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
383 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
385 #define DATAGRAM_CHAN_P(chan) (0)
386 #define DATAGRAM_CONN_P(proc) (0)
389 static Lisp_Object
get_process ();
390 static void exec_sentinel ();
392 extern EMACS_TIME
timer_check ();
393 extern int timers_run
;
395 /* Maximum number of bytes to send to a pty without an eof. */
396 static int pty_max_bytes
;
402 /* The file name of the pty opened by allocate_pty. */
404 static char pty_name
[24];
407 /* Compute the Lisp form of the process status, p->status, from
408 the numeric status that was returned by `wait'. */
410 static Lisp_Object
status_convert ();
414 struct Lisp_Process
*p
;
416 union { int i
; WAITTYPE wt
; } u
;
417 eassert (p
->raw_status_new
);
419 p
->status
= status_convert (u
.wt
);
420 p
->raw_status_new
= 0;
423 /* Convert a process status word in Unix format to
424 the list that we use internally. */
431 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
432 else if (WIFEXITED (w
))
433 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
434 WCOREDUMP (w
) ? Qt
: Qnil
));
435 else if (WIFSIGNALED (w
))
436 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
437 WCOREDUMP (w
) ? Qt
: Qnil
));
442 /* Given a status-list, extract the three pieces of information
443 and store them individually through the three pointers. */
446 decode_status (l
, symbol
, code
, coredump
)
464 *code
= XFASTINT (XCAR (tem
));
466 *coredump
= !NILP (tem
);
470 /* Return a string describing a process status list. */
474 struct Lisp_Process
*p
;
476 Lisp_Object status
= p
->status
;
479 Lisp_Object string
, string2
;
481 decode_status (status
, &symbol
, &code
, &coredump
);
483 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
486 synchronize_system_messages_locale ();
487 signame
= strsignal (code
);
490 string
= build_string (signame
);
491 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
492 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
493 return concat2 (string
, string2
);
495 else if (EQ (symbol
, Qexit
))
498 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
500 return build_string ("finished\n");
501 string
= Fnumber_to_string (make_number (code
));
502 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
503 return concat3 (build_string ("exited abnormally with code "),
506 else if (EQ (symbol
, Qfailed
))
508 string
= Fnumber_to_string (make_number (code
));
509 string2
= build_string ("\n");
510 return concat3 (build_string ("failed with code "),
514 return Fcopy_sequence (Fsymbol_name (symbol
));
519 /* Open an available pty, returning a file descriptor.
520 Return -1 on failure.
521 The file name of the terminal corresponding to the pty
522 is left in the variable pty_name. */
533 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
534 for (i
= 0; i
< 16; i
++)
537 struct stat stb
; /* Used in some PTY_OPEN. */
538 #ifdef PTY_NAME_SPRINTF
541 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
542 #endif /* no PTY_NAME_SPRINTF */
546 #else /* no PTY_OPEN */
549 /* Unusual IRIS code */
550 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
553 if (fstat (fd
, &stb
) < 0)
555 # else /* not IRIS */
556 { /* Some systems name their pseudoterminals so that there are gaps in
557 the usual sequence - for example, on HP9000/S700 systems, there
558 are no pseudoterminals with names ending in 'f'. So we wait for
559 three failures in a row before deciding that we've reached the
561 int failed_count
= 0;
563 if (stat (pty_name
, &stb
) < 0)
566 if (failed_count
>= 3)
573 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
575 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
577 # endif /* not IRIS */
579 #endif /* no PTY_OPEN */
583 /* check to make certain that both sides are available
584 this avoids a nasty yet stupid bug in rlogins */
585 #ifdef PTY_TTY_NAME_SPRINTF
588 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
589 #endif /* no PTY_TTY_NAME_SPRINTF */
591 if (access (pty_name
, 6) != 0)
594 # if !defined(IRIS) && !defined(__sgi)
600 #endif /* not UNIPLUS */
607 #endif /* HAVE_PTYS */
613 register Lisp_Object val
, tem
, name1
;
614 register struct Lisp_Process
*p
;
618 p
= allocate_process ();
620 XSETINT (p
->infd
, -1);
621 XSETINT (p
->outfd
, -1);
622 XSETFASTINT (p
->tick
, 0);
623 XSETFASTINT (p
->update_tick
, 0);
625 p
->raw_status_new
= 0;
627 p
->mark
= Fmake_marker ();
629 #ifdef ADAPTIVE_READ_BUFFERING
630 p
->adaptive_read_buffering
= Qnil
;
631 XSETFASTINT (p
->read_output_delay
, 0);
632 p
->read_output_skip
= Qnil
;
635 /* If name is already in use, modify it until it is unused. */
640 tem
= Fget_process (name1
);
641 if (NILP (tem
)) break;
642 sprintf (suffix
, "<%d>", i
);
643 name1
= concat2 (name
, build_string (suffix
));
647 XSETPROCESS (val
, p
);
648 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
653 remove_process (proc
)
654 register Lisp_Object proc
;
656 register Lisp_Object pair
;
658 pair
= Frassq (proc
, Vprocess_alist
);
659 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
661 deactivate_process (proc
);
664 /* Setup coding systems of PROCESS. */
667 setup_process_coding_systems (process
)
670 struct Lisp_Process
*p
= XPROCESS (process
);
671 int inch
= XINT (p
->infd
);
672 int outch
= XINT (p
->outfd
);
674 if (inch
< 0 || outch
< 0)
677 if (!proc_decode_coding_system
[inch
])
678 proc_decode_coding_system
[inch
]
679 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
680 setup_coding_system (p
->decode_coding_system
,
681 proc_decode_coding_system
[inch
]);
682 if (! NILP (p
->filter
))
684 if (NILP (p
->filter_multibyte
))
685 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
687 else if (BUFFERP (p
->buffer
))
689 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
690 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
693 if (!proc_encode_coding_system
[outch
])
694 proc_encode_coding_system
[outch
]
695 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
696 setup_coding_system (p
->encode_coding_system
,
697 proc_encode_coding_system
[outch
]);
698 if (proc_encode_coding_system
[outch
]->eol_type
== CODING_EOL_UNDECIDED
)
699 proc_encode_coding_system
[outch
]->eol_type
= system_eol_type
;
702 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
703 doc
: /* Return t if OBJECT is a process. */)
707 return PROCESSP (object
) ? Qt
: Qnil
;
710 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
711 doc
: /* Return the process named NAME, or nil if there is none. */)
713 register Lisp_Object name
;
718 return Fcdr (Fassoc (name
, Vprocess_alist
));
721 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
722 doc
: /* Return the (or a) process associated with BUFFER.
723 BUFFER may be a buffer or the name of one. */)
725 register Lisp_Object buffer
;
727 register Lisp_Object buf
, tail
, proc
;
729 if (NILP (buffer
)) return Qnil
;
730 buf
= Fget_buffer (buffer
);
731 if (NILP (buf
)) return Qnil
;
733 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
735 proc
= Fcdr (Fcar (tail
));
736 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
742 /* This is how commands for the user decode process arguments. It
743 accepts a process, a process name, a buffer, a buffer name, or nil.
744 Buffers denote the first process in the buffer, and nil denotes the
749 register Lisp_Object name
;
751 register Lisp_Object proc
, obj
;
754 obj
= Fget_process (name
);
756 obj
= Fget_buffer (name
);
758 error ("Process %s does not exist", SDATA (name
));
760 else if (NILP (name
))
761 obj
= Fcurrent_buffer ();
765 /* Now obj should be either a buffer object or a process object.
769 proc
= Fget_buffer_process (obj
);
771 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
781 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
782 doc
: /* Delete PROCESS: kill it and forget about it immediately.
783 PROCESS may be a process, a buffer, the name of a process or buffer, or
784 nil, indicating the current buffer's process. */)
786 register Lisp_Object process
;
788 register struct Lisp_Process
*p
;
790 process
= get_process (process
);
791 p
= XPROCESS (process
);
793 p
->raw_status_new
= 0;
796 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
797 XSETINT (p
->tick
, ++process_tick
);
800 else if (XINT (p
->infd
) >= 0)
802 Fkill_process (process
, Qnil
);
803 /* Do this now, since remove_process will make sigchld_handler do nothing. */
805 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
806 XSETINT (p
->tick
, ++process_tick
);
809 remove_process (process
);
813 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
814 doc
: /* Return the status of PROCESS.
815 The returned value is one of the following symbols:
816 run -- for a process that is running.
817 stop -- for a process stopped but continuable.
818 exit -- for a process that has exited.
819 signal -- for a process that has got a fatal signal.
820 open -- for a network stream connection that is open.
821 listen -- for a network stream server that is listening.
822 closed -- for a network stream connection that is closed.
823 connect -- when waiting for a non-blocking connection to complete.
824 failed -- when a non-blocking connection has failed.
825 nil -- if arg is a process name and no such process exists.
826 PROCESS may be a process, a buffer, the name of a process, or
827 nil, indicating the current buffer's process. */)
829 register Lisp_Object process
;
831 register struct Lisp_Process
*p
;
832 register Lisp_Object status
;
834 if (STRINGP (process
))
835 process
= Fget_process (process
);
837 process
= get_process (process
);
842 p
= XPROCESS (process
);
843 if (p
->raw_status_new
)
847 status
= XCAR (status
);
850 if (EQ (status
, Qexit
))
852 else if (EQ (p
->command
, Qt
))
854 else if (EQ (status
, Qrun
))
860 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
862 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
863 If PROCESS has not yet exited or died, return 0. */)
865 register Lisp_Object process
;
867 CHECK_PROCESS (process
);
868 if (XPROCESS (process
)->raw_status_new
)
869 update_status (XPROCESS (process
));
870 if (CONSP (XPROCESS (process
)->status
))
871 return XCAR (XCDR (XPROCESS (process
)->status
));
872 return make_number (0);
875 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
876 doc
: /* Return the process id of PROCESS.
877 This is the pid of the external process which PROCESS uses or talks to.
878 For a network connection, this value is nil. */)
880 register Lisp_Object process
;
882 CHECK_PROCESS (process
);
883 return (XPROCESS (process
)->pid
884 ? make_fixnum_or_float (XPROCESS (process
)->pid
)
888 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
889 doc
: /* Return the name of PROCESS, as a string.
890 This is the name of the program invoked in PROCESS,
891 possibly modified to make it unique among process names. */)
893 register Lisp_Object process
;
895 CHECK_PROCESS (process
);
896 return XPROCESS (process
)->name
;
899 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
900 doc
: /* Return the command that was executed to start PROCESS.
901 This is a list of strings, the first string being the program executed
902 and the rest of the strings being the arguments given to it.
903 For a non-child channel, this is nil. */)
905 register Lisp_Object process
;
907 CHECK_PROCESS (process
);
908 return XPROCESS (process
)->command
;
911 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
912 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
913 This is the terminal that the process itself reads and writes on,
914 not the name of the pty that Emacs uses to talk with that terminal. */)
916 register Lisp_Object process
;
918 CHECK_PROCESS (process
);
919 return XPROCESS (process
)->tty_name
;
922 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
924 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
926 register Lisp_Object process
, buffer
;
928 struct Lisp_Process
*p
;
930 CHECK_PROCESS (process
);
932 CHECK_BUFFER (buffer
);
933 p
= XPROCESS (process
);
936 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
937 setup_process_coding_systems (process
);
941 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
943 doc
: /* Return the buffer PROCESS is associated with.
944 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
946 register Lisp_Object process
;
948 CHECK_PROCESS (process
);
949 return XPROCESS (process
)->buffer
;
952 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
954 doc
: /* Return the marker for the end of the last output from PROCESS. */)
956 register Lisp_Object process
;
958 CHECK_PROCESS (process
);
959 return XPROCESS (process
)->mark
;
962 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
964 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
965 t means stop accepting output from the process.
967 When a process has a filter, its buffer is not used for output.
968 Instead, each time it does output, the entire string of output is
969 passed to the filter.
971 The filter gets two arguments: the process and the string of output.
972 The string argument is normally a multibyte string, except:
973 - if the process' input coding system is no-conversion or raw-text,
974 it is a unibyte string (the non-converted input), or else
975 - if `default-enable-multibyte-characters' is nil, it is a unibyte
976 string (the result of converting the decoded input multibyte
977 string to unibyte with `string-make-unibyte'). */)
979 register Lisp_Object process
, filter
;
981 struct Lisp_Process
*p
;
983 CHECK_PROCESS (process
);
984 p
= XPROCESS (process
);
986 /* Don't signal an error if the process' input file descriptor
987 is closed. This could make debugging Lisp more difficult,
988 for example when doing something like
990 (setq process (start-process ...))
992 (set-process-filter process ...) */
994 if (XINT (p
->infd
) >= 0)
996 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
998 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
999 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
1001 else if (EQ (p
->filter
, Qt
)
1002 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1004 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1005 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1011 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1012 setup_process_coding_systems (process
);
1016 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1018 doc
: /* Returns the filter function of PROCESS; nil if none.
1019 See `set-process-filter' for more info on filter functions. */)
1021 register Lisp_Object process
;
1023 CHECK_PROCESS (process
);
1024 return XPROCESS (process
)->filter
;
1027 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1029 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1030 The sentinel is called as a function when the process changes state.
1031 It gets two arguments: the process, and a string describing the change. */)
1033 register Lisp_Object process
, sentinel
;
1035 struct Lisp_Process
*p
;
1037 CHECK_PROCESS (process
);
1038 p
= XPROCESS (process
);
1040 p
->sentinel
= sentinel
;
1042 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1046 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1048 doc
: /* Return the sentinel of PROCESS; nil if none.
1049 See `set-process-sentinel' for more info on sentinels. */)
1051 register Lisp_Object process
;
1053 CHECK_PROCESS (process
);
1054 return XPROCESS (process
)->sentinel
;
1057 DEFUN ("set-process-window-size", Fset_process_window_size
,
1058 Sset_process_window_size
, 3, 3, 0,
1059 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1060 (process
, height
, width
)
1061 register Lisp_Object process
, height
, width
;
1063 CHECK_PROCESS (process
);
1064 CHECK_NATNUM (height
);
1065 CHECK_NATNUM (width
);
1067 if (XINT (XPROCESS (process
)->infd
) < 0
1068 || set_window_size (XINT (XPROCESS (process
)->infd
),
1069 XINT (height
), XINT (width
)) <= 0)
1075 DEFUN ("set-process-inherit-coding-system-flag",
1076 Fset_process_inherit_coding_system_flag
,
1077 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1078 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1079 If the second argument FLAG is non-nil, then the variable
1080 `buffer-file-coding-system' of the buffer associated with PROCESS
1081 will be bound to the value of the coding system used to decode
1084 This is useful when the coding system specified for the process buffer
1085 leaves either the character code conversion or the end-of-line conversion
1086 unspecified, or if the coding system used to decode the process output
1087 is more appropriate for saving the process buffer.
1089 Binding the variable `inherit-process-coding-system' to non-nil before
1090 starting the process is an alternative way of setting the inherit flag
1091 for the process which will run. */)
1093 register Lisp_Object process
, flag
;
1095 CHECK_PROCESS (process
);
1096 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1100 DEFUN ("process-inherit-coding-system-flag",
1101 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1103 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1104 If this flag is t, `buffer-file-coding-system' of the buffer
1105 associated with PROCESS will inherit the coding system used to decode
1106 the process output. */)
1108 register Lisp_Object process
;
1110 CHECK_PROCESS (process
);
1111 return XPROCESS (process
)->inherit_coding_system_flag
;
1114 DEFUN ("set-process-query-on-exit-flag",
1115 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1117 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1118 If the second argument FLAG is non-nil, Emacs will query the user before
1119 exiting if PROCESS is running. */)
1121 register Lisp_Object process
, flag
;
1123 CHECK_PROCESS (process
);
1124 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1128 DEFUN ("process-query-on-exit-flag",
1129 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1131 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1133 register Lisp_Object process
;
1135 CHECK_PROCESS (process
);
1136 return Fnull (XPROCESS (process
)->kill_without_query
);
1139 #ifdef DATAGRAM_SOCKETS
1140 Lisp_Object
Fprocess_datagram_address ();
1143 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1145 doc
: /* Return the contact info of PROCESS; t for a real child.
1146 For a net connection, the value depends on the optional KEY arg.
1147 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1148 if KEY is t, the complete contact information for the connection is
1149 returned, else the specific value for the keyword KEY is returned.
1150 See `make-network-process' for a list of keywords. */)
1152 register Lisp_Object process
, key
;
1154 Lisp_Object contact
;
1156 CHECK_PROCESS (process
);
1157 contact
= XPROCESS (process
)->childp
;
1159 #ifdef DATAGRAM_SOCKETS
1160 if (DATAGRAM_CONN_P (process
)
1161 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1162 contact
= Fplist_put (contact
, QCremote
,
1163 Fprocess_datagram_address (process
));
1166 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1169 return Fcons (Fplist_get (contact
, QChost
),
1170 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1171 return Fplist_get (contact
, key
);
1174 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1176 doc
: /* Return the plist of PROCESS. */)
1178 register Lisp_Object process
;
1180 CHECK_PROCESS (process
);
1181 return XPROCESS (process
)->plist
;
1184 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1186 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1188 register Lisp_Object process
, plist
;
1190 CHECK_PROCESS (process
);
1193 XPROCESS (process
)->plist
= plist
;
1197 #if 0 /* Turned off because we don't currently record this info
1198 in the process. Perhaps add it. */
1199 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1200 doc
: /* Return the connection type of PROCESS.
1201 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1202 a socket connection. */)
1204 Lisp_Object process
;
1206 return XPROCESS (process
)->type
;
1211 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1213 doc
: /* Convert network ADDRESS from internal format to a string.
1214 A 4 or 5 element vector represents an IPv4 address (with port number).
1215 An 8 or 9 element vector represents an IPv6 address (with port number).
1216 If optional second argument OMIT-PORT is non-nil, don't include a port
1217 number in the string, even when present in ADDRESS.
1218 Returns nil if format of ADDRESS is invalid. */)
1219 (address
, omit_port
)
1220 Lisp_Object address
, omit_port
;
1225 if (STRINGP (address
)) /* AF_LOCAL */
1228 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1230 register struct Lisp_Vector
*p
= XVECTOR (address
);
1231 Lisp_Object args
[6];
1234 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1236 args
[0] = build_string ("%d.%d.%d.%d");
1239 else if (p
->size
== 5)
1241 args
[0] = build_string ("%d.%d.%d.%d:%d");
1244 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1246 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1249 else if (p
->size
== 9)
1251 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1257 for (i
= 0; i
< nargs
; i
++)
1258 args
[i
+1] = p
->contents
[i
];
1259 return Fformat (nargs
+1, args
);
1262 if (CONSP (address
))
1264 Lisp_Object args
[2];
1265 args
[0] = build_string ("<Family %d>");
1266 args
[1] = Fcar (address
);
1267 return Fformat (2, args
);
1276 list_processes_1 (query_only
)
1277 Lisp_Object query_only
;
1279 register Lisp_Object tail
, tem
;
1280 Lisp_Object proc
, minspace
, tem1
;
1281 register struct Lisp_Process
*p
;
1283 int w_proc
, w_buffer
, w_tty
;
1284 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1286 w_proc
= 4; /* Proc */
1287 w_buffer
= 6; /* Buffer */
1288 w_tty
= 0; /* Omit if no ttys */
1290 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1294 proc
= Fcdr (Fcar (tail
));
1295 p
= XPROCESS (proc
);
1296 if (NILP (p
->childp
))
1298 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1300 if (STRINGP (p
->name
)
1301 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1303 if (!NILP (p
->buffer
))
1305 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1306 w_buffer
= 8; /* (Killed) */
1307 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1310 if (STRINGP (p
->tty_name
)
1311 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1315 XSETFASTINT (i_status
, w_proc
+ 1);
1316 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1319 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1320 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1323 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1326 XSETFASTINT (minspace
, 1);
1328 set_buffer_internal (XBUFFER (Vstandard_output
));
1329 current_buffer
->undo_list
= Qt
;
1331 current_buffer
->truncate_lines
= Qt
;
1333 write_string ("Proc", -1);
1334 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1335 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1338 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1340 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1341 write_string ("\n", -1);
1343 write_string ("----", -1);
1344 Findent_to (i_status
, minspace
); write_string ("------", -1);
1345 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1348 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1350 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1351 write_string ("\n", -1);
1353 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1357 proc
= Fcdr (Fcar (tail
));
1358 p
= XPROCESS (proc
);
1359 if (NILP (p
->childp
))
1361 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1364 Finsert (1, &p
->name
);
1365 Findent_to (i_status
, minspace
);
1367 if (p
->raw_status_new
)
1370 if (CONSP (p
->status
))
1371 symbol
= XCAR (p
->status
);
1374 if (EQ (symbol
, Qsignal
))
1377 tem
= Fcar (Fcdr (p
->status
));
1379 if (XINT (tem
) < NSIG
)
1380 write_string (sys_errlist
[XINT (tem
)], -1);
1383 Fprinc (symbol
, Qnil
);
1385 else if (NETCONN1_P (p
))
1387 if (EQ (symbol
, Qexit
))
1388 write_string ("closed", -1);
1389 else if (EQ (p
->command
, Qt
))
1390 write_string ("stopped", -1);
1391 else if (EQ (symbol
, Qrun
))
1392 write_string ("open", -1);
1394 Fprinc (symbol
, Qnil
);
1397 Fprinc (symbol
, Qnil
);
1399 if (EQ (symbol
, Qexit
))
1402 tem
= Fcar (Fcdr (p
->status
));
1405 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1406 write_string (tembuf
, -1);
1410 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1411 remove_process (proc
);
1413 Findent_to (i_buffer
, minspace
);
1414 if (NILP (p
->buffer
))
1415 insert_string ("(none)");
1416 else if (NILP (XBUFFER (p
->buffer
)->name
))
1417 insert_string ("(Killed)");
1419 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1423 Findent_to (i_tty
, minspace
);
1424 if (STRINGP (p
->tty_name
))
1425 Finsert (1, &p
->tty_name
);
1428 Findent_to (i_command
, minspace
);
1430 if (EQ (p
->status
, Qlisten
))
1432 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1433 if (INTEGERP (port
))
1434 port
= Fnumber_to_string (port
);
1436 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1437 sprintf (tembuf
, "(network %s server on %s)\n",
1438 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1439 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1440 insert_string (tembuf
);
1442 else if (NETCONN1_P (p
))
1444 /* For a local socket, there is no host name,
1445 so display service instead. */
1446 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1447 if (!STRINGP (host
))
1449 host
= Fplist_get (p
->childp
, QCservice
);
1450 if (INTEGERP (host
))
1451 host
= Fnumber_to_string (host
);
1454 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1455 sprintf (tembuf
, "(network %s connection to %s)\n",
1456 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1457 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1458 insert_string (tembuf
);
1470 insert_string (" ");
1472 insert_string ("\n");
1478 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1479 doc
: /* Display a list of all processes.
1480 If optional argument QUERY-ONLY is non-nil, only processes with
1481 the query-on-exit flag set will be listed.
1482 Any process listed as exited or signaled is actually eliminated
1483 after the listing is made. */)
1485 Lisp_Object query_only
;
1487 internal_with_output_to_temp_buffer ("*Process List*",
1488 list_processes_1
, query_only
);
1492 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1493 doc
: /* Return a list of all processes. */)
1496 return Fmapcar (Qcdr
, Vprocess_alist
);
1499 /* Starting asynchronous inferior processes. */
1501 static Lisp_Object
start_process_unwind ();
1503 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1504 doc
: /* Start a program in a subprocess. Return the process object for it.
1505 NAME is name for process. It is modified if necessary to make it unique.
1506 BUFFER is the buffer (or buffer name) to associate with the process.
1507 Process output goes at end of that buffer, unless you specify
1508 an output stream or filter function to handle the output.
1509 BUFFER may be also nil, meaning that this process is not associated
1511 PROGRAM is the program file name. It is searched for in PATH.
1512 Remaining arguments are strings to give program as arguments.
1514 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1517 register Lisp_Object
*args
;
1519 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1521 register unsigned char *new_argv
;
1524 register unsigned char **new_argv
;
1527 int count
= SPECPDL_INDEX ();
1531 buffer
= Fget_buffer_create (buffer
);
1533 /* Make sure that the child will be able to chdir to the current
1534 buffer's current directory, or its unhandled equivalent. We
1535 can't just have the child check for an error when it does the
1536 chdir, since it's in a vfork.
1538 We have to GCPRO around this because Fexpand_file_name and
1539 Funhandled_file_name_directory might call a file name handling
1540 function. The argument list is protected by the caller, so all
1541 we really have to worry about is buffer. */
1543 struct gcpro gcpro1
, gcpro2
;
1545 current_dir
= current_buffer
->directory
;
1547 GCPRO2 (buffer
, current_dir
);
1550 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1552 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1553 report_file_error ("Setting current directory",
1554 Fcons (current_buffer
->directory
, Qnil
));
1560 CHECK_STRING (name
);
1564 CHECK_STRING (program
);
1566 proc
= make_process (name
);
1567 /* If an error occurs and we can't start the process, we want to
1568 remove it from the process list. This means that each error
1569 check in create_process doesn't need to call remove_process
1570 itself; it's all taken care of here. */
1571 record_unwind_protect (start_process_unwind
, proc
);
1573 XPROCESS (proc
)->childp
= Qt
;
1574 XPROCESS (proc
)->plist
= Qnil
;
1575 XPROCESS (proc
)->buffer
= buffer
;
1576 XPROCESS (proc
)->sentinel
= Qnil
;
1577 XPROCESS (proc
)->filter
= Qnil
;
1578 XPROCESS (proc
)->filter_multibyte
1579 = buffer_defaults
.enable_multibyte_characters
;
1580 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1582 #ifdef ADAPTIVE_READ_BUFFERING
1583 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1586 /* Make the process marker point into the process buffer (if any). */
1587 if (BUFFERP (buffer
))
1588 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1589 BUF_ZV (XBUFFER (buffer
)),
1590 BUF_ZV_BYTE (XBUFFER (buffer
)));
1593 /* Decide coding systems for communicating with the process. Here
1594 we don't setup the structure coding_system nor pay attention to
1595 unibyte mode. They are done in create_process. */
1597 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1598 Lisp_Object coding_systems
= Qt
;
1599 Lisp_Object val
, *args2
;
1600 struct gcpro gcpro1
, gcpro2
;
1602 val
= Vcoding_system_for_read
;
1605 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1606 args2
[0] = Qstart_process
;
1607 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1608 GCPRO2 (proc
, current_dir
);
1609 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1611 if (CONSP (coding_systems
))
1612 val
= XCAR (coding_systems
);
1613 else if (CONSP (Vdefault_process_coding_system
))
1614 val
= XCAR (Vdefault_process_coding_system
);
1616 XPROCESS (proc
)->decode_coding_system
= val
;
1618 val
= Vcoding_system_for_write
;
1621 if (EQ (coding_systems
, Qt
))
1623 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1624 args2
[0] = Qstart_process
;
1625 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1626 GCPRO2 (proc
, current_dir
);
1627 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1630 if (CONSP (coding_systems
))
1631 val
= XCDR (coding_systems
);
1632 else if (CONSP (Vdefault_process_coding_system
))
1633 val
= XCDR (Vdefault_process_coding_system
);
1635 XPROCESS (proc
)->encode_coding_system
= val
;
1639 /* Make a one member argv with all args concatenated
1640 together separated by a blank. */
1641 len
= SBYTES (program
) + 2;
1642 for (i
= 3; i
< nargs
; i
++)
1646 len
+= SBYTES (tem
) + 1; /* count the blank */
1648 new_argv
= (unsigned char *) alloca (len
);
1649 strcpy (new_argv
, SDATA (program
));
1650 for (i
= 3; i
< nargs
; i
++)
1654 strcat (new_argv
, " ");
1655 strcat (new_argv
, SDATA (tem
));
1657 /* Need to add code here to check for program existence on VMS */
1660 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1662 /* If program file name is not absolute, search our path for it.
1663 Put the name we will really use in TEM. */
1664 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1665 && !(SCHARS (program
) > 1
1666 && IS_DEVICE_SEP (SREF (program
, 1))))
1668 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1671 GCPRO4 (name
, program
, buffer
, current_dir
);
1672 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1675 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1676 tem
= Fexpand_file_name (tem
, Qnil
);
1680 if (!NILP (Ffile_directory_p (program
)))
1681 error ("Specified program for new process is a directory");
1685 /* If program file name starts with /: for quoting a magic name,
1687 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1688 && SREF (tem
, 1) == ':')
1689 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1691 /* Encode the file name and put it in NEW_ARGV.
1692 That's where the child will use it to execute the program. */
1693 tem
= ENCODE_FILE (tem
);
1694 new_argv
[0] = SDATA (tem
);
1696 /* Here we encode arguments by the coding system used for sending
1697 data to the process. We don't support using different coding
1698 systems for encoding arguments and for encoding data sent to the
1701 for (i
= 3; i
< nargs
; i
++)
1705 if (STRING_MULTIBYTE (tem
))
1706 tem
= (code_convert_string_norecord
1707 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1708 new_argv
[i
- 2] = SDATA (tem
);
1710 new_argv
[i
- 2] = 0;
1711 #endif /* not VMS */
1713 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1714 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1715 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1716 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1718 XPROCESS (proc
)->inherit_coding_system_flag
1719 = (NILP (buffer
) || !inherit_process_coding_system
1722 create_process (proc
, (char **) new_argv
, current_dir
);
1724 return unbind_to (count
, proc
);
1727 /* This function is the unwind_protect form for Fstart_process. If
1728 PROC doesn't have its pid set, then we know someone has signaled
1729 an error and the process wasn't started successfully, so we should
1730 remove it from the process list. */
1732 start_process_unwind (proc
)
1735 if (!PROCESSP (proc
))
1738 /* Was PROC started successfully? */
1739 if (XPROCESS (proc
)->pid
<= 0)
1740 remove_process (proc
);
1746 create_process_1 (timer
)
1747 struct atimer
*timer
;
1749 /* Nothing to do. */
1753 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1756 /* Mimic blocking of signals on system V, which doesn't really have it. */
1758 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1759 int sigchld_deferred
;
1762 create_process_sigchld ()
1764 signal (SIGCHLD
, create_process_sigchld
);
1766 sigchld_deferred
= 1;
1772 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1774 create_process (process
, new_argv
, current_dir
)
1775 Lisp_Object process
;
1777 Lisp_Object current_dir
;
1779 int pid
, inchannel
, outchannel
;
1781 #ifdef POSIX_SIGNALS
1784 struct sigaction sigint_action
;
1785 struct sigaction sigquit_action
;
1787 struct sigaction sighup_action
;
1789 #else /* !POSIX_SIGNALS */
1792 SIGTYPE (*sigchld
)();
1795 #endif /* !POSIX_SIGNALS */
1796 /* Use volatile to protect variables from being clobbered by longjmp. */
1797 volatile int forkin
, forkout
;
1798 volatile int pty_flag
= 0;
1800 extern char **environ
;
1803 inchannel
= outchannel
= -1;
1806 if (!NILP (Vprocess_connection_type
))
1807 outchannel
= inchannel
= allocate_pty ();
1811 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1812 /* On most USG systems it does not work to open the pty's tty here,
1813 then close it and reopen it in the child. */
1815 /* Don't let this terminal become our controlling terminal
1816 (in case we don't have one). */
1817 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1819 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1822 report_file_error ("Opening pty", Qnil
);
1823 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1824 /* In the case that vfork is defined as fork, the parent process
1825 (Emacs) may send some data before the child process completes
1826 tty options setup. So we setup tty before forking. */
1827 child_setup_tty (forkout
);
1828 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1830 forkin
= forkout
= -1;
1831 #endif /* not USG, or USG_SUBTTY_WORKS */
1835 #endif /* HAVE_PTYS */
1838 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1839 report_file_error ("Opening socketpair", Qnil
);
1840 outchannel
= inchannel
= sv
[0];
1841 forkout
= forkin
= sv
[1];
1843 #else /* not SKTPAIR */
1848 report_file_error ("Creating pipe", Qnil
);
1854 emacs_close (inchannel
);
1855 emacs_close (forkout
);
1856 report_file_error ("Creating pipe", Qnil
);
1861 #endif /* not SKTPAIR */
1864 /* Replaced by close_process_descs */
1865 set_exclusive_use (inchannel
);
1866 set_exclusive_use (outchannel
);
1869 /* Stride people say it's a mystery why this is needed
1870 as well as the O_NDELAY, but that it fails without this. */
1871 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1874 ioctl (inchannel
, FIONBIO
, &one
);
1879 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1880 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1883 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1884 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1888 /* Record this as an active process, with its channels.
1889 As a result, child_setup will close Emacs's side of the pipes. */
1890 chan_process
[inchannel
] = process
;
1891 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1892 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1894 /* Previously we recorded the tty descriptor used in the subprocess.
1895 It was only used for getting the foreground tty process, so now
1896 we just reopen the device (see emacs_get_tty_pgrp) as this is
1897 more portable (see USG_SUBTTY_WORKS above). */
1899 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1900 XPROCESS (process
)->status
= Qrun
;
1901 setup_process_coding_systems (process
);
1903 /* Delay interrupts until we have a chance to store
1904 the new fork's pid in its process structure */
1905 #ifdef POSIX_SIGNALS
1906 sigemptyset (&blocked
);
1908 sigaddset (&blocked
, SIGCHLD
);
1910 #ifdef HAVE_WORKING_VFORK
1911 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1912 this sets the parent's signal handlers as well as the child's.
1913 So delay all interrupts whose handlers the child might munge,
1914 and record the current handlers so they can be restored later. */
1915 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1916 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1918 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1920 #endif /* HAVE_WORKING_VFORK */
1921 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1922 #else /* !POSIX_SIGNALS */
1926 #else /* not BSD4_1 */
1927 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1928 sigsetmask (sigmask (SIGCHLD
));
1929 #else /* ordinary USG */
1931 sigchld_deferred
= 0;
1932 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1934 #endif /* ordinary USG */
1935 #endif /* not BSD4_1 */
1936 #endif /* SIGCHLD */
1937 #endif /* !POSIX_SIGNALS */
1939 FD_SET (inchannel
, &input_wait_mask
);
1940 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1941 if (inchannel
> max_process_desc
)
1942 max_process_desc
= inchannel
;
1944 /* Until we store the proper pid, enable sigchld_handler
1945 to recognize an unknown pid as standing for this process.
1946 It is very important not to let this `marker' value stay
1947 in the table after this function has returned; if it does
1948 it might cause call-process to hang and subsequent asynchronous
1949 processes to get their return values scrambled. */
1950 XPROCESS (process
)->pid
= -1;
1955 /* child_setup must clobber environ on systems with true vfork.
1956 Protect it from permanent change. */
1957 char **save_environ
= environ
;
1959 current_dir
= ENCODE_FILE (current_dir
);
1964 #endif /* not WINDOWSNT */
1966 int xforkin
= forkin
;
1967 int xforkout
= forkout
;
1969 #if 0 /* This was probably a mistake--it duplicates code later on,
1970 but fails to handle all the cases. */
1971 /* Make sure SIGCHLD is not blocked in the child. */
1972 sigsetmask (SIGEMPTYMASK
);
1975 /* Make the pty be the controlling terminal of the process. */
1977 /* First, disconnect its current controlling terminal. */
1979 /* We tried doing setsid only if pty_flag, but it caused
1980 process_set_signal to fail on SGI when using a pipe. */
1982 /* Make the pty's terminal the controlling terminal. */
1986 /* We ignore the return value
1987 because faith@cs.unc.edu says that is necessary on Linux. */
1988 ioctl (xforkin
, TIOCSCTTY
, 0);
1991 #else /* not HAVE_SETSID */
1993 /* It's very important to call setpgrp here and no time
1994 afterwards. Otherwise, we lose our controlling tty which
1995 is set when we open the pty. */
1998 #endif /* not HAVE_SETSID */
1999 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2000 if (pty_flag
&& xforkin
>= 0)
2003 tcgetattr (xforkin
, &t
);
2005 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2006 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2009 #if defined (NTTYDISC) && defined (TIOCSETD)
2010 if (pty_flag
&& xforkin
>= 0)
2012 /* Use new line discipline. */
2013 int ldisc
= NTTYDISC
;
2014 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2019 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2020 can do TIOCSPGRP only to the process's controlling tty. */
2023 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2024 I can't test it since I don't have 4.3. */
2025 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2026 ioctl (j
, TIOCNOTTY
, 0);
2029 /* In order to get a controlling terminal on some versions
2030 of BSD, it is necessary to put the process in pgrp 0
2031 before it opens the terminal. */
2039 #endif /* TIOCNOTTY */
2041 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2042 /*** There is a suggestion that this ought to be a
2043 conditional on TIOCSPGRP,
2044 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2045 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2046 that system does seem to need this code, even though
2047 both HAVE_SETSID and TIOCSCTTY are defined. */
2048 /* Now close the pty (if we had it open) and reopen it.
2049 This makes the pty the controlling terminal of the subprocess. */
2052 #ifdef SET_CHILD_PTY_PGRP
2053 int pgrp
= getpid ();
2056 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2059 emacs_close (xforkin
);
2060 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2064 emacs_write (1, "Couldn't open the pty terminal ", 31);
2065 emacs_write (1, pty_name
, strlen (pty_name
));
2066 emacs_write (1, "\n", 1);
2070 #ifdef SET_CHILD_PTY_PGRP
2071 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2072 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2075 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2077 #ifdef SETUP_SLAVE_PTY
2082 #endif /* SETUP_SLAVE_PTY */
2084 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2085 Now reenable it in the child, so it will die when we want it to. */
2087 signal (SIGHUP
, SIG_DFL
);
2089 #endif /* HAVE_PTYS */
2091 signal (SIGINT
, SIG_DFL
);
2092 signal (SIGQUIT
, SIG_DFL
);
2094 /* Stop blocking signals in the child. */
2095 #ifdef POSIX_SIGNALS
2096 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2097 #else /* !POSIX_SIGNALS */
2101 #else /* not BSD4_1 */
2102 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2103 sigsetmask (SIGEMPTYMASK
);
2104 #else /* ordinary USG */
2106 signal (SIGCHLD
, sigchld
);
2108 #endif /* ordinary USG */
2109 #endif /* not BSD4_1 */
2110 #endif /* SIGCHLD */
2111 #endif /* !POSIX_SIGNALS */
2113 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2115 child_setup_tty (xforkout
);
2116 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2118 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2119 new_argv
, 1, current_dir
);
2120 #else /* not WINDOWSNT */
2121 child_setup (xforkin
, xforkout
, xforkout
,
2122 new_argv
, 1, current_dir
);
2123 #endif /* not WINDOWSNT */
2125 environ
= save_environ
;
2130 /* This runs in the Emacs process. */
2134 emacs_close (forkin
);
2135 if (forkin
!= forkout
&& forkout
>= 0)
2136 emacs_close (forkout
);
2140 /* vfork succeeded. */
2141 XPROCESS (process
)->pid
= pid
;
2144 register_child (pid
, inchannel
);
2145 #endif /* WINDOWSNT */
2147 /* If the subfork execv fails, and it exits,
2148 this close hangs. I don't know why.
2149 So have an interrupt jar it loose. */
2151 struct atimer
*timer
;
2155 EMACS_SET_SECS_USECS (offset
, 1, 0);
2156 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2159 emacs_close (forkin
);
2161 cancel_atimer (timer
);
2165 if (forkin
!= forkout
&& forkout
>= 0)
2166 emacs_close (forkout
);
2170 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2173 XPROCESS (process
)->tty_name
= Qnil
;
2176 /* Restore the signal state whether vfork succeeded or not.
2177 (We will signal an error, below, if it failed.) */
2178 #ifdef POSIX_SIGNALS
2179 #ifdef HAVE_WORKING_VFORK
2180 /* Restore the parent's signal handlers. */
2181 sigaction (SIGINT
, &sigint_action
, 0);
2182 sigaction (SIGQUIT
, &sigquit_action
, 0);
2184 sigaction (SIGHUP
, &sighup_action
, 0);
2186 #endif /* HAVE_WORKING_VFORK */
2187 /* Stop blocking signals in the parent. */
2188 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2189 #else /* !POSIX_SIGNALS */
2193 #else /* not BSD4_1 */
2194 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2195 sigsetmask (SIGEMPTYMASK
);
2196 #else /* ordinary USG */
2198 signal (SIGCHLD
, sigchld
);
2199 /* Now really handle any of these signals
2200 that came in during this function. */
2201 if (sigchld_deferred
)
2202 kill (getpid (), SIGCHLD
);
2204 #endif /* ordinary USG */
2205 #endif /* not BSD4_1 */
2206 #endif /* SIGCHLD */
2207 #endif /* !POSIX_SIGNALS */
2209 /* Now generate the error if vfork failed. */
2211 report_file_error ("Doing vfork", Qnil
);
2213 #endif /* not VMS */
2218 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2219 The address family of sa is not included in the result. */
2222 conv_sockaddr_to_lisp (sa
, len
)
2223 struct sockaddr
*sa
;
2226 Lisp_Object address
;
2229 register struct Lisp_Vector
*p
;
2231 switch (sa
->sa_family
)
2235 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2236 len
= sizeof (sin
->sin_addr
) + 1;
2237 address
= Fmake_vector (make_number (len
), Qnil
);
2238 p
= XVECTOR (address
);
2239 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2240 cp
= (unsigned char *)&sin
->sin_addr
;
2246 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2247 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2248 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2249 address
= Fmake_vector (make_number (len
), Qnil
);
2250 p
= XVECTOR (address
);
2251 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2252 for (i
= 0; i
< len
; i
++)
2253 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2257 #ifdef HAVE_LOCAL_SOCKETS
2260 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2261 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2262 if (sockun
->sun_path
[i
] == 0)
2264 return make_unibyte_string (sockun
->sun_path
, i
);
2268 len
-= sizeof (sa
->sa_family
);
2269 address
= Fcons (make_number (sa
->sa_family
),
2270 Fmake_vector (make_number (len
), Qnil
));
2271 p
= XVECTOR (XCDR (address
));
2272 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2278 p
->contents
[i
++] = make_number (*cp
++);
2284 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2287 get_lisp_to_sockaddr_size (address
, familyp
)
2288 Lisp_Object address
;
2291 register struct Lisp_Vector
*p
;
2293 if (VECTORP (address
))
2295 p
= XVECTOR (address
);
2299 return sizeof (struct sockaddr_in
);
2302 else if (p
->size
== 9)
2304 *familyp
= AF_INET6
;
2305 return sizeof (struct sockaddr_in6
);
2309 #ifdef HAVE_LOCAL_SOCKETS
2310 else if (STRINGP (address
))
2312 *familyp
= AF_LOCAL
;
2313 return sizeof (struct sockaddr_un
);
2316 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2318 struct sockaddr
*sa
;
2319 *familyp
= XINT (XCAR (address
));
2320 p
= XVECTOR (XCDR (address
));
2321 return p
->size
+ sizeof (sa
->sa_family
);
2326 /* Convert an address object (vector or string) to an internal sockaddr.
2328 The address format has been basically validated by
2329 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2330 it could have come from user data. So if FAMILY is not valid,
2331 we return after zeroing *SA. */
2334 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2336 Lisp_Object address
;
2337 struct sockaddr
*sa
;
2340 register struct Lisp_Vector
*p
;
2341 register unsigned char *cp
= NULL
;
2346 if (VECTORP (address
))
2348 p
= XVECTOR (address
);
2349 if (family
== AF_INET
)
2351 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2352 len
= sizeof (sin
->sin_addr
) + 1;
2353 i
= XINT (p
->contents
[--len
]);
2354 sin
->sin_port
= htons (i
);
2355 cp
= (unsigned char *)&sin
->sin_addr
;
2356 sa
->sa_family
= family
;
2359 else if (family
== AF_INET6
)
2361 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2362 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2363 len
= sizeof (sin6
->sin6_addr
) + 1;
2364 i
= XINT (p
->contents
[--len
]);
2365 sin6
->sin6_port
= htons (i
);
2366 for (i
= 0; i
< len
; i
++)
2367 if (INTEGERP (p
->contents
[i
]))
2369 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2372 sa
->sa_family
= family
;
2377 else if (STRINGP (address
))
2379 #ifdef HAVE_LOCAL_SOCKETS
2380 if (family
== AF_LOCAL
)
2382 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2383 cp
= SDATA (address
);
2384 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2385 sockun
->sun_path
[i
] = *cp
++;
2386 sa
->sa_family
= family
;
2393 p
= XVECTOR (XCDR (address
));
2394 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2397 for (i
= 0; i
< len
; i
++)
2398 if (INTEGERP (p
->contents
[i
]))
2399 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2402 #ifdef DATAGRAM_SOCKETS
2403 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2405 doc
: /* Get the current datagram address associated with PROCESS. */)
2407 Lisp_Object process
;
2411 CHECK_PROCESS (process
);
2413 if (!DATAGRAM_CONN_P (process
))
2416 channel
= XINT (XPROCESS (process
)->infd
);
2417 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2418 datagram_address
[channel
].len
);
2421 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2423 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2424 Returns nil upon error setting address, ADDRESS otherwise. */)
2426 Lisp_Object process
, address
;
2431 CHECK_PROCESS (process
);
2433 if (!DATAGRAM_CONN_P (process
))
2436 channel
= XINT (XPROCESS (process
)->infd
);
2438 len
= get_lisp_to_sockaddr_size (address
, &family
);
2439 if (datagram_address
[channel
].len
!= len
)
2441 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2447 static struct socket_options
{
2448 /* The name of this option. Should be lowercase version of option
2449 name without SO_ prefix. */
2451 /* Option level SOL_... */
2453 /* Option number SO_... */
2455 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2456 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2457 } socket_options
[] =
2459 #ifdef SO_BINDTODEVICE
2460 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2463 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2466 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2469 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2472 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2475 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2478 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2481 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2483 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2486 /* Set option OPT to value VAL on socket S.
2488 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2489 Signals an error if setting a known option fails.
2493 set_socket_option (s
, opt
, val
)
2495 Lisp_Object opt
, val
;
2498 struct socket_options
*sopt
;
2503 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2504 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2505 if (strcmp (name
, sopt
->name
) == 0)
2508 switch (sopt
->opttype
)
2513 optval
= NILP (val
) ? 0 : 1;
2514 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2515 &optval
, sizeof (optval
));
2523 optval
= XINT (val
);
2525 error ("Bad option value for %s", name
);
2526 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2527 &optval
, sizeof (optval
));
2531 #ifdef SO_BINDTODEVICE
2534 char devname
[IFNAMSIZ
+1];
2536 /* This is broken, at least in the Linux 2.4 kernel.
2537 To unbind, the arg must be a zero integer, not the empty string.
2538 This should work on all systems. KFS. 2003-09-23. */
2539 bzero (devname
, sizeof devname
);
2542 char *arg
= (char *) SDATA (val
);
2543 int len
= min (strlen (arg
), IFNAMSIZ
);
2544 bcopy (arg
, devname
, len
);
2546 else if (!NILP (val
))
2547 error ("Bad option value for %s", name
);
2548 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2557 struct linger linger
;
2560 linger
.l_linger
= 0;
2562 linger
.l_linger
= XINT (val
);
2564 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2565 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2566 &linger
, sizeof (linger
));
2576 report_file_error ("Cannot set network option",
2577 Fcons (opt
, Fcons (val
, Qnil
)));
2578 return (1 << sopt
->optbit
);
2582 DEFUN ("set-network-process-option",
2583 Fset_network_process_option
, Sset_network_process_option
,
2585 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2586 See `make-network-process' for a list of options and values.
2587 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2588 OPTION is not a supported option, return nil instead; otherwise return t. */)
2589 (process
, option
, value
, no_error
)
2590 Lisp_Object process
, option
, value
;
2591 Lisp_Object no_error
;
2594 struct Lisp_Process
*p
;
2596 CHECK_PROCESS (process
);
2597 p
= XPROCESS (process
);
2598 if (!NETCONN1_P (p
))
2599 error ("Process is not a network process");
2603 error ("Process is not running");
2605 if (set_socket_option (s
, option
, value
))
2607 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2611 if (NILP (no_error
))
2612 error ("Unknown or unsupported option");
2618 /* A version of request_sigio suitable for a record_unwind_protect. */
2621 unwind_request_sigio (dummy
)
2624 if (interrupt_input
)
2629 /* Create a network stream/datagram client/server process. Treated
2630 exactly like a normal process when reading and writing. Primary
2631 differences are in status display and process deletion. A network
2632 connection has no PID; you cannot signal it. All you can do is
2633 stop/continue it and deactivate/close it via delete-process */
2635 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2637 doc
: /* Create and return a network server or client process.
2639 In Emacs, network connections are represented by process objects, so
2640 input and output work as for subprocesses and `delete-process' closes
2641 a network connection. However, a network process has no process id,
2642 it cannot be signaled, and the status codes are different from normal
2645 Arguments are specified as keyword/argument pairs. The following
2646 arguments are defined:
2648 :name NAME -- NAME is name for process. It is modified if necessary
2651 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2652 with the process. Process output goes at end of that buffer, unless
2653 you specify an output stream or filter function to handle the output.
2654 BUFFER may be also nil, meaning that this process is not associated
2657 :host HOST -- HOST is name of the host to connect to, or its IP
2658 address. The symbol `local' specifies the local host. If specified
2659 for a server process, it must be a valid name or address for the local
2660 host, and only clients connecting to that address will be accepted.
2662 :service SERVICE -- SERVICE is name of the service desired, or an
2663 integer specifying a port number to connect to. If SERVICE is t,
2664 a random port number is selected for the server.
2666 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2667 stream type connection, `datagram' creates a datagram type connection.
2669 :family FAMILY -- FAMILY is the address (and protocol) family for the
2670 service specified by HOST and SERVICE. The default (nil) is to use
2671 whatever address family (IPv4 or IPv6) that is defined for the host
2672 and port number specified by HOST and SERVICE. Other address families
2674 local -- for a local (i.e. UNIX) address specified by SERVICE.
2675 ipv4 -- use IPv4 address family only.
2676 ipv6 -- use IPv6 address family only.
2678 :local ADDRESS -- ADDRESS is the local address used for the connection.
2679 This parameter is ignored when opening a client process. When specified
2680 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2682 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2683 connection. This parameter is ignored when opening a stream server
2684 process. For a datagram server process, it specifies the initial
2685 setting of the remote datagram address. When specified for a client
2686 process, the FAMILY, HOST, and SERVICE args are ignored.
2688 The format of ADDRESS depends on the address family:
2689 - An IPv4 address is represented as an vector of integers [A B C D P]
2690 corresponding to numeric IP address A.B.C.D and port number P.
2691 - A local address is represented as a string with the address in the
2692 local address space.
2693 - An "unsupported family" address is represented by a cons (F . AV)
2694 where F is the family number and AV is a vector containing the socket
2695 address data with one element per address data byte. Do not rely on
2696 this format in portable code, as it may depend on implementation
2697 defined constants, data sizes, and data structure alignment.
2699 :coding CODING -- If CODING is a symbol, it specifies the coding
2700 system used for both reading and writing for this process. If CODING
2701 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2702 ENCODING is used for writing.
2704 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2705 return without waiting for the connection to complete; instead, the
2706 sentinel function will be called with second arg matching "open" (if
2707 successful) or "failed" when the connect completes. Default is to use
2708 a blocking connect (i.e. wait) for stream type connections.
2710 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2711 running when Emacs is exited.
2713 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2714 In the stopped state, a server process does not accept new
2715 connections, and a client process does not handle incoming traffic.
2716 The stopped state is cleared by `continue-process' and set by
2719 :filter FILTER -- Install FILTER as the process filter.
2721 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2722 process filter are multibyte, otherwise they are unibyte.
2723 If this keyword is not specified, the strings are multibyte iff
2724 `default-enable-multibyte-characters' is non-nil.
2726 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2728 :log LOG -- Install LOG as the server process log function. This
2729 function is called when the server accepts a network connection from a
2730 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2731 is the server process, CLIENT is the new process for the connection,
2732 and MESSAGE is a string.
2734 :plist PLIST -- Install PLIST as the new process' initial plist.
2736 :server QLEN -- if QLEN is non-nil, create a server process for the
2737 specified FAMILY, SERVICE, and connection type (stream or datagram).
2738 If QLEN is an integer, it is used as the max. length of the server's
2739 pending connection queue (also known as the backlog); the default
2740 queue length is 5. Default is to create a client process.
2742 The following network options can be specified for this connection:
2744 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2745 :dontroute BOOL -- Only send to directly connected hosts.
2746 :keepalive BOOL -- Send keep-alive messages on network stream.
2747 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2748 :oobinline BOOL -- Place out-of-band data in receive data stream.
2749 :priority INT -- Set protocol defined priority for sent packets.
2750 :reuseaddr BOOL -- Allow reusing a recently used local address
2751 (this is allowed by default for a server process).
2752 :bindtodevice NAME -- bind to interface NAME. Using this may require
2753 special privileges on some systems.
2755 Consult the relevant system programmer's manual pages for more
2756 information on using these options.
2759 A server process will listen for and accept connections from clients.
2760 When a client connection is accepted, a new network process is created
2761 for the connection with the following parameters:
2763 - The client's process name is constructed by concatenating the server
2764 process' NAME and a client identification string.
2765 - If the FILTER argument is non-nil, the client process will not get a
2766 separate process buffer; otherwise, the client's process buffer is a newly
2767 created buffer named after the server process' BUFFER name or process
2768 NAME concatenated with the client identification string.
2769 - The connection type and the process filter and sentinel parameters are
2770 inherited from the server process' TYPE, FILTER and SENTINEL.
2771 - The client process' contact info is set according to the client's
2772 addressing information (typically an IP address and a port number).
2773 - The client process' plist is initialized from the server's plist.
2775 Notice that the FILTER and SENTINEL args are never used directly by
2776 the server process. Also, the BUFFER argument is not used directly by
2777 the server process, but via the optional :log function, accepted (and
2778 failed) connections may be logged in the server process' buffer.
2780 The original argument list, modified with the actual connection
2781 information, is available via the `process-contact' function.
2783 usage: (make-network-process &rest ARGS) */)
2789 Lisp_Object contact
;
2790 struct Lisp_Process
*p
;
2791 #ifdef HAVE_GETADDRINFO
2792 struct addrinfo ai
, *res
, *lres
;
2793 struct addrinfo hints
;
2794 char *portstring
, portbuf
[128];
2795 #else /* HAVE_GETADDRINFO */
2796 struct _emacs_addrinfo
2802 struct sockaddr
*ai_addr
;
2803 struct _emacs_addrinfo
*ai_next
;
2805 #endif /* HAVE_GETADDRINFO */
2806 struct sockaddr_in address_in
;
2807 #ifdef HAVE_LOCAL_SOCKETS
2808 struct sockaddr_un address_un
;
2813 int s
= -1, outch
, inch
;
2814 struct gcpro gcpro1
;
2815 int count
= SPECPDL_INDEX ();
2817 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2819 Lisp_Object name
, buffer
, host
, service
, address
;
2820 Lisp_Object filter
, sentinel
;
2821 int is_non_blocking_client
= 0;
2822 int is_server
= 0, backlog
= 5;
2829 /* Save arguments for process-contact and clone-process. */
2830 contact
= Flist (nargs
, args
);
2834 /* Ensure socket support is loaded if available. */
2835 init_winsock (TRUE
);
2838 /* :type TYPE (nil: stream, datagram */
2839 tem
= Fplist_get (contact
, QCtype
);
2841 socktype
= SOCK_STREAM
;
2842 #ifdef DATAGRAM_SOCKETS
2843 else if (EQ (tem
, Qdatagram
))
2844 socktype
= SOCK_DGRAM
;
2847 error ("Unsupported connection type");
2850 tem
= Fplist_get (contact
, QCserver
);
2853 /* Don't support network sockets when non-blocking mode is
2854 not available, since a blocked Emacs is not useful. */
2855 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2856 error ("Network servers not supported");
2860 backlog
= XINT (tem
);
2864 /* Make QCaddress an alias for :local (server) or :remote (client). */
2865 QCaddress
= is_server
? QClocal
: QCremote
;
2868 if (!is_server
&& socktype
== SOCK_STREAM
2869 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2871 #ifndef NON_BLOCKING_CONNECT
2872 error ("Non-blocking connect not supported");
2874 is_non_blocking_client
= 1;
2878 name
= Fplist_get (contact
, QCname
);
2879 buffer
= Fplist_get (contact
, QCbuffer
);
2880 filter
= Fplist_get (contact
, QCfilter
);
2881 sentinel
= Fplist_get (contact
, QCsentinel
);
2883 CHECK_STRING (name
);
2886 /* Let's handle TERM before things get complicated ... */
2887 host
= Fplist_get (contact
, QChost
);
2888 CHECK_STRING (host
);
2890 service
= Fplist_get (contact
, QCservice
);
2891 if (INTEGERP (service
))
2892 port
= htons ((unsigned short) XINT (service
));
2895 struct servent
*svc_info
;
2896 CHECK_STRING (service
);
2897 svc_info
= getservbyname (SDATA (service
), "tcp");
2899 error ("Unknown service: %s", SDATA (service
));
2900 port
= svc_info
->s_port
;
2903 s
= connect_server (0);
2905 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2906 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2907 send_command (s
, C_DUMB
, 1, 0);
2909 #else /* not TERM */
2911 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2912 ai
.ai_socktype
= socktype
;
2917 /* :local ADDRESS or :remote ADDRESS */
2918 address
= Fplist_get (contact
, QCaddress
);
2919 if (!NILP (address
))
2921 host
= service
= Qnil
;
2923 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2924 error ("Malformed :address");
2925 ai
.ai_family
= family
;
2926 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2927 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2931 /* :family FAMILY -- nil (for Inet), local, or integer. */
2932 tem
= Fplist_get (contact
, QCfamily
);
2935 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2941 #ifdef HAVE_LOCAL_SOCKETS
2942 else if (EQ (tem
, Qlocal
))
2946 else if (EQ (tem
, Qipv6
))
2949 else if (EQ (tem
, Qipv4
))
2951 else if (INTEGERP (tem
))
2952 family
= XINT (tem
);
2954 error ("Unknown address family");
2956 ai
.ai_family
= family
;
2958 /* :service SERVICE -- string, integer (port number), or t (random port). */
2959 service
= Fplist_get (contact
, QCservice
);
2961 #ifdef HAVE_LOCAL_SOCKETS
2962 if (family
== AF_LOCAL
)
2964 /* Host is not used. */
2966 CHECK_STRING (service
);
2967 bzero (&address_un
, sizeof address_un
);
2968 address_un
.sun_family
= AF_LOCAL
;
2969 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2970 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2971 ai
.ai_addrlen
= sizeof address_un
;
2976 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2977 host
= Fplist_get (contact
, QChost
);
2980 if (EQ (host
, Qlocal
))
2981 host
= build_string ("localhost");
2982 CHECK_STRING (host
);
2985 /* Slow down polling to every ten seconds.
2986 Some kernels have a bug which causes retrying connect to fail
2987 after a connect. Polling can interfere with gethostbyname too. */
2988 #ifdef POLL_FOR_INPUT
2989 if (socktype
== SOCK_STREAM
)
2991 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2992 bind_polling_period (10);
2996 #ifdef HAVE_GETADDRINFO
2997 /* If we have a host, use getaddrinfo to resolve both host and service.
2998 Otherwise, use getservbyname to lookup the service. */
3002 /* SERVICE can either be a string or int.
3003 Convert to a C string for later use by getaddrinfo. */
3004 if (EQ (service
, Qt
))
3006 else if (INTEGERP (service
))
3008 sprintf (portbuf
, "%ld", (long) XINT (service
));
3009 portstring
= portbuf
;
3013 CHECK_STRING (service
);
3014 portstring
= SDATA (service
);
3019 memset (&hints
, 0, sizeof (hints
));
3021 hints
.ai_family
= family
;
3022 hints
.ai_socktype
= socktype
;
3023 hints
.ai_protocol
= 0;
3024 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3026 #ifdef HAVE_GAI_STRERROR
3027 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3029 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3035 #endif /* HAVE_GETADDRINFO */
3037 /* We end up here if getaddrinfo is not defined, or in case no hostname
3038 has been specified (e.g. for a local server process). */
3040 if (EQ (service
, Qt
))
3042 else if (INTEGERP (service
))
3043 port
= htons ((unsigned short) XINT (service
));
3046 struct servent
*svc_info
;
3047 CHECK_STRING (service
);
3048 svc_info
= getservbyname (SDATA (service
),
3049 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3051 error ("Unknown service: %s", SDATA (service
));
3052 port
= svc_info
->s_port
;
3055 bzero (&address_in
, sizeof address_in
);
3056 address_in
.sin_family
= family
;
3057 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3058 address_in
.sin_port
= port
;
3060 #ifndef HAVE_GETADDRINFO
3063 struct hostent
*host_info_ptr
;
3065 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3066 as it may `hang' Emacs for a very long time. */
3069 host_info_ptr
= gethostbyname (SDATA (host
));
3074 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3075 host_info_ptr
->h_length
);
3076 family
= host_info_ptr
->h_addrtype
;
3077 address_in
.sin_family
= family
;
3080 /* Attempt to interpret host as numeric inet address */
3082 IN_ADDR numeric_addr
;
3083 numeric_addr
= inet_addr ((char *) SDATA (host
));
3084 if (NUMERIC_ADDR_ERROR
)
3085 error ("Unknown host \"%s\"", SDATA (host
));
3087 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3088 sizeof (address_in
.sin_addr
));
3092 #endif /* not HAVE_GETADDRINFO */
3094 ai
.ai_family
= family
;
3095 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3096 ai
.ai_addrlen
= sizeof address_in
;
3100 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3101 when connect is interrupted. So let's not let it get interrupted.
3102 Note we do not turn off polling, because polling is only used
3103 when not interrupt_input, and thus not normally used on the systems
3104 which have this bug. On systems which use polling, there's no way
3105 to quit if polling is turned off. */
3107 && !is_server
&& socktype
== SOCK_STREAM
)
3109 /* Comment from KFS: The original open-network-stream code
3110 didn't unwind protect this, but it seems like the proper
3111 thing to do. In any case, I don't see how it could harm to
3112 do this -- and it makes cleanup (using unbind_to) easier. */
3113 record_unwind_protect (unwind_request_sigio
, Qnil
);
3117 /* Do this in case we never enter the for-loop below. */
3118 count1
= SPECPDL_INDEX ();
3121 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3127 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3134 #ifdef DATAGRAM_SOCKETS
3135 if (!is_server
&& socktype
== SOCK_DGRAM
)
3137 #endif /* DATAGRAM_SOCKETS */
3139 #ifdef NON_BLOCKING_CONNECT
3140 if (is_non_blocking_client
)
3143 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3145 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3157 /* Make us close S if quit. */
3158 record_unwind_protect (close_file_unwind
, make_number (s
));
3160 /* Parse network options in the arg list.
3161 We simply ignore anything which isn't a known option (including other keywords).
3162 An error is signalled if setting a known option fails. */
3163 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3164 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3168 /* Configure as a server socket. */
3170 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3171 explicit :reuseaddr key to override this. */
3172 #ifdef HAVE_LOCAL_SOCKETS
3173 if (family
!= AF_LOCAL
)
3175 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3178 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3179 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3182 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3183 report_file_error ("Cannot bind server socket", Qnil
);
3185 #ifdef HAVE_GETSOCKNAME
3186 if (EQ (service
, Qt
))
3188 struct sockaddr_in sa1
;
3189 int len1
= sizeof (sa1
);
3190 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3192 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3193 service
= make_number (ntohs (sa1
.sin_port
));
3194 contact
= Fplist_put (contact
, QCservice
, service
);
3199 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3200 report_file_error ("Cannot listen on server socket", Qnil
);
3208 /* This turns off all alarm-based interrupts; the
3209 bind_polling_period call above doesn't always turn all the
3210 short-interval ones off, especially if interrupt_input is
3213 It'd be nice to be able to control the connect timeout
3214 though. Would non-blocking connect calls be portable?
3216 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3218 turn_on_atimers (0);
3220 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3223 turn_on_atimers (1);
3225 if (ret
== 0 || xerrno
== EISCONN
)
3227 /* The unwind-protect will be discarded afterwards.
3228 Likewise for immediate_quit. */
3232 #ifdef NON_BLOCKING_CONNECT
3234 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3238 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3246 /* Discard the unwind protect closing S. */
3247 specpdl_ptr
= specpdl
+ count1
;
3251 if (xerrno
== EINTR
)
3257 #ifdef DATAGRAM_SOCKETS
3258 if (socktype
== SOCK_DGRAM
)
3260 if (datagram_address
[s
].sa
)
3262 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3263 datagram_address
[s
].len
= lres
->ai_addrlen
;
3267 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3268 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3271 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3272 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3273 conv_lisp_to_sockaddr (rfamily
, remote
,
3274 datagram_address
[s
].sa
, rlen
);
3278 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3281 contact
= Fplist_put (contact
, QCaddress
,
3282 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3283 #ifdef HAVE_GETSOCKNAME
3286 struct sockaddr_in sa1
;
3287 int len1
= sizeof (sa1
);
3288 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3289 contact
= Fplist_put (contact
, QClocal
,
3290 conv_sockaddr_to_lisp (&sa1
, len1
));
3295 #ifdef HAVE_GETADDRINFO
3302 /* Discard the unwind protect for closing S, if any. */
3303 specpdl_ptr
= specpdl
+ count1
;
3305 /* Unwind bind_polling_period and request_sigio. */
3306 unbind_to (count
, Qnil
);
3310 /* If non-blocking got this far - and failed - assume non-blocking is
3311 not supported after all. This is probably a wrong assumption, but
3312 the normal blocking calls to open-network-stream handles this error
3314 if (is_non_blocking_client
)
3319 report_file_error ("make server process failed", contact
);
3321 report_file_error ("make client process failed", contact
);
3324 #endif /* not TERM */
3330 buffer
= Fget_buffer_create (buffer
);
3331 proc
= make_process (name
);
3333 chan_process
[inch
] = proc
;
3336 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3339 fcntl (inch
, F_SETFL
, O_NDELAY
);
3343 p
= XPROCESS (proc
);
3345 p
->childp
= contact
;
3346 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3349 p
->sentinel
= sentinel
;
3351 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3352 /* Override the above only if :filter-multibyte is specified. */
3353 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3354 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3355 p
->log
= Fplist_get (contact
, QClog
);
3356 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3357 p
->kill_without_query
= Qt
;
3358 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3361 XSETINT (p
->infd
, inch
);
3362 XSETINT (p
->outfd
, outch
);
3363 if (is_server
&& socktype
== SOCK_STREAM
)
3364 p
->status
= Qlisten
;
3366 /* Make the process marker point into the process buffer (if any). */
3367 if (BUFFERP (buffer
))
3368 set_marker_both (p
->mark
, buffer
,
3369 BUF_ZV (XBUFFER (buffer
)),
3370 BUF_ZV_BYTE (XBUFFER (buffer
)));
3372 #ifdef NON_BLOCKING_CONNECT
3373 if (is_non_blocking_client
)
3375 /* We may get here if connect did succeed immediately. However,
3376 in that case, we still need to signal this like a non-blocking
3378 p
->status
= Qconnect
;
3379 if (!FD_ISSET (inch
, &connect_wait_mask
))
3381 FD_SET (inch
, &connect_wait_mask
);
3382 num_pending_connects
++;
3387 /* A server may have a client filter setting of Qt, but it must
3388 still listen for incoming connects unless it is stopped. */
3389 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3390 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3392 FD_SET (inch
, &input_wait_mask
);
3393 FD_SET (inch
, &non_keyboard_wait_mask
);
3396 if (inch
> max_process_desc
)
3397 max_process_desc
= inch
;
3399 tem
= Fplist_member (contact
, QCcoding
);
3400 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3401 tem
= Qnil
; /* No error message (too late!). */
3404 /* Setup coding systems for communicating with the network stream. */
3405 struct gcpro gcpro1
;
3406 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3407 Lisp_Object coding_systems
= Qt
;
3408 Lisp_Object args
[5], val
;
3412 val
= XCAR (XCDR (tem
));
3416 else if (!NILP (Vcoding_system_for_read
))
3417 val
= Vcoding_system_for_read
;
3418 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3419 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3420 /* We dare not decode end-of-line format by setting VAL to
3421 Qraw_text, because the existing Emacs Lisp libraries
3422 assume that they receive bare code including a sequene of
3427 if (NILP (host
) || NILP (service
))
3428 coding_systems
= Qnil
;
3431 args
[0] = Qopen_network_stream
, args
[1] = name
,
3432 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3434 coding_systems
= Ffind_operation_coding_system (5, args
);
3437 if (CONSP (coding_systems
))
3438 val
= XCAR (coding_systems
);
3439 else if (CONSP (Vdefault_process_coding_system
))
3440 val
= XCAR (Vdefault_process_coding_system
);
3444 p
->decode_coding_system
= val
;
3448 val
= XCAR (XCDR (tem
));
3452 else if (!NILP (Vcoding_system_for_write
))
3453 val
= Vcoding_system_for_write
;
3454 else if (NILP (current_buffer
->enable_multibyte_characters
))
3458 if (EQ (coding_systems
, Qt
))
3460 if (NILP (host
) || NILP (service
))
3461 coding_systems
= Qnil
;
3464 args
[0] = Qopen_network_stream
, args
[1] = name
,
3465 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3467 coding_systems
= Ffind_operation_coding_system (5, args
);
3471 if (CONSP (coding_systems
))
3472 val
= XCDR (coding_systems
);
3473 else if (CONSP (Vdefault_process_coding_system
))
3474 val
= XCDR (Vdefault_process_coding_system
);
3478 p
->encode_coding_system
= val
;
3480 setup_process_coding_systems (proc
);
3482 p
->decoding_buf
= make_uninit_string (0);
3483 p
->decoding_carryover
= make_number (0);
3484 p
->encoding_buf
= make_uninit_string (0);
3485 p
->encoding_carryover
= make_number (0);
3487 p
->inherit_coding_system_flag
3488 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3494 #endif /* HAVE_SOCKETS */
3497 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3500 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3501 doc
: /* Return an alist of all network interfaces and their network address.
3502 Each element is a cons, the car of which is a string containing the
3503 interface name, and the cdr is the network address in internal
3504 format; see the description of ADDRESS in `make-network-process'. */)
3507 struct ifconf ifconf
;
3508 struct ifreq
*ifreqs
= NULL
;
3513 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3519 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3520 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3527 ifconf
.ifc_len
= buf_size
;
3528 ifconf
.ifc_req
= ifreqs
;
3529 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3535 if (ifconf
.ifc_len
== buf_size
)
3539 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3542 while (--ifaces
>= 0)
3544 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3545 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3546 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3548 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3549 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3550 res
= Fcons (Fcons (build_string (namebuf
),
3551 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3552 sizeof (struct sockaddr
))),
3558 #endif /* SIOCGIFCONF */
3560 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3567 static struct ifflag_def ifflag_table
[] = {
3571 #ifdef IFF_BROADCAST
3572 { IFF_BROADCAST
, "broadcast" },
3575 { IFF_DEBUG
, "debug" },
3578 { IFF_LOOPBACK
, "loopback" },
3580 #ifdef IFF_POINTOPOINT
3581 { IFF_POINTOPOINT
, "pointopoint" },
3584 { IFF_RUNNING
, "running" },
3587 { IFF_NOARP
, "noarp" },
3590 { IFF_PROMISC
, "promisc" },
3592 #ifdef IFF_NOTRAILERS
3593 { IFF_NOTRAILERS
, "notrailers" },
3596 { IFF_ALLMULTI
, "allmulti" },
3599 { IFF_MASTER
, "master" },
3602 { IFF_SLAVE
, "slave" },
3604 #ifdef IFF_MULTICAST
3605 { IFF_MULTICAST
, "multicast" },
3608 { IFF_PORTSEL
, "portsel" },
3610 #ifdef IFF_AUTOMEDIA
3611 { IFF_AUTOMEDIA
, "automedia" },
3614 { IFF_DYNAMIC
, "dynamic" },
3617 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3620 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3623 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3626 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3629 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3634 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3635 doc
: /* Return information about network interface named IFNAME.
3636 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3637 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3638 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3639 FLAGS is the current flags of the interface. */)
3644 Lisp_Object res
= Qnil
;
3649 CHECK_STRING (ifname
);
3651 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3652 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3654 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3659 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3660 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3662 int flags
= rq
.ifr_flags
;
3663 struct ifflag_def
*fp
;
3667 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3669 if (flags
& fp
->flag_bit
)
3671 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3672 flags
-= fp
->flag_bit
;
3675 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3677 if (flags
& (1 << fnum
))
3679 elt
= Fcons (make_number (fnum
), elt
);
3684 res
= Fcons (elt
, res
);
3687 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3688 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3690 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3691 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3695 for (n
= 0; n
< 6; n
++)
3696 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3697 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3700 res
= Fcons (elt
, res
);
3703 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3704 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3707 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3708 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3710 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3714 res
= Fcons (elt
, res
);
3717 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3718 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3721 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3724 res
= Fcons (elt
, res
);
3727 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3728 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3731 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3734 res
= Fcons (elt
, res
);
3738 return any
? res
: Qnil
;
3741 #endif /* HAVE_SOCKETS */
3743 /* Turn off input and output for process PROC. */
3746 deactivate_process (proc
)
3749 register int inchannel
, outchannel
;
3750 register struct Lisp_Process
*p
= XPROCESS (proc
);
3752 inchannel
= XINT (p
->infd
);
3753 outchannel
= XINT (p
->outfd
);
3755 #ifdef ADAPTIVE_READ_BUFFERING
3756 if (XINT (p
->read_output_delay
) > 0)
3758 if (--process_output_delay_count
< 0)
3759 process_output_delay_count
= 0;
3760 XSETINT (p
->read_output_delay
, 0);
3761 p
->read_output_skip
= Qnil
;
3767 /* Beware SIGCHLD hereabouts. */
3768 flush_pending_output (inchannel
);
3771 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3772 sys$
dassgn (outchannel
);
3773 vs
= get_vms_process_pointer (p
->pid
);
3775 give_back_vms_process_stuff (vs
);
3778 emacs_close (inchannel
);
3779 if (outchannel
>= 0 && outchannel
!= inchannel
)
3780 emacs_close (outchannel
);
3783 XSETINT (p
->infd
, -1);
3784 XSETINT (p
->outfd
, -1);
3785 #ifdef DATAGRAM_SOCKETS
3786 if (DATAGRAM_CHAN_P (inchannel
))
3788 xfree (datagram_address
[inchannel
].sa
);
3789 datagram_address
[inchannel
].sa
= 0;
3790 datagram_address
[inchannel
].len
= 0;
3793 chan_process
[inchannel
] = Qnil
;
3794 FD_CLR (inchannel
, &input_wait_mask
);
3795 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3796 #ifdef NON_BLOCKING_CONNECT
3797 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3799 FD_CLR (inchannel
, &connect_wait_mask
);
3800 if (--num_pending_connects
< 0)
3804 if (inchannel
== max_process_desc
)
3807 /* We just closed the highest-numbered process input descriptor,
3808 so recompute the highest-numbered one now. */
3809 max_process_desc
= 0;
3810 for (i
= 0; i
< MAXDESC
; i
++)
3811 if (!NILP (chan_process
[i
]))
3812 max_process_desc
= i
;
3817 /* Close all descriptors currently in use for communication
3818 with subprocess. This is used in a newly-forked subprocess
3819 to get rid of irrelevant descriptors. */
3822 close_process_descs ()
3826 for (i
= 0; i
< MAXDESC
; i
++)
3828 Lisp_Object process
;
3829 process
= chan_process
[i
];
3830 if (!NILP (process
))
3832 int in
= XINT (XPROCESS (process
)->infd
);
3833 int out
= XINT (XPROCESS (process
)->outfd
);
3836 if (out
>= 0 && in
!= out
)
3843 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3845 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3846 It is read into the process' buffers or given to their filter functions.
3847 Non-nil arg PROCESS means do not return until some output has been received
3850 Non-nil second arg SECONDS and third arg MILLISEC are number of
3851 seconds and milliseconds to wait; return after that much time whether
3852 or not there is input. If SECONDS is a floating point number,
3853 it specifies a fractional number of seconds to wait.
3855 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3856 from PROCESS, suspending reading output from other processes.
3857 If JUST-THIS-ONE is an integer, don't run any timers either.
3858 Return non-nil iff we received any output before the timeout expired. */)
3859 (process
, seconds
, millisec
, just_this_one
)
3860 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3862 int secs
, usecs
= 0;
3864 if (! NILP (process
))
3865 CHECK_PROCESS (process
);
3867 just_this_one
= Qnil
;
3869 if (!NILP (seconds
))
3871 if (INTEGERP (seconds
))
3872 secs
= XINT (seconds
);
3873 else if (FLOATP (seconds
))
3875 double timeout
= XFLOAT_DATA (seconds
);
3876 secs
= (int) timeout
;
3877 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3880 wrong_type_argument (Qnumberp
, seconds
);
3882 if (INTEGERP (millisec
))
3885 usecs
+= XINT (millisec
) * 1000;
3886 carry
= usecs
/ 1000000;
3888 if ((usecs
-= carry
* 1000000) < 0)
3895 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3896 secs
= -1, usecs
= 0;
3899 secs
= NILP (process
) ? -1 : 0;
3902 (wait_reading_process_output (secs
, usecs
, 0, 0,
3904 !NILP (process
) ? XPROCESS (process
) : NULL
,
3905 NILP (just_this_one
) ? 0 :
3906 !INTEGERP (just_this_one
) ? 1 : -1)
3910 /* Accept a connection for server process SERVER on CHANNEL. */
3912 static int connect_counter
= 0;
3915 server_accept_connection (server
, channel
)
3919 Lisp_Object proc
, caller
, name
, buffer
;
3920 Lisp_Object contact
, host
, service
;
3921 struct Lisp_Process
*ps
= XPROCESS (server
);
3922 struct Lisp_Process
*p
;
3926 struct sockaddr_in in
;
3928 struct sockaddr_in6 in6
;
3930 #ifdef HAVE_LOCAL_SOCKETS
3931 struct sockaddr_un un
;
3934 int len
= sizeof saddr
;
3936 s
= accept (channel
, &saddr
.sa
, &len
);
3945 if (code
== EWOULDBLOCK
)
3949 if (!NILP (ps
->log
))
3950 call3 (ps
->log
, server
, Qnil
,
3951 concat3 (build_string ("accept failed with code"),
3952 Fnumber_to_string (make_number (code
)),
3953 build_string ("\n")));
3959 /* Setup a new process to handle the connection. */
3961 /* Generate a unique identification of the caller, and build contact
3962 information for this process. */
3965 switch (saddr
.sa
.sa_family
)
3969 Lisp_Object args
[5];
3970 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3971 args
[0] = build_string ("%d.%d.%d.%d");
3972 args
[1] = make_number (*ip
++);
3973 args
[2] = make_number (*ip
++);
3974 args
[3] = make_number (*ip
++);
3975 args
[4] = make_number (*ip
++);
3976 host
= Fformat (5, args
);
3977 service
= make_number (ntohs (saddr
.in
.sin_port
));
3979 args
[0] = build_string (" <%s:%d>");
3982 caller
= Fformat (3, args
);
3989 Lisp_Object args
[9];
3990 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
3992 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
3993 for (i
= 0; i
< 8; i
++)
3994 args
[i
+1] = make_number (ntohs(ip6
[i
]));
3995 host
= Fformat (9, args
);
3996 service
= make_number (ntohs (saddr
.in
.sin_port
));
3998 args
[0] = build_string (" <[%s]:%d>");
4001 caller
= Fformat (3, args
);
4006 #ifdef HAVE_LOCAL_SOCKETS
4010 caller
= Fnumber_to_string (make_number (connect_counter
));
4011 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4015 /* Create a new buffer name for this process if it doesn't have a
4016 filter. The new buffer name is based on the buffer name or
4017 process name of the server process concatenated with the caller
4020 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4024 buffer
= ps
->buffer
;
4026 buffer
= Fbuffer_name (buffer
);
4031 buffer
= concat2 (buffer
, caller
);
4032 buffer
= Fget_buffer_create (buffer
);
4036 /* Generate a unique name for the new server process. Combine the
4037 server process name with the caller identification. */
4039 name
= concat2 (ps
->name
, caller
);
4040 proc
= make_process (name
);
4042 chan_process
[s
] = proc
;
4045 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4048 fcntl (s
, F_SETFL
, O_NDELAY
);
4052 p
= XPROCESS (proc
);
4054 /* Build new contact information for this setup. */
4055 contact
= Fcopy_sequence (ps
->childp
);
4056 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4057 contact
= Fplist_put (contact
, QChost
, host
);
4058 if (!NILP (service
))
4059 contact
= Fplist_put (contact
, QCservice
, service
);
4060 contact
= Fplist_put (contact
, QCremote
,
4061 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4062 #ifdef HAVE_GETSOCKNAME
4064 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4065 contact
= Fplist_put (contact
, QClocal
,
4066 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4069 p
->childp
= contact
;
4070 p
->plist
= Fcopy_sequence (ps
->plist
);
4073 p
->sentinel
= ps
->sentinel
;
4074 p
->filter
= ps
->filter
;
4077 XSETINT (p
->infd
, s
);
4078 XSETINT (p
->outfd
, s
);
4081 /* Client processes for accepted connections are not stopped initially. */
4082 if (!EQ (p
->filter
, Qt
))
4084 FD_SET (s
, &input_wait_mask
);
4085 FD_SET (s
, &non_keyboard_wait_mask
);
4088 if (s
> max_process_desc
)
4089 max_process_desc
= s
;
4091 /* Setup coding system for new process based on server process.
4092 This seems to be the proper thing to do, as the coding system
4093 of the new process should reflect the settings at the time the
4094 server socket was opened; not the current settings. */
4096 p
->decode_coding_system
= ps
->decode_coding_system
;
4097 p
->encode_coding_system
= ps
->encode_coding_system
;
4098 setup_process_coding_systems (proc
);
4100 p
->decoding_buf
= make_uninit_string (0);
4101 p
->decoding_carryover
= make_number (0);
4102 p
->encoding_buf
= make_uninit_string (0);
4103 p
->encoding_carryover
= make_number (0);
4105 p
->inherit_coding_system_flag
4106 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4108 if (!NILP (ps
->log
))
4109 call3 (ps
->log
, server
, proc
,
4110 concat3 (build_string ("accept from "),
4111 (STRINGP (host
) ? host
: build_string ("-")),
4112 build_string ("\n")));
4114 if (!NILP (p
->sentinel
))
4115 exec_sentinel (proc
,
4116 concat3 (build_string ("open from "),
4117 (STRINGP (host
) ? host
: build_string ("-")),
4118 build_string ("\n")));
4121 /* This variable is different from waiting_for_input in keyboard.c.
4122 It is used to communicate to a lisp process-filter/sentinel (via the
4123 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4124 for user-input when that process-filter was called.
4125 waiting_for_input cannot be used as that is by definition 0 when
4126 lisp code is being evalled.
4127 This is also used in record_asynch_buffer_change.
4128 For that purpose, this must be 0
4129 when not inside wait_reading_process_output. */
4130 static int waiting_for_user_input_p
;
4132 /* This is here so breakpoints can be put on it. */
4134 wait_reading_process_output_1 ()
4138 /* Read and dispose of subprocess output while waiting for timeout to
4139 elapse and/or keyboard input to be available.
4142 timeout in seconds, or
4143 zero for no limit, or
4144 -1 means gobble data immediately available but don't wait for any.
4147 an additional duration to wait, measured in microseconds.
4148 If this is nonzero and time_limit is 0, then the timeout
4149 consists of MICROSECS only.
4151 READ_KBD is a lisp value:
4152 0 to ignore keyboard input, or
4153 1 to return when input is available, or
4154 -1 meaning caller will actually read the input, so don't throw to
4155 the quit handler, or
4157 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4158 output that arrives.
4160 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4161 (and gobble terminal input into the buffer if any arrives).
4163 If WAIT_PROC is specified, wait until something arrives from that
4164 process. The return value is true iff we read some input from
4167 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4168 (suspending output from other processes). A negative value
4169 means don't run any timers either.
4171 If WAIT_PROC is specified, then the function returns true iff we
4172 received input from that process before the timeout elapsed.
4173 Otherwise, return true iff we received input from any process. */
4176 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4177 wait_for_cell
, wait_proc
, just_wait_proc
)
4178 int time_limit
, microsecs
, read_kbd
, do_display
;
4179 Lisp_Object wait_for_cell
;
4180 struct Lisp_Process
*wait_proc
;
4183 register int channel
, nfds
;
4184 SELECT_TYPE Available
;
4185 #ifdef NON_BLOCKING_CONNECT
4186 SELECT_TYPE Connecting
;
4189 int check_delay
, no_avail
;
4192 EMACS_TIME timeout
, end_time
;
4193 int wait_channel
= -1;
4194 int got_some_input
= 0;
4195 /* Either nil or a cons cell, the car of which is of interest and
4196 may be changed outside of this routine. */
4197 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4199 FD_ZERO (&Available
);
4200 #ifdef NON_BLOCKING_CONNECT
4201 FD_ZERO (&Connecting
);
4204 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4205 if (wait_proc
!= NULL
)
4206 wait_channel
= XINT (wait_proc
->infd
);
4208 waiting_for_user_input_p
= read_kbd
;
4210 /* Since we may need to wait several times,
4211 compute the absolute time to return at. */
4212 if (time_limit
|| microsecs
)
4214 EMACS_GET_TIME (end_time
);
4215 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4216 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4218 #ifdef POLL_INTERRUPTED_SYS_CALL
4219 /* AlainF 5-Jul-1996
4220 HP-UX 10.10 seem to have problems with signals coming in
4221 Causes "poll: interrupted system call" messages when Emacs is run
4223 Turn off periodic alarms (in case they are in use),
4224 and then turn off any other atimers. */
4226 turn_on_atimers (0);
4227 #endif /* POLL_INTERRUPTED_SYS_CALL */
4231 int timeout_reduced_for_timers
= 0;
4233 /* If calling from keyboard input, do not quit
4234 since we want to return C-g as an input character.
4235 Otherwise, do pending quit if requested. */
4239 else if (interrupt_input_pending
)
4240 handle_async_input ();
4243 /* Exit now if the cell we're waiting for became non-nil. */
4244 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4247 /* Compute time from now till when time limit is up */
4248 /* Exit if already run out */
4249 if (time_limit
== -1)
4251 /* -1 specified for timeout means
4252 gobble output available now
4253 but don't wait at all. */
4255 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4257 else if (time_limit
|| microsecs
)
4259 EMACS_GET_TIME (timeout
);
4260 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4261 if (EMACS_TIME_NEG_P (timeout
))
4266 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4269 /* Normally we run timers here.
4270 But not if wait_for_cell; in those cases,
4271 the wait is supposed to be short,
4272 and those callers cannot handle running arbitrary Lisp code here. */
4273 if (NILP (wait_for_cell
)
4274 && just_wait_proc
>= 0)
4276 EMACS_TIME timer_delay
;
4280 int old_timers_run
= timers_run
;
4281 struct buffer
*old_buffer
= current_buffer
;
4283 timer_delay
= timer_check (1);
4285 /* If a timer has run, this might have changed buffers
4286 an alike. Make read_key_sequence aware of that. */
4287 if (timers_run
!= old_timers_run
4288 && old_buffer
!= current_buffer
4289 && waiting_for_user_input_p
== -1)
4290 record_asynch_buffer_change ();
4292 if (timers_run
!= old_timers_run
&& do_display
)
4293 /* We must retry, since a timer may have requeued itself
4294 and that could alter the time_delay. */
4295 redisplay_preserve_echo_area (9);
4299 while (!detect_input_pending ());
4301 /* If there is unread keyboard input, also return. */
4303 && requeued_events_pending_p ())
4306 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4308 EMACS_TIME difference
;
4309 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4310 if (EMACS_TIME_NEG_P (difference
))
4312 timeout
= timer_delay
;
4313 timeout_reduced_for_timers
= 1;
4316 /* If time_limit is -1, we are not going to wait at all. */
4317 else if (time_limit
!= -1)
4319 /* This is so a breakpoint can be put here. */
4320 wait_reading_process_output_1 ();
4324 /* Cause C-g and alarm signals to take immediate action,
4325 and cause input available signals to zero out timeout.
4327 It is important that we do this before checking for process
4328 activity. If we get a SIGCHLD after the explicit checks for
4329 process activity, timeout is the only way we will know. */
4331 set_waiting_for_input (&timeout
);
4333 /* If status of something has changed, and no input is
4334 available, notify the user of the change right away. After
4335 this explicit check, we'll let the SIGCHLD handler zap
4336 timeout to get our attention. */
4337 if (update_tick
!= process_tick
&& do_display
)
4340 #ifdef NON_BLOCKING_CONNECT
4344 Atemp
= input_wait_mask
;
4346 /* On Mac OS X 10.0, the SELECT system call always says input is
4347 present (for reading) at stdin, even when none is. This
4348 causes the call to SELECT below to return 1 and
4349 status_notify not to be called. As a result output of
4350 subprocesses are incorrectly discarded.
4354 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4356 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4357 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4359 #ifdef NON_BLOCKING_CONNECT
4360 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4364 (SELECT_TYPE
*)0, &timeout
)
4367 /* It's okay for us to do this and then continue with
4368 the loop, since timeout has already been zeroed out. */
4369 clear_waiting_for_input ();
4370 status_notify (NULL
);
4374 /* Don't wait for output from a non-running process. Just
4375 read whatever data has already been received. */
4376 if (wait_proc
&& wait_proc
->raw_status_new
)
4377 update_status (wait_proc
);
4379 && ! EQ (wait_proc
->status
, Qrun
)
4380 && ! EQ (wait_proc
->status
, Qconnect
))
4382 int nread
, total_nread
= 0;
4384 clear_waiting_for_input ();
4385 XSETPROCESS (proc
, wait_proc
);
4387 /* Read data from the process, until we exhaust it. */
4388 while (XINT (wait_proc
->infd
) >= 0)
4390 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4396 total_nread
+= nread
;
4398 else if (nread
== -1 && EIO
== errno
)
4402 else if (nread
== -1 && EAGAIN
== errno
)
4406 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4410 if (total_nread
> 0 && do_display
)
4411 redisplay_preserve_echo_area (10);
4416 /* Wait till there is something to do */
4418 if (wait_proc
&& just_wait_proc
)
4420 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4422 FD_SET (XINT (wait_proc
->infd
), &Available
);
4424 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4426 else if (!NILP (wait_for_cell
))
4428 Available
= non_process_wait_mask
;
4430 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4435 Available
= non_keyboard_wait_mask
;
4437 Available
= input_wait_mask
;
4438 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4439 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4442 /* If frame size has changed or the window is newly mapped,
4443 redisplay now, before we start to wait. There is a race
4444 condition here; if a SIGIO arrives between now and the select
4445 and indicates that a frame is trashed, the select may block
4446 displaying a trashed screen. */
4447 if (frame_garbaged
&& do_display
)
4449 clear_waiting_for_input ();
4450 redisplay_preserve_echo_area (11);
4452 set_waiting_for_input (&timeout
);
4456 if (read_kbd
&& detect_input_pending ())
4463 #ifdef NON_BLOCKING_CONNECT
4465 Connecting
= connect_wait_mask
;
4468 #ifdef ADAPTIVE_READ_BUFFERING
4469 /* Set the timeout for adaptive read buffering if any
4470 process has non-nil read_output_skip and non-zero
4471 read_output_delay, and we are not reading output for a
4472 specific wait_channel. It is not executed if
4473 Vprocess_adaptive_read_buffering is nil. */
4474 if (process_output_skip
&& check_delay
> 0)
4476 int usecs
= EMACS_USECS (timeout
);
4477 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4478 usecs
= READ_OUTPUT_DELAY_MAX
;
4479 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4481 proc
= chan_process
[channel
];
4484 /* Find minimum non-zero read_output_delay among the
4485 processes with non-nil read_output_skip. */
4486 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4489 if (NILP (XPROCESS (proc
)->read_output_skip
))
4491 FD_CLR (channel
, &Available
);
4492 XPROCESS (proc
)->read_output_skip
= Qnil
;
4493 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4494 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4497 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4498 process_output_skip
= 0;
4502 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4504 #ifdef NON_BLOCKING_CONNECT
4505 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4509 (SELECT_TYPE
*)0, &timeout
);
4514 /* Make C-g and alarm signals set flags again */
4515 clear_waiting_for_input ();
4517 /* If we woke up due to SIGWINCH, actually change size now. */
4518 do_pending_window_change (0);
4520 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4521 /* We wanted the full specified time, so return now. */
4525 if (xerrno
== EINTR
)
4528 /* Ultrix select seems to return ENOMEM when it is
4529 interrupted. Treat it just like EINTR. Bleah. Note
4530 that we want to test for the "ultrix" CPP symbol, not
4531 "__ultrix__"; the latter is only defined under GCC, but
4532 not by DEC's bundled CC. -JimB */
4533 else if (xerrno
== ENOMEM
)
4537 /* This happens for no known reason on ALLIANT.
4538 I am guessing that this is the right response. -- RMS. */
4539 else if (xerrno
== EFAULT
)
4542 else if (xerrno
== EBADF
)
4545 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4546 the child's closure of the pts gives the parent a SIGHUP, and
4547 the ptc file descriptor is automatically closed,
4548 yielding EBADF here or at select() call above.
4549 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4550 in m/ibmrt-aix.h), and here we just ignore the select error.
4551 Cleanup occurs c/o status_notify after SIGCLD. */
4552 no_avail
= 1; /* Cannot depend on values returned */
4558 error ("select error: %s", emacs_strerror (xerrno
));
4563 FD_ZERO (&Available
);
4564 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4567 #if defined(sun) && !defined(USG5_4)
4568 if (nfds
> 0 && keyboard_bit_set (&Available
)
4570 /* System sometimes fails to deliver SIGIO.
4572 David J. Mackenzie says that Emacs doesn't compile under
4573 Solaris if this code is enabled, thus the USG5_4 in the CPP
4574 conditional. "I haven't noticed any ill effects so far.
4575 If you find a Solaris expert somewhere, they might know
4577 kill (getpid (), SIGIO
);
4580 #if 0 /* When polling is used, interrupt_input is 0,
4581 so get_input_pending should read the input.
4582 So this should not be needed. */
4583 /* If we are using polling for input,
4584 and we see input available, make it get read now.
4585 Otherwise it might not actually get read for a second.
4586 And on hpux, since we turn off polling in wait_reading_process_output,
4587 it might never get read at all if we don't spend much time
4588 outside of wait_reading_process_output. */
4589 if (read_kbd
&& interrupt_input
4590 && keyboard_bit_set (&Available
)
4591 && input_polling_used ())
4592 kill (getpid (), SIGALRM
);
4595 /* Check for keyboard input */
4596 /* If there is any, return immediately
4597 to give it higher priority than subprocesses */
4601 int old_timers_run
= timers_run
;
4602 struct buffer
*old_buffer
= current_buffer
;
4605 if (detect_input_pending_run_timers (do_display
))
4607 swallow_events (do_display
);
4608 if (detect_input_pending_run_timers (do_display
))
4612 /* If a timer has run, this might have changed buffers
4613 an alike. Make read_key_sequence aware of that. */
4614 if (timers_run
!= old_timers_run
4615 && waiting_for_user_input_p
== -1
4616 && old_buffer
!= current_buffer
)
4617 record_asynch_buffer_change ();
4623 /* If there is unread keyboard input, also return. */
4625 && requeued_events_pending_p ())
4628 /* If we are not checking for keyboard input now,
4629 do process events (but don't run any timers).
4630 This is so that X events will be processed.
4631 Otherwise they may have to wait until polling takes place.
4632 That would causes delays in pasting selections, for example.
4634 (We used to do this only if wait_for_cell.) */
4635 if (read_kbd
== 0 && detect_input_pending ())
4637 swallow_events (do_display
);
4638 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4639 if (detect_input_pending ())
4644 /* Exit now if the cell we're waiting for became non-nil. */
4645 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4649 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4650 go read it. This can happen with X on BSD after logging out.
4651 In that case, there really is no input and no SIGIO,
4652 but select says there is input. */
4654 if (read_kbd
&& interrupt_input
4655 && keyboard_bit_set (&Available
) && ! noninteractive
)
4656 kill (getpid (), SIGIO
);
4660 got_some_input
|= nfds
> 0;
4662 /* If checking input just got us a size-change event from X,
4663 obey it now if we should. */
4664 if (read_kbd
|| ! NILP (wait_for_cell
))
4665 do_pending_window_change (0);
4667 /* Check for data from a process. */
4668 if (no_avail
|| nfds
== 0)
4671 /* Really FIRST_PROC_DESC should be 0 on Unix,
4672 but this is safer in the short run. */
4673 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4675 if (FD_ISSET (channel
, &Available
)
4676 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4680 /* If waiting for this channel, arrange to return as
4681 soon as no more input to be processed. No more
4683 if (wait_channel
== channel
)
4689 proc
= chan_process
[channel
];
4693 /* If this is a server stream socket, accept connection. */
4694 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4696 server_accept_connection (proc
, channel
);
4700 /* Read data from the process, starting with our
4701 buffered-ahead character if we have one. */
4703 nread
= read_process_output (proc
, channel
);
4706 /* Since read_process_output can run a filter,
4707 which can call accept-process-output,
4708 don't try to read from any other processes
4709 before doing the select again. */
4710 FD_ZERO (&Available
);
4713 redisplay_preserve_echo_area (12);
4716 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4719 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4720 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4722 else if (nread
== -1 && errno
== EAGAIN
)
4726 else if (nread
== -1 && errno
== EAGAIN
)
4728 /* Note that we cannot distinguish between no input
4729 available now and a closed pipe.
4730 With luck, a closed pipe will be accompanied by
4731 subprocess termination and SIGCHLD. */
4732 else if (nread
== 0 && !NETCONN_P (proc
))
4734 #endif /* O_NDELAY */
4735 #endif /* O_NONBLOCK */
4737 /* On some OSs with ptys, when the process on one end of
4738 a pty exits, the other end gets an error reading with
4739 errno = EIO instead of getting an EOF (0 bytes read).
4740 Therefore, if we get an error reading and errno =
4741 EIO, just continue, because the child process has
4742 exited and should clean itself up soon (e.g. when we
4745 However, it has been known to happen that the SIGCHLD
4746 got lost. So raise the signl again just in case.
4748 else if (nread
== -1 && errno
== EIO
)
4749 kill (getpid (), SIGCHLD
);
4750 #endif /* HAVE_PTYS */
4751 /* If we can detect process termination, don't consider the process
4752 gone just because its pipe is closed. */
4754 else if (nread
== 0 && !NETCONN_P (proc
))
4759 /* Preserve status of processes already terminated. */
4760 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4761 deactivate_process (proc
);
4762 if (XPROCESS (proc
)->raw_status_new
)
4763 update_status (XPROCESS (proc
));
4764 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4765 XPROCESS (proc
)->status
4766 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4769 #ifdef NON_BLOCKING_CONNECT
4770 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4771 && FD_ISSET (channel
, &connect_wait_mask
))
4773 struct Lisp_Process
*p
;
4775 FD_CLR (channel
, &connect_wait_mask
);
4776 if (--num_pending_connects
< 0)
4779 proc
= chan_process
[channel
];
4783 p
= XPROCESS (proc
);
4786 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4787 So only use it on systems where it is known to work. */
4789 int xlen
= sizeof(xerrno
);
4790 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4795 struct sockaddr pname
;
4796 int pnamelen
= sizeof(pname
);
4798 /* If connection failed, getpeername will fail. */
4800 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4802 /* Obtain connect failure code through error slippage. */
4805 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4812 XSETINT (p
->tick
, ++process_tick
);
4813 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4814 deactivate_process (proc
);
4819 /* Execute the sentinel here. If we had relied on
4820 status_notify to do it later, it will read input
4821 from the process before calling the sentinel. */
4822 exec_sentinel (proc
, build_string ("open\n"));
4823 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4825 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4826 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4830 #endif /* NON_BLOCKING_CONNECT */
4831 } /* end for each file descriptor */
4832 } /* end while exit conditions not met */
4834 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4836 /* If calling from keyboard input, do not quit
4837 since we want to return C-g as an input character.
4838 Otherwise, do pending quit if requested. */
4841 /* Prevent input_pending from remaining set if we quit. */
4842 clear_input_pending ();
4845 #ifdef POLL_INTERRUPTED_SYS_CALL
4846 /* AlainF 5-Jul-1996
4847 HP-UX 10.10 seems to have problems with signals coming in
4848 Causes "poll: interrupted system call" messages when Emacs is run
4850 Turn periodic alarms back on */
4852 #endif /* POLL_INTERRUPTED_SYS_CALL */
4854 return got_some_input
;
4857 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4860 read_process_output_call (fun_and_args
)
4861 Lisp_Object fun_and_args
;
4863 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4867 read_process_output_error_handler (error
)
4870 cmd_error_internal (error
, "error in process filter: ");
4872 update_echo_area ();
4873 Fsleep_for (make_number (2), Qnil
);
4877 /* Read pending output from the process channel,
4878 starting with our buffered-ahead character if we have one.
4879 Yield number of decoded characters read.
4881 This function reads at most 4096 characters.
4882 If you want to read all available subprocess output,
4883 you must call it repeatedly until it returns zero.
4885 The characters read are decoded according to PROC's coding-system
4889 read_process_output (proc
, channel
)
4891 register int channel
;
4893 register int nbytes
;
4895 register Lisp_Object outstream
;
4896 register struct buffer
*old
= current_buffer
;
4897 register struct Lisp_Process
*p
= XPROCESS (proc
);
4898 register int opoint
;
4899 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4900 int carryover
= XINT (p
->decoding_carryover
);
4904 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4906 vs
= get_vms_process_pointer (p
->pid
);
4910 return (0); /* Really weird if it does this */
4911 if (!(vs
->iosb
[0] & 1))
4912 return -1; /* I/O error */
4915 error ("Could not get VMS process pointer");
4916 chars
= vs
->inputBuffer
;
4917 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4920 start_vms_process_read (vs
); /* Crank up the next read on the process */
4921 return 1; /* Nothing worth printing, say we got 1 */
4925 /* The data carried over in the previous decoding (which are at
4926 the tail of decoding buffer) should be prepended to the new
4927 data read to decode all together. */
4928 chars
= (char *) alloca (nbytes
+ carryover
);
4929 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4930 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4934 chars
= (char *) alloca (carryover
+ readmax
);
4936 /* See the comment above. */
4937 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4939 #ifdef DATAGRAM_SOCKETS
4940 /* We have a working select, so proc_buffered_char is always -1. */
4941 if (DATAGRAM_CHAN_P (channel
))
4943 int len
= datagram_address
[channel
].len
;
4944 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4945 0, datagram_address
[channel
].sa
, &len
);
4949 if (proc_buffered_char
[channel
] < 0)
4951 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
4952 #ifdef ADAPTIVE_READ_BUFFERING
4953 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
4955 int delay
= XINT (p
->read_output_delay
);
4958 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4961 process_output_delay_count
++;
4962 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4965 else if (delay
> 0 && (nbytes
== readmax
))
4967 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4969 process_output_delay_count
--;
4971 XSETINT (p
->read_output_delay
, delay
);
4974 p
->read_output_skip
= Qt
;
4975 process_output_skip
= 1;
4982 chars
[carryover
] = proc_buffered_char
[channel
];
4983 proc_buffered_char
[channel
] = -1;
4984 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
4988 nbytes
= nbytes
+ 1;
4990 #endif /* not VMS */
4992 XSETINT (p
->decoding_carryover
, 0);
4994 /* At this point, NBYTES holds number of bytes just received
4995 (including the one in proc_buffered_char[channel]). */
4998 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5000 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5003 /* Now set NBYTES how many bytes we must decode. */
5004 nbytes
+= carryover
;
5006 /* Read and dispose of the process output. */
5007 outstream
= p
->filter
;
5008 if (!NILP (outstream
))
5010 /* We inhibit quit here instead of just catching it so that
5011 hitting ^G when a filter happens to be running won't screw
5013 int count
= SPECPDL_INDEX ();
5014 Lisp_Object odeactivate
;
5015 Lisp_Object obuffer
, okeymap
;
5017 int outer_running_asynch_code
= running_asynch_code
;
5018 int waiting
= waiting_for_user_input_p
;
5020 /* No need to gcpro these, because all we do with them later
5021 is test them for EQness, and none of them should be a string. */
5022 odeactivate
= Vdeactivate_mark
;
5023 XSETBUFFER (obuffer
, current_buffer
);
5024 okeymap
= current_buffer
->keymap
;
5026 specbind (Qinhibit_quit
, Qt
);
5027 specbind (Qlast_nonmenu_event
, Qt
);
5029 /* In case we get recursively called,
5030 and we already saved the match data nonrecursively,
5031 save the same match data in safely recursive fashion. */
5032 if (outer_running_asynch_code
)
5035 /* Don't clobber the CURRENT match data, either! */
5036 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5037 restore_search_regs ();
5038 record_unwind_save_match_data ();
5039 Fset_match_data (tem
, Qt
);
5042 /* For speed, if a search happens within this code,
5043 save the match data in a special nonrecursive fashion. */
5044 running_asynch_code
= 1;
5046 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5048 Vlast_coding_system_used
= coding
->symbol
;
5049 /* A new coding system might be found. */
5050 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5052 p
->decode_coding_system
= coding
->symbol
;
5054 /* Don't call setup_coding_system for
5055 proc_decode_coding_system[channel] here. It is done in
5056 detect_coding called via decode_coding above. */
5058 /* If a coding system for encoding is not yet decided, we set
5059 it as the same as coding-system for decoding.
5061 But, before doing that we must check if
5062 proc_encode_coding_system[p->outfd] surely points to a
5063 valid memory because p->outfd will be changed once EOF is
5064 sent to the process. */
5065 if (NILP (p
->encode_coding_system
)
5066 && proc_encode_coding_system
[XINT (p
->outfd
)])
5068 p
->encode_coding_system
= coding
->symbol
;
5069 setup_coding_system (coding
->symbol
,
5070 proc_encode_coding_system
[XINT (p
->outfd
)]);
5071 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5072 == CODING_EOL_UNDECIDED
)
5073 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5078 carryover
= nbytes
- coding
->consumed
;
5079 if (SCHARS (p
->decoding_buf
) < carryover
)
5080 p
->decoding_buf
= make_uninit_string (carryover
);
5081 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5083 XSETINT (p
->decoding_carryover
, carryover
);
5084 /* Adjust the multibyteness of TEXT to that of the filter. */
5085 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5086 text
= (STRING_MULTIBYTE (text
)
5087 ? Fstring_as_unibyte (text
)
5088 : Fstring_to_multibyte (text
));
5089 if (SBYTES (text
) > 0)
5090 internal_condition_case_1 (read_process_output_call
,
5092 Fcons (proc
, Fcons (text
, Qnil
))),
5093 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5094 read_process_output_error_handler
);
5096 /* If we saved the match data nonrecursively, restore it now. */
5097 restore_search_regs ();
5098 running_asynch_code
= outer_running_asynch_code
;
5100 /* Handling the process output should not deactivate the mark. */
5101 Vdeactivate_mark
= odeactivate
;
5103 /* Restore waiting_for_user_input_p as it was
5104 when we were called, in case the filter clobbered it. */
5105 waiting_for_user_input_p
= waiting
;
5107 #if 0 /* Call record_asynch_buffer_change unconditionally,
5108 because we might have changed minor modes or other things
5109 that affect key bindings. */
5110 if (! EQ (Fcurrent_buffer (), obuffer
)
5111 || ! EQ (current_buffer
->keymap
, okeymap
))
5113 /* But do it only if the caller is actually going to read events.
5114 Otherwise there's no need to make him wake up, and it could
5115 cause trouble (for example it would make Fsit_for return). */
5116 if (waiting_for_user_input_p
== -1)
5117 record_asynch_buffer_change ();
5120 start_vms_process_read (vs
);
5122 unbind_to (count
, Qnil
);
5126 /* If no filter, write into buffer if it isn't dead. */
5127 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5129 Lisp_Object old_read_only
;
5130 int old_begv
, old_zv
;
5131 int old_begv_byte
, old_zv_byte
;
5132 Lisp_Object odeactivate
;
5133 int before
, before_byte
;
5138 odeactivate
= Vdeactivate_mark
;
5140 Fset_buffer (p
->buffer
);
5142 opoint_byte
= PT_BYTE
;
5143 old_read_only
= current_buffer
->read_only
;
5146 old_begv_byte
= BEGV_BYTE
;
5147 old_zv_byte
= ZV_BYTE
;
5149 current_buffer
->read_only
= Qnil
;
5151 /* Insert new output into buffer
5152 at the current end-of-output marker,
5153 thus preserving logical ordering of input and output. */
5154 if (XMARKER (p
->mark
)->buffer
)
5155 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5156 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5159 SET_PT_BOTH (ZV
, ZV_BYTE
);
5161 before_byte
= PT_BYTE
;
5163 /* If the output marker is outside of the visible region, save
5164 the restriction and widen. */
5165 if (! (BEGV
<= PT
&& PT
<= ZV
))
5168 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5170 Vlast_coding_system_used
= coding
->symbol
;
5171 /* A new coding system might be found. See the comment in the
5172 similar code in the previous `if' block. */
5173 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5175 p
->decode_coding_system
= coding
->symbol
;
5176 if (NILP (p
->encode_coding_system
)
5177 && proc_encode_coding_system
[XINT (p
->outfd
)])
5179 p
->encode_coding_system
= coding
->symbol
;
5180 setup_coding_system (coding
->symbol
,
5181 proc_encode_coding_system
[XINT (p
->outfd
)]);
5182 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5183 == CODING_EOL_UNDECIDED
)
5184 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5188 carryover
= nbytes
- coding
->consumed
;
5189 if (SCHARS (p
->decoding_buf
) < carryover
)
5190 p
->decoding_buf
= make_uninit_string (carryover
);
5191 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5193 XSETINT (p
->decoding_carryover
, carryover
);
5194 /* Adjust the multibyteness of TEXT to that of the buffer. */
5195 if (NILP (current_buffer
->enable_multibyte_characters
)
5196 != ! STRING_MULTIBYTE (text
))
5197 text
= (STRING_MULTIBYTE (text
)
5198 ? Fstring_as_unibyte (text
)
5199 : Fstring_to_multibyte (text
));
5200 /* Insert before markers in case we are inserting where
5201 the buffer's mark is, and the user's next command is Meta-y. */
5202 insert_from_string_before_markers (text
, 0, 0,
5203 SCHARS (text
), SBYTES (text
), 0);
5205 /* Make sure the process marker's position is valid when the
5206 process buffer is changed in the signal_after_change above.
5207 W3 is known to do that. */
5208 if (BUFFERP (p
->buffer
)
5209 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5210 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5212 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5214 update_mode_lines
++;
5216 /* Make sure opoint and the old restrictions
5217 float ahead of any new text just as point would. */
5218 if (opoint
>= before
)
5220 opoint
+= PT
- before
;
5221 opoint_byte
+= PT_BYTE
- before_byte
;
5223 if (old_begv
> before
)
5225 old_begv
+= PT
- before
;
5226 old_begv_byte
+= PT_BYTE
- before_byte
;
5228 if (old_zv
>= before
)
5230 old_zv
+= PT
- before
;
5231 old_zv_byte
+= PT_BYTE
- before_byte
;
5234 /* If the restriction isn't what it should be, set it. */
5235 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5236 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5238 /* Handling the process output should not deactivate the mark. */
5239 Vdeactivate_mark
= odeactivate
;
5241 current_buffer
->read_only
= old_read_only
;
5242 SET_PT_BOTH (opoint
, opoint_byte
);
5243 set_buffer_internal (old
);
5246 start_vms_process_read (vs
);
5251 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5253 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5254 This is intended for use by asynchronous process output filters and sentinels. */)
5257 return (waiting_for_user_input_p
? Qt
: Qnil
);
5260 /* Sending data to subprocess */
5262 jmp_buf send_process_frame
;
5263 Lisp_Object process_sent_to
;
5266 send_process_trap ()
5268 SIGNAL_THREAD_CHECK (SIGPIPE
);
5273 sigunblock (sigmask (SIGPIPE
));
5274 longjmp (send_process_frame
, 1);
5277 /* Send some data to process PROC.
5278 BUF is the beginning of the data; LEN is the number of characters.
5279 OBJECT is the Lisp object that the data comes from. If OBJECT is
5280 nil or t, it means that the data comes from C string.
5282 If OBJECT is not nil, the data is encoded by PROC's coding-system
5283 for encoding before it is sent.
5285 This function can evaluate Lisp code and can garbage collect. */
5288 send_process (proc
, buf
, len
, object
)
5289 volatile Lisp_Object proc
;
5290 unsigned char *volatile buf
;
5292 volatile Lisp_Object object
;
5294 /* Use volatile to protect variables from being clobbered by longjmp. */
5295 struct Lisp_Process
*p
= XPROCESS (proc
);
5297 struct coding_system
*coding
;
5298 struct gcpro gcpro1
;
5299 SIGTYPE (*volatile old_sigpipe
) ();
5304 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5307 if (p
->raw_status_new
)
5309 if (! EQ (p
->status
, Qrun
))
5310 error ("Process %s not running", SDATA (p
->name
));
5311 if (XINT (p
->outfd
) < 0)
5312 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5314 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5315 Vlast_coding_system_used
= coding
->symbol
;
5317 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5318 || (BUFFERP (object
)
5319 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5322 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5323 /* The coding system for encoding was changed to raw-text
5324 because we sent a unibyte text previously. Now we are
5325 sending a multibyte text, thus we must encode it by the
5326 original coding system specified for the current process. */
5327 setup_coding_system (p
->encode_coding_system
, coding
);
5328 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
5329 coding
->eol_type
= system_eol_type
;
5330 /* src_multibyte should be set to 1 _after_ a call to
5331 setup_coding_system, since it resets src_multibyte to
5333 coding
->src_multibyte
= 1;
5337 /* For sending a unibyte text, character code conversion should
5338 not take place but EOL conversion should. So, setup raw-text
5339 or one of the subsidiary if we have not yet done it. */
5340 if (coding
->type
!= coding_type_raw_text
)
5342 if (CODING_REQUIRE_FLUSHING (coding
))
5344 /* But, before changing the coding, we must flush out data. */
5345 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5346 send_process (proc
, "", 0, Qt
);
5348 coding
->src_multibyte
= 0;
5349 setup_raw_text_coding_system (coding
);
5352 coding
->dst_multibyte
= 0;
5354 if (CODING_REQUIRE_ENCODING (coding
))
5356 int require
= encoding_buffer_size (coding
, len
);
5357 int from_byte
= -1, from
= -1, to
= -1;
5359 if (BUFFERP (object
))
5361 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5362 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5363 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5365 else if (STRINGP (object
))
5367 from_byte
= buf
- SDATA (object
);
5368 from
= string_byte_to_char (object
, from_byte
);
5369 to
= string_byte_to_char (object
, from_byte
+ len
);
5372 if (coding
->composing
!= COMPOSITION_DISABLED
)
5375 coding_save_composition (coding
, from
, to
, object
);
5377 coding
->composing
= COMPOSITION_DISABLED
;
5380 if (SBYTES (p
->encoding_buf
) < require
)
5381 p
->encoding_buf
= make_uninit_string (require
);
5384 buf
= (BUFFERP (object
)
5385 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5386 : SDATA (object
) + from_byte
);
5388 object
= p
->encoding_buf
;
5389 encode_coding (coding
, (char *) buf
, SDATA (object
),
5390 len
, SBYTES (object
));
5391 coding_free_composition_data (coding
);
5392 len
= coding
->produced
;
5393 buf
= SDATA (object
);
5397 vs
= get_vms_process_pointer (p
->pid
);
5399 error ("Could not find this process: %x", p
->pid
);
5400 else if (write_to_vms_process (vs
, buf
, len
))
5404 if (pty_max_bytes
== 0)
5406 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5407 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5408 if (pty_max_bytes
< 0)
5409 pty_max_bytes
= 250;
5411 pty_max_bytes
= 250;
5413 /* Deduct one, to leave space for the eof. */
5417 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5418 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5419 when returning with longjmp despite being declared volatile. */
5420 if (!setjmp (send_process_frame
))
5422 process_sent_to
= proc
;
5427 /* Decide how much data we can send in one batch.
5428 Long lines need to be split into multiple batches. */
5429 if (!NILP (p
->pty_flag
))
5431 /* Starting this at zero is always correct when not the first
5432 iteration because the previous iteration ended by sending C-d.
5433 It may not be correct for the first iteration
5434 if a partial line was sent in a separate send_process call.
5435 If that proves worth handling, we need to save linepos
5436 in the process object. */
5438 unsigned char *ptr
= (unsigned char *) buf
;
5439 unsigned char *end
= (unsigned char *) buf
+ len
;
5441 /* Scan through this text for a line that is too long. */
5442 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5450 /* If we found one, break the line there
5451 and put in a C-d to force the buffer through. */
5455 /* Send this batch, using one or more write calls. */
5458 int outfd
= XINT (p
->outfd
);
5459 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5460 #ifdef DATAGRAM_SOCKETS
5461 if (DATAGRAM_CHAN_P (outfd
))
5463 rv
= sendto (outfd
, (char *) buf
, this,
5464 0, datagram_address
[outfd
].sa
,
5465 datagram_address
[outfd
].len
);
5466 if (rv
< 0 && errno
== EMSGSIZE
)
5468 signal (SIGPIPE
, old_sigpipe
);
5469 report_file_error ("sending datagram",
5470 Fcons (proc
, Qnil
));
5476 rv
= emacs_write (outfd
, (char *) buf
, this);
5477 #ifdef ADAPTIVE_READ_BUFFERING
5478 if (XINT (p
->read_output_delay
) > 0
5479 && EQ (p
->adaptive_read_buffering
, Qt
))
5481 XSETFASTINT (p
->read_output_delay
, 0);
5482 process_output_delay_count
--;
5483 p
->read_output_skip
= Qnil
;
5487 signal (SIGPIPE
, old_sigpipe
);
5493 || errno
== EWOULDBLOCK
5499 /* Buffer is full. Wait, accepting input;
5500 that may allow the program
5501 to finish doing output and read more. */
5505 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5506 /* A gross hack to work around a bug in FreeBSD.
5507 In the following sequence, read(2) returns
5511 write(2) 954 bytes, get EAGAIN
5512 read(2) 1024 bytes in process_read_output
5513 read(2) 11 bytes in process_read_output
5515 That is, read(2) returns more bytes than have
5516 ever been written successfully. The 1033 bytes
5517 read are the 1022 bytes written successfully
5518 after processing (for example with CRs added if
5519 the terminal is set up that way which it is
5520 here). The same bytes will be seen again in a
5521 later read(2), without the CRs. */
5523 if (errno
== EAGAIN
)
5526 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5528 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5530 /* Running filters might relocate buffers or strings.
5531 Arrange to relocate BUF. */
5532 if (BUFFERP (object
))
5533 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5534 else if (STRINGP (object
))
5535 offset
= buf
- SDATA (object
);
5537 #ifdef EMACS_HAS_USECS
5538 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5540 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5543 if (BUFFERP (object
))
5544 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5545 else if (STRINGP (object
))
5546 buf
= offset
+ SDATA (object
);
5551 /* This is a real error. */
5552 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5559 /* If we sent just part of the string, put in an EOF
5560 to force it through, before we send the rest. */
5562 Fprocess_send_eof (proc
);
5565 #endif /* not VMS */
5568 signal (SIGPIPE
, old_sigpipe
);
5570 proc
= process_sent_to
;
5571 p
= XPROCESS (proc
);
5573 p
->raw_status_new
= 0;
5574 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5575 XSETINT (p
->tick
, ++process_tick
);
5576 deactivate_process (proc
);
5578 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5580 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5587 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5589 doc
: /* Send current contents of region as input to PROCESS.
5590 PROCESS may be a process, a buffer, the name of a process or buffer, or
5591 nil, indicating the current buffer's process.
5592 Called from program, takes three arguments, PROCESS, START and END.
5593 If the region is more than 500 characters long,
5594 it is sent in several bunches. This may happen even for shorter regions.
5595 Output from processes can arrive in between bunches. */)
5596 (process
, start
, end
)
5597 Lisp_Object process
, start
, end
;
5602 proc
= get_process (process
);
5603 validate_region (&start
, &end
);
5605 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5606 move_gap (XINT (start
));
5608 start1
= CHAR_TO_BYTE (XINT (start
));
5609 end1
= CHAR_TO_BYTE (XINT (end
));
5610 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5611 Fcurrent_buffer ());
5616 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5618 doc
: /* Send PROCESS the contents of STRING as input.
5619 PROCESS may be a process, a buffer, the name of a process or buffer, or
5620 nil, indicating the current buffer's process.
5621 If STRING is more than 500 characters long,
5622 it is sent in several bunches. This may happen even for shorter strings.
5623 Output from processes can arrive in between bunches. */)
5625 Lisp_Object process
, string
;
5628 CHECK_STRING (string
);
5629 proc
= get_process (process
);
5630 send_process (proc
, SDATA (string
),
5631 SBYTES (string
), string
);
5635 /* Return the foreground process group for the tty/pty that
5636 the process P uses. */
5638 emacs_get_tty_pgrp (p
)
5639 struct Lisp_Process
*p
;
5644 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5647 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5648 master side. Try the slave side. */
5649 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5653 ioctl (fd
, TIOCGPGRP
, &gid
);
5657 #endif /* defined (TIOCGPGRP ) */
5662 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5663 Sprocess_running_child_p
, 0, 1, 0,
5664 doc
: /* Return t if PROCESS has given the terminal to a child.
5665 If the operating system does not make it possible to find out,
5666 return t unconditionally. */)
5668 Lisp_Object process
;
5670 /* Initialize in case ioctl doesn't exist or gives an error,
5671 in a way that will cause returning t. */
5674 struct Lisp_Process
*p
;
5676 proc
= get_process (process
);
5677 p
= XPROCESS (proc
);
5679 if (!EQ (p
->childp
, Qt
))
5680 error ("Process %s is not a subprocess",
5682 if (XINT (p
->infd
) < 0)
5683 error ("Process %s is not active",
5686 gid
= emacs_get_tty_pgrp (p
);
5693 /* send a signal number SIGNO to PROCESS.
5694 If CURRENT_GROUP is t, that means send to the process group
5695 that currently owns the terminal being used to communicate with PROCESS.
5696 This is used for various commands in shell mode.
5697 If CURRENT_GROUP is lambda, that means send to the process group
5698 that currently owns the terminal, but only if it is NOT the shell itself.
5700 If NOMSG is zero, insert signal-announcements into process's buffers
5703 If we can, we try to signal PROCESS by sending control characters
5704 down the pty. This allows us to signal inferiors who have changed
5705 their uid, for which killpg would return an EPERM error. */
5708 process_send_signal (process
, signo
, current_group
, nomsg
)
5709 Lisp_Object process
;
5711 Lisp_Object current_group
;
5715 register struct Lisp_Process
*p
;
5719 proc
= get_process (process
);
5720 p
= XPROCESS (proc
);
5722 if (!EQ (p
->childp
, Qt
))
5723 error ("Process %s is not a subprocess",
5725 if (XINT (p
->infd
) < 0)
5726 error ("Process %s is not active",
5729 if (NILP (p
->pty_flag
))
5730 current_group
= Qnil
;
5732 /* If we are using pgrps, get a pgrp number and make it negative. */
5733 if (NILP (current_group
))
5734 /* Send the signal to the shell's process group. */
5738 #ifdef SIGNALS_VIA_CHARACTERS
5739 /* If possible, send signals to the entire pgrp
5740 by sending an input character to it. */
5742 /* TERMIOS is the latest and bestest, and seems most likely to
5743 work. If the system has it, use it. */
5746 cc_t
*sig_char
= NULL
;
5748 tcgetattr (XINT (p
->infd
), &t
);
5753 sig_char
= &t
.c_cc
[VINTR
];
5757 sig_char
= &t
.c_cc
[VQUIT
];
5761 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5762 sig_char
= &t
.c_cc
[VSWTCH
];
5764 sig_char
= &t
.c_cc
[VSUSP
];
5769 if (sig_char
&& *sig_char
!= CDISABLE
)
5771 send_process (proc
, sig_char
, 1, Qnil
);
5774 /* If we can't send the signal with a character,
5775 fall through and send it another way. */
5776 #else /* ! HAVE_TERMIOS */
5778 /* On Berkeley descendants, the following IOCTL's retrieve the
5779 current control characters. */
5780 #if defined (TIOCGLTC) && defined (TIOCGETC)
5788 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5789 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5792 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5793 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5797 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5798 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5800 #endif /* ! defined (SIGTSTP) */
5803 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5805 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5812 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5813 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5816 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5817 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5821 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5822 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5824 #endif /* ! defined (SIGTSTP) */
5826 #else /* ! defined (TCGETA) */
5827 Your configuration files are messed up
.
5828 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5829 you'd better be using one of the alternatives above! */
5830 #endif /* ! defined (TCGETA) */
5831 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5832 /* In this case, the code above should alway returns. */
5834 #endif /* ! defined HAVE_TERMIOS */
5836 /* The code above may fall through if it can't
5837 handle the signal. */
5838 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5841 /* Get the current pgrp using the tty itself, if we have that.
5842 Otherwise, use the pty to get the pgrp.
5843 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5844 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5845 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5846 His patch indicates that if TIOCGPGRP returns an error, then
5847 we should just assume that p->pid is also the process group id. */
5849 gid
= emacs_get_tty_pgrp (p
);
5852 /* If we can't get the information, assume
5853 the shell owns the tty. */
5856 /* It is not clear whether anything really can set GID to -1.
5857 Perhaps on some system one of those ioctls can or could do so.
5858 Or perhaps this is vestigial. */
5861 #else /* ! defined (TIOCGPGRP ) */
5862 /* Can't select pgrps on this system, so we know that
5863 the child itself heads the pgrp. */
5865 #endif /* ! defined (TIOCGPGRP ) */
5867 /* If current_group is lambda, and the shell owns the terminal,
5868 don't send any signal. */
5869 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5877 p
->raw_status_new
= 0;
5879 XSETINT (p
->tick
, ++process_tick
);
5881 status_notify (NULL
);
5883 #endif /* ! defined (SIGCONT) */
5886 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5891 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5896 sys$
forcex (&(p
->pid
), 0, 1);
5899 flush_pending_output (XINT (p
->infd
));
5903 /* If we don't have process groups, send the signal to the immediate
5904 subprocess. That isn't really right, but it's better than any
5905 obvious alternative. */
5908 kill (p
->pid
, signo
);
5912 /* gid may be a pid, or minus a pgrp's number */
5914 if (!NILP (current_group
))
5916 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5917 EMACS_KILLPG (gid
, signo
);
5924 #else /* ! defined (TIOCSIGSEND) */
5925 EMACS_KILLPG (gid
, signo
);
5926 #endif /* ! defined (TIOCSIGSEND) */
5929 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5930 doc
: /* Interrupt process PROCESS.
5931 PROCESS may be a process, a buffer, or the name of a process or buffer.
5932 No arg or nil means current buffer's process.
5933 Second arg CURRENT-GROUP non-nil means send signal to
5934 the current process-group of the process's controlling terminal
5935 rather than to the process's own process group.
5936 If the process is a shell, this means interrupt current subjob
5937 rather than the shell.
5939 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5940 don't send the signal. */)
5941 (process
, current_group
)
5942 Lisp_Object process
, current_group
;
5944 process_send_signal (process
, SIGINT
, current_group
, 0);
5948 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5949 doc
: /* Kill process PROCESS. May be process or name of one.
5950 See function `interrupt-process' for more details on usage. */)
5951 (process
, current_group
)
5952 Lisp_Object process
, current_group
;
5954 process_send_signal (process
, SIGKILL
, current_group
, 0);
5958 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5959 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5960 See function `interrupt-process' for more details on usage. */)
5961 (process
, current_group
)
5962 Lisp_Object process
, current_group
;
5964 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5968 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5969 doc
: /* Stop process PROCESS. May be process or name of one.
5970 See function `interrupt-process' for more details on usage.
5971 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5972 (process
, current_group
)
5973 Lisp_Object process
, current_group
;
5976 if (PROCESSP (process
) && NETCONN_P (process
))
5978 struct Lisp_Process
*p
;
5980 p
= XPROCESS (process
);
5981 if (NILP (p
->command
)
5982 && XINT (p
->infd
) >= 0)
5984 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5985 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5992 error ("No SIGTSTP support");
5994 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5999 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6000 doc
: /* Continue process PROCESS. May be process or name of one.
6001 See function `interrupt-process' for more details on usage.
6002 If PROCESS is a network process, resume handling of incoming traffic. */)
6003 (process
, current_group
)
6004 Lisp_Object process
, current_group
;
6007 if (PROCESSP (process
) && NETCONN_P (process
))
6009 struct Lisp_Process
*p
;
6011 p
= XPROCESS (process
);
6012 if (EQ (p
->command
, Qt
)
6013 && XINT (p
->infd
) >= 0
6014 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6016 FD_SET (XINT (p
->infd
), &input_wait_mask
);
6017 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6024 process_send_signal (process
, SIGCONT
, current_group
, 0);
6026 error ("No SIGCONT support");
6031 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6032 2, 2, "sProcess (name or number): \nnSignal code: ",
6033 doc
: /* Send PROCESS the signal with code SIGCODE.
6034 PROCESS may also be an integer specifying the process id of the
6035 process to signal; in this case, the process need not be a child of
6037 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6039 Lisp_Object process
, sigcode
;
6043 if (INTEGERP (process
))
6045 pid
= XINT (process
);
6049 if (FLOATP (process
))
6051 pid
= (pid_t
) XFLOAT (process
);
6055 if (STRINGP (process
))
6058 if (tem
= Fget_process (process
), NILP (tem
))
6060 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6067 process
= get_process (process
);
6072 CHECK_PROCESS (process
);
6073 pid
= XPROCESS (process
)->pid
;
6075 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6079 #define handle_signal(NAME, VALUE) \
6080 else if (!strcmp (name, NAME)) \
6081 XSETINT (sigcode, VALUE)
6083 if (INTEGERP (sigcode
))
6087 unsigned char *name
;
6089 CHECK_SYMBOL (sigcode
);
6090 name
= SDATA (SYMBOL_NAME (sigcode
));
6092 if (!strncmp(name
, "SIG", 3))
6098 handle_signal ("HUP", SIGHUP
);
6101 handle_signal ("INT", SIGINT
);
6104 handle_signal ("QUIT", SIGQUIT
);
6107 handle_signal ("ILL", SIGILL
);
6110 handle_signal ("ABRT", SIGABRT
);
6113 handle_signal ("EMT", SIGEMT
);
6116 handle_signal ("KILL", SIGKILL
);
6119 handle_signal ("FPE", SIGFPE
);
6122 handle_signal ("BUS", SIGBUS
);
6125 handle_signal ("SEGV", SIGSEGV
);
6128 handle_signal ("SYS", SIGSYS
);
6131 handle_signal ("PIPE", SIGPIPE
);
6134 handle_signal ("ALRM", SIGALRM
);
6137 handle_signal ("TERM", SIGTERM
);
6140 handle_signal ("URG", SIGURG
);
6143 handle_signal ("STOP", SIGSTOP
);
6146 handle_signal ("TSTP", SIGTSTP
);
6149 handle_signal ("CONT", SIGCONT
);
6152 handle_signal ("CHLD", SIGCHLD
);
6155 handle_signal ("TTIN", SIGTTIN
);
6158 handle_signal ("TTOU", SIGTTOU
);
6161 handle_signal ("IO", SIGIO
);
6164 handle_signal ("XCPU", SIGXCPU
);
6167 handle_signal ("XFSZ", SIGXFSZ
);
6170 handle_signal ("VTALRM", SIGVTALRM
);
6173 handle_signal ("PROF", SIGPROF
);
6176 handle_signal ("WINCH", SIGWINCH
);
6179 handle_signal ("INFO", SIGINFO
);
6182 handle_signal ("USR1", SIGUSR1
);
6185 handle_signal ("USR2", SIGUSR2
);
6188 error ("Undefined signal name %s", name
);
6191 #undef handle_signal
6193 return make_number (kill (pid
, XINT (sigcode
)));
6196 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6197 doc
: /* Make PROCESS see end-of-file in its input.
6198 EOF comes after any text already sent to it.
6199 PROCESS may be a process, a buffer, the name of a process or buffer, or
6200 nil, indicating the current buffer's process.
6201 If PROCESS is a network connection, or is a process communicating
6202 through a pipe (as opposed to a pty), then you cannot send any more
6203 text to PROCESS after you call this function. */)
6205 Lisp_Object process
;
6208 struct coding_system
*coding
;
6210 if (DATAGRAM_CONN_P (process
))
6213 proc
= get_process (process
);
6214 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6216 /* Make sure the process is really alive. */
6217 if (XPROCESS (proc
)->raw_status_new
)
6218 update_status (XPROCESS (proc
));
6219 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6220 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6222 if (CODING_REQUIRE_FLUSHING (coding
))
6224 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6225 send_process (proc
, "", 0, Qnil
);
6229 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6231 if (!NILP (XPROCESS (proc
)->pty_flag
))
6232 send_process (proc
, "\004", 1, Qnil
);
6235 int old_outfd
, new_outfd
;
6237 #ifdef HAVE_SHUTDOWN
6238 /* If this is a network connection, or socketpair is used
6239 for communication with the subprocess, call shutdown to cause EOF.
6240 (In some old system, shutdown to socketpair doesn't work.
6241 Then we just can't win.) */
6242 if (XPROCESS (proc
)->pid
== 0
6243 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6244 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6245 /* In case of socketpair, outfd == infd, so don't close it. */
6246 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6247 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6248 #else /* not HAVE_SHUTDOWN */
6249 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6250 #endif /* not HAVE_SHUTDOWN */
6251 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6254 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6256 if (!proc_encode_coding_system
[new_outfd
])
6257 proc_encode_coding_system
[new_outfd
]
6258 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6259 bcopy (proc_encode_coding_system
[old_outfd
],
6260 proc_encode_coding_system
[new_outfd
],
6261 sizeof (struct coding_system
));
6262 bzero (proc_encode_coding_system
[old_outfd
],
6263 sizeof (struct coding_system
));
6265 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6271 /* Kill all processes associated with `buffer'.
6272 If `buffer' is nil, kill all processes */
6275 kill_buffer_processes (buffer
)
6278 Lisp_Object tail
, proc
;
6280 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6282 proc
= XCDR (XCAR (tail
));
6283 if (GC_PROCESSP (proc
)
6284 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6286 if (NETCONN_P (proc
))
6287 Fdelete_process (proc
);
6288 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6289 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6294 /* On receipt of a signal that a child status has changed, loop asking
6295 about children with changed statuses until the system says there
6298 All we do is change the status; we do not run sentinels or print
6299 notifications. That is saved for the next time keyboard input is
6300 done, in order to avoid timing errors.
6302 ** WARNING: this can be called during garbage collection.
6303 Therefore, it must not be fooled by the presence of mark bits in
6306 ** USG WARNING: Although it is not obvious from the documentation
6307 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6308 signal() before executing at least one wait(), otherwise the
6309 handler will be called again, resulting in an infinite loop. The
6310 relevant portion of the documentation reads "SIGCLD signals will be
6311 queued and the signal-catching function will be continually
6312 reentered until the queue is empty". Invoking signal() causes the
6313 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6316 ** Malloc WARNING: This should never call malloc either directly or
6317 indirectly; if it does, that is a bug */
6320 sigchld_handler (signo
)
6323 int old_errno
= errno
;
6325 register struct Lisp_Process
*p
;
6326 extern EMACS_TIME
*input_available_clear_time
;
6328 SIGNAL_THREAD_CHECK (signo
);
6332 sigheld
|= sigbit (SIGCHLD
);
6344 #endif /* no WUNTRACED */
6345 /* Keep trying to get a status until we get a definitive result. */
6349 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6351 while (pid
< 0 && errno
== EINTR
);
6355 /* PID == 0 means no processes found, PID == -1 means a real
6356 failure. We have done all our job, so return. */
6358 /* USG systems forget handlers when they are used;
6359 must reestablish each time */
6360 #if defined (USG) && !defined (POSIX_SIGNALS)
6361 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6364 sigheld
&= ~sigbit (SIGCHLD
);
6372 #endif /* no WNOHANG */
6374 /* Find the process that signaled us, and record its status. */
6377 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6379 proc
= XCDR (XCAR (tail
));
6380 p
= XPROCESS (proc
);
6381 if (GC_EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6386 /* Look for an asynchronous process whose pid hasn't been filled
6389 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6391 proc
= XCDR (XCAR (tail
));
6392 p
= XPROCESS (proc
);
6398 /* Change the status of the process that was found. */
6401 union { int i
; WAITTYPE wt
; } u
;
6402 int clear_desc_flag
= 0;
6404 XSETINT (p
->tick
, ++process_tick
);
6406 p
->raw_status
= u
.i
;
6407 p
->raw_status_new
= 1;
6409 /* If process has terminated, stop waiting for its output. */
6410 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6411 && XINT (p
->infd
) >= 0)
6412 clear_desc_flag
= 1;
6414 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6415 if (clear_desc_flag
)
6417 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6418 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6421 /* Tell wait_reading_process_output that it needs to wake up and
6423 if (input_available_clear_time
)
6424 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6427 /* There was no asynchronous process found for that id. Check
6428 if we have a synchronous process. */
6431 synch_process_alive
= 0;
6433 /* Report the status of the synchronous process. */
6435 synch_process_retcode
= WRETCODE (w
);
6436 else if (WIFSIGNALED (w
))
6437 synch_process_termsig
= WTERMSIG (w
);
6439 /* Tell wait_reading_process_output that it needs to wake up and
6441 if (input_available_clear_time
)
6442 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6445 /* On some systems, we must return right away.
6446 If any more processes want to signal us, we will
6448 Otherwise (on systems that have WNOHANG), loop around
6449 to use up all the processes that have something to tell us. */
6450 #if (defined WINDOWSNT \
6451 || (defined USG && !defined GNU_LINUX \
6452 && !(defined HPUX && defined WNOHANG)))
6453 #if defined (USG) && ! defined (POSIX_SIGNALS)
6454 signal (signo
, sigchld_handler
);
6458 #endif /* USG, but not HPUX with WNOHANG */
6464 exec_sentinel_unwind (data
)
6467 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6472 exec_sentinel_error_handler (error
)
6475 cmd_error_internal (error
, "error in process sentinel: ");
6477 update_echo_area ();
6478 Fsleep_for (make_number (2), Qnil
);
6483 exec_sentinel (proc
, reason
)
6484 Lisp_Object proc
, reason
;
6486 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6487 register struct Lisp_Process
*p
= XPROCESS (proc
);
6488 int count
= SPECPDL_INDEX ();
6489 int outer_running_asynch_code
= running_asynch_code
;
6490 int waiting
= waiting_for_user_input_p
;
6492 /* No need to gcpro these, because all we do with them later
6493 is test them for EQness, and none of them should be a string. */
6494 odeactivate
= Vdeactivate_mark
;
6495 XSETBUFFER (obuffer
, current_buffer
);
6496 okeymap
= current_buffer
->keymap
;
6498 sentinel
= p
->sentinel
;
6499 if (NILP (sentinel
))
6502 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6503 assure that it gets restored no matter how the sentinel exits. */
6505 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6506 /* Inhibit quit so that random quits don't screw up a running filter. */
6507 specbind (Qinhibit_quit
, Qt
);
6508 specbind (Qlast_nonmenu_event
, Qt
);
6510 /* In case we get recursively called,
6511 and we already saved the match data nonrecursively,
6512 save the same match data in safely recursive fashion. */
6513 if (outer_running_asynch_code
)
6516 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6517 restore_search_regs ();
6518 record_unwind_save_match_data ();
6519 Fset_match_data (tem
, Qt
);
6522 /* For speed, if a search happens within this code,
6523 save the match data in a special nonrecursive fashion. */
6524 running_asynch_code
= 1;
6526 internal_condition_case_1 (read_process_output_call
,
6528 Fcons (proc
, Fcons (reason
, Qnil
))),
6529 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6530 exec_sentinel_error_handler
);
6532 /* If we saved the match data nonrecursively, restore it now. */
6533 restore_search_regs ();
6534 running_asynch_code
= outer_running_asynch_code
;
6536 Vdeactivate_mark
= odeactivate
;
6538 /* Restore waiting_for_user_input_p as it was
6539 when we were called, in case the filter clobbered it. */
6540 waiting_for_user_input_p
= waiting
;
6543 if (! EQ (Fcurrent_buffer (), obuffer
)
6544 || ! EQ (current_buffer
->keymap
, okeymap
))
6546 /* But do it only if the caller is actually going to read events.
6547 Otherwise there's no need to make him wake up, and it could
6548 cause trouble (for example it would make Fsit_for return). */
6549 if (waiting_for_user_input_p
== -1)
6550 record_asynch_buffer_change ();
6552 unbind_to (count
, Qnil
);
6555 /* Report all recent events of a change in process status
6556 (either run the sentinel or output a message).
6557 This is usually done while Emacs is waiting for keyboard input
6558 but can be done at other times. */
6561 status_notify (deleting_process
)
6562 struct Lisp_Process
*deleting_process
;
6564 register Lisp_Object proc
, buffer
;
6565 Lisp_Object tail
, msg
;
6566 struct gcpro gcpro1
, gcpro2
;
6570 /* We need to gcpro tail; if read_process_output calls a filter
6571 which deletes a process and removes the cons to which tail points
6572 from Vprocess_alist, and then causes a GC, tail is an unprotected
6576 /* Set this now, so that if new processes are created by sentinels
6577 that we run, we get called again to handle their status changes. */
6578 update_tick
= process_tick
;
6580 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6583 register struct Lisp_Process
*p
;
6585 proc
= Fcdr (Fcar (tail
));
6586 p
= XPROCESS (proc
);
6588 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6590 XSETINT (p
->update_tick
, XINT (p
->tick
));
6592 /* If process is still active, read any output that remains. */
6593 while (! EQ (p
->filter
, Qt
)
6594 && ! EQ (p
->status
, Qconnect
)
6595 && ! EQ (p
->status
, Qlisten
)
6596 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6597 && XINT (p
->infd
) >= 0
6598 && p
!= deleting_process
6599 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6603 /* Get the text to use for the message. */
6604 if (p
->raw_status_new
)
6606 msg
= status_message (p
);
6608 /* If process is terminated, deactivate it or delete it. */
6610 if (CONSP (p
->status
))
6611 symbol
= XCAR (p
->status
);
6613 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6614 || EQ (symbol
, Qclosed
))
6616 if (delete_exited_processes
)
6617 remove_process (proc
);
6619 deactivate_process (proc
);
6622 /* The actions above may have further incremented p->tick.
6623 So set p->update_tick again
6624 so that an error in the sentinel will not cause
6625 this code to be run again. */
6626 XSETINT (p
->update_tick
, XINT (p
->tick
));
6627 /* Now output the message suitably. */
6628 if (!NILP (p
->sentinel
))
6629 exec_sentinel (proc
, msg
);
6630 /* Don't bother with a message in the buffer
6631 when a process becomes runnable. */
6632 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6634 Lisp_Object ro
, tem
;
6635 struct buffer
*old
= current_buffer
;
6636 int opoint
, opoint_byte
;
6637 int before
, before_byte
;
6639 ro
= XBUFFER (buffer
)->read_only
;
6641 /* Avoid error if buffer is deleted
6642 (probably that's why the process is dead, too) */
6643 if (NILP (XBUFFER (buffer
)->name
))
6645 Fset_buffer (buffer
);
6648 opoint_byte
= PT_BYTE
;
6649 /* Insert new output into buffer
6650 at the current end-of-output marker,
6651 thus preserving logical ordering of input and output. */
6652 if (XMARKER (p
->mark
)->buffer
)
6653 Fgoto_char (p
->mark
);
6655 SET_PT_BOTH (ZV
, ZV_BYTE
);
6658 before_byte
= PT_BYTE
;
6660 tem
= current_buffer
->read_only
;
6661 current_buffer
->read_only
= Qnil
;
6662 insert_string ("\nProcess ");
6663 Finsert (1, &p
->name
);
6664 insert_string (" ");
6666 current_buffer
->read_only
= tem
;
6667 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6669 if (opoint
>= before
)
6670 SET_PT_BOTH (opoint
+ (PT
- before
),
6671 opoint_byte
+ (PT_BYTE
- before_byte
));
6673 SET_PT_BOTH (opoint
, opoint_byte
);
6675 set_buffer_internal (old
);
6680 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6681 redisplay_preserve_echo_area (13);
6687 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6688 Sset_process_coding_system
, 1, 3, 0,
6689 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6690 DECODING will be used to decode subprocess output and ENCODING to
6691 encode subprocess input. */)
6692 (process
, decoding
, encoding
)
6693 register Lisp_Object process
, decoding
, encoding
;
6695 register struct Lisp_Process
*p
;
6697 CHECK_PROCESS (process
);
6698 p
= XPROCESS (process
);
6699 if (XINT (p
->infd
) < 0)
6700 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6701 if (XINT (p
->outfd
) < 0)
6702 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6703 Fcheck_coding_system (decoding
);
6704 Fcheck_coding_system (encoding
);
6706 p
->decode_coding_system
= decoding
;
6707 p
->encode_coding_system
= encoding
;
6708 setup_process_coding_systems (process
);
6713 DEFUN ("process-coding-system",
6714 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6715 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6717 register Lisp_Object process
;
6719 CHECK_PROCESS (process
);
6720 return Fcons (XPROCESS (process
)->decode_coding_system
,
6721 XPROCESS (process
)->encode_coding_system
);
6724 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6725 Sset_process_filter_multibyte
, 2, 2, 0,
6726 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6727 If FLAG is non-nil, the filter is given multibyte strings.
6728 If FLAG is nil, the filter is given unibyte strings. In this case,
6729 all character code conversion except for end-of-line conversion is
6732 Lisp_Object process
, flag
;
6734 register struct Lisp_Process
*p
;
6736 CHECK_PROCESS (process
);
6737 p
= XPROCESS (process
);
6738 p
->filter_multibyte
= flag
;
6739 setup_process_coding_systems (process
);
6744 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6745 Sprocess_filter_multibyte_p
, 1, 1, 0,
6746 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6748 Lisp_Object process
;
6750 register struct Lisp_Process
*p
;
6752 CHECK_PROCESS (process
);
6753 p
= XPROCESS (process
);
6755 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6760 /* The first time this is called, assume keyboard input comes from DESC
6761 instead of from where we used to expect it.
6762 Subsequent calls mean assume input keyboard can come from DESC
6763 in addition to other places. */
6765 static int add_keyboard_wait_descriptor_called_flag
;
6768 add_keyboard_wait_descriptor (desc
)
6771 if (! add_keyboard_wait_descriptor_called_flag
)
6772 FD_CLR (0, &input_wait_mask
);
6773 add_keyboard_wait_descriptor_called_flag
= 1;
6774 FD_SET (desc
, &input_wait_mask
);
6775 FD_SET (desc
, &non_process_wait_mask
);
6776 if (desc
> max_keyboard_desc
)
6777 max_keyboard_desc
= desc
;
6780 /* From now on, do not expect DESC to give keyboard input. */
6783 delete_keyboard_wait_descriptor (desc
)
6787 int lim
= max_keyboard_desc
;
6789 FD_CLR (desc
, &input_wait_mask
);
6790 FD_CLR (desc
, &non_process_wait_mask
);
6792 if (desc
== max_keyboard_desc
)
6793 for (fd
= 0; fd
< lim
; fd
++)
6794 if (FD_ISSET (fd
, &input_wait_mask
)
6795 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6796 max_keyboard_desc
= fd
;
6799 /* Return nonzero if *MASK has a bit set
6800 that corresponds to one of the keyboard input descriptors. */
6803 keyboard_bit_set (mask
)
6808 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6809 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6810 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6823 if (! noninteractive
|| initialized
)
6825 signal (SIGCHLD
, sigchld_handler
);
6828 FD_ZERO (&input_wait_mask
);
6829 FD_ZERO (&non_keyboard_wait_mask
);
6830 FD_ZERO (&non_process_wait_mask
);
6831 max_process_desc
= 0;
6833 #ifdef NON_BLOCKING_CONNECT
6834 FD_ZERO (&connect_wait_mask
);
6835 num_pending_connects
= 0;
6838 #ifdef ADAPTIVE_READ_BUFFERING
6839 process_output_delay_count
= 0;
6840 process_output_skip
= 0;
6843 FD_SET (0, &input_wait_mask
);
6845 Vprocess_alist
= Qnil
;
6846 for (i
= 0; i
< MAXDESC
; i
++)
6848 chan_process
[i
] = Qnil
;
6849 proc_buffered_char
[i
] = -1;
6851 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6852 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6853 #ifdef DATAGRAM_SOCKETS
6854 bzero (datagram_address
, sizeof datagram_address
);
6859 Lisp_Object subfeatures
= Qnil
;
6860 struct socket_options
*sopt
;
6862 #define ADD_SUBFEATURE(key, val) \
6863 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6865 #ifdef NON_BLOCKING_CONNECT
6866 ADD_SUBFEATURE (QCnowait
, Qt
);
6868 #ifdef DATAGRAM_SOCKETS
6869 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6871 #ifdef HAVE_LOCAL_SOCKETS
6872 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6874 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6876 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6878 #ifdef HAVE_GETSOCKNAME
6879 ADD_SUBFEATURE (QCservice
, Qt
);
6881 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6882 ADD_SUBFEATURE (QCserver
, Qt
);
6885 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6886 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6888 Fprovide (intern ("make-network-process"), subfeatures
);
6890 #endif /* HAVE_SOCKETS */
6892 #if defined (DARWIN) || defined (MAC_OSX)
6893 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6894 processes. As such, we only change the default value. */
6897 char *release
= get_operating_system_release();
6898 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6899 && release
[1] == '.')) {
6900 Vprocess_connection_type
= Qnil
;
6909 Qprocessp
= intern ("processp");
6910 staticpro (&Qprocessp
);
6911 Qrun
= intern ("run");
6913 Qstop
= intern ("stop");
6915 Qsignal
= intern ("signal");
6916 staticpro (&Qsignal
);
6918 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6921 Qexit = intern ("exit");
6922 staticpro (&Qexit); */
6924 Qopen
= intern ("open");
6926 Qclosed
= intern ("closed");
6927 staticpro (&Qclosed
);
6928 Qconnect
= intern ("connect");
6929 staticpro (&Qconnect
);
6930 Qfailed
= intern ("failed");
6931 staticpro (&Qfailed
);
6932 Qlisten
= intern ("listen");
6933 staticpro (&Qlisten
);
6934 Qlocal
= intern ("local");
6935 staticpro (&Qlocal
);
6936 Qipv4
= intern ("ipv4");
6939 Qipv6
= intern ("ipv6");
6942 Qdatagram
= intern ("datagram");
6943 staticpro (&Qdatagram
);
6945 QCname
= intern (":name");
6946 staticpro (&QCname
);
6947 QCbuffer
= intern (":buffer");
6948 staticpro (&QCbuffer
);
6949 QChost
= intern (":host");
6950 staticpro (&QChost
);
6951 QCservice
= intern (":service");
6952 staticpro (&QCservice
);
6953 QCtype
= intern (":type");
6954 staticpro (&QCtype
);
6955 QClocal
= intern (":local");
6956 staticpro (&QClocal
);
6957 QCremote
= intern (":remote");
6958 staticpro (&QCremote
);
6959 QCcoding
= intern (":coding");
6960 staticpro (&QCcoding
);
6961 QCserver
= intern (":server");
6962 staticpro (&QCserver
);
6963 QCnowait
= intern (":nowait");
6964 staticpro (&QCnowait
);
6965 QCsentinel
= intern (":sentinel");
6966 staticpro (&QCsentinel
);
6967 QClog
= intern (":log");
6969 QCnoquery
= intern (":noquery");
6970 staticpro (&QCnoquery
);
6971 QCstop
= intern (":stop");
6972 staticpro (&QCstop
);
6973 QCoptions
= intern (":options");
6974 staticpro (&QCoptions
);
6975 QCplist
= intern (":plist");
6976 staticpro (&QCplist
);
6977 QCfilter_multibyte
= intern (":filter-multibyte");
6978 staticpro (&QCfilter_multibyte
);
6980 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6981 staticpro (&Qlast_nonmenu_event
);
6983 staticpro (&Vprocess_alist
);
6985 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6986 doc
: /* *Non-nil means delete processes immediately when they exit.
6987 nil means don't delete them until `list-processes' is run. */);
6989 delete_exited_processes
= 1;
6991 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6992 doc
: /* Control type of device used to communicate with subprocesses.
6993 Values are nil to use a pipe, or t or `pty' to use a pty.
6994 The value has no effect if the system has no ptys or if all ptys are busy:
6995 then a pipe is used in any case.
6996 The value takes effect when `start-process' is called. */);
6997 Vprocess_connection_type
= Qt
;
6999 #ifdef ADAPTIVE_READ_BUFFERING
7000 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7001 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7002 On some systems, when Emacs reads the output from a subprocess, the output data
7003 is read in very small blocks, potentially resulting in very poor performance.
7004 This behavior can be remedied to some extent by setting this variable to a
7005 non-nil value, as it will automatically delay reading from such processes, to
7006 allow them to produce more output before Emacs tries to read it.
7007 If the value is t, the delay is reset after each write to the process; any other
7008 non-nil value means that the delay is not reset on write.
7009 The variable takes effect when `start-process' is called. */);
7010 Vprocess_adaptive_read_buffering
= Qt
;
7013 defsubr (&Sprocessp
);
7014 defsubr (&Sget_process
);
7015 defsubr (&Sget_buffer_process
);
7016 defsubr (&Sdelete_process
);
7017 defsubr (&Sprocess_status
);
7018 defsubr (&Sprocess_exit_status
);
7019 defsubr (&Sprocess_id
);
7020 defsubr (&Sprocess_name
);
7021 defsubr (&Sprocess_tty_name
);
7022 defsubr (&Sprocess_command
);
7023 defsubr (&Sset_process_buffer
);
7024 defsubr (&Sprocess_buffer
);
7025 defsubr (&Sprocess_mark
);
7026 defsubr (&Sset_process_filter
);
7027 defsubr (&Sprocess_filter
);
7028 defsubr (&Sset_process_sentinel
);
7029 defsubr (&Sprocess_sentinel
);
7030 defsubr (&Sset_process_window_size
);
7031 defsubr (&Sset_process_inherit_coding_system_flag
);
7032 defsubr (&Sprocess_inherit_coding_system_flag
);
7033 defsubr (&Sset_process_query_on_exit_flag
);
7034 defsubr (&Sprocess_query_on_exit_flag
);
7035 defsubr (&Sprocess_contact
);
7036 defsubr (&Sprocess_plist
);
7037 defsubr (&Sset_process_plist
);
7038 defsubr (&Slist_processes
);
7039 defsubr (&Sprocess_list
);
7040 defsubr (&Sstart_process
);
7042 defsubr (&Sset_network_process_option
);
7043 defsubr (&Smake_network_process
);
7044 defsubr (&Sformat_network_address
);
7045 #endif /* HAVE_SOCKETS */
7046 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7048 defsubr (&Snetwork_interface_list
);
7050 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7051 defsubr (&Snetwork_interface_info
);
7053 #endif /* HAVE_SOCKETS ... */
7054 #ifdef DATAGRAM_SOCKETS
7055 defsubr (&Sprocess_datagram_address
);
7056 defsubr (&Sset_process_datagram_address
);
7058 defsubr (&Saccept_process_output
);
7059 defsubr (&Sprocess_send_region
);
7060 defsubr (&Sprocess_send_string
);
7061 defsubr (&Sinterrupt_process
);
7062 defsubr (&Skill_process
);
7063 defsubr (&Squit_process
);
7064 defsubr (&Sstop_process
);
7065 defsubr (&Scontinue_process
);
7066 defsubr (&Sprocess_running_child_p
);
7067 defsubr (&Sprocess_send_eof
);
7068 defsubr (&Ssignal_process
);
7069 defsubr (&Swaiting_for_user_input_p
);
7070 /* defsubr (&Sprocess_connection); */
7071 defsubr (&Sset_process_coding_system
);
7072 defsubr (&Sprocess_coding_system
);
7073 defsubr (&Sset_process_filter_multibyte
);
7074 defsubr (&Sprocess_filter_multibyte_p
);
7078 #else /* not subprocesses */
7080 #include <sys/types.h>
7084 #include "systime.h"
7085 #include "charset.h"
7087 #include "termopts.h"
7088 #include "sysselect.h"
7090 extern int frame_garbaged
;
7092 extern EMACS_TIME
timer_check ();
7093 extern int timers_run
;
7097 /* As described above, except assuming that there are no subprocesses:
7099 Wait for timeout to elapse and/or keyboard input to be available.
7102 timeout in seconds, or
7103 zero for no limit, or
7104 -1 means gobble data immediately available but don't wait for any.
7106 read_kbd is a Lisp_Object:
7107 0 to ignore keyboard input, or
7108 1 to return when input is available, or
7109 -1 means caller will actually read the input, so don't throw to
7112 see full version for other parameters. We know that wait_proc will
7113 always be NULL, since `subprocesses' isn't defined.
7115 do_display != 0 means redisplay should be done to show subprocess
7116 output that arrives.
7118 Return true iff we received input from any process. */
7121 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7122 wait_for_cell
, wait_proc
, just_wait_proc
)
7123 int time_limit
, microsecs
, read_kbd
, do_display
;
7124 Lisp_Object wait_for_cell
;
7125 struct Lisp_Process
*wait_proc
;
7129 EMACS_TIME end_time
, timeout
;
7130 SELECT_TYPE waitchannels
;
7133 /* What does time_limit really mean? */
7134 if (time_limit
|| microsecs
)
7136 EMACS_GET_TIME (end_time
);
7137 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7138 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7141 /* Turn off periodic alarms (in case they are in use)
7142 and then turn off any other atimers,
7143 because the select emulator uses alarms. */
7145 turn_on_atimers (0);
7149 int timeout_reduced_for_timers
= 0;
7151 /* If calling from keyboard input, do not quit
7152 since we want to return C-g as an input character.
7153 Otherwise, do pending quit if requested. */
7157 /* Exit now if the cell we're waiting for became non-nil. */
7158 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7161 /* Compute time from now till when time limit is up */
7162 /* Exit if already run out */
7163 if (time_limit
== -1)
7165 /* -1 specified for timeout means
7166 gobble output available now
7167 but don't wait at all. */
7169 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7171 else if (time_limit
|| microsecs
)
7173 EMACS_GET_TIME (timeout
);
7174 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7175 if (EMACS_TIME_NEG_P (timeout
))
7180 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7183 /* If our caller will not immediately handle keyboard events,
7184 run timer events directly.
7185 (Callers that will immediately read keyboard events
7186 call timer_delay on their own.) */
7187 if (NILP (wait_for_cell
))
7189 EMACS_TIME timer_delay
;
7193 int old_timers_run
= timers_run
;
7194 timer_delay
= timer_check (1);
7195 if (timers_run
!= old_timers_run
&& do_display
)
7196 /* We must retry, since a timer may have requeued itself
7197 and that could alter the time delay. */
7198 redisplay_preserve_echo_area (14);
7202 while (!detect_input_pending ());
7204 /* If there is unread keyboard input, also return. */
7206 && requeued_events_pending_p ())
7209 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7211 EMACS_TIME difference
;
7212 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7213 if (EMACS_TIME_NEG_P (difference
))
7215 timeout
= timer_delay
;
7216 timeout_reduced_for_timers
= 1;
7221 /* Cause C-g and alarm signals to take immediate action,
7222 and cause input available signals to zero out timeout. */
7224 set_waiting_for_input (&timeout
);
7226 /* Wait till there is something to do. */
7228 if (! read_kbd
&& NILP (wait_for_cell
))
7229 FD_ZERO (&waitchannels
);
7231 FD_SET (0, &waitchannels
);
7233 /* If a frame has been newly mapped and needs updating,
7234 reprocess its display stuff. */
7235 if (frame_garbaged
&& do_display
)
7237 clear_waiting_for_input ();
7238 redisplay_preserve_echo_area (15);
7240 set_waiting_for_input (&timeout
);
7243 if (read_kbd
&& detect_input_pending ())
7246 FD_ZERO (&waitchannels
);
7249 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7254 /* Make C-g and alarm signals set flags again */
7255 clear_waiting_for_input ();
7257 /* If we woke up due to SIGWINCH, actually change size now. */
7258 do_pending_window_change (0);
7260 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7261 /* We waited the full specified time, so return now. */
7266 /* If the system call was interrupted, then go around the
7268 if (xerrno
== EINTR
)
7269 FD_ZERO (&waitchannels
);
7271 error ("select error: %s", emacs_strerror (xerrno
));
7274 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7275 /* System sometimes fails to deliver SIGIO. */
7276 kill (getpid (), SIGIO
);
7279 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7280 kill (getpid (), SIGIO
);
7283 /* Check for keyboard input */
7286 && detect_input_pending_run_timers (do_display
))
7288 swallow_events (do_display
);
7289 if (detect_input_pending_run_timers (do_display
))
7293 /* If there is unread keyboard input, also return. */
7295 && requeued_events_pending_p ())
7298 /* If wait_for_cell. check for keyboard input
7299 but don't run any timers.
7300 ??? (It seems wrong to me to check for keyboard
7301 input at all when wait_for_cell, but the code
7302 has been this way since July 1994.
7303 Try changing this after version 19.31.) */
7304 if (! NILP (wait_for_cell
)
7305 && detect_input_pending ())
7307 swallow_events (do_display
);
7308 if (detect_input_pending ())
7312 /* Exit now if the cell we're waiting for became non-nil. */
7313 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7323 /* Don't confuse make-docfile by having two doc strings for this function.
7324 make-docfile does not pay attention to #if, for good reason! */
7325 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7328 register Lisp_Object name
;
7333 /* Don't confuse make-docfile by having two doc strings for this function.
7334 make-docfile does not pay attention to #if, for good reason! */
7335 DEFUN ("process-inherit-coding-system-flag",
7336 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7340 register Lisp_Object process
;
7342 /* Ignore the argument and return the value of
7343 inherit-process-coding-system. */
7344 return inherit_process_coding_system
? Qt
: Qnil
;
7347 /* Kill all processes associated with `buffer'.
7348 If `buffer' is nil, kill all processes.
7349 Since we have no subprocesses, this does nothing. */
7352 kill_buffer_processes (buffer
)
7365 QCtype
= intern (":type");
7366 staticpro (&QCtype
);
7368 defsubr (&Sget_buffer_process
);
7369 defsubr (&Sprocess_inherit_coding_system_flag
);
7373 #endif /* not subprocesses */
7375 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7376 (do not change this comment) */