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
;
153 extern Lisp_Object Qsignal
;
154 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
155 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
159 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
160 Lisp_Object QClocal
, QCremote
, QCcoding
;
161 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
162 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
163 Lisp_Object QCfilter_multibyte
;
164 Lisp_Object Qlast_nonmenu_event
;
165 /* QCfamily is declared and initialized in xfaces.c,
166 QCfilter in keyboard.c. */
167 extern Lisp_Object QCfamily
, QCfilter
;
169 /* Qexit is declared and initialized in eval.c. */
171 /* QCfamily is defined in xfaces.c. */
172 extern Lisp_Object QCfamily
;
173 /* QCfilter is defined in keyboard.c. */
174 extern Lisp_Object QCfilter
;
176 /* a process object is a network connection when its childp field is neither
177 Qt nor Qnil but is instead a property list (KEY VAL ...). */
180 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
181 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
183 #define NETCONN_P(p) 0
184 #define NETCONN1_P(p) 0
185 #endif /* HAVE_SOCKETS */
187 /* Define first descriptor number available for subprocesses. */
189 #define FIRST_PROC_DESC 1
191 #define FIRST_PROC_DESC 3
194 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
197 #if !defined (SIGCHLD) && defined (SIGCLD)
198 #define SIGCHLD SIGCLD
201 #include "syssignal.h"
205 extern char *get_operating_system_release ();
211 extern char *sys_errlist
[];
218 /* t means use pty, nil means use a pipe,
219 maybe other values to come. */
220 static Lisp_Object Vprocess_connection_type
;
224 #include <sys/socket.h>
228 /* These next two vars are non-static since sysdep.c uses them in the
229 emulation of `select'. */
230 /* Number of events of change of status of a process. */
232 /* Number of events for which the user or sentinel has been notified. */
235 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
237 #ifdef BROKEN_NON_BLOCKING_CONNECT
238 #undef NON_BLOCKING_CONNECT
240 #ifndef NON_BLOCKING_CONNECT
243 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
244 #if defined (O_NONBLOCK) || defined (O_NDELAY)
245 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
246 #define NON_BLOCKING_CONNECT
247 #endif /* EWOULDBLOCK || EINPROGRESS */
248 #endif /* O_NONBLOCK || O_NDELAY */
249 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
250 #endif /* HAVE_SELECT */
251 #endif /* HAVE_SOCKETS */
252 #endif /* NON_BLOCKING_CONNECT */
253 #endif /* BROKEN_NON_BLOCKING_CONNECT */
255 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
256 this system. We need to read full packets, so we need a
257 "non-destructive" select. So we require either native select,
258 or emulation of select using FIONREAD. */
260 #ifdef BROKEN_DATAGRAM_SOCKETS
261 #undef DATAGRAM_SOCKETS
263 #ifndef DATAGRAM_SOCKETS
265 #if defined (HAVE_SELECT) || defined (FIONREAD)
266 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
267 #define DATAGRAM_SOCKETS
268 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
269 #endif /* HAVE_SELECT || FIONREAD */
270 #endif /* HAVE_SOCKETS */
271 #endif /* DATAGRAM_SOCKETS */
272 #endif /* BROKEN_DATAGRAM_SOCKETS */
275 #undef NON_BLOCKING_CONNECT
276 #undef DATAGRAM_SOCKETS
279 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
280 #ifdef EMACS_HAS_USECS
281 #define ADAPTIVE_READ_BUFFERING
285 #ifdef ADAPTIVE_READ_BUFFERING
286 #define READ_OUTPUT_DELAY_INCREMENT 10000
287 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
288 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
290 /* Number of processes which have a non-zero read_output_delay,
291 and therefore might be delayed for adaptive read buffering. */
293 static int process_output_delay_count
;
295 /* Non-zero if any process has non-nil read_output_skip. */
297 static int process_output_skip
;
299 /* Non-nil means to delay reading process output to improve buffering.
300 A value of t means that delay is reset after each send, any other
301 non-nil value does not reset the delay. A value of nil disables
302 adaptive read buffering completely. */
303 static Lisp_Object Vprocess_adaptive_read_buffering
;
305 #define process_output_delay_count 0
309 #include "sysselect.h"
311 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
312 static void deactivate_process
P_ ((Lisp_Object
));
313 static void status_notify
P_ ((struct Lisp_Process
*));
314 static int read_process_output
P_ ((Lisp_Object
, int));
316 /* If we support a window system, turn on the code to poll periodically
317 to detect C-g. It isn't actually used when doing interrupt input. */
318 #ifdef HAVE_WINDOW_SYSTEM
319 #define POLL_FOR_INPUT
322 static Lisp_Object
get_process ();
323 static void exec_sentinel ();
325 extern EMACS_TIME
timer_check ();
326 extern int timers_run
;
328 /* Mask of bits indicating the descriptors that we wait for input on. */
330 static SELECT_TYPE input_wait_mask
;
332 /* Mask that excludes keyboard input descriptor (s). */
334 static SELECT_TYPE non_keyboard_wait_mask
;
336 /* Mask that excludes process input descriptor (s). */
338 static SELECT_TYPE non_process_wait_mask
;
340 #ifdef NON_BLOCKING_CONNECT
341 /* Mask of bits indicating the descriptors that we wait for connect to
342 complete on. Once they complete, they are removed from this mask
343 and added to the input_wait_mask and non_keyboard_wait_mask. */
345 static SELECT_TYPE connect_wait_mask
;
347 /* Number of bits set in connect_wait_mask. */
348 static int num_pending_connects
;
350 #define IF_NON_BLOCKING_CONNECT(s) s
352 #define IF_NON_BLOCKING_CONNECT(s)
355 /* The largest descriptor currently in use for a process object. */
356 static int max_process_desc
;
358 /* The largest descriptor currently in use for keyboard input. */
359 static int max_keyboard_desc
;
361 /* Nonzero means delete a process right away if it exits. */
362 static int delete_exited_processes
;
364 /* Indexed by descriptor, gives the process (if any) for that descriptor */
365 Lisp_Object chan_process
[MAXDESC
];
367 /* Alist of elements (NAME . PROCESS) */
368 Lisp_Object Vprocess_alist
;
370 /* Buffered-ahead input char from process, indexed by channel.
371 -1 means empty (no char is buffered).
372 Used on sys V where the only way to tell if there is any
373 output from the process is to read at least one char.
374 Always -1 on systems that support FIONREAD. */
376 /* Don't make static; need to access externally. */
377 int proc_buffered_char
[MAXDESC
];
379 /* Table of `struct coding-system' for each process. */
380 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
381 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
383 #ifdef DATAGRAM_SOCKETS
384 /* Table of `partner address' for datagram sockets. */
385 struct sockaddr_and_len
{
388 } datagram_address
[MAXDESC
];
389 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
390 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
392 #define DATAGRAM_CHAN_P(chan) (0)
393 #define DATAGRAM_CONN_P(proc) (0)
396 /* Maximum number of bytes to send to a pty without an eof. */
397 static int pty_max_bytes
;
399 /* Nonzero means don't run process sentinels. This is used
401 int inhibit_sentinels
;
407 /* The file name of the pty opened by allocate_pty. */
409 static char pty_name
[24];
412 /* Compute the Lisp form of the process status, p->status, from
413 the numeric status that was returned by `wait'. */
415 static Lisp_Object
status_convert ();
419 struct Lisp_Process
*p
;
421 union { int i
; WAITTYPE wt
; } u
;
422 eassert (p
->raw_status_new
);
424 p
->status
= status_convert (u
.wt
);
425 p
->raw_status_new
= 0;
428 /* Convert a process status word in Unix format to
429 the list that we use internally. */
436 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
437 else if (WIFEXITED (w
))
438 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
439 WCOREDUMP (w
) ? Qt
: Qnil
));
440 else if (WIFSIGNALED (w
))
441 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
442 WCOREDUMP (w
) ? Qt
: Qnil
));
447 /* Given a status-list, extract the three pieces of information
448 and store them individually through the three pointers. */
451 decode_status (l
, symbol
, code
, coredump
)
469 *code
= XFASTINT (XCAR (tem
));
471 *coredump
= !NILP (tem
);
475 /* Return a string describing a process status list. */
479 struct Lisp_Process
*p
;
481 Lisp_Object status
= p
->status
;
484 Lisp_Object string
, string2
;
486 decode_status (status
, &symbol
, &code
, &coredump
);
488 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
491 synchronize_system_messages_locale ();
492 signame
= strsignal (code
);
495 string
= build_string (signame
);
496 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
497 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
498 return concat2 (string
, string2
);
500 else if (EQ (symbol
, Qexit
))
503 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
505 return build_string ("finished\n");
506 string
= Fnumber_to_string (make_number (code
));
507 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
508 return concat3 (build_string ("exited abnormally with code "),
511 else if (EQ (symbol
, Qfailed
))
513 string
= Fnumber_to_string (make_number (code
));
514 string2
= build_string ("\n");
515 return concat3 (build_string ("failed with code "),
519 return Fcopy_sequence (Fsymbol_name (symbol
));
524 /* Open an available pty, returning a file descriptor.
525 Return -1 on failure.
526 The file name of the terminal corresponding to the pty
527 is left in the variable pty_name. */
538 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
539 for (i
= 0; i
< 16; i
++)
542 struct stat stb
; /* Used in some PTY_OPEN. */
543 #ifdef PTY_NAME_SPRINTF
546 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
547 #endif /* no PTY_NAME_SPRINTF */
551 #else /* no PTY_OPEN */
554 /* Unusual IRIS code */
555 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
558 if (fstat (fd
, &stb
) < 0)
560 # else /* not IRIS */
561 { /* Some systems name their pseudoterminals so that there are gaps in
562 the usual sequence - for example, on HP9000/S700 systems, there
563 are no pseudoterminals with names ending in 'f'. So we wait for
564 three failures in a row before deciding that we've reached the
566 int failed_count
= 0;
568 if (stat (pty_name
, &stb
) < 0)
571 if (failed_count
>= 3)
578 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
580 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
582 # endif /* not IRIS */
584 #endif /* no PTY_OPEN */
588 /* check to make certain that both sides are available
589 this avoids a nasty yet stupid bug in rlogins */
590 #ifdef PTY_TTY_NAME_SPRINTF
593 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
594 #endif /* no PTY_TTY_NAME_SPRINTF */
596 if (access (pty_name
, 6) != 0)
599 # if !defined(IRIS) && !defined(__sgi)
605 #endif /* not UNIPLUS */
612 #endif /* HAVE_PTYS */
618 register Lisp_Object val
, tem
, name1
;
619 register struct Lisp_Process
*p
;
623 p
= allocate_process ();
625 XSETINT (p
->infd
, -1);
626 XSETINT (p
->outfd
, -1);
627 XSETFASTINT (p
->tick
, 0);
628 XSETFASTINT (p
->update_tick
, 0);
630 p
->raw_status_new
= 0;
632 p
->mark
= Fmake_marker ();
634 #ifdef ADAPTIVE_READ_BUFFERING
635 p
->adaptive_read_buffering
= Qnil
;
636 XSETFASTINT (p
->read_output_delay
, 0);
637 p
->read_output_skip
= Qnil
;
640 /* If name is already in use, modify it until it is unused. */
645 tem
= Fget_process (name1
);
646 if (NILP (tem
)) break;
647 sprintf (suffix
, "<%d>", i
);
648 name1
= concat2 (name
, build_string (suffix
));
652 XSETPROCESS (val
, p
);
653 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
658 remove_process (proc
)
659 register Lisp_Object proc
;
661 register Lisp_Object pair
;
663 pair
= Frassq (proc
, Vprocess_alist
);
664 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
666 deactivate_process (proc
);
669 /* Setup coding systems of PROCESS. */
672 setup_process_coding_systems (process
)
675 struct Lisp_Process
*p
= XPROCESS (process
);
676 int inch
= XINT (p
->infd
);
677 int outch
= XINT (p
->outfd
);
679 if (inch
< 0 || outch
< 0)
682 if (!proc_decode_coding_system
[inch
])
683 proc_decode_coding_system
[inch
]
684 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
685 setup_coding_system (p
->decode_coding_system
,
686 proc_decode_coding_system
[inch
]);
687 if (! NILP (p
->filter
))
689 if (NILP (p
->filter_multibyte
))
690 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
692 else if (BUFFERP (p
->buffer
))
694 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
695 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
698 if (!proc_encode_coding_system
[outch
])
699 proc_encode_coding_system
[outch
]
700 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
701 setup_coding_system (p
->encode_coding_system
,
702 proc_encode_coding_system
[outch
]);
703 if (proc_encode_coding_system
[outch
]->eol_type
== CODING_EOL_UNDECIDED
)
704 proc_encode_coding_system
[outch
]->eol_type
= system_eol_type
;
707 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
708 doc
: /* Return t if OBJECT is a process. */)
712 return PROCESSP (object
) ? Qt
: Qnil
;
715 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
716 doc
: /* Return the process named NAME, or nil if there is none. */)
718 register Lisp_Object name
;
723 return Fcdr (Fassoc (name
, Vprocess_alist
));
726 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
727 doc
: /* Return the (or a) process associated with BUFFER.
728 BUFFER may be a buffer or the name of one. */)
730 register Lisp_Object buffer
;
732 register Lisp_Object buf
, tail
, proc
;
734 if (NILP (buffer
)) return Qnil
;
735 buf
= Fget_buffer (buffer
);
736 if (NILP (buf
)) return Qnil
;
738 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
740 proc
= Fcdr (Fcar (tail
));
741 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
747 /* This is how commands for the user decode process arguments. It
748 accepts a process, a process name, a buffer, a buffer name, or nil.
749 Buffers denote the first process in the buffer, and nil denotes the
754 register Lisp_Object name
;
756 register Lisp_Object proc
, obj
;
759 obj
= Fget_process (name
);
761 obj
= Fget_buffer (name
);
763 error ("Process %s does not exist", SDATA (name
));
765 else if (NILP (name
))
766 obj
= Fcurrent_buffer ();
770 /* Now obj should be either a buffer object or a process object.
774 proc
= Fget_buffer_process (obj
);
776 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
788 /* Fdelete_process promises to immediately forget about the process, but in
789 reality, Emacs needs to remember those processes until they have been
790 treated by sigchld_handler; otherwise this handler would consider the
791 process as being synchronous and say that the synchronous process is
793 static Lisp_Object deleted_pid_list
;
796 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
797 doc
: /* Delete PROCESS: kill it and forget about it immediately.
798 PROCESS may be a process, a buffer, the name of a process or buffer, or
799 nil, indicating the current buffer's process. */)
801 register Lisp_Object process
;
803 register struct Lisp_Process
*p
;
805 process
= get_process (process
);
806 p
= XPROCESS (process
);
808 p
->raw_status_new
= 0;
811 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
812 XSETINT (p
->tick
, ++process_tick
);
815 else if (XINT (p
->infd
) >= 0)
820 /* No problem storing the pid here, as it is still in Vprocess_alist. */
821 deleted_pid_list
= Fcons (make_fixnum_or_float (p
->pid
),
822 /* GC treated elements set to nil. */
823 Fdelq (Qnil
, deleted_pid_list
));
824 /* If the process has already signaled, remove it from the list. */
825 if (p
->raw_status_new
)
828 if (CONSP (p
->status
))
829 symbol
= XCAR (p
->status
);
830 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
831 Fdelete (make_fixnum_or_float (p
->pid
), deleted_pid_list
);
835 Fkill_process (process
, Qnil
);
836 /* Do this now, since remove_process will make sigchld_handler do nothing. */
838 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
839 XSETINT (p
->tick
, ++process_tick
);
843 remove_process (process
);
847 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
848 doc
: /* Return the status of PROCESS.
849 The returned value is one of the following symbols:
850 run -- for a process that is running.
851 stop -- for a process stopped but continuable.
852 exit -- for a process that has exited.
853 signal -- for a process that has got a fatal signal.
854 open -- for a network stream connection that is open.
855 listen -- for a network stream server that is listening.
856 closed -- for a network stream connection that is closed.
857 connect -- when waiting for a non-blocking connection to complete.
858 failed -- when a non-blocking connection has failed.
859 nil -- if arg is a process name and no such process exists.
860 PROCESS may be a process, a buffer, the name of a process, or
861 nil, indicating the current buffer's process. */)
863 register Lisp_Object process
;
865 register struct Lisp_Process
*p
;
866 register Lisp_Object status
;
868 if (STRINGP (process
))
869 process
= Fget_process (process
);
871 process
= get_process (process
);
876 p
= XPROCESS (process
);
877 if (p
->raw_status_new
)
881 status
= XCAR (status
);
884 if (EQ (status
, Qexit
))
886 else if (EQ (p
->command
, Qt
))
888 else if (EQ (status
, Qrun
))
894 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
896 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
897 If PROCESS has not yet exited or died, return 0. */)
899 register Lisp_Object process
;
901 CHECK_PROCESS (process
);
902 if (XPROCESS (process
)->raw_status_new
)
903 update_status (XPROCESS (process
));
904 if (CONSP (XPROCESS (process
)->status
))
905 return XCAR (XCDR (XPROCESS (process
)->status
));
906 return make_number (0);
909 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
910 doc
: /* Return the process id of PROCESS.
911 This is the pid of the external process which PROCESS uses or talks to.
912 For a network connection, this value is nil. */)
914 register Lisp_Object process
;
916 CHECK_PROCESS (process
);
917 return (XPROCESS (process
)->pid
918 ? make_fixnum_or_float (XPROCESS (process
)->pid
)
922 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
923 doc
: /* Return the name of PROCESS, as a string.
924 This is the name of the program invoked in PROCESS,
925 possibly modified to make it unique among process names. */)
927 register Lisp_Object process
;
929 CHECK_PROCESS (process
);
930 return XPROCESS (process
)->name
;
933 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
934 doc
: /* Return the command that was executed to start PROCESS.
935 This is a list of strings, the first string being the program executed
936 and the rest of the strings being the arguments given to it.
937 For a non-child channel, this is nil. */)
939 register Lisp_Object process
;
941 CHECK_PROCESS (process
);
942 return XPROCESS (process
)->command
;
945 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
946 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
947 This is the terminal that the process itself reads and writes on,
948 not the name of the pty that Emacs uses to talk with that terminal. */)
950 register Lisp_Object process
;
952 CHECK_PROCESS (process
);
953 return XPROCESS (process
)->tty_name
;
956 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
958 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
960 register Lisp_Object process
, buffer
;
962 struct Lisp_Process
*p
;
964 CHECK_PROCESS (process
);
966 CHECK_BUFFER (buffer
);
967 p
= XPROCESS (process
);
970 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
971 setup_process_coding_systems (process
);
975 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
977 doc
: /* Return the buffer PROCESS is associated with.
978 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
980 register Lisp_Object process
;
982 CHECK_PROCESS (process
);
983 return XPROCESS (process
)->buffer
;
986 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
988 doc
: /* Return the marker for the end of the last output from PROCESS. */)
990 register Lisp_Object process
;
992 CHECK_PROCESS (process
);
993 return XPROCESS (process
)->mark
;
996 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
998 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
999 t means stop accepting output from the process.
1001 When a process has a filter, its buffer is not used for output.
1002 Instead, each time it does output, the entire string of output is
1003 passed to the filter.
1005 The filter gets two arguments: the process and the string of output.
1006 The string argument is normally a multibyte string, except:
1007 - if the process' input coding system is no-conversion or raw-text,
1008 it is a unibyte string (the non-converted input), or else
1009 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1010 string (the result of converting the decoded input multibyte
1011 string to unibyte with `string-make-unibyte'). */)
1013 register Lisp_Object process
, filter
;
1015 struct Lisp_Process
*p
;
1017 CHECK_PROCESS (process
);
1018 p
= XPROCESS (process
);
1020 /* Don't signal an error if the process' input file descriptor
1021 is closed. This could make debugging Lisp more difficult,
1022 for example when doing something like
1024 (setq process (start-process ...))
1026 (set-process-filter process ...) */
1028 if (XINT (p
->infd
) >= 0)
1030 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1032 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
1033 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
1035 else if (EQ (p
->filter
, Qt
)
1036 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1038 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1039 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1045 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1046 setup_process_coding_systems (process
);
1050 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1052 doc
: /* Returns the filter function of PROCESS; nil if none.
1053 See `set-process-filter' for more info on filter functions. */)
1055 register Lisp_Object process
;
1057 CHECK_PROCESS (process
);
1058 return XPROCESS (process
)->filter
;
1061 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1063 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1064 The sentinel is called as a function when the process changes state.
1065 It gets two arguments: the process, and a string describing the change. */)
1067 register Lisp_Object process
, sentinel
;
1069 struct Lisp_Process
*p
;
1071 CHECK_PROCESS (process
);
1072 p
= XPROCESS (process
);
1074 p
->sentinel
= sentinel
;
1076 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1080 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1082 doc
: /* Return the sentinel of PROCESS; nil if none.
1083 See `set-process-sentinel' for more info on sentinels. */)
1085 register Lisp_Object process
;
1087 CHECK_PROCESS (process
);
1088 return XPROCESS (process
)->sentinel
;
1091 DEFUN ("set-process-window-size", Fset_process_window_size
,
1092 Sset_process_window_size
, 3, 3, 0,
1093 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1094 (process
, height
, width
)
1095 register Lisp_Object process
, height
, width
;
1097 CHECK_PROCESS (process
);
1098 CHECK_NATNUM (height
);
1099 CHECK_NATNUM (width
);
1101 if (XINT (XPROCESS (process
)->infd
) < 0
1102 || set_window_size (XINT (XPROCESS (process
)->infd
),
1103 XINT (height
), XINT (width
)) <= 0)
1109 DEFUN ("set-process-inherit-coding-system-flag",
1110 Fset_process_inherit_coding_system_flag
,
1111 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1112 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1113 If the second argument FLAG is non-nil, then the variable
1114 `buffer-file-coding-system' of the buffer associated with PROCESS
1115 will be bound to the value of the coding system used to decode
1118 This is useful when the coding system specified for the process buffer
1119 leaves either the character code conversion or the end-of-line conversion
1120 unspecified, or if the coding system used to decode the process output
1121 is more appropriate for saving the process buffer.
1123 Binding the variable `inherit-process-coding-system' to non-nil before
1124 starting the process is an alternative way of setting the inherit flag
1125 for the process which will run. */)
1127 register Lisp_Object process
, flag
;
1129 CHECK_PROCESS (process
);
1130 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1134 DEFUN ("process-inherit-coding-system-flag",
1135 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1137 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1138 If this flag is t, `buffer-file-coding-system' of the buffer
1139 associated with PROCESS will inherit the coding system used to decode
1140 the process output. */)
1142 register Lisp_Object process
;
1144 CHECK_PROCESS (process
);
1145 return XPROCESS (process
)->inherit_coding_system_flag
;
1148 DEFUN ("set-process-query-on-exit-flag",
1149 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1151 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1152 If the second argument FLAG is non-nil, Emacs will query the user before
1153 exiting if PROCESS is running. */)
1155 register Lisp_Object process
, flag
;
1157 CHECK_PROCESS (process
);
1158 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1162 DEFUN ("process-query-on-exit-flag",
1163 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1165 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1167 register Lisp_Object process
;
1169 CHECK_PROCESS (process
);
1170 return Fnull (XPROCESS (process
)->kill_without_query
);
1173 #ifdef DATAGRAM_SOCKETS
1174 Lisp_Object
Fprocess_datagram_address ();
1177 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1179 doc
: /* Return the contact info of PROCESS; t for a real child.
1180 For a net connection, the value depends on the optional KEY arg.
1181 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1182 if KEY is t, the complete contact information for the connection is
1183 returned, else the specific value for the keyword KEY is returned.
1184 See `make-network-process' for a list of keywords. */)
1186 register Lisp_Object process
, key
;
1188 Lisp_Object contact
;
1190 CHECK_PROCESS (process
);
1191 contact
= XPROCESS (process
)->childp
;
1193 #ifdef DATAGRAM_SOCKETS
1194 if (DATAGRAM_CONN_P (process
)
1195 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1196 contact
= Fplist_put (contact
, QCremote
,
1197 Fprocess_datagram_address (process
));
1200 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1203 return Fcons (Fplist_get (contact
, QChost
),
1204 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1205 return Fplist_get (contact
, key
);
1208 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1210 doc
: /* Return the plist of PROCESS. */)
1212 register Lisp_Object process
;
1214 CHECK_PROCESS (process
);
1215 return XPROCESS (process
)->plist
;
1218 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1220 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1222 register Lisp_Object process
, plist
;
1224 CHECK_PROCESS (process
);
1227 XPROCESS (process
)->plist
= plist
;
1231 #if 0 /* Turned off because we don't currently record this info
1232 in the process. Perhaps add it. */
1233 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1234 doc
: /* Return the connection type of PROCESS.
1235 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1236 a socket connection. */)
1238 Lisp_Object process
;
1240 return XPROCESS (process
)->type
;
1245 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1247 doc
: /* Convert network ADDRESS from internal format to a string.
1248 A 4 or 5 element vector represents an IPv4 address (with port number).
1249 An 8 or 9 element vector represents an IPv6 address (with port number).
1250 If optional second argument OMIT-PORT is non-nil, don't include a port
1251 number in the string, even when present in ADDRESS.
1252 Returns nil if format of ADDRESS is invalid. */)
1253 (address
, omit_port
)
1254 Lisp_Object address
, omit_port
;
1259 if (STRINGP (address
)) /* AF_LOCAL */
1262 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1264 register struct Lisp_Vector
*p
= XVECTOR (address
);
1265 Lisp_Object args
[6];
1268 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1270 args
[0] = build_string ("%d.%d.%d.%d");
1273 else if (p
->size
== 5)
1275 args
[0] = build_string ("%d.%d.%d.%d:%d");
1278 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1280 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1283 else if (p
->size
== 9)
1285 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1291 for (i
= 0; i
< nargs
; i
++)
1292 args
[i
+1] = p
->contents
[i
];
1293 return Fformat (nargs
+1, args
);
1296 if (CONSP (address
))
1298 Lisp_Object args
[2];
1299 args
[0] = build_string ("<Family %d>");
1300 args
[1] = Fcar (address
);
1301 return Fformat (2, args
);
1310 list_processes_1 (query_only
)
1311 Lisp_Object query_only
;
1313 register Lisp_Object tail
, tem
;
1314 Lisp_Object proc
, minspace
, tem1
;
1315 register struct Lisp_Process
*p
;
1317 int w_proc
, w_buffer
, w_tty
;
1319 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1321 w_proc
= 4; /* Proc */
1322 w_buffer
= 6; /* Buffer */
1323 w_tty
= 0; /* Omit if no ttys */
1325 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1329 proc
= Fcdr (Fcar (tail
));
1330 p
= XPROCESS (proc
);
1331 if (NILP (p
->childp
))
1333 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1335 if (STRINGP (p
->name
)
1336 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1338 if (!NILP (p
->buffer
))
1340 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1341 w_buffer
= 8; /* (Killed) */
1342 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1345 if (STRINGP (p
->tty_name
)
1346 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1350 XSETFASTINT (i_status
, w_proc
+ 1);
1351 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1354 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1355 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1358 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1361 XSETFASTINT (minspace
, 1);
1363 set_buffer_internal (XBUFFER (Vstandard_output
));
1364 current_buffer
->undo_list
= Qt
;
1366 current_buffer
->truncate_lines
= Qt
;
1368 write_string ("Proc", -1);
1369 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1370 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1373 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1375 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1376 write_string ("\n", -1);
1378 write_string ("----", -1);
1379 Findent_to (i_status
, minspace
); write_string ("------", -1);
1380 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1383 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1385 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1386 write_string ("\n", -1);
1388 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1392 proc
= Fcdr (Fcar (tail
));
1393 p
= XPROCESS (proc
);
1394 if (NILP (p
->childp
))
1396 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1399 Finsert (1, &p
->name
);
1400 Findent_to (i_status
, minspace
);
1402 if (p
->raw_status_new
)
1405 if (CONSP (p
->status
))
1406 symbol
= XCAR (p
->status
);
1409 if (EQ (symbol
, Qsignal
))
1412 tem
= Fcar (Fcdr (p
->status
));
1414 if (XINT (tem
) < NSIG
)
1415 write_string (sys_errlist
[XINT (tem
)], -1);
1418 Fprinc (symbol
, Qnil
);
1420 else if (NETCONN1_P (p
))
1422 if (EQ (symbol
, Qexit
))
1423 write_string ("closed", -1);
1424 else if (EQ (p
->command
, Qt
))
1425 write_string ("stopped", -1);
1426 else if (EQ (symbol
, Qrun
))
1427 write_string ("open", -1);
1429 Fprinc (symbol
, Qnil
);
1432 Fprinc (symbol
, Qnil
);
1434 if (EQ (symbol
, Qexit
))
1437 tem
= Fcar (Fcdr (p
->status
));
1440 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1441 write_string (tembuf
, -1);
1445 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
) || EQ (symbol
, Qclosed
))
1448 Findent_to (i_buffer
, minspace
);
1449 if (NILP (p
->buffer
))
1450 insert_string ("(none)");
1451 else if (NILP (XBUFFER (p
->buffer
)->name
))
1452 insert_string ("(Killed)");
1454 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1458 Findent_to (i_tty
, minspace
);
1459 if (STRINGP (p
->tty_name
))
1460 Finsert (1, &p
->tty_name
);
1463 Findent_to (i_command
, minspace
);
1465 if (EQ (p
->status
, Qlisten
))
1467 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1468 if (INTEGERP (port
))
1469 port
= Fnumber_to_string (port
);
1471 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1472 sprintf (tembuf
, "(network %s server on %s)\n",
1473 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1474 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1475 insert_string (tembuf
);
1477 else if (NETCONN1_P (p
))
1479 /* For a local socket, there is no host name,
1480 so display service instead. */
1481 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1482 if (!STRINGP (host
))
1484 host
= Fplist_get (p
->childp
, QCservice
);
1485 if (INTEGERP (host
))
1486 host
= Fnumber_to_string (host
);
1489 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1490 sprintf (tembuf
, "(network %s connection to %s)\n",
1491 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1492 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1493 insert_string (tembuf
);
1505 insert_string (" ");
1507 insert_string ("\n");
1511 status_notify (NULL
);
1515 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1516 doc
: /* Display a list of all processes.
1517 If optional argument QUERY-ONLY is non-nil, only processes with
1518 the query-on-exit flag set will be listed.
1519 Any process listed as exited or signaled is actually eliminated
1520 after the listing is made. */)
1522 Lisp_Object query_only
;
1524 internal_with_output_to_temp_buffer ("*Process List*",
1525 list_processes_1
, query_only
);
1529 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1530 doc
: /* Return a list of all processes. */)
1533 return Fmapcar (Qcdr
, Vprocess_alist
);
1536 /* Starting asynchronous inferior processes. */
1538 static Lisp_Object
start_process_unwind ();
1540 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1541 doc
: /* Start a program in a subprocess. Return the process object for it.
1542 NAME is name for process. It is modified if necessary to make it unique.
1543 BUFFER is the buffer (or buffer name) to associate with the process.
1544 Process output goes at end of that buffer, unless you specify
1545 an output stream or filter function to handle the output.
1546 BUFFER may be also nil, meaning that this process is not associated
1548 PROGRAM is the program file name. It is searched for in PATH.
1549 Remaining arguments are strings to give program as arguments.
1551 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1554 register Lisp_Object
*args
;
1556 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1558 register unsigned char *new_argv
;
1561 register unsigned char **new_argv
;
1564 int count
= SPECPDL_INDEX ();
1568 buffer
= Fget_buffer_create (buffer
);
1570 /* Make sure that the child will be able to chdir to the current
1571 buffer's current directory, or its unhandled equivalent. We
1572 can't just have the child check for an error when it does the
1573 chdir, since it's in a vfork.
1575 We have to GCPRO around this because Fexpand_file_name and
1576 Funhandled_file_name_directory might call a file name handling
1577 function. The argument list is protected by the caller, so all
1578 we really have to worry about is buffer. */
1580 struct gcpro gcpro1
, gcpro2
;
1582 current_dir
= current_buffer
->directory
;
1584 GCPRO2 (buffer
, current_dir
);
1587 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1589 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1590 report_file_error ("Setting current directory",
1591 Fcons (current_buffer
->directory
, Qnil
));
1597 CHECK_STRING (name
);
1601 CHECK_STRING (program
);
1603 proc
= make_process (name
);
1604 /* If an error occurs and we can't start the process, we want to
1605 remove it from the process list. This means that each error
1606 check in create_process doesn't need to call remove_process
1607 itself; it's all taken care of here. */
1608 record_unwind_protect (start_process_unwind
, proc
);
1610 XPROCESS (proc
)->childp
= Qt
;
1611 XPROCESS (proc
)->plist
= Qnil
;
1612 XPROCESS (proc
)->buffer
= buffer
;
1613 XPROCESS (proc
)->sentinel
= Qnil
;
1614 XPROCESS (proc
)->filter
= Qnil
;
1615 XPROCESS (proc
)->filter_multibyte
1616 = buffer_defaults
.enable_multibyte_characters
;
1617 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1619 #ifdef ADAPTIVE_READ_BUFFERING
1620 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1623 /* Make the process marker point into the process buffer (if any). */
1624 if (BUFFERP (buffer
))
1625 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1626 BUF_ZV (XBUFFER (buffer
)),
1627 BUF_ZV_BYTE (XBUFFER (buffer
)));
1630 /* Decide coding systems for communicating with the process. Here
1631 we don't setup the structure coding_system nor pay attention to
1632 unibyte mode. They are done in create_process. */
1634 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1635 Lisp_Object coding_systems
= Qt
;
1636 Lisp_Object val
, *args2
;
1637 struct gcpro gcpro1
, gcpro2
;
1639 val
= Vcoding_system_for_read
;
1642 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1643 args2
[0] = Qstart_process
;
1644 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1645 GCPRO2 (proc
, current_dir
);
1646 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1648 if (CONSP (coding_systems
))
1649 val
= XCAR (coding_systems
);
1650 else if (CONSP (Vdefault_process_coding_system
))
1651 val
= XCAR (Vdefault_process_coding_system
);
1653 XPROCESS (proc
)->decode_coding_system
= val
;
1655 val
= Vcoding_system_for_write
;
1658 if (EQ (coding_systems
, Qt
))
1660 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1661 args2
[0] = Qstart_process
;
1662 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1663 GCPRO2 (proc
, current_dir
);
1664 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1667 if (CONSP (coding_systems
))
1668 val
= XCDR (coding_systems
);
1669 else if (CONSP (Vdefault_process_coding_system
))
1670 val
= XCDR (Vdefault_process_coding_system
);
1672 XPROCESS (proc
)->encode_coding_system
= val
;
1676 /* Make a one member argv with all args concatenated
1677 together separated by a blank. */
1678 len
= SBYTES (program
) + 2;
1679 for (i
= 3; i
< nargs
; i
++)
1683 len
+= SBYTES (tem
) + 1; /* count the blank */
1685 new_argv
= (unsigned char *) alloca (len
);
1686 strcpy (new_argv
, SDATA (program
));
1687 for (i
= 3; i
< nargs
; i
++)
1691 strcat (new_argv
, " ");
1692 strcat (new_argv
, SDATA (tem
));
1694 /* Need to add code here to check for program existence on VMS */
1697 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1699 /* If program file name is not absolute, search our path for it.
1700 Put the name we will really use in TEM. */
1701 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1702 && !(SCHARS (program
) > 1
1703 && IS_DEVICE_SEP (SREF (program
, 1))))
1705 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1708 GCPRO4 (name
, program
, buffer
, current_dir
);
1709 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1712 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1713 tem
= Fexpand_file_name (tem
, Qnil
);
1717 if (!NILP (Ffile_directory_p (program
)))
1718 error ("Specified program for new process is a directory");
1722 /* If program file name starts with /: for quoting a magic name,
1724 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1725 && SREF (tem
, 1) == ':')
1726 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1728 /* Encode the file name and put it in NEW_ARGV.
1729 That's where the child will use it to execute the program. */
1730 tem
= ENCODE_FILE (tem
);
1731 new_argv
[0] = SDATA (tem
);
1733 /* Here we encode arguments by the coding system used for sending
1734 data to the process. We don't support using different coding
1735 systems for encoding arguments and for encoding data sent to the
1738 for (i
= 3; i
< nargs
; i
++)
1742 if (STRING_MULTIBYTE (tem
))
1743 tem
= (code_convert_string_norecord
1744 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1745 new_argv
[i
- 2] = SDATA (tem
);
1747 new_argv
[i
- 2] = 0;
1748 #endif /* not VMS */
1750 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1751 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1752 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1753 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1755 XPROCESS (proc
)->inherit_coding_system_flag
1756 = (NILP (buffer
) || !inherit_process_coding_system
1759 create_process (proc
, (char **) new_argv
, current_dir
);
1761 return unbind_to (count
, proc
);
1764 /* This function is the unwind_protect form for Fstart_process. If
1765 PROC doesn't have its pid set, then we know someone has signaled
1766 an error and the process wasn't started successfully, so we should
1767 remove it from the process list. */
1769 start_process_unwind (proc
)
1772 if (!PROCESSP (proc
))
1775 /* Was PROC started successfully? */
1776 if (XPROCESS (proc
)->pid
<= 0)
1777 remove_process (proc
);
1783 create_process_1 (timer
)
1784 struct atimer
*timer
;
1786 /* Nothing to do. */
1790 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1793 /* Mimic blocking of signals on system V, which doesn't really have it. */
1795 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1796 int sigchld_deferred
;
1799 create_process_sigchld ()
1801 signal (SIGCHLD
, create_process_sigchld
);
1803 sigchld_deferred
= 1;
1809 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1811 create_process (process
, new_argv
, current_dir
)
1812 Lisp_Object process
;
1814 Lisp_Object current_dir
;
1816 int pid
, inchannel
, outchannel
;
1818 #ifdef POSIX_SIGNALS
1821 struct sigaction sigint_action
;
1822 struct sigaction sigquit_action
;
1824 struct sigaction sighup_action
;
1826 #else /* !POSIX_SIGNALS */
1829 SIGTYPE (*sigchld
)();
1832 #endif /* !POSIX_SIGNALS */
1833 /* Use volatile to protect variables from being clobbered by longjmp. */
1834 volatile int forkin
, forkout
;
1835 volatile int pty_flag
= 0;
1837 extern char **environ
;
1840 inchannel
= outchannel
= -1;
1843 if (!NILP (Vprocess_connection_type
))
1844 outchannel
= inchannel
= allocate_pty ();
1848 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1849 /* On most USG systems it does not work to open the pty's tty here,
1850 then close it and reopen it in the child. */
1852 /* Don't let this terminal become our controlling terminal
1853 (in case we don't have one). */
1854 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1856 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1859 report_file_error ("Opening pty", Qnil
);
1860 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1861 /* In the case that vfork is defined as fork, the parent process
1862 (Emacs) may send some data before the child process completes
1863 tty options setup. So we setup tty before forking. */
1864 child_setup_tty (forkout
);
1865 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1867 forkin
= forkout
= -1;
1868 #endif /* not USG, or USG_SUBTTY_WORKS */
1872 #endif /* HAVE_PTYS */
1875 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1876 report_file_error ("Opening socketpair", Qnil
);
1877 outchannel
= inchannel
= sv
[0];
1878 forkout
= forkin
= sv
[1];
1880 #else /* not SKTPAIR */
1885 report_file_error ("Creating pipe", Qnil
);
1891 emacs_close (inchannel
);
1892 emacs_close (forkout
);
1893 report_file_error ("Creating pipe", Qnil
);
1898 #endif /* not SKTPAIR */
1901 /* Replaced by close_process_descs */
1902 set_exclusive_use (inchannel
);
1903 set_exclusive_use (outchannel
);
1906 /* Stride people say it's a mystery why this is needed
1907 as well as the O_NDELAY, but that it fails without this. */
1908 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1911 ioctl (inchannel
, FIONBIO
, &one
);
1916 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1917 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1920 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1921 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1925 /* Record this as an active process, with its channels.
1926 As a result, child_setup will close Emacs's side of the pipes. */
1927 chan_process
[inchannel
] = process
;
1928 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1929 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1931 /* Previously we recorded the tty descriptor used in the subprocess.
1932 It was only used for getting the foreground tty process, so now
1933 we just reopen the device (see emacs_get_tty_pgrp) as this is
1934 more portable (see USG_SUBTTY_WORKS above). */
1936 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1937 XPROCESS (process
)->status
= Qrun
;
1938 setup_process_coding_systems (process
);
1940 /* Delay interrupts until we have a chance to store
1941 the new fork's pid in its process structure */
1942 #ifdef POSIX_SIGNALS
1943 sigemptyset (&blocked
);
1945 sigaddset (&blocked
, SIGCHLD
);
1947 #ifdef HAVE_WORKING_VFORK
1948 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1949 this sets the parent's signal handlers as well as the child's.
1950 So delay all interrupts whose handlers the child might munge,
1951 and record the current handlers so they can be restored later. */
1952 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1953 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1955 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1957 #endif /* HAVE_WORKING_VFORK */
1958 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1959 #else /* !POSIX_SIGNALS */
1963 #else /* not BSD4_1 */
1964 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1965 sigsetmask (sigmask (SIGCHLD
));
1966 #else /* ordinary USG */
1968 sigchld_deferred
= 0;
1969 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1971 #endif /* ordinary USG */
1972 #endif /* not BSD4_1 */
1973 #endif /* SIGCHLD */
1974 #endif /* !POSIX_SIGNALS */
1976 FD_SET (inchannel
, &input_wait_mask
);
1977 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1978 if (inchannel
> max_process_desc
)
1979 max_process_desc
= inchannel
;
1981 /* Until we store the proper pid, enable sigchld_handler
1982 to recognize an unknown pid as standing for this process.
1983 It is very important not to let this `marker' value stay
1984 in the table after this function has returned; if it does
1985 it might cause call-process to hang and subsequent asynchronous
1986 processes to get their return values scrambled. */
1987 XPROCESS (process
)->pid
= -1;
1992 /* child_setup must clobber environ on systems with true vfork.
1993 Protect it from permanent change. */
1994 char **save_environ
= environ
;
1996 current_dir
= ENCODE_FILE (current_dir
);
2001 #endif /* not WINDOWSNT */
2003 int xforkin
= forkin
;
2004 int xforkout
= forkout
;
2006 #if 0 /* This was probably a mistake--it duplicates code later on,
2007 but fails to handle all the cases. */
2008 /* Make sure SIGCHLD is not blocked in the child. */
2009 sigsetmask (SIGEMPTYMASK
);
2012 /* Make the pty be the controlling terminal of the process. */
2014 /* First, disconnect its current controlling terminal. */
2016 /* We tried doing setsid only if pty_flag, but it caused
2017 process_set_signal to fail on SGI when using a pipe. */
2019 /* Make the pty's terminal the controlling terminal. */
2023 /* We ignore the return value
2024 because faith@cs.unc.edu says that is necessary on Linux. */
2025 ioctl (xforkin
, TIOCSCTTY
, 0);
2028 #else /* not HAVE_SETSID */
2030 /* It's very important to call setpgrp here and no time
2031 afterwards. Otherwise, we lose our controlling tty which
2032 is set when we open the pty. */
2035 #endif /* not HAVE_SETSID */
2036 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2037 if (pty_flag
&& xforkin
>= 0)
2040 tcgetattr (xforkin
, &t
);
2042 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2043 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2046 #if defined (NTTYDISC) && defined (TIOCSETD)
2047 if (pty_flag
&& xforkin
>= 0)
2049 /* Use new line discipline. */
2050 int ldisc
= NTTYDISC
;
2051 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2056 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2057 can do TIOCSPGRP only to the process's controlling tty. */
2060 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2061 I can't test it since I don't have 4.3. */
2062 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2063 ioctl (j
, TIOCNOTTY
, 0);
2066 /* In order to get a controlling terminal on some versions
2067 of BSD, it is necessary to put the process in pgrp 0
2068 before it opens the terminal. */
2076 #endif /* TIOCNOTTY */
2078 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2079 /*** There is a suggestion that this ought to be a
2080 conditional on TIOCSPGRP,
2081 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2082 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2083 that system does seem to need this code, even though
2084 both HAVE_SETSID and TIOCSCTTY are defined. */
2085 /* Now close the pty (if we had it open) and reopen it.
2086 This makes the pty the controlling terminal of the subprocess. */
2089 #ifdef SET_CHILD_PTY_PGRP
2090 int pgrp
= getpid ();
2093 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2096 emacs_close (xforkin
);
2097 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2101 emacs_write (1, "Couldn't open the pty terminal ", 31);
2102 emacs_write (1, pty_name
, strlen (pty_name
));
2103 emacs_write (1, "\n", 1);
2107 #ifdef SET_CHILD_PTY_PGRP
2108 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2109 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2112 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2114 #ifdef SETUP_SLAVE_PTY
2119 #endif /* SETUP_SLAVE_PTY */
2121 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2122 Now reenable it in the child, so it will die when we want it to. */
2124 signal (SIGHUP
, SIG_DFL
);
2126 #endif /* HAVE_PTYS */
2128 signal (SIGINT
, SIG_DFL
);
2129 signal (SIGQUIT
, SIG_DFL
);
2131 /* Stop blocking signals in the child. */
2132 #ifdef POSIX_SIGNALS
2133 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2134 #else /* !POSIX_SIGNALS */
2138 #else /* not BSD4_1 */
2139 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2140 sigsetmask (SIGEMPTYMASK
);
2141 #else /* ordinary USG */
2143 signal (SIGCHLD
, sigchld
);
2145 #endif /* ordinary USG */
2146 #endif /* not BSD4_1 */
2147 #endif /* SIGCHLD */
2148 #endif /* !POSIX_SIGNALS */
2150 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2152 child_setup_tty (xforkout
);
2153 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2155 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2156 new_argv
, 1, current_dir
);
2157 #else /* not WINDOWSNT */
2158 child_setup (xforkin
, xforkout
, xforkout
,
2159 new_argv
, 1, current_dir
);
2160 #endif /* not WINDOWSNT */
2162 environ
= save_environ
;
2167 /* This runs in the Emacs process. */
2171 emacs_close (forkin
);
2172 if (forkin
!= forkout
&& forkout
>= 0)
2173 emacs_close (forkout
);
2177 /* vfork succeeded. */
2178 XPROCESS (process
)->pid
= pid
;
2181 register_child (pid
, inchannel
);
2182 #endif /* WINDOWSNT */
2184 /* If the subfork execv fails, and it exits,
2185 this close hangs. I don't know why.
2186 So have an interrupt jar it loose. */
2188 struct atimer
*timer
;
2192 EMACS_SET_SECS_USECS (offset
, 1, 0);
2193 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2196 emacs_close (forkin
);
2198 cancel_atimer (timer
);
2202 if (forkin
!= forkout
&& forkout
>= 0)
2203 emacs_close (forkout
);
2207 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2210 XPROCESS (process
)->tty_name
= Qnil
;
2213 /* Restore the signal state whether vfork succeeded or not.
2214 (We will signal an error, below, if it failed.) */
2215 #ifdef POSIX_SIGNALS
2216 #ifdef HAVE_WORKING_VFORK
2217 /* Restore the parent's signal handlers. */
2218 sigaction (SIGINT
, &sigint_action
, 0);
2219 sigaction (SIGQUIT
, &sigquit_action
, 0);
2221 sigaction (SIGHUP
, &sighup_action
, 0);
2223 #endif /* HAVE_WORKING_VFORK */
2224 /* Stop blocking signals in the parent. */
2225 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2226 #else /* !POSIX_SIGNALS */
2230 #else /* not BSD4_1 */
2231 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2232 sigsetmask (SIGEMPTYMASK
);
2233 #else /* ordinary USG */
2235 signal (SIGCHLD
, sigchld
);
2236 /* Now really handle any of these signals
2237 that came in during this function. */
2238 if (sigchld_deferred
)
2239 kill (getpid (), SIGCHLD
);
2241 #endif /* ordinary USG */
2242 #endif /* not BSD4_1 */
2243 #endif /* SIGCHLD */
2244 #endif /* !POSIX_SIGNALS */
2246 /* Now generate the error if vfork failed. */
2248 report_file_error ("Doing vfork", Qnil
);
2250 #endif /* not VMS */
2255 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2256 The address family of sa is not included in the result. */
2259 conv_sockaddr_to_lisp (sa
, len
)
2260 struct sockaddr
*sa
;
2263 Lisp_Object address
;
2266 register struct Lisp_Vector
*p
;
2268 switch (sa
->sa_family
)
2272 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2273 len
= sizeof (sin
->sin_addr
) + 1;
2274 address
= Fmake_vector (make_number (len
), Qnil
);
2275 p
= XVECTOR (address
);
2276 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2277 cp
= (unsigned char *)&sin
->sin_addr
;
2283 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2284 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2285 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2286 address
= Fmake_vector (make_number (len
), Qnil
);
2287 p
= XVECTOR (address
);
2288 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2289 for (i
= 0; i
< len
; i
++)
2290 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2294 #ifdef HAVE_LOCAL_SOCKETS
2297 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2298 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2299 if (sockun
->sun_path
[i
] == 0)
2301 return make_unibyte_string (sockun
->sun_path
, i
);
2305 len
-= sizeof (sa
->sa_family
);
2306 address
= Fcons (make_number (sa
->sa_family
),
2307 Fmake_vector (make_number (len
), Qnil
));
2308 p
= XVECTOR (XCDR (address
));
2309 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2315 p
->contents
[i
++] = make_number (*cp
++);
2321 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2324 get_lisp_to_sockaddr_size (address
, familyp
)
2325 Lisp_Object address
;
2328 register struct Lisp_Vector
*p
;
2330 if (VECTORP (address
))
2332 p
= XVECTOR (address
);
2336 return sizeof (struct sockaddr_in
);
2339 else if (p
->size
== 9)
2341 *familyp
= AF_INET6
;
2342 return sizeof (struct sockaddr_in6
);
2346 #ifdef HAVE_LOCAL_SOCKETS
2347 else if (STRINGP (address
))
2349 *familyp
= AF_LOCAL
;
2350 return sizeof (struct sockaddr_un
);
2353 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2355 struct sockaddr
*sa
;
2356 *familyp
= XINT (XCAR (address
));
2357 p
= XVECTOR (XCDR (address
));
2358 return p
->size
+ sizeof (sa
->sa_family
);
2363 /* Convert an address object (vector or string) to an internal sockaddr.
2365 The address format has been basically validated by
2366 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2367 it could have come from user data. So if FAMILY is not valid,
2368 we return after zeroing *SA. */
2371 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2373 Lisp_Object address
;
2374 struct sockaddr
*sa
;
2377 register struct Lisp_Vector
*p
;
2378 register unsigned char *cp
= NULL
;
2383 if (VECTORP (address
))
2385 p
= XVECTOR (address
);
2386 if (family
== AF_INET
)
2388 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2389 len
= sizeof (sin
->sin_addr
) + 1;
2390 i
= XINT (p
->contents
[--len
]);
2391 sin
->sin_port
= htons (i
);
2392 cp
= (unsigned char *)&sin
->sin_addr
;
2393 sa
->sa_family
= family
;
2396 else if (family
== AF_INET6
)
2398 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2399 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2400 len
= sizeof (sin6
->sin6_addr
) + 1;
2401 i
= XINT (p
->contents
[--len
]);
2402 sin6
->sin6_port
= htons (i
);
2403 for (i
= 0; i
< len
; i
++)
2404 if (INTEGERP (p
->contents
[i
]))
2406 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2409 sa
->sa_family
= family
;
2414 else if (STRINGP (address
))
2416 #ifdef HAVE_LOCAL_SOCKETS
2417 if (family
== AF_LOCAL
)
2419 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2420 cp
= SDATA (address
);
2421 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2422 sockun
->sun_path
[i
] = *cp
++;
2423 sa
->sa_family
= family
;
2430 p
= XVECTOR (XCDR (address
));
2431 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2434 for (i
= 0; i
< len
; i
++)
2435 if (INTEGERP (p
->contents
[i
]))
2436 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2439 #ifdef DATAGRAM_SOCKETS
2440 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2442 doc
: /* Get the current datagram address associated with PROCESS. */)
2444 Lisp_Object process
;
2448 CHECK_PROCESS (process
);
2450 if (!DATAGRAM_CONN_P (process
))
2453 channel
= XINT (XPROCESS (process
)->infd
);
2454 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2455 datagram_address
[channel
].len
);
2458 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2460 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2461 Returns nil upon error setting address, ADDRESS otherwise. */)
2463 Lisp_Object process
, address
;
2468 CHECK_PROCESS (process
);
2470 if (!DATAGRAM_CONN_P (process
))
2473 channel
= XINT (XPROCESS (process
)->infd
);
2475 len
= get_lisp_to_sockaddr_size (address
, &family
);
2476 if (datagram_address
[channel
].len
!= len
)
2478 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2484 static struct socket_options
{
2485 /* The name of this option. Should be lowercase version of option
2486 name without SO_ prefix. */
2488 /* Option level SOL_... */
2490 /* Option number SO_... */
2492 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2493 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2494 } socket_options
[] =
2496 #ifdef SO_BINDTODEVICE
2497 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2500 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2503 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2506 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2509 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2512 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2515 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2518 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2520 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2523 /* Set option OPT to value VAL on socket S.
2525 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2526 Signals an error if setting a known option fails.
2530 set_socket_option (s
, opt
, val
)
2532 Lisp_Object opt
, val
;
2535 struct socket_options
*sopt
;
2540 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2541 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2542 if (strcmp (name
, sopt
->name
) == 0)
2545 switch (sopt
->opttype
)
2550 optval
= NILP (val
) ? 0 : 1;
2551 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2552 &optval
, sizeof (optval
));
2560 optval
= XINT (val
);
2562 error ("Bad option value for %s", name
);
2563 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2564 &optval
, sizeof (optval
));
2568 #ifdef SO_BINDTODEVICE
2571 char devname
[IFNAMSIZ
+1];
2573 /* This is broken, at least in the Linux 2.4 kernel.
2574 To unbind, the arg must be a zero integer, not the empty string.
2575 This should work on all systems. KFS. 2003-09-23. */
2576 bzero (devname
, sizeof devname
);
2579 char *arg
= (char *) SDATA (val
);
2580 int len
= min (strlen (arg
), IFNAMSIZ
);
2581 bcopy (arg
, devname
, len
);
2583 else if (!NILP (val
))
2584 error ("Bad option value for %s", name
);
2585 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2594 struct linger linger
;
2597 linger
.l_linger
= 0;
2599 linger
.l_linger
= XINT (val
);
2601 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2602 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2603 &linger
, sizeof (linger
));
2613 report_file_error ("Cannot set network option",
2614 Fcons (opt
, Fcons (val
, Qnil
)));
2615 return (1 << sopt
->optbit
);
2619 DEFUN ("set-network-process-option",
2620 Fset_network_process_option
, Sset_network_process_option
,
2622 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2623 See `make-network-process' for a list of options and values.
2624 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2625 OPTION is not a supported option, return nil instead; otherwise return t. */)
2626 (process
, option
, value
, no_error
)
2627 Lisp_Object process
, option
, value
;
2628 Lisp_Object no_error
;
2631 struct Lisp_Process
*p
;
2633 CHECK_PROCESS (process
);
2634 p
= XPROCESS (process
);
2635 if (!NETCONN1_P (p
))
2636 error ("Process is not a network process");
2640 error ("Process is not running");
2642 if (set_socket_option (s
, option
, value
))
2644 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2648 if (NILP (no_error
))
2649 error ("Unknown or unsupported option");
2655 /* A version of request_sigio suitable for a record_unwind_protect. */
2658 unwind_request_sigio (dummy
)
2661 if (interrupt_input
)
2666 /* Create a network stream/datagram client/server process. Treated
2667 exactly like a normal process when reading and writing. Primary
2668 differences are in status display and process deletion. A network
2669 connection has no PID; you cannot signal it. All you can do is
2670 stop/continue it and deactivate/close it via delete-process */
2672 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2674 doc
: /* Create and return a network server or client process.
2676 In Emacs, network connections are represented by process objects, so
2677 input and output work as for subprocesses and `delete-process' closes
2678 a network connection. However, a network process has no process id,
2679 it cannot be signaled, and the status codes are different from normal
2682 Arguments are specified as keyword/argument pairs. The following
2683 arguments are defined:
2685 :name NAME -- NAME is name for process. It is modified if necessary
2688 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2689 with the process. Process output goes at end of that buffer, unless
2690 you specify an output stream or filter function to handle the output.
2691 BUFFER may be also nil, meaning that this process is not associated
2694 :host HOST -- HOST is name of the host to connect to, or its IP
2695 address. The symbol `local' specifies the local host. If specified
2696 for a server process, it must be a valid name or address for the local
2697 host, and only clients connecting to that address will be accepted.
2699 :service SERVICE -- SERVICE is name of the service desired, or an
2700 integer specifying a port number to connect to. If SERVICE is t,
2701 a random port number is selected for the server.
2703 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2704 stream type connection, `datagram' creates a datagram type connection.
2706 :family FAMILY -- FAMILY is the address (and protocol) family for the
2707 service specified by HOST and SERVICE. The default (nil) is to use
2708 whatever address family (IPv4 or IPv6) that is defined for the host
2709 and port number specified by HOST and SERVICE. Other address families
2711 local -- for a local (i.e. UNIX) address specified by SERVICE.
2712 ipv4 -- use IPv4 address family only.
2713 ipv6 -- use IPv6 address family only.
2715 :local ADDRESS -- ADDRESS is the local address used for the connection.
2716 This parameter is ignored when opening a client process. When specified
2717 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2719 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2720 connection. This parameter is ignored when opening a stream server
2721 process. For a datagram server process, it specifies the initial
2722 setting of the remote datagram address. When specified for a client
2723 process, the FAMILY, HOST, and SERVICE args are ignored.
2725 The format of ADDRESS depends on the address family:
2726 - An IPv4 address is represented as an vector of integers [A B C D P]
2727 corresponding to numeric IP address A.B.C.D and port number P.
2728 - A local address is represented as a string with the address in the
2729 local address space.
2730 - An "unsupported family" address is represented by a cons (F . AV)
2731 where F is the family number and AV is a vector containing the socket
2732 address data with one element per address data byte. Do not rely on
2733 this format in portable code, as it may depend on implementation
2734 defined constants, data sizes, and data structure alignment.
2736 :coding CODING -- If CODING is a symbol, it specifies the coding
2737 system used for both reading and writing for this process. If CODING
2738 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2739 ENCODING is used for writing.
2741 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2742 return without waiting for the connection to complete; instead, the
2743 sentinel function will be called with second arg matching "open" (if
2744 successful) or "failed" when the connect completes. Default is to use
2745 a blocking connect (i.e. wait) for stream type connections.
2747 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2748 running when Emacs is exited.
2750 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2751 In the stopped state, a server process does not accept new
2752 connections, and a client process does not handle incoming traffic.
2753 The stopped state is cleared by `continue-process' and set by
2756 :filter FILTER -- Install FILTER as the process filter.
2758 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2759 process filter are multibyte, otherwise they are unibyte.
2760 If this keyword is not specified, the strings are multibyte iff
2761 `default-enable-multibyte-characters' is non-nil.
2763 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2765 :log LOG -- Install LOG as the server process log function. This
2766 function is called when the server accepts a network connection from a
2767 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2768 is the server process, CLIENT is the new process for the connection,
2769 and MESSAGE is a string.
2771 :plist PLIST -- Install PLIST as the new process' initial plist.
2773 :server QLEN -- if QLEN is non-nil, create a server process for the
2774 specified FAMILY, SERVICE, and connection type (stream or datagram).
2775 If QLEN is an integer, it is used as the max. length of the server's
2776 pending connection queue (also known as the backlog); the default
2777 queue length is 5. Default is to create a client process.
2779 The following network options can be specified for this connection:
2781 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2782 :dontroute BOOL -- Only send to directly connected hosts.
2783 :keepalive BOOL -- Send keep-alive messages on network stream.
2784 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2785 :oobinline BOOL -- Place out-of-band data in receive data stream.
2786 :priority INT -- Set protocol defined priority for sent packets.
2787 :reuseaddr BOOL -- Allow reusing a recently used local address
2788 (this is allowed by default for a server process).
2789 :bindtodevice NAME -- bind to interface NAME. Using this may require
2790 special privileges on some systems.
2792 Consult the relevant system programmer's manual pages for more
2793 information on using these options.
2796 A server process will listen for and accept connections from clients.
2797 When a client connection is accepted, a new network process is created
2798 for the connection with the following parameters:
2800 - The client's process name is constructed by concatenating the server
2801 process' NAME and a client identification string.
2802 - If the FILTER argument is non-nil, the client process will not get a
2803 separate process buffer; otherwise, the client's process buffer is a newly
2804 created buffer named after the server process' BUFFER name or process
2805 NAME concatenated with the client identification string.
2806 - The connection type and the process filter and sentinel parameters are
2807 inherited from the server process' TYPE, FILTER and SENTINEL.
2808 - The client process' contact info is set according to the client's
2809 addressing information (typically an IP address and a port number).
2810 - The client process' plist is initialized from the server's plist.
2812 Notice that the FILTER and SENTINEL args are never used directly by
2813 the server process. Also, the BUFFER argument is not used directly by
2814 the server process, but via the optional :log function, accepted (and
2815 failed) connections may be logged in the server process' buffer.
2817 The original argument list, modified with the actual connection
2818 information, is available via the `process-contact' function.
2820 usage: (make-network-process &rest ARGS) */)
2826 Lisp_Object contact
;
2827 struct Lisp_Process
*p
;
2828 #ifdef HAVE_GETADDRINFO
2829 struct addrinfo ai
, *res
, *lres
;
2830 struct addrinfo hints
;
2831 char *portstring
, portbuf
[128];
2832 #else /* HAVE_GETADDRINFO */
2833 struct _emacs_addrinfo
2839 struct sockaddr
*ai_addr
;
2840 struct _emacs_addrinfo
*ai_next
;
2842 #endif /* HAVE_GETADDRINFO */
2843 struct sockaddr_in address_in
;
2844 #ifdef HAVE_LOCAL_SOCKETS
2845 struct sockaddr_un address_un
;
2850 int s
= -1, outch
, inch
;
2851 struct gcpro gcpro1
;
2852 int count
= SPECPDL_INDEX ();
2854 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2856 Lisp_Object name
, buffer
, host
, service
, address
;
2857 Lisp_Object filter
, sentinel
;
2858 int is_non_blocking_client
= 0;
2859 int is_server
= 0, backlog
= 5;
2866 /* Save arguments for process-contact and clone-process. */
2867 contact
= Flist (nargs
, args
);
2871 /* Ensure socket support is loaded if available. */
2872 init_winsock (TRUE
);
2875 /* :type TYPE (nil: stream, datagram */
2876 tem
= Fplist_get (contact
, QCtype
);
2878 socktype
= SOCK_STREAM
;
2879 #ifdef DATAGRAM_SOCKETS
2880 else if (EQ (tem
, Qdatagram
))
2881 socktype
= SOCK_DGRAM
;
2884 error ("Unsupported connection type");
2887 tem
= Fplist_get (contact
, QCserver
);
2890 /* Don't support network sockets when non-blocking mode is
2891 not available, since a blocked Emacs is not useful. */
2892 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2893 error ("Network servers not supported");
2897 backlog
= XINT (tem
);
2901 /* Make QCaddress an alias for :local (server) or :remote (client). */
2902 QCaddress
= is_server
? QClocal
: QCremote
;
2905 if (!is_server
&& socktype
== SOCK_STREAM
2906 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2908 #ifndef NON_BLOCKING_CONNECT
2909 error ("Non-blocking connect not supported");
2911 is_non_blocking_client
= 1;
2915 name
= Fplist_get (contact
, QCname
);
2916 buffer
= Fplist_get (contact
, QCbuffer
);
2917 filter
= Fplist_get (contact
, QCfilter
);
2918 sentinel
= Fplist_get (contact
, QCsentinel
);
2920 CHECK_STRING (name
);
2923 /* Let's handle TERM before things get complicated ... */
2924 host
= Fplist_get (contact
, QChost
);
2925 CHECK_STRING (host
);
2927 service
= Fplist_get (contact
, QCservice
);
2928 if (INTEGERP (service
))
2929 port
= htons ((unsigned short) XINT (service
));
2932 struct servent
*svc_info
;
2933 CHECK_STRING (service
);
2934 svc_info
= getservbyname (SDATA (service
), "tcp");
2936 error ("Unknown service: %s", SDATA (service
));
2937 port
= svc_info
->s_port
;
2940 s
= connect_server (0);
2942 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2943 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2944 send_command (s
, C_DUMB
, 1, 0);
2946 #else /* not TERM */
2948 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2949 ai
.ai_socktype
= socktype
;
2954 /* :local ADDRESS or :remote ADDRESS */
2955 address
= Fplist_get (contact
, QCaddress
);
2956 if (!NILP (address
))
2958 host
= service
= Qnil
;
2960 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2961 error ("Malformed :address");
2962 ai
.ai_family
= family
;
2963 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2964 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2968 /* :family FAMILY -- nil (for Inet), local, or integer. */
2969 tem
= Fplist_get (contact
, QCfamily
);
2972 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2978 #ifdef HAVE_LOCAL_SOCKETS
2979 else if (EQ (tem
, Qlocal
))
2983 else if (EQ (tem
, Qipv6
))
2986 else if (EQ (tem
, Qipv4
))
2988 else if (INTEGERP (tem
))
2989 family
= XINT (tem
);
2991 error ("Unknown address family");
2993 ai
.ai_family
= family
;
2995 /* :service SERVICE -- string, integer (port number), or t (random port). */
2996 service
= Fplist_get (contact
, QCservice
);
2998 #ifdef HAVE_LOCAL_SOCKETS
2999 if (family
== AF_LOCAL
)
3001 /* Host is not used. */
3003 CHECK_STRING (service
);
3004 bzero (&address_un
, sizeof address_un
);
3005 address_un
.sun_family
= AF_LOCAL
;
3006 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3007 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3008 ai
.ai_addrlen
= sizeof address_un
;
3013 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3014 host
= Fplist_get (contact
, QChost
);
3017 if (EQ (host
, Qlocal
))
3018 host
= build_string ("localhost");
3019 CHECK_STRING (host
);
3022 /* Slow down polling to every ten seconds.
3023 Some kernels have a bug which causes retrying connect to fail
3024 after a connect. Polling can interfere with gethostbyname too. */
3025 #ifdef POLL_FOR_INPUT
3026 if (socktype
== SOCK_STREAM
)
3028 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3029 bind_polling_period (10);
3033 #ifdef HAVE_GETADDRINFO
3034 /* If we have a host, use getaddrinfo to resolve both host and service.
3035 Otherwise, use getservbyname to lookup the service. */
3039 /* SERVICE can either be a string or int.
3040 Convert to a C string for later use by getaddrinfo. */
3041 if (EQ (service
, Qt
))
3043 else if (INTEGERP (service
))
3045 sprintf (portbuf
, "%ld", (long) XINT (service
));
3046 portstring
= portbuf
;
3050 CHECK_STRING (service
);
3051 portstring
= SDATA (service
);
3056 memset (&hints
, 0, sizeof (hints
));
3058 hints
.ai_family
= family
;
3059 hints
.ai_socktype
= socktype
;
3060 hints
.ai_protocol
= 0;
3061 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3063 #ifdef HAVE_GAI_STRERROR
3064 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3066 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3072 #endif /* HAVE_GETADDRINFO */
3074 /* We end up here if getaddrinfo is not defined, or in case no hostname
3075 has been specified (e.g. for a local server process). */
3077 if (EQ (service
, Qt
))
3079 else if (INTEGERP (service
))
3080 port
= htons ((unsigned short) XINT (service
));
3083 struct servent
*svc_info
;
3084 CHECK_STRING (service
);
3085 svc_info
= getservbyname (SDATA (service
),
3086 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3088 error ("Unknown service: %s", SDATA (service
));
3089 port
= svc_info
->s_port
;
3092 bzero (&address_in
, sizeof address_in
);
3093 address_in
.sin_family
= family
;
3094 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3095 address_in
.sin_port
= port
;
3097 #ifndef HAVE_GETADDRINFO
3100 struct hostent
*host_info_ptr
;
3102 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3103 as it may `hang' Emacs for a very long time. */
3106 host_info_ptr
= gethostbyname (SDATA (host
));
3111 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3112 host_info_ptr
->h_length
);
3113 family
= host_info_ptr
->h_addrtype
;
3114 address_in
.sin_family
= family
;
3117 /* Attempt to interpret host as numeric inet address */
3119 IN_ADDR numeric_addr
;
3120 numeric_addr
= inet_addr ((char *) SDATA (host
));
3121 if (NUMERIC_ADDR_ERROR
)
3122 error ("Unknown host \"%s\"", SDATA (host
));
3124 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3125 sizeof (address_in
.sin_addr
));
3129 #endif /* not HAVE_GETADDRINFO */
3131 ai
.ai_family
= family
;
3132 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3133 ai
.ai_addrlen
= sizeof address_in
;
3137 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3138 when connect is interrupted. So let's not let it get interrupted.
3139 Note we do not turn off polling, because polling is only used
3140 when not interrupt_input, and thus not normally used on the systems
3141 which have this bug. On systems which use polling, there's no way
3142 to quit if polling is turned off. */
3144 && !is_server
&& socktype
== SOCK_STREAM
)
3146 /* Comment from KFS: The original open-network-stream code
3147 didn't unwind protect this, but it seems like the proper
3148 thing to do. In any case, I don't see how it could harm to
3149 do this -- and it makes cleanup (using unbind_to) easier. */
3150 record_unwind_protect (unwind_request_sigio
, Qnil
);
3154 /* Do this in case we never enter the for-loop below. */
3155 count1
= SPECPDL_INDEX ();
3158 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3164 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3171 #ifdef DATAGRAM_SOCKETS
3172 if (!is_server
&& socktype
== SOCK_DGRAM
)
3174 #endif /* DATAGRAM_SOCKETS */
3176 #ifdef NON_BLOCKING_CONNECT
3177 if (is_non_blocking_client
)
3180 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3182 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3194 /* Make us close S if quit. */
3195 record_unwind_protect (close_file_unwind
, make_number (s
));
3197 /* Parse network options in the arg list.
3198 We simply ignore anything which isn't a known option (including other keywords).
3199 An error is signalled if setting a known option fails. */
3200 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3201 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3205 /* Configure as a server socket. */
3207 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3208 explicit :reuseaddr key to override this. */
3209 #ifdef HAVE_LOCAL_SOCKETS
3210 if (family
!= AF_LOCAL
)
3212 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3215 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3216 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3219 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3220 report_file_error ("Cannot bind server socket", Qnil
);
3222 #ifdef HAVE_GETSOCKNAME
3223 if (EQ (service
, Qt
))
3225 struct sockaddr_in sa1
;
3226 int len1
= sizeof (sa1
);
3227 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3229 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3230 service
= make_number (ntohs (sa1
.sin_port
));
3231 contact
= Fplist_put (contact
, QCservice
, service
);
3236 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3237 report_file_error ("Cannot listen on server socket", Qnil
);
3245 /* This turns off all alarm-based interrupts; the
3246 bind_polling_period call above doesn't always turn all the
3247 short-interval ones off, especially if interrupt_input is
3250 It'd be nice to be able to control the connect timeout
3251 though. Would non-blocking connect calls be portable?
3253 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3255 turn_on_atimers (0);
3257 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3260 turn_on_atimers (1);
3262 if (ret
== 0 || xerrno
== EISCONN
)
3264 /* The unwind-protect will be discarded afterwards.
3265 Likewise for immediate_quit. */
3269 #ifdef NON_BLOCKING_CONNECT
3271 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3275 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3283 /* Discard the unwind protect closing S. */
3284 specpdl_ptr
= specpdl
+ count1
;
3288 if (xerrno
== EINTR
)
3294 #ifdef DATAGRAM_SOCKETS
3295 if (socktype
== SOCK_DGRAM
)
3297 if (datagram_address
[s
].sa
)
3299 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3300 datagram_address
[s
].len
= lres
->ai_addrlen
;
3304 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3305 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3308 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3309 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3310 conv_lisp_to_sockaddr (rfamily
, remote
,
3311 datagram_address
[s
].sa
, rlen
);
3315 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3318 contact
= Fplist_put (contact
, QCaddress
,
3319 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3320 #ifdef HAVE_GETSOCKNAME
3323 struct sockaddr_in sa1
;
3324 int len1
= sizeof (sa1
);
3325 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3326 contact
= Fplist_put (contact
, QClocal
,
3327 conv_sockaddr_to_lisp (&sa1
, len1
));
3332 #ifdef HAVE_GETADDRINFO
3339 /* Discard the unwind protect for closing S, if any. */
3340 specpdl_ptr
= specpdl
+ count1
;
3342 /* Unwind bind_polling_period and request_sigio. */
3343 unbind_to (count
, Qnil
);
3347 /* If non-blocking got this far - and failed - assume non-blocking is
3348 not supported after all. This is probably a wrong assumption, but
3349 the normal blocking calls to open-network-stream handles this error
3351 if (is_non_blocking_client
)
3356 report_file_error ("make server process failed", contact
);
3358 report_file_error ("make client process failed", contact
);
3361 #endif /* not TERM */
3367 buffer
= Fget_buffer_create (buffer
);
3368 proc
= make_process (name
);
3370 chan_process
[inch
] = proc
;
3373 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3376 fcntl (inch
, F_SETFL
, O_NDELAY
);
3380 p
= XPROCESS (proc
);
3382 p
->childp
= contact
;
3383 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3386 p
->sentinel
= sentinel
;
3388 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3389 /* Override the above only if :filter-multibyte is specified. */
3390 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3391 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3392 p
->log
= Fplist_get (contact
, QClog
);
3393 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3394 p
->kill_without_query
= Qt
;
3395 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3398 XSETINT (p
->infd
, inch
);
3399 XSETINT (p
->outfd
, outch
);
3400 if (is_server
&& socktype
== SOCK_STREAM
)
3401 p
->status
= Qlisten
;
3403 /* Make the process marker point into the process buffer (if any). */
3404 if (BUFFERP (buffer
))
3405 set_marker_both (p
->mark
, buffer
,
3406 BUF_ZV (XBUFFER (buffer
)),
3407 BUF_ZV_BYTE (XBUFFER (buffer
)));
3409 #ifdef NON_BLOCKING_CONNECT
3410 if (is_non_blocking_client
)
3412 /* We may get here if connect did succeed immediately. However,
3413 in that case, we still need to signal this like a non-blocking
3415 p
->status
= Qconnect
;
3416 if (!FD_ISSET (inch
, &connect_wait_mask
))
3418 FD_SET (inch
, &connect_wait_mask
);
3419 num_pending_connects
++;
3424 /* A server may have a client filter setting of Qt, but it must
3425 still listen for incoming connects unless it is stopped. */
3426 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3427 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3429 FD_SET (inch
, &input_wait_mask
);
3430 FD_SET (inch
, &non_keyboard_wait_mask
);
3433 if (inch
> max_process_desc
)
3434 max_process_desc
= inch
;
3436 tem
= Fplist_member (contact
, QCcoding
);
3437 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3438 tem
= Qnil
; /* No error message (too late!). */
3441 /* Setup coding systems for communicating with the network stream. */
3442 struct gcpro gcpro1
;
3443 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3444 Lisp_Object coding_systems
= Qt
;
3445 Lisp_Object args
[5], val
;
3449 val
= XCAR (XCDR (tem
));
3453 else if (!NILP (Vcoding_system_for_read
))
3454 val
= Vcoding_system_for_read
;
3455 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3456 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3457 /* We dare not decode end-of-line format by setting VAL to
3458 Qraw_text, because the existing Emacs Lisp libraries
3459 assume that they receive bare code including a sequene of
3464 if (NILP (host
) || NILP (service
))
3465 coding_systems
= Qnil
;
3468 args
[0] = Qopen_network_stream
, args
[1] = name
,
3469 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3471 coding_systems
= Ffind_operation_coding_system (5, args
);
3474 if (CONSP (coding_systems
))
3475 val
= XCAR (coding_systems
);
3476 else if (CONSP (Vdefault_process_coding_system
))
3477 val
= XCAR (Vdefault_process_coding_system
);
3481 p
->decode_coding_system
= val
;
3485 val
= XCAR (XCDR (tem
));
3489 else if (!NILP (Vcoding_system_for_write
))
3490 val
= Vcoding_system_for_write
;
3491 else if (NILP (current_buffer
->enable_multibyte_characters
))
3495 if (EQ (coding_systems
, Qt
))
3497 if (NILP (host
) || NILP (service
))
3498 coding_systems
= Qnil
;
3501 args
[0] = Qopen_network_stream
, args
[1] = name
,
3502 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3504 coding_systems
= Ffind_operation_coding_system (5, args
);
3508 if (CONSP (coding_systems
))
3509 val
= XCDR (coding_systems
);
3510 else if (CONSP (Vdefault_process_coding_system
))
3511 val
= XCDR (Vdefault_process_coding_system
);
3515 p
->encode_coding_system
= val
;
3517 setup_process_coding_systems (proc
);
3519 p
->decoding_buf
= make_uninit_string (0);
3520 p
->decoding_carryover
= make_number (0);
3521 p
->encoding_buf
= make_uninit_string (0);
3522 p
->encoding_carryover
= make_number (0);
3524 p
->inherit_coding_system_flag
3525 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3531 #endif /* HAVE_SOCKETS */
3534 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3537 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3538 doc
: /* Return an alist of all network interfaces and their network address.
3539 Each element is a cons, the car of which is a string containing the
3540 interface name, and the cdr is the network address in internal
3541 format; see the description of ADDRESS in `make-network-process'. */)
3544 struct ifconf ifconf
;
3545 struct ifreq
*ifreqs
= NULL
;
3550 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3556 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3557 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3564 ifconf
.ifc_len
= buf_size
;
3565 ifconf
.ifc_req
= ifreqs
;
3566 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3572 if (ifconf
.ifc_len
== buf_size
)
3576 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3579 while (--ifaces
>= 0)
3581 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3582 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3583 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3585 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3586 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3587 res
= Fcons (Fcons (build_string (namebuf
),
3588 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3589 sizeof (struct sockaddr
))),
3595 #endif /* SIOCGIFCONF */
3597 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3604 static struct ifflag_def ifflag_table
[] = {
3608 #ifdef IFF_BROADCAST
3609 { IFF_BROADCAST
, "broadcast" },
3612 { IFF_DEBUG
, "debug" },
3615 { IFF_LOOPBACK
, "loopback" },
3617 #ifdef IFF_POINTOPOINT
3618 { IFF_POINTOPOINT
, "pointopoint" },
3621 { IFF_RUNNING
, "running" },
3624 { IFF_NOARP
, "noarp" },
3627 { IFF_PROMISC
, "promisc" },
3629 #ifdef IFF_NOTRAILERS
3630 { IFF_NOTRAILERS
, "notrailers" },
3633 { IFF_ALLMULTI
, "allmulti" },
3636 { IFF_MASTER
, "master" },
3639 { IFF_SLAVE
, "slave" },
3641 #ifdef IFF_MULTICAST
3642 { IFF_MULTICAST
, "multicast" },
3645 { IFF_PORTSEL
, "portsel" },
3647 #ifdef IFF_AUTOMEDIA
3648 { IFF_AUTOMEDIA
, "automedia" },
3651 { IFF_DYNAMIC
, "dynamic" },
3654 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3657 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3660 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3663 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3666 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3671 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3672 doc
: /* Return information about network interface named IFNAME.
3673 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3674 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3675 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3676 FLAGS is the current flags of the interface. */)
3681 Lisp_Object res
= Qnil
;
3686 CHECK_STRING (ifname
);
3688 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3689 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3691 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3696 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3697 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3699 int flags
= rq
.ifr_flags
;
3700 struct ifflag_def
*fp
;
3704 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3706 if (flags
& fp
->flag_bit
)
3708 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3709 flags
-= fp
->flag_bit
;
3712 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3714 if (flags
& (1 << fnum
))
3716 elt
= Fcons (make_number (fnum
), elt
);
3721 res
= Fcons (elt
, res
);
3724 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3725 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3727 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3728 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3732 for (n
= 0; n
< 6; n
++)
3733 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3734 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3737 res
= Fcons (elt
, res
);
3740 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3741 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3744 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3745 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3747 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3751 res
= Fcons (elt
, res
);
3754 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3755 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3758 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3761 res
= Fcons (elt
, res
);
3764 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3765 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3768 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3771 res
= Fcons (elt
, res
);
3775 return any
? res
: Qnil
;
3778 #endif /* HAVE_SOCKETS */
3780 /* Turn off input and output for process PROC. */
3783 deactivate_process (proc
)
3786 register int inchannel
, outchannel
;
3787 register struct Lisp_Process
*p
= XPROCESS (proc
);
3789 inchannel
= XINT (p
->infd
);
3790 outchannel
= XINT (p
->outfd
);
3792 #ifdef ADAPTIVE_READ_BUFFERING
3793 if (XINT (p
->read_output_delay
) > 0)
3795 if (--process_output_delay_count
< 0)
3796 process_output_delay_count
= 0;
3797 XSETINT (p
->read_output_delay
, 0);
3798 p
->read_output_skip
= Qnil
;
3804 /* Beware SIGCHLD hereabouts. */
3805 flush_pending_output (inchannel
);
3808 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3809 sys$
dassgn (outchannel
);
3810 vs
= get_vms_process_pointer (p
->pid
);
3812 give_back_vms_process_stuff (vs
);
3815 emacs_close (inchannel
);
3816 if (outchannel
>= 0 && outchannel
!= inchannel
)
3817 emacs_close (outchannel
);
3820 XSETINT (p
->infd
, -1);
3821 XSETINT (p
->outfd
, -1);
3822 #ifdef DATAGRAM_SOCKETS
3823 if (DATAGRAM_CHAN_P (inchannel
))
3825 xfree (datagram_address
[inchannel
].sa
);
3826 datagram_address
[inchannel
].sa
= 0;
3827 datagram_address
[inchannel
].len
= 0;
3830 chan_process
[inchannel
] = Qnil
;
3831 FD_CLR (inchannel
, &input_wait_mask
);
3832 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3833 #ifdef NON_BLOCKING_CONNECT
3834 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3836 FD_CLR (inchannel
, &connect_wait_mask
);
3837 if (--num_pending_connects
< 0)
3841 if (inchannel
== max_process_desc
)
3844 /* We just closed the highest-numbered process input descriptor,
3845 so recompute the highest-numbered one now. */
3846 max_process_desc
= 0;
3847 for (i
= 0; i
< MAXDESC
; i
++)
3848 if (!NILP (chan_process
[i
]))
3849 max_process_desc
= i
;
3854 /* Close all descriptors currently in use for communication
3855 with subprocess. This is used in a newly-forked subprocess
3856 to get rid of irrelevant descriptors. */
3859 close_process_descs ()
3863 for (i
= 0; i
< MAXDESC
; i
++)
3865 Lisp_Object process
;
3866 process
= chan_process
[i
];
3867 if (!NILP (process
))
3869 int in
= XINT (XPROCESS (process
)->infd
);
3870 int out
= XINT (XPROCESS (process
)->outfd
);
3873 if (out
>= 0 && in
!= out
)
3880 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3882 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3883 It is read into the process' buffers or given to their filter functions.
3884 Non-nil arg PROCESS means do not return until some output has been received
3887 Non-nil second arg SECONDS and third arg MILLISEC are number of
3888 seconds and milliseconds to wait; return after that much time whether
3889 or not there is input. If SECONDS is a floating point number,
3890 it specifies a fractional number of seconds to wait.
3892 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3893 from PROCESS, suspending reading output from other processes.
3894 If JUST-THIS-ONE is an integer, don't run any timers either.
3895 Return non-nil iff we received any output before the timeout expired. */)
3896 (process
, seconds
, millisec
, just_this_one
)
3897 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3899 int secs
, usecs
= 0;
3901 if (! NILP (process
))
3902 CHECK_PROCESS (process
);
3904 just_this_one
= Qnil
;
3906 if (!NILP (seconds
))
3908 if (INTEGERP (seconds
))
3909 secs
= XINT (seconds
);
3910 else if (FLOATP (seconds
))
3912 double timeout
= XFLOAT_DATA (seconds
);
3913 secs
= (int) timeout
;
3914 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3917 wrong_type_argument (Qnumberp
, seconds
);
3919 if (INTEGERP (millisec
))
3922 usecs
+= XINT (millisec
) * 1000;
3923 carry
= usecs
/ 1000000;
3925 if ((usecs
-= carry
* 1000000) < 0)
3932 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3933 secs
= -1, usecs
= 0;
3936 secs
= NILP (process
) ? -1 : 0;
3939 (wait_reading_process_output (secs
, usecs
, 0, 0,
3941 !NILP (process
) ? XPROCESS (process
) : NULL
,
3942 NILP (just_this_one
) ? 0 :
3943 !INTEGERP (just_this_one
) ? 1 : -1)
3947 /* Accept a connection for server process SERVER on CHANNEL. */
3949 static int connect_counter
= 0;
3952 server_accept_connection (server
, channel
)
3956 Lisp_Object proc
, caller
, name
, buffer
;
3957 Lisp_Object contact
, host
, service
;
3958 struct Lisp_Process
*ps
= XPROCESS (server
);
3959 struct Lisp_Process
*p
;
3963 struct sockaddr_in in
;
3965 struct sockaddr_in6 in6
;
3967 #ifdef HAVE_LOCAL_SOCKETS
3968 struct sockaddr_un un
;
3971 int len
= sizeof saddr
;
3973 s
= accept (channel
, &saddr
.sa
, &len
);
3982 if (code
== EWOULDBLOCK
)
3986 if (!NILP (ps
->log
))
3987 call3 (ps
->log
, server
, Qnil
,
3988 concat3 (build_string ("accept failed with code"),
3989 Fnumber_to_string (make_number (code
)),
3990 build_string ("\n")));
3996 /* Setup a new process to handle the connection. */
3998 /* Generate a unique identification of the caller, and build contact
3999 information for this process. */
4002 switch (saddr
.sa
.sa_family
)
4006 Lisp_Object args
[5];
4007 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4008 args
[0] = build_string ("%d.%d.%d.%d");
4009 args
[1] = make_number (*ip
++);
4010 args
[2] = make_number (*ip
++);
4011 args
[3] = make_number (*ip
++);
4012 args
[4] = make_number (*ip
++);
4013 host
= Fformat (5, args
);
4014 service
= make_number (ntohs (saddr
.in
.sin_port
));
4016 args
[0] = build_string (" <%s:%d>");
4019 caller
= Fformat (3, args
);
4026 Lisp_Object args
[9];
4027 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4029 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4030 for (i
= 0; i
< 8; i
++)
4031 args
[i
+1] = make_number (ntohs(ip6
[i
]));
4032 host
= Fformat (9, args
);
4033 service
= make_number (ntohs (saddr
.in
.sin_port
));
4035 args
[0] = build_string (" <[%s]:%d>");
4038 caller
= Fformat (3, args
);
4043 #ifdef HAVE_LOCAL_SOCKETS
4047 caller
= Fnumber_to_string (make_number (connect_counter
));
4048 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4052 /* Create a new buffer name for this process if it doesn't have a
4053 filter. The new buffer name is based on the buffer name or
4054 process name of the server process concatenated with the caller
4057 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4061 buffer
= ps
->buffer
;
4063 buffer
= Fbuffer_name (buffer
);
4068 buffer
= concat2 (buffer
, caller
);
4069 buffer
= Fget_buffer_create (buffer
);
4073 /* Generate a unique name for the new server process. Combine the
4074 server process name with the caller identification. */
4076 name
= concat2 (ps
->name
, caller
);
4077 proc
= make_process (name
);
4079 chan_process
[s
] = proc
;
4082 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4085 fcntl (s
, F_SETFL
, O_NDELAY
);
4089 p
= XPROCESS (proc
);
4091 /* Build new contact information for this setup. */
4092 contact
= Fcopy_sequence (ps
->childp
);
4093 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4094 contact
= Fplist_put (contact
, QChost
, host
);
4095 if (!NILP (service
))
4096 contact
= Fplist_put (contact
, QCservice
, service
);
4097 contact
= Fplist_put (contact
, QCremote
,
4098 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4099 #ifdef HAVE_GETSOCKNAME
4101 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4102 contact
= Fplist_put (contact
, QClocal
,
4103 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4106 p
->childp
= contact
;
4107 p
->plist
= Fcopy_sequence (ps
->plist
);
4110 p
->sentinel
= ps
->sentinel
;
4111 p
->filter
= ps
->filter
;
4114 XSETINT (p
->infd
, s
);
4115 XSETINT (p
->outfd
, s
);
4118 /* Client processes for accepted connections are not stopped initially. */
4119 if (!EQ (p
->filter
, Qt
))
4121 FD_SET (s
, &input_wait_mask
);
4122 FD_SET (s
, &non_keyboard_wait_mask
);
4125 if (s
> max_process_desc
)
4126 max_process_desc
= s
;
4128 /* Setup coding system for new process based on server process.
4129 This seems to be the proper thing to do, as the coding system
4130 of the new process should reflect the settings at the time the
4131 server socket was opened; not the current settings. */
4133 p
->decode_coding_system
= ps
->decode_coding_system
;
4134 p
->encode_coding_system
= ps
->encode_coding_system
;
4135 setup_process_coding_systems (proc
);
4137 p
->decoding_buf
= make_uninit_string (0);
4138 p
->decoding_carryover
= make_number (0);
4139 p
->encoding_buf
= make_uninit_string (0);
4140 p
->encoding_carryover
= make_number (0);
4142 p
->inherit_coding_system_flag
4143 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4145 if (!NILP (ps
->log
))
4146 call3 (ps
->log
, server
, proc
,
4147 concat3 (build_string ("accept from "),
4148 (STRINGP (host
) ? host
: build_string ("-")),
4149 build_string ("\n")));
4151 if (!NILP (p
->sentinel
))
4152 exec_sentinel (proc
,
4153 concat3 (build_string ("open from "),
4154 (STRINGP (host
) ? host
: build_string ("-")),
4155 build_string ("\n")));
4158 /* This variable is different from waiting_for_input in keyboard.c.
4159 It is used to communicate to a lisp process-filter/sentinel (via the
4160 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4161 for user-input when that process-filter was called.
4162 waiting_for_input cannot be used as that is by definition 0 when
4163 lisp code is being evalled.
4164 This is also used in record_asynch_buffer_change.
4165 For that purpose, this must be 0
4166 when not inside wait_reading_process_output. */
4167 static int waiting_for_user_input_p
;
4170 wait_reading_process_output_unwind (data
)
4173 waiting_for_user_input_p
= XINT (data
);
4177 /* This is here so breakpoints can be put on it. */
4179 wait_reading_process_output_1 ()
4183 /* Use a wrapper around select to work around a bug in gdb 5.3.
4184 Normally, the wrapper is optimzed away by inlining.
4186 If emacs is stopped inside select, the gdb backtrace doesn't
4187 show the function which called select, so it is practically
4188 impossible to step through wait_reading_process_output. */
4192 select_wrapper (n
, rfd
, wfd
, xfd
, tmo
)
4194 SELECT_TYPE
*rfd
, *wfd
, *xfd
;
4197 return select (n
, rfd
, wfd
, xfd
, tmo
);
4199 #define select select_wrapper
4202 /* Read and dispose of subprocess output while waiting for timeout to
4203 elapse and/or keyboard input to be available.
4206 timeout in seconds, or
4207 zero for no limit, or
4208 -1 means gobble data immediately available but don't wait for any.
4211 an additional duration to wait, measured in microseconds.
4212 If this is nonzero and time_limit is 0, then the timeout
4213 consists of MICROSECS only.
4215 READ_KBD is a lisp value:
4216 0 to ignore keyboard input, or
4217 1 to return when input is available, or
4218 -1 meaning caller will actually read the input, so don't throw to
4219 the quit handler, or
4221 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4222 output that arrives.
4224 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4225 (and gobble terminal input into the buffer if any arrives).
4227 If WAIT_PROC is specified, wait until something arrives from that
4228 process. The return value is true iff we read some input from
4231 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4232 (suspending output from other processes). A negative value
4233 means don't run any timers either.
4235 If WAIT_PROC is specified, then the function returns true iff we
4236 received input from that process before the timeout elapsed.
4237 Otherwise, return true iff we received input from any process. */
4240 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4241 wait_for_cell
, wait_proc
, just_wait_proc
)
4242 int time_limit
, microsecs
, read_kbd
, do_display
;
4243 Lisp_Object wait_for_cell
;
4244 struct Lisp_Process
*wait_proc
;
4247 register int channel
, nfds
;
4248 SELECT_TYPE Available
;
4249 #ifdef NON_BLOCKING_CONNECT
4250 SELECT_TYPE Connecting
;
4253 int check_delay
, no_avail
;
4256 EMACS_TIME timeout
, end_time
;
4257 int wait_channel
= -1;
4258 int got_some_input
= 0;
4259 int count
= SPECPDL_INDEX ();
4261 FD_ZERO (&Available
);
4262 #ifdef NON_BLOCKING_CONNECT
4263 FD_ZERO (&Connecting
);
4266 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4267 if (wait_proc
!= NULL
)
4268 wait_channel
= XINT (wait_proc
->infd
);
4270 record_unwind_protect (wait_reading_process_output_unwind
,
4271 make_number (waiting_for_user_input_p
));
4272 waiting_for_user_input_p
= read_kbd
;
4274 /* Since we may need to wait several times,
4275 compute the absolute time to return at. */
4276 if (time_limit
|| microsecs
)
4278 EMACS_GET_TIME (end_time
);
4279 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4280 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4282 #ifdef POLL_INTERRUPTED_SYS_CALL
4283 /* AlainF 5-Jul-1996
4284 HP-UX 10.10 seem to have problems with signals coming in
4285 Causes "poll: interrupted system call" messages when Emacs is run
4287 Turn off periodic alarms (in case they are in use),
4288 and then turn off any other atimers. */
4290 turn_on_atimers (0);
4291 #endif /* POLL_INTERRUPTED_SYS_CALL */
4295 int timeout_reduced_for_timers
= 0;
4297 /* If calling from keyboard input, do not quit
4298 since we want to return C-g as an input character.
4299 Otherwise, do pending quit if requested. */
4303 else if (interrupt_input_pending
)
4304 handle_async_input ();
4307 /* Exit now if the cell we're waiting for became non-nil. */
4308 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4311 /* Compute time from now till when time limit is up */
4312 /* Exit if already run out */
4313 if (time_limit
== -1)
4315 /* -1 specified for timeout means
4316 gobble output available now
4317 but don't wait at all. */
4319 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4321 else if (time_limit
|| microsecs
)
4323 EMACS_GET_TIME (timeout
);
4324 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4325 if (EMACS_TIME_NEG_P (timeout
))
4330 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4333 /* Normally we run timers here.
4334 But not if wait_for_cell; in those cases,
4335 the wait is supposed to be short,
4336 and those callers cannot handle running arbitrary Lisp code here. */
4337 if (NILP (wait_for_cell
)
4338 && just_wait_proc
>= 0)
4340 EMACS_TIME timer_delay
;
4344 int old_timers_run
= timers_run
;
4345 struct buffer
*old_buffer
= current_buffer
;
4347 timer_delay
= timer_check (1);
4349 /* If a timer has run, this might have changed buffers
4350 an alike. Make read_key_sequence aware of that. */
4351 if (timers_run
!= old_timers_run
4352 && old_buffer
!= current_buffer
4353 && waiting_for_user_input_p
== -1)
4354 record_asynch_buffer_change ();
4356 if (timers_run
!= old_timers_run
&& do_display
)
4357 /* We must retry, since a timer may have requeued itself
4358 and that could alter the time_delay. */
4359 redisplay_preserve_echo_area (9);
4363 while (!detect_input_pending ());
4365 /* If there is unread keyboard input, also return. */
4367 && requeued_events_pending_p ())
4370 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4372 EMACS_TIME difference
;
4373 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4374 if (EMACS_TIME_NEG_P (difference
))
4376 timeout
= timer_delay
;
4377 timeout_reduced_for_timers
= 1;
4380 /* If time_limit is -1, we are not going to wait at all. */
4381 else if (time_limit
!= -1)
4383 /* This is so a breakpoint can be put here. */
4384 wait_reading_process_output_1 ();
4388 /* Cause C-g and alarm signals to take immediate action,
4389 and cause input available signals to zero out timeout.
4391 It is important that we do this before checking for process
4392 activity. If we get a SIGCHLD after the explicit checks for
4393 process activity, timeout is the only way we will know. */
4395 set_waiting_for_input (&timeout
);
4397 /* If status of something has changed, and no input is
4398 available, notify the user of the change right away. After
4399 this explicit check, we'll let the SIGCHLD handler zap
4400 timeout to get our attention. */
4401 if (update_tick
!= process_tick
&& do_display
)
4404 #ifdef NON_BLOCKING_CONNECT
4408 Atemp
= input_wait_mask
;
4410 /* On Mac OS X 10.0, the SELECT system call always says input is
4411 present (for reading) at stdin, even when none is. This
4412 causes the call to SELECT below to return 1 and
4413 status_notify not to be called. As a result output of
4414 subprocesses are incorrectly discarded.
4418 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4420 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4421 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4423 #ifdef NON_BLOCKING_CONNECT
4424 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4428 (SELECT_TYPE
*)0, &timeout
)
4431 /* It's okay for us to do this and then continue with
4432 the loop, since timeout has already been zeroed out. */
4433 clear_waiting_for_input ();
4434 status_notify (NULL
);
4438 /* Don't wait for output from a non-running process. Just
4439 read whatever data has already been received. */
4440 if (wait_proc
&& wait_proc
->raw_status_new
)
4441 update_status (wait_proc
);
4443 && ! EQ (wait_proc
->status
, Qrun
)
4444 && ! EQ (wait_proc
->status
, Qconnect
))
4446 int nread
, total_nread
= 0;
4448 clear_waiting_for_input ();
4449 XSETPROCESS (proc
, wait_proc
);
4451 /* Read data from the process, until we exhaust it. */
4452 while (XINT (wait_proc
->infd
) >= 0)
4454 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4460 total_nread
+= nread
;
4462 else if (nread
== -1 && EIO
== errno
)
4466 else if (nread
== -1 && EAGAIN
== errno
)
4470 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4474 if (total_nread
> 0 && do_display
)
4475 redisplay_preserve_echo_area (10);
4480 /* Wait till there is something to do */
4482 if (wait_proc
&& just_wait_proc
)
4484 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4486 FD_SET (XINT (wait_proc
->infd
), &Available
);
4488 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4490 else if (!NILP (wait_for_cell
))
4492 Available
= non_process_wait_mask
;
4494 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4499 Available
= non_keyboard_wait_mask
;
4501 Available
= input_wait_mask
;
4502 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4503 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4506 /* If frame size has changed or the window is newly mapped,
4507 redisplay now, before we start to wait. There is a race
4508 condition here; if a SIGIO arrives between now and the select
4509 and indicates that a frame is trashed, the select may block
4510 displaying a trashed screen. */
4511 if (frame_garbaged
&& do_display
)
4513 clear_waiting_for_input ();
4514 redisplay_preserve_echo_area (11);
4516 set_waiting_for_input (&timeout
);
4520 if (read_kbd
&& detect_input_pending ())
4527 #ifdef NON_BLOCKING_CONNECT
4529 Connecting
= connect_wait_mask
;
4532 #ifdef ADAPTIVE_READ_BUFFERING
4533 /* Set the timeout for adaptive read buffering if any
4534 process has non-nil read_output_skip and non-zero
4535 read_output_delay, and we are not reading output for a
4536 specific wait_channel. It is not executed if
4537 Vprocess_adaptive_read_buffering is nil. */
4538 if (process_output_skip
&& check_delay
> 0)
4540 int usecs
= EMACS_USECS (timeout
);
4541 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4542 usecs
= READ_OUTPUT_DELAY_MAX
;
4543 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4545 proc
= chan_process
[channel
];
4548 /* Find minimum non-zero read_output_delay among the
4549 processes with non-nil read_output_skip. */
4550 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4553 if (NILP (XPROCESS (proc
)->read_output_skip
))
4555 FD_CLR (channel
, &Available
);
4556 XPROCESS (proc
)->read_output_skip
= Qnil
;
4557 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4558 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4561 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4562 process_output_skip
= 0;
4566 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4568 #ifdef NON_BLOCKING_CONNECT
4569 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4573 (SELECT_TYPE
*)0, &timeout
);
4578 /* Make C-g and alarm signals set flags again */
4579 clear_waiting_for_input ();
4581 /* If we woke up due to SIGWINCH, actually change size now. */
4582 do_pending_window_change (0);
4584 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4585 /* We wanted the full specified time, so return now. */
4589 if (xerrno
== EINTR
)
4592 /* Ultrix select seems to return ENOMEM when it is
4593 interrupted. Treat it just like EINTR. Bleah. Note
4594 that we want to test for the "ultrix" CPP symbol, not
4595 "__ultrix__"; the latter is only defined under GCC, but
4596 not by DEC's bundled CC. -JimB */
4597 else if (xerrno
== ENOMEM
)
4601 /* This happens for no known reason on ALLIANT.
4602 I am guessing that this is the right response. -- RMS. */
4603 else if (xerrno
== EFAULT
)
4606 else if (xerrno
== EBADF
)
4609 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4610 the child's closure of the pts gives the parent a SIGHUP, and
4611 the ptc file descriptor is automatically closed,
4612 yielding EBADF here or at select() call above.
4613 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4614 in m/ibmrt-aix.h), and here we just ignore the select error.
4615 Cleanup occurs c/o status_notify after SIGCLD. */
4616 no_avail
= 1; /* Cannot depend on values returned */
4622 error ("select error: %s", emacs_strerror (xerrno
));
4627 FD_ZERO (&Available
);
4628 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4631 #if defined(sun) && !defined(USG5_4)
4632 if (nfds
> 0 && keyboard_bit_set (&Available
)
4634 /* System sometimes fails to deliver SIGIO.
4636 David J. Mackenzie says that Emacs doesn't compile under
4637 Solaris if this code is enabled, thus the USG5_4 in the CPP
4638 conditional. "I haven't noticed any ill effects so far.
4639 If you find a Solaris expert somewhere, they might know
4641 kill (getpid (), SIGIO
);
4644 #if 0 /* When polling is used, interrupt_input is 0,
4645 so get_input_pending should read the input.
4646 So this should not be needed. */
4647 /* If we are using polling for input,
4648 and we see input available, make it get read now.
4649 Otherwise it might not actually get read for a second.
4650 And on hpux, since we turn off polling in wait_reading_process_output,
4651 it might never get read at all if we don't spend much time
4652 outside of wait_reading_process_output. */
4653 if (read_kbd
&& interrupt_input
4654 && keyboard_bit_set (&Available
)
4655 && input_polling_used ())
4656 kill (getpid (), SIGALRM
);
4659 /* Check for keyboard input */
4660 /* If there is any, return immediately
4661 to give it higher priority than subprocesses */
4665 int old_timers_run
= timers_run
;
4666 struct buffer
*old_buffer
= current_buffer
;
4669 if (detect_input_pending_run_timers (do_display
))
4671 swallow_events (do_display
);
4672 if (detect_input_pending_run_timers (do_display
))
4676 /* If a timer has run, this might have changed buffers
4677 an alike. Make read_key_sequence aware of that. */
4678 if (timers_run
!= old_timers_run
4679 && waiting_for_user_input_p
== -1
4680 && old_buffer
!= current_buffer
)
4681 record_asynch_buffer_change ();
4687 /* If there is unread keyboard input, also return. */
4689 && requeued_events_pending_p ())
4692 /* If we are not checking for keyboard input now,
4693 do process events (but don't run any timers).
4694 This is so that X events will be processed.
4695 Otherwise they may have to wait until polling takes place.
4696 That would causes delays in pasting selections, for example.
4698 (We used to do this only if wait_for_cell.) */
4699 if (read_kbd
== 0 && detect_input_pending ())
4701 swallow_events (do_display
);
4702 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4703 if (detect_input_pending ())
4708 /* Exit now if the cell we're waiting for became non-nil. */
4709 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4713 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4714 go read it. This can happen with X on BSD after logging out.
4715 In that case, there really is no input and no SIGIO,
4716 but select says there is input. */
4718 if (read_kbd
&& interrupt_input
4719 && keyboard_bit_set (&Available
) && ! noninteractive
)
4720 kill (getpid (), SIGIO
);
4724 got_some_input
|= nfds
> 0;
4726 /* If checking input just got us a size-change event from X,
4727 obey it now if we should. */
4728 if (read_kbd
|| ! NILP (wait_for_cell
))
4729 do_pending_window_change (0);
4731 /* Check for data from a process. */
4732 if (no_avail
|| nfds
== 0)
4735 /* Really FIRST_PROC_DESC should be 0 on Unix,
4736 but this is safer in the short run. */
4737 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4739 if (FD_ISSET (channel
, &Available
)
4740 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4744 /* If waiting for this channel, arrange to return as
4745 soon as no more input to be processed. No more
4747 if (wait_channel
== channel
)
4753 proc
= chan_process
[channel
];
4757 /* If this is a server stream socket, accept connection. */
4758 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4760 server_accept_connection (proc
, channel
);
4764 /* Read data from the process, starting with our
4765 buffered-ahead character if we have one. */
4767 nread
= read_process_output (proc
, channel
);
4770 /* Since read_process_output can run a filter,
4771 which can call accept-process-output,
4772 don't try to read from any other processes
4773 before doing the select again. */
4774 FD_ZERO (&Available
);
4777 redisplay_preserve_echo_area (12);
4780 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4783 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4784 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4786 else if (nread
== -1 && errno
== EAGAIN
)
4790 else if (nread
== -1 && errno
== EAGAIN
)
4792 /* Note that we cannot distinguish between no input
4793 available now and a closed pipe.
4794 With luck, a closed pipe will be accompanied by
4795 subprocess termination and SIGCHLD. */
4796 else if (nread
== 0 && !NETCONN_P (proc
))
4798 #endif /* O_NDELAY */
4799 #endif /* O_NONBLOCK */
4801 /* On some OSs with ptys, when the process on one end of
4802 a pty exits, the other end gets an error reading with
4803 errno = EIO instead of getting an EOF (0 bytes read).
4804 Therefore, if we get an error reading and errno =
4805 EIO, just continue, because the child process has
4806 exited and should clean itself up soon (e.g. when we
4809 However, it has been known to happen that the SIGCHLD
4810 got lost. So raise the signl again just in case.
4812 else if (nread
== -1 && errno
== EIO
)
4813 kill (getpid (), SIGCHLD
);
4814 #endif /* HAVE_PTYS */
4815 /* If we can detect process termination, don't consider the process
4816 gone just because its pipe is closed. */
4818 else if (nread
== 0 && !NETCONN_P (proc
))
4823 /* Preserve status of processes already terminated. */
4824 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4825 deactivate_process (proc
);
4826 if (XPROCESS (proc
)->raw_status_new
)
4827 update_status (XPROCESS (proc
));
4828 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4829 XPROCESS (proc
)->status
4830 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4833 #ifdef NON_BLOCKING_CONNECT
4834 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4835 && FD_ISSET (channel
, &connect_wait_mask
))
4837 struct Lisp_Process
*p
;
4839 FD_CLR (channel
, &connect_wait_mask
);
4840 if (--num_pending_connects
< 0)
4843 proc
= chan_process
[channel
];
4847 p
= XPROCESS (proc
);
4850 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4851 So only use it on systems where it is known to work. */
4853 int xlen
= sizeof(xerrno
);
4854 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4859 struct sockaddr pname
;
4860 int pnamelen
= sizeof(pname
);
4862 /* If connection failed, getpeername will fail. */
4864 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4866 /* Obtain connect failure code through error slippage. */
4869 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4876 XSETINT (p
->tick
, ++process_tick
);
4877 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4878 deactivate_process (proc
);
4883 /* Execute the sentinel here. If we had relied on
4884 status_notify to do it later, it will read input
4885 from the process before calling the sentinel. */
4886 exec_sentinel (proc
, build_string ("open\n"));
4887 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4889 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4890 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4894 #endif /* NON_BLOCKING_CONNECT */
4895 } /* end for each file descriptor */
4896 } /* end while exit conditions not met */
4898 unbind_to (count
, Qnil
);
4900 /* If calling from keyboard input, do not quit
4901 since we want to return C-g as an input character.
4902 Otherwise, do pending quit if requested. */
4905 /* Prevent input_pending from remaining set if we quit. */
4906 clear_input_pending ();
4909 #ifdef POLL_INTERRUPTED_SYS_CALL
4910 /* AlainF 5-Jul-1996
4911 HP-UX 10.10 seems to have problems with signals coming in
4912 Causes "poll: interrupted system call" messages when Emacs is run
4914 Turn periodic alarms back on */
4916 #endif /* POLL_INTERRUPTED_SYS_CALL */
4918 return got_some_input
;
4921 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4924 read_process_output_call (fun_and_args
)
4925 Lisp_Object fun_and_args
;
4927 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4931 read_process_output_error_handler (error
)
4934 cmd_error_internal (error
, "error in process filter: ");
4936 update_echo_area ();
4937 Fsleep_for (make_number (2), Qnil
);
4941 /* Read pending output from the process channel,
4942 starting with our buffered-ahead character if we have one.
4943 Yield number of decoded characters read.
4945 This function reads at most 4096 characters.
4946 If you want to read all available subprocess output,
4947 you must call it repeatedly until it returns zero.
4949 The characters read are decoded according to PROC's coding-system
4953 read_process_output (proc
, channel
)
4955 register int channel
;
4957 register int nbytes
;
4959 register Lisp_Object outstream
;
4960 register struct buffer
*old
= current_buffer
;
4961 register struct Lisp_Process
*p
= XPROCESS (proc
);
4962 register int opoint
;
4963 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4964 int carryover
= XINT (p
->decoding_carryover
);
4968 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4970 vs
= get_vms_process_pointer (p
->pid
);
4974 return (0); /* Really weird if it does this */
4975 if (!(vs
->iosb
[0] & 1))
4976 return -1; /* I/O error */
4979 error ("Could not get VMS process pointer");
4980 chars
= vs
->inputBuffer
;
4981 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4984 start_vms_process_read (vs
); /* Crank up the next read on the process */
4985 return 1; /* Nothing worth printing, say we got 1 */
4989 /* The data carried over in the previous decoding (which are at
4990 the tail of decoding buffer) should be prepended to the new
4991 data read to decode all together. */
4992 chars
= (char *) alloca (nbytes
+ carryover
);
4993 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4994 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4998 chars
= (char *) alloca (carryover
+ readmax
);
5000 /* See the comment above. */
5001 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
5003 #ifdef DATAGRAM_SOCKETS
5004 /* We have a working select, so proc_buffered_char is always -1. */
5005 if (DATAGRAM_CHAN_P (channel
))
5007 int len
= datagram_address
[channel
].len
;
5008 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5009 0, datagram_address
[channel
].sa
, &len
);
5013 if (proc_buffered_char
[channel
] < 0)
5015 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5016 #ifdef ADAPTIVE_READ_BUFFERING
5017 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
5019 int delay
= XINT (p
->read_output_delay
);
5022 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5025 process_output_delay_count
++;
5026 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5029 else if (delay
> 0 && (nbytes
== readmax
))
5031 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5033 process_output_delay_count
--;
5035 XSETINT (p
->read_output_delay
, delay
);
5038 p
->read_output_skip
= Qt
;
5039 process_output_skip
= 1;
5046 chars
[carryover
] = proc_buffered_char
[channel
];
5047 proc_buffered_char
[channel
] = -1;
5048 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5052 nbytes
= nbytes
+ 1;
5054 #endif /* not VMS */
5056 XSETINT (p
->decoding_carryover
, 0);
5058 /* At this point, NBYTES holds number of bytes just received
5059 (including the one in proc_buffered_char[channel]). */
5062 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5064 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5067 /* Now set NBYTES how many bytes we must decode. */
5068 nbytes
+= carryover
;
5070 /* Read and dispose of the process output. */
5071 outstream
= p
->filter
;
5072 if (!NILP (outstream
))
5074 /* We inhibit quit here instead of just catching it so that
5075 hitting ^G when a filter happens to be running won't screw
5077 int count
= SPECPDL_INDEX ();
5078 Lisp_Object odeactivate
;
5079 Lisp_Object obuffer
, okeymap
;
5081 int outer_running_asynch_code
= running_asynch_code
;
5082 int waiting
= waiting_for_user_input_p
;
5084 /* No need to gcpro these, because all we do with them later
5085 is test them for EQness, and none of them should be a string. */
5086 odeactivate
= Vdeactivate_mark
;
5087 XSETBUFFER (obuffer
, current_buffer
);
5088 okeymap
= current_buffer
->keymap
;
5090 specbind (Qinhibit_quit
, Qt
);
5091 specbind (Qlast_nonmenu_event
, Qt
);
5093 /* In case we get recursively called,
5094 and we already saved the match data nonrecursively,
5095 save the same match data in safely recursive fashion. */
5096 if (outer_running_asynch_code
)
5099 /* Don't clobber the CURRENT match data, either! */
5100 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5101 restore_search_regs ();
5102 record_unwind_save_match_data ();
5103 Fset_match_data (tem
, Qt
);
5106 /* For speed, if a search happens within this code,
5107 save the match data in a special nonrecursive fashion. */
5108 running_asynch_code
= 1;
5110 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5112 Vlast_coding_system_used
= coding
->symbol
;
5113 /* A new coding system might be found. */
5114 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5116 p
->decode_coding_system
= coding
->symbol
;
5118 /* Don't call setup_coding_system for
5119 proc_decode_coding_system[channel] here. It is done in
5120 detect_coding called via decode_coding above. */
5122 /* If a coding system for encoding is not yet decided, we set
5123 it as the same as coding-system for decoding.
5125 But, before doing that we must check if
5126 proc_encode_coding_system[p->outfd] surely points to a
5127 valid memory because p->outfd will be changed once EOF is
5128 sent to the process. */
5129 if (NILP (p
->encode_coding_system
)
5130 && proc_encode_coding_system
[XINT (p
->outfd
)])
5132 p
->encode_coding_system
= coding
->symbol
;
5133 setup_coding_system (coding
->symbol
,
5134 proc_encode_coding_system
[XINT (p
->outfd
)]);
5135 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5136 == CODING_EOL_UNDECIDED
)
5137 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5142 carryover
= nbytes
- coding
->consumed
;
5146 if (SCHARS (p
->decoding_buf
) < carryover
)
5147 p
->decoding_buf
= make_uninit_string (carryover
);
5148 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5150 XSETINT (p
->decoding_carryover
, carryover
);
5151 /* Adjust the multibyteness of TEXT to that of the filter. */
5152 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5153 text
= (STRING_MULTIBYTE (text
)
5154 ? Fstring_as_unibyte (text
)
5155 : Fstring_to_multibyte (text
));
5156 if (SBYTES (text
) > 0)
5157 internal_condition_case_1 (read_process_output_call
,
5159 Fcons (proc
, Fcons (text
, Qnil
))),
5160 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5161 read_process_output_error_handler
);
5163 /* If we saved the match data nonrecursively, restore it now. */
5164 restore_search_regs ();
5165 running_asynch_code
= outer_running_asynch_code
;
5167 /* Handling the process output should not deactivate the mark. */
5168 Vdeactivate_mark
= odeactivate
;
5170 /* Restore waiting_for_user_input_p as it was
5171 when we were called, in case the filter clobbered it. */
5172 waiting_for_user_input_p
= waiting
;
5174 #if 0 /* Call record_asynch_buffer_change unconditionally,
5175 because we might have changed minor modes or other things
5176 that affect key bindings. */
5177 if (! EQ (Fcurrent_buffer (), obuffer
)
5178 || ! EQ (current_buffer
->keymap
, okeymap
))
5180 /* But do it only if the caller is actually going to read events.
5181 Otherwise there's no need to make him wake up, and it could
5182 cause trouble (for example it would make sit_for return). */
5183 if (waiting_for_user_input_p
== -1)
5184 record_asynch_buffer_change ();
5187 start_vms_process_read (vs
);
5189 unbind_to (count
, Qnil
);
5193 /* If no filter, write into buffer if it isn't dead. */
5194 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5196 Lisp_Object old_read_only
;
5197 int old_begv
, old_zv
;
5198 int old_begv_byte
, old_zv_byte
;
5199 Lisp_Object odeactivate
;
5200 int before
, before_byte
;
5205 odeactivate
= Vdeactivate_mark
;
5207 Fset_buffer (p
->buffer
);
5209 opoint_byte
= PT_BYTE
;
5210 old_read_only
= current_buffer
->read_only
;
5213 old_begv_byte
= BEGV_BYTE
;
5214 old_zv_byte
= ZV_BYTE
;
5216 current_buffer
->read_only
= Qnil
;
5218 /* Insert new output into buffer
5219 at the current end-of-output marker,
5220 thus preserving logical ordering of input and output. */
5221 if (XMARKER (p
->mark
)->buffer
)
5222 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5223 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5226 SET_PT_BOTH (ZV
, ZV_BYTE
);
5228 before_byte
= PT_BYTE
;
5230 /* If the output marker is outside of the visible region, save
5231 the restriction and widen. */
5232 if (! (BEGV
<= PT
&& PT
<= ZV
))
5235 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5237 Vlast_coding_system_used
= coding
->symbol
;
5238 /* A new coding system might be found. See the comment in the
5239 similar code in the previous `if' block. */
5240 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5242 p
->decode_coding_system
= coding
->symbol
;
5243 if (NILP (p
->encode_coding_system
)
5244 && proc_encode_coding_system
[XINT (p
->outfd
)])
5246 p
->encode_coding_system
= coding
->symbol
;
5247 setup_coding_system (coding
->symbol
,
5248 proc_encode_coding_system
[XINT (p
->outfd
)]);
5249 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5250 == CODING_EOL_UNDECIDED
)
5251 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5255 carryover
= nbytes
- coding
->consumed
;
5259 if (SCHARS (p
->decoding_buf
) < carryover
)
5260 p
->decoding_buf
= make_uninit_string (carryover
);
5261 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5263 XSETINT (p
->decoding_carryover
, carryover
);
5265 /* Adjust the multibyteness of TEXT to that of the buffer. */
5266 if (NILP (current_buffer
->enable_multibyte_characters
)
5267 != ! STRING_MULTIBYTE (text
))
5268 text
= (STRING_MULTIBYTE (text
)
5269 ? Fstring_as_unibyte (text
)
5270 : Fstring_to_multibyte (text
));
5271 /* Insert before markers in case we are inserting where
5272 the buffer's mark is, and the user's next command is Meta-y. */
5273 insert_from_string_before_markers (text
, 0, 0,
5274 SCHARS (text
), SBYTES (text
), 0);
5276 /* Make sure the process marker's position is valid when the
5277 process buffer is changed in the signal_after_change above.
5278 W3 is known to do that. */
5279 if (BUFFERP (p
->buffer
)
5280 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5281 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5283 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5285 update_mode_lines
++;
5287 /* Make sure opoint and the old restrictions
5288 float ahead of any new text just as point would. */
5289 if (opoint
>= before
)
5291 opoint
+= PT
- before
;
5292 opoint_byte
+= PT_BYTE
- before_byte
;
5294 if (old_begv
> before
)
5296 old_begv
+= PT
- before
;
5297 old_begv_byte
+= PT_BYTE
- before_byte
;
5299 if (old_zv
>= before
)
5301 old_zv
+= PT
- before
;
5302 old_zv_byte
+= PT_BYTE
- before_byte
;
5305 /* If the restriction isn't what it should be, set it. */
5306 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5307 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5309 /* Handling the process output should not deactivate the mark. */
5310 Vdeactivate_mark
= odeactivate
;
5312 current_buffer
->read_only
= old_read_only
;
5313 SET_PT_BOTH (opoint
, opoint_byte
);
5314 set_buffer_internal (old
);
5317 start_vms_process_read (vs
);
5322 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5324 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5325 This is intended for use by asynchronous process output filters and sentinels. */)
5328 return (waiting_for_user_input_p
? Qt
: Qnil
);
5331 /* Sending data to subprocess */
5333 jmp_buf send_process_frame
;
5334 Lisp_Object process_sent_to
;
5337 send_process_trap ()
5339 SIGNAL_THREAD_CHECK (SIGPIPE
);
5344 sigunblock (sigmask (SIGPIPE
));
5345 longjmp (send_process_frame
, 1);
5348 /* Send some data to process PROC.
5349 BUF is the beginning of the data; LEN is the number of characters.
5350 OBJECT is the Lisp object that the data comes from. If OBJECT is
5351 nil or t, it means that the data comes from C string.
5353 If OBJECT is not nil, the data is encoded by PROC's coding-system
5354 for encoding before it is sent.
5356 This function can evaluate Lisp code and can garbage collect. */
5359 send_process (proc
, buf
, len
, object
)
5360 volatile Lisp_Object proc
;
5361 unsigned char *volatile buf
;
5363 volatile Lisp_Object object
;
5365 /* Use volatile to protect variables from being clobbered by longjmp. */
5366 struct Lisp_Process
*p
= XPROCESS (proc
);
5368 struct coding_system
*coding
;
5369 struct gcpro gcpro1
;
5370 SIGTYPE (*volatile old_sigpipe
) ();
5375 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5378 if (p
->raw_status_new
)
5380 if (! EQ (p
->status
, Qrun
))
5381 error ("Process %s not running", SDATA (p
->name
));
5382 if (XINT (p
->outfd
) < 0)
5383 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5385 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5386 Vlast_coding_system_used
= coding
->symbol
;
5388 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5389 || (BUFFERP (object
)
5390 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5393 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5394 /* The coding system for encoding was changed to raw-text
5395 because we sent a unibyte text previously. Now we are
5396 sending a multibyte text, thus we must encode it by the
5397 original coding system specified for the current process. */
5398 setup_coding_system (p
->encode_coding_system
, coding
);
5399 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
5400 coding
->eol_type
= system_eol_type
;
5401 /* src_multibyte should be set to 1 _after_ a call to
5402 setup_coding_system, since it resets src_multibyte to
5404 coding
->src_multibyte
= 1;
5408 /* For sending a unibyte text, character code conversion should
5409 not take place but EOL conversion should. So, setup raw-text
5410 or one of the subsidiary if we have not yet done it. */
5411 if (coding
->type
!= coding_type_raw_text
)
5413 if (CODING_REQUIRE_FLUSHING (coding
))
5415 /* But, before changing the coding, we must flush out data. */
5416 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5417 send_process (proc
, "", 0, Qt
);
5419 coding
->src_multibyte
= 0;
5420 setup_raw_text_coding_system (coding
);
5423 coding
->dst_multibyte
= 0;
5425 if (CODING_REQUIRE_ENCODING (coding
))
5427 int require
= encoding_buffer_size (coding
, len
);
5428 int from_byte
= -1, from
= -1, to
= -1;
5430 if (BUFFERP (object
))
5432 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5433 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5434 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5436 else if (STRINGP (object
))
5438 from_byte
= buf
- SDATA (object
);
5439 from
= string_byte_to_char (object
, from_byte
);
5440 to
= string_byte_to_char (object
, from_byte
+ len
);
5443 if (coding
->composing
!= COMPOSITION_DISABLED
)
5446 coding_save_composition (coding
, from
, to
, object
);
5448 coding
->composing
= COMPOSITION_DISABLED
;
5451 if (SBYTES (p
->encoding_buf
) < require
)
5452 p
->encoding_buf
= make_uninit_string (require
);
5455 buf
= (BUFFERP (object
)
5456 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5457 : SDATA (object
) + from_byte
);
5459 object
= p
->encoding_buf
;
5460 encode_coding (coding
, (char *) buf
, SDATA (object
),
5461 len
, SBYTES (object
));
5462 coding_free_composition_data (coding
);
5463 len
= coding
->produced
;
5464 buf
= SDATA (object
);
5468 vs
= get_vms_process_pointer (p
->pid
);
5470 error ("Could not find this process: %x", p
->pid
);
5471 else if (write_to_vms_process (vs
, buf
, len
))
5475 if (pty_max_bytes
== 0)
5477 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5478 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5479 if (pty_max_bytes
< 0)
5480 pty_max_bytes
= 250;
5482 pty_max_bytes
= 250;
5484 /* Deduct one, to leave space for the eof. */
5488 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5489 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5490 when returning with longjmp despite being declared volatile. */
5491 if (!setjmp (send_process_frame
))
5493 process_sent_to
= proc
;
5498 /* Decide how much data we can send in one batch.
5499 Long lines need to be split into multiple batches. */
5500 if (!NILP (p
->pty_flag
))
5502 /* Starting this at zero is always correct when not the first
5503 iteration because the previous iteration ended by sending C-d.
5504 It may not be correct for the first iteration
5505 if a partial line was sent in a separate send_process call.
5506 If that proves worth handling, we need to save linepos
5507 in the process object. */
5509 unsigned char *ptr
= (unsigned char *) buf
;
5510 unsigned char *end
= (unsigned char *) buf
+ len
;
5512 /* Scan through this text for a line that is too long. */
5513 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5521 /* If we found one, break the line there
5522 and put in a C-d to force the buffer through. */
5526 /* Send this batch, using one or more write calls. */
5529 int outfd
= XINT (p
->outfd
);
5530 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5531 #ifdef DATAGRAM_SOCKETS
5532 if (DATAGRAM_CHAN_P (outfd
))
5534 rv
= sendto (outfd
, (char *) buf
, this,
5535 0, datagram_address
[outfd
].sa
,
5536 datagram_address
[outfd
].len
);
5537 if (rv
< 0 && errno
== EMSGSIZE
)
5539 signal (SIGPIPE
, old_sigpipe
);
5540 report_file_error ("sending datagram",
5541 Fcons (proc
, Qnil
));
5547 rv
= emacs_write (outfd
, (char *) buf
, this);
5548 #ifdef ADAPTIVE_READ_BUFFERING
5549 if (XINT (p
->read_output_delay
) > 0
5550 && EQ (p
->adaptive_read_buffering
, Qt
))
5552 XSETFASTINT (p
->read_output_delay
, 0);
5553 process_output_delay_count
--;
5554 p
->read_output_skip
= Qnil
;
5558 signal (SIGPIPE
, old_sigpipe
);
5564 || errno
== EWOULDBLOCK
5570 /* Buffer is full. Wait, accepting input;
5571 that may allow the program
5572 to finish doing output and read more. */
5576 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5577 /* A gross hack to work around a bug in FreeBSD.
5578 In the following sequence, read(2) returns
5582 write(2) 954 bytes, get EAGAIN
5583 read(2) 1024 bytes in process_read_output
5584 read(2) 11 bytes in process_read_output
5586 That is, read(2) returns more bytes than have
5587 ever been written successfully. The 1033 bytes
5588 read are the 1022 bytes written successfully
5589 after processing (for example with CRs added if
5590 the terminal is set up that way which it is
5591 here). The same bytes will be seen again in a
5592 later read(2), without the CRs. */
5594 if (errno
== EAGAIN
)
5597 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5599 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5601 /* Running filters might relocate buffers or strings.
5602 Arrange to relocate BUF. */
5603 if (BUFFERP (object
))
5604 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5605 else if (STRINGP (object
))
5606 offset
= buf
- SDATA (object
);
5608 #ifdef EMACS_HAS_USECS
5609 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5611 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5614 if (BUFFERP (object
))
5615 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5616 else if (STRINGP (object
))
5617 buf
= offset
+ SDATA (object
);
5622 /* This is a real error. */
5623 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5630 /* If we sent just part of the string, put in an EOF
5631 to force it through, before we send the rest. */
5633 Fprocess_send_eof (proc
);
5636 #endif /* not VMS */
5639 signal (SIGPIPE
, old_sigpipe
);
5641 proc
= process_sent_to
;
5642 p
= XPROCESS (proc
);
5644 p
->raw_status_new
= 0;
5645 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5646 XSETINT (p
->tick
, ++process_tick
);
5647 deactivate_process (proc
);
5649 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5651 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5658 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5660 doc
: /* Send current contents of region as input to PROCESS.
5661 PROCESS may be a process, a buffer, the name of a process or buffer, or
5662 nil, indicating the current buffer's process.
5663 Called from program, takes three arguments, PROCESS, START and END.
5664 If the region is more than 500 characters long,
5665 it is sent in several bunches. This may happen even for shorter regions.
5666 Output from processes can arrive in between bunches. */)
5667 (process
, start
, end
)
5668 Lisp_Object process
, start
, end
;
5673 proc
= get_process (process
);
5674 validate_region (&start
, &end
);
5676 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5677 move_gap (XINT (start
));
5679 start1
= CHAR_TO_BYTE (XINT (start
));
5680 end1
= CHAR_TO_BYTE (XINT (end
));
5681 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5682 Fcurrent_buffer ());
5687 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5689 doc
: /* Send PROCESS the contents of STRING as input.
5690 PROCESS may be a process, a buffer, the name of a process or buffer, or
5691 nil, indicating the current buffer's process.
5692 If STRING is more than 500 characters long,
5693 it is sent in several bunches. This may happen even for shorter strings.
5694 Output from processes can arrive in between bunches. */)
5696 Lisp_Object process
, string
;
5699 CHECK_STRING (string
);
5700 proc
= get_process (process
);
5701 send_process (proc
, SDATA (string
),
5702 SBYTES (string
), string
);
5706 /* Return the foreground process group for the tty/pty that
5707 the process P uses. */
5709 emacs_get_tty_pgrp (p
)
5710 struct Lisp_Process
*p
;
5715 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5718 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5719 master side. Try the slave side. */
5720 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5724 ioctl (fd
, TIOCGPGRP
, &gid
);
5728 #endif /* defined (TIOCGPGRP ) */
5733 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5734 Sprocess_running_child_p
, 0, 1, 0,
5735 doc
: /* Return t if PROCESS has given the terminal to a child.
5736 If the operating system does not make it possible to find out,
5737 return t unconditionally. */)
5739 Lisp_Object process
;
5741 /* Initialize in case ioctl doesn't exist or gives an error,
5742 in a way that will cause returning t. */
5745 struct Lisp_Process
*p
;
5747 proc
= get_process (process
);
5748 p
= XPROCESS (proc
);
5750 if (!EQ (p
->childp
, Qt
))
5751 error ("Process %s is not a subprocess",
5753 if (XINT (p
->infd
) < 0)
5754 error ("Process %s is not active",
5757 gid
= emacs_get_tty_pgrp (p
);
5764 /* send a signal number SIGNO to PROCESS.
5765 If CURRENT_GROUP is t, that means send to the process group
5766 that currently owns the terminal being used to communicate with PROCESS.
5767 This is used for various commands in shell mode.
5768 If CURRENT_GROUP is lambda, that means send to the process group
5769 that currently owns the terminal, but only if it is NOT the shell itself.
5771 If NOMSG is zero, insert signal-announcements into process's buffers
5774 If we can, we try to signal PROCESS by sending control characters
5775 down the pty. This allows us to signal inferiors who have changed
5776 their uid, for which killpg would return an EPERM error. */
5779 process_send_signal (process
, signo
, current_group
, nomsg
)
5780 Lisp_Object process
;
5782 Lisp_Object current_group
;
5786 register struct Lisp_Process
*p
;
5790 proc
= get_process (process
);
5791 p
= XPROCESS (proc
);
5793 if (!EQ (p
->childp
, Qt
))
5794 error ("Process %s is not a subprocess",
5796 if (XINT (p
->infd
) < 0)
5797 error ("Process %s is not active",
5800 if (NILP (p
->pty_flag
))
5801 current_group
= Qnil
;
5803 /* If we are using pgrps, get a pgrp number and make it negative. */
5804 if (NILP (current_group
))
5805 /* Send the signal to the shell's process group. */
5809 #ifdef SIGNALS_VIA_CHARACTERS
5810 /* If possible, send signals to the entire pgrp
5811 by sending an input character to it. */
5813 /* TERMIOS is the latest and bestest, and seems most likely to
5814 work. If the system has it, use it. */
5817 cc_t
*sig_char
= NULL
;
5819 tcgetattr (XINT (p
->infd
), &t
);
5824 sig_char
= &t
.c_cc
[VINTR
];
5828 sig_char
= &t
.c_cc
[VQUIT
];
5832 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5833 sig_char
= &t
.c_cc
[VSWTCH
];
5835 sig_char
= &t
.c_cc
[VSUSP
];
5840 if (sig_char
&& *sig_char
!= CDISABLE
)
5842 send_process (proc
, sig_char
, 1, Qnil
);
5845 /* If we can't send the signal with a character,
5846 fall through and send it another way. */
5847 #else /* ! HAVE_TERMIOS */
5849 /* On Berkeley descendants, the following IOCTL's retrieve the
5850 current control characters. */
5851 #if defined (TIOCGLTC) && defined (TIOCGETC)
5859 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5860 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5863 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5864 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5868 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5869 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5871 #endif /* ! defined (SIGTSTP) */
5874 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5876 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5883 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5884 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5887 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5888 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5892 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5893 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5895 #endif /* ! defined (SIGTSTP) */
5897 #else /* ! defined (TCGETA) */
5898 Your configuration files are messed up
.
5899 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5900 you'd better be using one of the alternatives above! */
5901 #endif /* ! defined (TCGETA) */
5902 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5903 /* In this case, the code above should alway returns. */
5905 #endif /* ! defined HAVE_TERMIOS */
5907 /* The code above may fall through if it can't
5908 handle the signal. */
5909 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5912 /* Get the current pgrp using the tty itself, if we have that.
5913 Otherwise, use the pty to get the pgrp.
5914 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5915 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5916 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5917 His patch indicates that if TIOCGPGRP returns an error, then
5918 we should just assume that p->pid is also the process group id. */
5920 gid
= emacs_get_tty_pgrp (p
);
5923 /* If we can't get the information, assume
5924 the shell owns the tty. */
5927 /* It is not clear whether anything really can set GID to -1.
5928 Perhaps on some system one of those ioctls can or could do so.
5929 Or perhaps this is vestigial. */
5932 #else /* ! defined (TIOCGPGRP ) */
5933 /* Can't select pgrps on this system, so we know that
5934 the child itself heads the pgrp. */
5936 #endif /* ! defined (TIOCGPGRP ) */
5938 /* If current_group is lambda, and the shell owns the terminal,
5939 don't send any signal. */
5940 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5948 p
->raw_status_new
= 0;
5950 XSETINT (p
->tick
, ++process_tick
);
5952 status_notify (NULL
);
5954 #endif /* ! defined (SIGCONT) */
5957 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5962 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5967 sys$
forcex (&(p
->pid
), 0, 1);
5970 flush_pending_output (XINT (p
->infd
));
5974 /* If we don't have process groups, send the signal to the immediate
5975 subprocess. That isn't really right, but it's better than any
5976 obvious alternative. */
5979 kill (p
->pid
, signo
);
5983 /* gid may be a pid, or minus a pgrp's number */
5985 if (!NILP (current_group
))
5987 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5988 EMACS_KILLPG (gid
, signo
);
5995 #else /* ! defined (TIOCSIGSEND) */
5996 EMACS_KILLPG (gid
, signo
);
5997 #endif /* ! defined (TIOCSIGSEND) */
6000 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6001 doc
: /* Interrupt process PROCESS.
6002 PROCESS may be a process, a buffer, or the name of a process or buffer.
6003 No arg or nil means current buffer's process.
6004 Second arg CURRENT-GROUP non-nil means send signal to
6005 the current process-group of the process's controlling terminal
6006 rather than to the process's own process group.
6007 If the process is a shell, this means interrupt current subjob
6008 rather than the shell.
6010 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6011 don't send the signal. */)
6012 (process
, current_group
)
6013 Lisp_Object process
, current_group
;
6015 process_send_signal (process
, SIGINT
, current_group
, 0);
6019 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6020 doc
: /* Kill process PROCESS. May be process or name of one.
6021 See function `interrupt-process' for more details on usage. */)
6022 (process
, current_group
)
6023 Lisp_Object process
, current_group
;
6025 process_send_signal (process
, SIGKILL
, current_group
, 0);
6029 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6030 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6031 See function `interrupt-process' for more details on usage. */)
6032 (process
, current_group
)
6033 Lisp_Object process
, current_group
;
6035 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6039 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6040 doc
: /* Stop process PROCESS. May be process or name of one.
6041 See function `interrupt-process' for more details on usage.
6042 If PROCESS is a network process, inhibit handling of incoming traffic. */)
6043 (process
, current_group
)
6044 Lisp_Object process
, current_group
;
6047 if (PROCESSP (process
) && NETCONN_P (process
))
6049 struct Lisp_Process
*p
;
6051 p
= XPROCESS (process
);
6052 if (NILP (p
->command
)
6053 && XINT (p
->infd
) >= 0)
6055 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6056 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6063 error ("No SIGTSTP support");
6065 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6070 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6071 doc
: /* Continue process PROCESS. May be process or name of one.
6072 See function `interrupt-process' for more details on usage.
6073 If PROCESS is a network process, resume handling of incoming traffic. */)
6074 (process
, current_group
)
6075 Lisp_Object process
, current_group
;
6078 if (PROCESSP (process
) && NETCONN_P (process
))
6080 struct Lisp_Process
*p
;
6082 p
= XPROCESS (process
);
6083 if (EQ (p
->command
, Qt
)
6084 && XINT (p
->infd
) >= 0
6085 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6087 FD_SET (XINT (p
->infd
), &input_wait_mask
);
6088 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6095 process_send_signal (process
, SIGCONT
, current_group
, 0);
6097 error ("No SIGCONT support");
6102 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6103 2, 2, "sProcess (name or number): \nnSignal code: ",
6104 doc
: /* Send PROCESS the signal with code SIGCODE.
6105 PROCESS may also be an integer specifying the process id of the
6106 process to signal; in this case, the process need not be a child of
6108 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6110 Lisp_Object process
, sigcode
;
6114 if (INTEGERP (process
))
6116 pid
= XINT (process
);
6120 if (FLOATP (process
))
6122 pid
= (pid_t
) XFLOAT (process
);
6126 if (STRINGP (process
))
6129 if (tem
= Fget_process (process
), NILP (tem
))
6131 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6138 process
= get_process (process
);
6143 CHECK_PROCESS (process
);
6144 pid
= XPROCESS (process
)->pid
;
6146 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6150 #define parse_signal(NAME, VALUE) \
6151 else if (!strcasecmp (name, NAME)) \
6152 XSETINT (sigcode, VALUE)
6154 if (INTEGERP (sigcode
))
6158 unsigned char *name
;
6160 CHECK_SYMBOL (sigcode
);
6161 name
= SDATA (SYMBOL_NAME (sigcode
));
6163 if (!strncasecmp(name
, "sig", 3))
6169 parse_signal ("usr1", SIGUSR1
);
6172 parse_signal ("usr2", SIGUSR2
);
6175 parse_signal ("term", SIGTERM
);
6178 parse_signal ("hup", SIGHUP
);
6181 parse_signal ("int", SIGINT
);
6184 parse_signal ("quit", SIGQUIT
);
6187 parse_signal ("ill", SIGILL
);
6190 parse_signal ("abrt", SIGABRT
);
6193 parse_signal ("emt", SIGEMT
);
6196 parse_signal ("kill", SIGKILL
);
6199 parse_signal ("fpe", SIGFPE
);
6202 parse_signal ("bus", SIGBUS
);
6205 parse_signal ("segv", SIGSEGV
);
6208 parse_signal ("sys", SIGSYS
);
6211 parse_signal ("pipe", SIGPIPE
);
6214 parse_signal ("alrm", SIGALRM
);
6217 parse_signal ("urg", SIGURG
);
6220 parse_signal ("stop", SIGSTOP
);
6223 parse_signal ("tstp", SIGTSTP
);
6226 parse_signal ("cont", SIGCONT
);
6229 parse_signal ("chld", SIGCHLD
);
6232 parse_signal ("ttin", SIGTTIN
);
6235 parse_signal ("ttou", SIGTTOU
);
6238 parse_signal ("io", SIGIO
);
6241 parse_signal ("xcpu", SIGXCPU
);
6244 parse_signal ("xfsz", SIGXFSZ
);
6247 parse_signal ("vtalrm", SIGVTALRM
);
6250 parse_signal ("prof", SIGPROF
);
6253 parse_signal ("winch", SIGWINCH
);
6256 parse_signal ("info", SIGINFO
);
6259 error ("Undefined signal name %s", name
);
6264 return make_number (kill (pid
, XINT (sigcode
)));
6267 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6268 doc
: /* Make PROCESS see end-of-file in its input.
6269 EOF comes after any text already sent to it.
6270 PROCESS may be a process, a buffer, the name of a process or buffer, or
6271 nil, indicating the current buffer's process.
6272 If PROCESS is a network connection, or is a process communicating
6273 through a pipe (as opposed to a pty), then you cannot send any more
6274 text to PROCESS after you call this function. */)
6276 Lisp_Object process
;
6279 struct coding_system
*coding
;
6281 if (DATAGRAM_CONN_P (process
))
6284 proc
= get_process (process
);
6285 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6287 /* Make sure the process is really alive. */
6288 if (XPROCESS (proc
)->raw_status_new
)
6289 update_status (XPROCESS (proc
));
6290 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6291 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6293 if (CODING_REQUIRE_FLUSHING (coding
))
6295 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6296 send_process (proc
, "", 0, Qnil
);
6300 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6302 if (!NILP (XPROCESS (proc
)->pty_flag
))
6303 send_process (proc
, "\004", 1, Qnil
);
6306 int old_outfd
, new_outfd
;
6308 #ifdef HAVE_SHUTDOWN
6309 /* If this is a network connection, or socketpair is used
6310 for communication with the subprocess, call shutdown to cause EOF.
6311 (In some old system, shutdown to socketpair doesn't work.
6312 Then we just can't win.) */
6313 if (XPROCESS (proc
)->pid
== 0
6314 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6315 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6316 /* In case of socketpair, outfd == infd, so don't close it. */
6317 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6318 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6319 #else /* not HAVE_SHUTDOWN */
6320 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6321 #endif /* not HAVE_SHUTDOWN */
6322 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6325 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6327 if (!proc_encode_coding_system
[new_outfd
])
6328 proc_encode_coding_system
[new_outfd
]
6329 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6330 bcopy (proc_encode_coding_system
[old_outfd
],
6331 proc_encode_coding_system
[new_outfd
],
6332 sizeof (struct coding_system
));
6333 bzero (proc_encode_coding_system
[old_outfd
],
6334 sizeof (struct coding_system
));
6336 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6342 /* Kill all processes associated with `buffer'.
6343 If `buffer' is nil, kill all processes */
6346 kill_buffer_processes (buffer
)
6349 Lisp_Object tail
, proc
;
6351 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6353 proc
= XCDR (XCAR (tail
));
6354 if (GC_PROCESSP (proc
)
6355 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6357 if (NETCONN_P (proc
))
6358 Fdelete_process (proc
);
6359 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6360 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6365 /* On receipt of a signal that a child status has changed, loop asking
6366 about children with changed statuses until the system says there
6369 All we do is change the status; we do not run sentinels or print
6370 notifications. That is saved for the next time keyboard input is
6371 done, in order to avoid timing errors.
6373 ** WARNING: this can be called during garbage collection.
6374 Therefore, it must not be fooled by the presence of mark bits in
6377 ** USG WARNING: Although it is not obvious from the documentation
6378 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6379 signal() before executing at least one wait(), otherwise the
6380 handler will be called again, resulting in an infinite loop. The
6381 relevant portion of the documentation reads "SIGCLD signals will be
6382 queued and the signal-catching function will be continually
6383 reentered until the queue is empty". Invoking signal() causes the
6384 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6387 ** Malloc WARNING: This should never call malloc either directly or
6388 indirectly; if it does, that is a bug */
6392 sigchld_handler (signo
)
6395 int old_errno
= errno
;
6397 register struct Lisp_Process
*p
;
6398 extern EMACS_TIME
*input_available_clear_time
;
6400 SIGNAL_THREAD_CHECK (signo
);
6404 sigheld
|= sigbit (SIGCHLD
);
6416 #endif /* no WUNTRACED */
6417 /* Keep trying to get a status until we get a definitive result. */
6421 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6423 while (pid
< 0 && errno
== EINTR
);
6427 /* PID == 0 means no processes found, PID == -1 means a real
6428 failure. We have done all our job, so return. */
6430 /* USG systems forget handlers when they are used;
6431 must reestablish each time */
6432 #if defined (USG) && !defined (POSIX_SIGNALS)
6433 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6436 sigheld
&= ~sigbit (SIGCHLD
);
6444 #endif /* no WNOHANG */
6446 /* Find the process that signaled us, and record its status. */
6448 /* The process can have been deleted by Fdelete_process. */
6449 tail
= Fmember (make_fixnum_or_float (pid
), deleted_pid_list
);
6452 Fsetcar (tail
, Qnil
);
6453 goto sigchld_end_of_loop
;
6456 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6458 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6460 proc
= XCDR (XCAR (tail
));
6461 p
= XPROCESS (proc
);
6462 if (GC_EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6467 /* Look for an asynchronous process whose pid hasn't been filled
6470 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6472 proc
= XCDR (XCAR (tail
));
6473 p
= XPROCESS (proc
);
6479 /* Change the status of the process that was found. */
6482 union { int i
; WAITTYPE wt
; } u
;
6483 int clear_desc_flag
= 0;
6485 XSETINT (p
->tick
, ++process_tick
);
6487 p
->raw_status
= u
.i
;
6488 p
->raw_status_new
= 1;
6490 /* If process has terminated, stop waiting for its output. */
6491 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6492 && XINT (p
->infd
) >= 0)
6493 clear_desc_flag
= 1;
6495 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6496 if (clear_desc_flag
)
6498 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6499 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6502 /* Tell wait_reading_process_output that it needs to wake up and
6504 if (input_available_clear_time
)
6505 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6508 /* There was no asynchronous process found for that pid: we have
6509 a synchronous process. */
6512 synch_process_alive
= 0;
6514 /* Report the status of the synchronous process. */
6516 synch_process_retcode
= WRETCODE (w
);
6517 else if (WIFSIGNALED (w
))
6518 synch_process_termsig
= WTERMSIG (w
);
6520 /* Tell wait_reading_process_output that it needs to wake up and
6522 if (input_available_clear_time
)
6523 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6526 sigchld_end_of_loop
:
6529 /* On some systems, we must return right away.
6530 If any more processes want to signal us, we will
6532 Otherwise (on systems that have WNOHANG), loop around
6533 to use up all the processes that have something to tell us. */
6534 #if (defined WINDOWSNT \
6535 || (defined USG && !defined GNU_LINUX \
6536 && !(defined HPUX && defined WNOHANG)))
6537 #if defined (USG) && ! defined (POSIX_SIGNALS)
6538 signal (signo
, sigchld_handler
);
6542 #endif /* USG, but not HPUX with WNOHANG */
6545 #endif /* SIGCHLD */
6549 exec_sentinel_unwind (data
)
6552 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6557 exec_sentinel_error_handler (error
)
6560 cmd_error_internal (error
, "error in process sentinel: ");
6562 update_echo_area ();
6563 Fsleep_for (make_number (2), Qnil
);
6568 exec_sentinel (proc
, reason
)
6569 Lisp_Object proc
, reason
;
6571 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6572 register struct Lisp_Process
*p
= XPROCESS (proc
);
6573 int count
= SPECPDL_INDEX ();
6574 int outer_running_asynch_code
= running_asynch_code
;
6575 int waiting
= waiting_for_user_input_p
;
6577 if (inhibit_sentinels
)
6580 /* No need to gcpro these, because all we do with them later
6581 is test them for EQness, and none of them should be a string. */
6582 odeactivate
= Vdeactivate_mark
;
6583 XSETBUFFER (obuffer
, current_buffer
);
6584 okeymap
= current_buffer
->keymap
;
6586 sentinel
= p
->sentinel
;
6587 if (NILP (sentinel
))
6590 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6591 assure that it gets restored no matter how the sentinel exits. */
6593 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6594 /* Inhibit quit so that random quits don't screw up a running filter. */
6595 specbind (Qinhibit_quit
, Qt
);
6596 specbind (Qlast_nonmenu_event
, Qt
);
6598 /* In case we get recursively called,
6599 and we already saved the match data nonrecursively,
6600 save the same match data in safely recursive fashion. */
6601 if (outer_running_asynch_code
)
6604 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6605 restore_search_regs ();
6606 record_unwind_save_match_data ();
6607 Fset_match_data (tem
, Qt
);
6610 /* For speed, if a search happens within this code,
6611 save the match data in a special nonrecursive fashion. */
6612 running_asynch_code
= 1;
6614 internal_condition_case_1 (read_process_output_call
,
6616 Fcons (proc
, Fcons (reason
, Qnil
))),
6617 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6618 exec_sentinel_error_handler
);
6620 /* If we saved the match data nonrecursively, restore it now. */
6621 restore_search_regs ();
6622 running_asynch_code
= outer_running_asynch_code
;
6624 Vdeactivate_mark
= odeactivate
;
6626 /* Restore waiting_for_user_input_p as it was
6627 when we were called, in case the filter clobbered it. */
6628 waiting_for_user_input_p
= waiting
;
6631 if (! EQ (Fcurrent_buffer (), obuffer
)
6632 || ! EQ (current_buffer
->keymap
, okeymap
))
6634 /* But do it only if the caller is actually going to read events.
6635 Otherwise there's no need to make him wake up, and it could
6636 cause trouble (for example it would make sit_for return). */
6637 if (waiting_for_user_input_p
== -1)
6638 record_asynch_buffer_change ();
6640 unbind_to (count
, Qnil
);
6643 /* Report all recent events of a change in process status
6644 (either run the sentinel or output a message).
6645 This is usually done while Emacs is waiting for keyboard input
6646 but can be done at other times. */
6649 status_notify (deleting_process
)
6650 struct Lisp_Process
*deleting_process
;
6652 register Lisp_Object proc
, buffer
;
6653 Lisp_Object tail
, msg
;
6654 struct gcpro gcpro1
, gcpro2
;
6658 /* We need to gcpro tail; if read_process_output calls a filter
6659 which deletes a process and removes the cons to which tail points
6660 from Vprocess_alist, and then causes a GC, tail is an unprotected
6664 /* Set this now, so that if new processes are created by sentinels
6665 that we run, we get called again to handle their status changes. */
6666 update_tick
= process_tick
;
6668 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6671 register struct Lisp_Process
*p
;
6673 proc
= Fcdr (Fcar (tail
));
6674 p
= XPROCESS (proc
);
6676 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6678 XSETINT (p
->update_tick
, XINT (p
->tick
));
6680 /* If process is still active, read any output that remains. */
6681 while (! EQ (p
->filter
, Qt
)
6682 && ! EQ (p
->status
, Qconnect
)
6683 && ! EQ (p
->status
, Qlisten
)
6684 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6685 && XINT (p
->infd
) >= 0
6686 && p
!= deleting_process
6687 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6691 /* Get the text to use for the message. */
6692 if (p
->raw_status_new
)
6694 msg
= status_message (p
);
6696 /* If process is terminated, deactivate it or delete it. */
6698 if (CONSP (p
->status
))
6699 symbol
= XCAR (p
->status
);
6701 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6702 || EQ (symbol
, Qclosed
))
6704 if (delete_exited_processes
)
6705 remove_process (proc
);
6707 deactivate_process (proc
);
6710 /* The actions above may have further incremented p->tick.
6711 So set p->update_tick again
6712 so that an error in the sentinel will not cause
6713 this code to be run again. */
6714 XSETINT (p
->update_tick
, XINT (p
->tick
));
6715 /* Now output the message suitably. */
6716 if (!NILP (p
->sentinel
))
6717 exec_sentinel (proc
, msg
);
6718 /* Don't bother with a message in the buffer
6719 when a process becomes runnable. */
6720 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6722 Lisp_Object ro
, tem
;
6723 struct buffer
*old
= current_buffer
;
6724 int opoint
, opoint_byte
;
6725 int before
, before_byte
;
6727 ro
= XBUFFER (buffer
)->read_only
;
6729 /* Avoid error if buffer is deleted
6730 (probably that's why the process is dead, too) */
6731 if (NILP (XBUFFER (buffer
)->name
))
6733 Fset_buffer (buffer
);
6736 opoint_byte
= PT_BYTE
;
6737 /* Insert new output into buffer
6738 at the current end-of-output marker,
6739 thus preserving logical ordering of input and output. */
6740 if (XMARKER (p
->mark
)->buffer
)
6741 Fgoto_char (p
->mark
);
6743 SET_PT_BOTH (ZV
, ZV_BYTE
);
6746 before_byte
= PT_BYTE
;
6748 tem
= current_buffer
->read_only
;
6749 current_buffer
->read_only
= Qnil
;
6750 insert_string ("\nProcess ");
6751 Finsert (1, &p
->name
);
6752 insert_string (" ");
6754 current_buffer
->read_only
= tem
;
6755 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6757 if (opoint
>= before
)
6758 SET_PT_BOTH (opoint
+ (PT
- before
),
6759 opoint_byte
+ (PT_BYTE
- before_byte
));
6761 SET_PT_BOTH (opoint
, opoint_byte
);
6763 set_buffer_internal (old
);
6768 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6769 redisplay_preserve_echo_area (13);
6775 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6776 Sset_process_coding_system
, 1, 3, 0,
6777 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6778 DECODING will be used to decode subprocess output and ENCODING to
6779 encode subprocess input. */)
6780 (process
, decoding
, encoding
)
6781 register Lisp_Object process
, decoding
, encoding
;
6783 register struct Lisp_Process
*p
;
6785 CHECK_PROCESS (process
);
6786 p
= XPROCESS (process
);
6787 if (XINT (p
->infd
) < 0)
6788 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6789 if (XINT (p
->outfd
) < 0)
6790 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6791 Fcheck_coding_system (decoding
);
6792 Fcheck_coding_system (encoding
);
6794 p
->decode_coding_system
= decoding
;
6795 p
->encode_coding_system
= encoding
;
6796 setup_process_coding_systems (process
);
6801 DEFUN ("process-coding-system",
6802 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6803 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6805 register Lisp_Object process
;
6807 CHECK_PROCESS (process
);
6808 return Fcons (XPROCESS (process
)->decode_coding_system
,
6809 XPROCESS (process
)->encode_coding_system
);
6812 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6813 Sset_process_filter_multibyte
, 2, 2, 0,
6814 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6815 If FLAG is non-nil, the filter is given multibyte strings.
6816 If FLAG is nil, the filter is given unibyte strings. In this case,
6817 all character code conversion except for end-of-line conversion is
6820 Lisp_Object process
, flag
;
6822 register struct Lisp_Process
*p
;
6824 CHECK_PROCESS (process
);
6825 p
= XPROCESS (process
);
6826 p
->filter_multibyte
= flag
;
6827 setup_process_coding_systems (process
);
6832 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6833 Sprocess_filter_multibyte_p
, 1, 1, 0,
6834 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6836 Lisp_Object process
;
6838 register struct Lisp_Process
*p
;
6840 CHECK_PROCESS (process
);
6841 p
= XPROCESS (process
);
6843 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6848 /* The first time this is called, assume keyboard input comes from DESC
6849 instead of from where we used to expect it.
6850 Subsequent calls mean assume input keyboard can come from DESC
6851 in addition to other places. */
6853 static int add_keyboard_wait_descriptor_called_flag
;
6856 add_keyboard_wait_descriptor (desc
)
6859 if (! add_keyboard_wait_descriptor_called_flag
)
6860 FD_CLR (0, &input_wait_mask
);
6861 add_keyboard_wait_descriptor_called_flag
= 1;
6862 FD_SET (desc
, &input_wait_mask
);
6863 FD_SET (desc
, &non_process_wait_mask
);
6864 if (desc
> max_keyboard_desc
)
6865 max_keyboard_desc
= desc
;
6868 /* From now on, do not expect DESC to give keyboard input. */
6871 delete_keyboard_wait_descriptor (desc
)
6875 int lim
= max_keyboard_desc
;
6877 FD_CLR (desc
, &input_wait_mask
);
6878 FD_CLR (desc
, &non_process_wait_mask
);
6880 if (desc
== max_keyboard_desc
)
6881 for (fd
= 0; fd
< lim
; fd
++)
6882 if (FD_ISSET (fd
, &input_wait_mask
)
6883 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6884 max_keyboard_desc
= fd
;
6887 /* Return nonzero if *MASK has a bit set
6888 that corresponds to one of the keyboard input descriptors. */
6891 keyboard_bit_set (mask
)
6896 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6897 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6898 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6909 inhibit_sentinels
= 0;
6913 if (! noninteractive
|| initialized
)
6915 signal (SIGCHLD
, sigchld_handler
);
6918 FD_ZERO (&input_wait_mask
);
6919 FD_ZERO (&non_keyboard_wait_mask
);
6920 FD_ZERO (&non_process_wait_mask
);
6921 max_process_desc
= 0;
6923 #ifdef NON_BLOCKING_CONNECT
6924 FD_ZERO (&connect_wait_mask
);
6925 num_pending_connects
= 0;
6928 #ifdef ADAPTIVE_READ_BUFFERING
6929 process_output_delay_count
= 0;
6930 process_output_skip
= 0;
6933 FD_SET (0, &input_wait_mask
);
6935 Vprocess_alist
= Qnil
;
6937 deleted_pid_list
= Qnil
;
6939 for (i
= 0; i
< MAXDESC
; i
++)
6941 chan_process
[i
] = Qnil
;
6942 proc_buffered_char
[i
] = -1;
6944 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6945 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6946 #ifdef DATAGRAM_SOCKETS
6947 bzero (datagram_address
, sizeof datagram_address
);
6952 Lisp_Object subfeatures
= Qnil
;
6953 struct socket_options
*sopt
;
6955 #define ADD_SUBFEATURE(key, val) \
6956 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6958 #ifdef NON_BLOCKING_CONNECT
6959 ADD_SUBFEATURE (QCnowait
, Qt
);
6961 #ifdef DATAGRAM_SOCKETS
6962 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6964 #ifdef HAVE_LOCAL_SOCKETS
6965 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6967 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6969 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6971 #ifdef HAVE_GETSOCKNAME
6972 ADD_SUBFEATURE (QCservice
, Qt
);
6974 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6975 ADD_SUBFEATURE (QCserver
, Qt
);
6978 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6979 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6981 Fprovide (intern ("make-network-process"), subfeatures
);
6983 #endif /* HAVE_SOCKETS */
6985 #if defined (DARWIN) || defined (MAC_OSX)
6986 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6987 processes. As such, we only change the default value. */
6990 char *release
= get_operating_system_release();
6991 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6992 && release
[1] == '.')) {
6993 Vprocess_connection_type
= Qnil
;
7002 Qprocessp
= intern ("processp");
7003 staticpro (&Qprocessp
);
7004 Qrun
= intern ("run");
7006 Qstop
= intern ("stop");
7009 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7012 Qexit = intern ("exit");
7013 staticpro (&Qexit); */
7015 Qopen
= intern ("open");
7017 Qclosed
= intern ("closed");
7018 staticpro (&Qclosed
);
7019 Qconnect
= intern ("connect");
7020 staticpro (&Qconnect
);
7021 Qfailed
= intern ("failed");
7022 staticpro (&Qfailed
);
7023 Qlisten
= intern ("listen");
7024 staticpro (&Qlisten
);
7025 Qlocal
= intern ("local");
7026 staticpro (&Qlocal
);
7027 Qipv4
= intern ("ipv4");
7030 Qipv6
= intern ("ipv6");
7033 Qdatagram
= intern ("datagram");
7034 staticpro (&Qdatagram
);
7036 QCname
= intern (":name");
7037 staticpro (&QCname
);
7038 QCbuffer
= intern (":buffer");
7039 staticpro (&QCbuffer
);
7040 QChost
= intern (":host");
7041 staticpro (&QChost
);
7042 QCservice
= intern (":service");
7043 staticpro (&QCservice
);
7044 QCtype
= intern (":type");
7045 staticpro (&QCtype
);
7046 QClocal
= intern (":local");
7047 staticpro (&QClocal
);
7048 QCremote
= intern (":remote");
7049 staticpro (&QCremote
);
7050 QCcoding
= intern (":coding");
7051 staticpro (&QCcoding
);
7052 QCserver
= intern (":server");
7053 staticpro (&QCserver
);
7054 QCnowait
= intern (":nowait");
7055 staticpro (&QCnowait
);
7056 QCsentinel
= intern (":sentinel");
7057 staticpro (&QCsentinel
);
7058 QClog
= intern (":log");
7060 QCnoquery
= intern (":noquery");
7061 staticpro (&QCnoquery
);
7062 QCstop
= intern (":stop");
7063 staticpro (&QCstop
);
7064 QCoptions
= intern (":options");
7065 staticpro (&QCoptions
);
7066 QCplist
= intern (":plist");
7067 staticpro (&QCplist
);
7068 QCfilter_multibyte
= intern (":filter-multibyte");
7069 staticpro (&QCfilter_multibyte
);
7071 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
7072 staticpro (&Qlast_nonmenu_event
);
7074 staticpro (&Vprocess_alist
);
7076 staticpro (&deleted_pid_list
);
7079 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7080 doc
: /* *Non-nil means delete processes immediately when they exit.
7081 A value of nil means don't delete them until `list-processes' is run. */);
7083 delete_exited_processes
= 1;
7085 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7086 doc
: /* Control type of device used to communicate with subprocesses.
7087 Values are nil to use a pipe, or t or `pty' to use a pty.
7088 The value has no effect if the system has no ptys or if all ptys are busy:
7089 then a pipe is used in any case.
7090 The value takes effect when `start-process' is called. */);
7091 Vprocess_connection_type
= Qt
;
7093 #ifdef ADAPTIVE_READ_BUFFERING
7094 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7095 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7096 On some systems, when Emacs reads the output from a subprocess, the output data
7097 is read in very small blocks, potentially resulting in very poor performance.
7098 This behavior can be remedied to some extent by setting this variable to a
7099 non-nil value, as it will automatically delay reading from such processes, to
7100 allow them to produce more output before Emacs tries to read it.
7101 If the value is t, the delay is reset after each write to the process; any other
7102 non-nil value means that the delay is not reset on write.
7103 The variable takes effect when `start-process' is called. */);
7104 Vprocess_adaptive_read_buffering
= Qt
;
7107 defsubr (&Sprocessp
);
7108 defsubr (&Sget_process
);
7109 defsubr (&Sget_buffer_process
);
7110 defsubr (&Sdelete_process
);
7111 defsubr (&Sprocess_status
);
7112 defsubr (&Sprocess_exit_status
);
7113 defsubr (&Sprocess_id
);
7114 defsubr (&Sprocess_name
);
7115 defsubr (&Sprocess_tty_name
);
7116 defsubr (&Sprocess_command
);
7117 defsubr (&Sset_process_buffer
);
7118 defsubr (&Sprocess_buffer
);
7119 defsubr (&Sprocess_mark
);
7120 defsubr (&Sset_process_filter
);
7121 defsubr (&Sprocess_filter
);
7122 defsubr (&Sset_process_sentinel
);
7123 defsubr (&Sprocess_sentinel
);
7124 defsubr (&Sset_process_window_size
);
7125 defsubr (&Sset_process_inherit_coding_system_flag
);
7126 defsubr (&Sprocess_inherit_coding_system_flag
);
7127 defsubr (&Sset_process_query_on_exit_flag
);
7128 defsubr (&Sprocess_query_on_exit_flag
);
7129 defsubr (&Sprocess_contact
);
7130 defsubr (&Sprocess_plist
);
7131 defsubr (&Sset_process_plist
);
7132 defsubr (&Slist_processes
);
7133 defsubr (&Sprocess_list
);
7134 defsubr (&Sstart_process
);
7136 defsubr (&Sset_network_process_option
);
7137 defsubr (&Smake_network_process
);
7138 defsubr (&Sformat_network_address
);
7139 #endif /* HAVE_SOCKETS */
7140 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7142 defsubr (&Snetwork_interface_list
);
7144 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7145 defsubr (&Snetwork_interface_info
);
7147 #endif /* HAVE_SOCKETS ... */
7148 #ifdef DATAGRAM_SOCKETS
7149 defsubr (&Sprocess_datagram_address
);
7150 defsubr (&Sset_process_datagram_address
);
7152 defsubr (&Saccept_process_output
);
7153 defsubr (&Sprocess_send_region
);
7154 defsubr (&Sprocess_send_string
);
7155 defsubr (&Sinterrupt_process
);
7156 defsubr (&Skill_process
);
7157 defsubr (&Squit_process
);
7158 defsubr (&Sstop_process
);
7159 defsubr (&Scontinue_process
);
7160 defsubr (&Sprocess_running_child_p
);
7161 defsubr (&Sprocess_send_eof
);
7162 defsubr (&Ssignal_process
);
7163 defsubr (&Swaiting_for_user_input_p
);
7164 /* defsubr (&Sprocess_connection); */
7165 defsubr (&Sset_process_coding_system
);
7166 defsubr (&Sprocess_coding_system
);
7167 defsubr (&Sset_process_filter_multibyte
);
7168 defsubr (&Sprocess_filter_multibyte_p
);
7172 #else /* not subprocesses */
7174 #include <sys/types.h>
7178 #include "systime.h"
7179 #include "charset.h"
7181 #include "termopts.h"
7182 #include "sysselect.h"
7184 extern int frame_garbaged
;
7186 extern EMACS_TIME
timer_check ();
7187 extern int timers_run
;
7191 /* As described above, except assuming that there are no subprocesses:
7193 Wait for timeout to elapse and/or keyboard input to be available.
7196 timeout in seconds, or
7197 zero for no limit, or
7198 -1 means gobble data immediately available but don't wait for any.
7200 read_kbd is a Lisp_Object:
7201 0 to ignore keyboard input, or
7202 1 to return when input is available, or
7203 -1 means caller will actually read the input, so don't throw to
7206 see full version for other parameters. We know that wait_proc will
7207 always be NULL, since `subprocesses' isn't defined.
7209 do_display != 0 means redisplay should be done to show subprocess
7210 output that arrives.
7212 Return true iff we received input from any process. */
7215 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7216 wait_for_cell
, wait_proc
, just_wait_proc
)
7217 int time_limit
, microsecs
, read_kbd
, do_display
;
7218 Lisp_Object wait_for_cell
;
7219 struct Lisp_Process
*wait_proc
;
7223 EMACS_TIME end_time
, timeout
;
7224 SELECT_TYPE waitchannels
;
7227 /* What does time_limit really mean? */
7228 if (time_limit
|| microsecs
)
7230 EMACS_GET_TIME (end_time
);
7231 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7232 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7235 /* Turn off periodic alarms (in case they are in use)
7236 and then turn off any other atimers,
7237 because the select emulator uses alarms. */
7239 turn_on_atimers (0);
7243 int timeout_reduced_for_timers
= 0;
7245 /* If calling from keyboard input, do not quit
7246 since we want to return C-g as an input character.
7247 Otherwise, do pending quit if requested. */
7251 /* Exit now if the cell we're waiting for became non-nil. */
7252 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7255 /* Compute time from now till when time limit is up */
7256 /* Exit if already run out */
7257 if (time_limit
== -1)
7259 /* -1 specified for timeout means
7260 gobble output available now
7261 but don't wait at all. */
7263 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7265 else if (time_limit
|| microsecs
)
7267 EMACS_GET_TIME (timeout
);
7268 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7269 if (EMACS_TIME_NEG_P (timeout
))
7274 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7277 /* If our caller will not immediately handle keyboard events,
7278 run timer events directly.
7279 (Callers that will immediately read keyboard events
7280 call timer_delay on their own.) */
7281 if (NILP (wait_for_cell
))
7283 EMACS_TIME timer_delay
;
7287 int old_timers_run
= timers_run
;
7288 timer_delay
= timer_check (1);
7289 if (timers_run
!= old_timers_run
&& do_display
)
7290 /* We must retry, since a timer may have requeued itself
7291 and that could alter the time delay. */
7292 redisplay_preserve_echo_area (14);
7296 while (!detect_input_pending ());
7298 /* If there is unread keyboard input, also return. */
7300 && requeued_events_pending_p ())
7303 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7305 EMACS_TIME difference
;
7306 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7307 if (EMACS_TIME_NEG_P (difference
))
7309 timeout
= timer_delay
;
7310 timeout_reduced_for_timers
= 1;
7315 /* Cause C-g and alarm signals to take immediate action,
7316 and cause input available signals to zero out timeout. */
7318 set_waiting_for_input (&timeout
);
7320 /* Wait till there is something to do. */
7322 if (! read_kbd
&& NILP (wait_for_cell
))
7323 FD_ZERO (&waitchannels
);
7325 FD_SET (0, &waitchannels
);
7327 /* If a frame has been newly mapped and needs updating,
7328 reprocess its display stuff. */
7329 if (frame_garbaged
&& do_display
)
7331 clear_waiting_for_input ();
7332 redisplay_preserve_echo_area (15);
7334 set_waiting_for_input (&timeout
);
7337 if (read_kbd
&& detect_input_pending ())
7340 FD_ZERO (&waitchannels
);
7343 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7348 /* Make C-g and alarm signals set flags again */
7349 clear_waiting_for_input ();
7351 /* If we woke up due to SIGWINCH, actually change size now. */
7352 do_pending_window_change (0);
7354 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7355 /* We waited the full specified time, so return now. */
7360 /* If the system call was interrupted, then go around the
7362 if (xerrno
== EINTR
)
7363 FD_ZERO (&waitchannels
);
7365 error ("select error: %s", emacs_strerror (xerrno
));
7368 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7369 /* System sometimes fails to deliver SIGIO. */
7370 kill (getpid (), SIGIO
);
7373 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7374 kill (getpid (), SIGIO
);
7377 /* Check for keyboard input */
7380 && detect_input_pending_run_timers (do_display
))
7382 swallow_events (do_display
);
7383 if (detect_input_pending_run_timers (do_display
))
7387 /* If there is unread keyboard input, also return. */
7389 && requeued_events_pending_p ())
7392 /* If wait_for_cell. check for keyboard input
7393 but don't run any timers.
7394 ??? (It seems wrong to me to check for keyboard
7395 input at all when wait_for_cell, but the code
7396 has been this way since July 1994.
7397 Try changing this after version 19.31.) */
7398 if (! NILP (wait_for_cell
)
7399 && detect_input_pending ())
7401 swallow_events (do_display
);
7402 if (detect_input_pending ())
7406 /* Exit now if the cell we're waiting for became non-nil. */
7407 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7417 /* Don't confuse make-docfile by having two doc strings for this function.
7418 make-docfile does not pay attention to #if, for good reason! */
7419 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7422 register Lisp_Object name
;
7427 /* Don't confuse make-docfile by having two doc strings for this function.
7428 make-docfile does not pay attention to #if, for good reason! */
7429 DEFUN ("process-inherit-coding-system-flag",
7430 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7434 register Lisp_Object process
;
7436 /* Ignore the argument and return the value of
7437 inherit-process-coding-system. */
7438 return inherit_process_coding_system
? Qt
: Qnil
;
7441 /* Kill all processes associated with `buffer'.
7442 If `buffer' is nil, kill all processes.
7443 Since we have no subprocesses, this does nothing. */
7446 kill_buffer_processes (buffer
)
7459 QCtype
= intern (":type");
7460 staticpro (&QCtype
);
7462 defsubr (&Sget_buffer_process
);
7463 defsubr (&Sprocess_inherit_coding_system_flag
);
7467 #endif /* not subprocesses */
7469 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7470 (do not change this comment) */