1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
3 2001, 2002, 2003 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
26 /* This file is split into two parts by the following preprocessor
27 conditional. The 'then' clause contains all of the support for
28 asynchronous subprocesses. The 'else' clause contains stub
29 versions of some of the asynchronous subprocess routines that are
30 often called elsewhere in Emacs, so we don't have to #ifdef the
31 sections that call them. */
39 #include <sys/types.h> /* some typedefs are used in sys/file.h */
46 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
49 #endif /* not WINDOWSNT */
51 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
52 #include <sys/socket.h>
54 #include <netinet/in.h>
55 #include <arpa/inet.h>
56 #ifdef NEED_NET_ERRNO_H
57 #include <net/errno.h>
58 #endif /* NEED_NET_ERRNO_H */
60 /* Are local (unix) sockets supported? */
61 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
62 #if !defined (AF_LOCAL) && defined (AF_UNIX)
63 #define AF_LOCAL AF_UNIX
66 #define HAVE_LOCAL_SOCKETS
70 #endif /* HAVE_SOCKETS */
72 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
77 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
78 #ifdef HAVE_BROKEN_INET_ADDR
79 #define IN_ADDR struct in_addr
80 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
82 #define IN_ADDR unsigned long
83 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
86 #if defined(BSD_SYSTEM) || defined(STRIDE)
87 #include <sys/ioctl.h>
88 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
90 #endif /* HAVE_PTYS and no O_NDELAY */
91 #endif /* BSD_SYSTEM || STRIDE */
93 #ifdef BROKEN_O_NONBLOCK
95 #endif /* BROKEN_O_NONBLOCK */
101 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
103 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
104 /* sys/ioctl.h may have been included already */
106 #include <sys/ioctl.h>
113 #include <sys/sysmacros.h> /* for "minor" */
114 #endif /* not IRIS */
117 #include <sys/wait.h>
129 #include "termhooks.h"
130 #include "termopts.h"
131 #include "commands.h"
132 #include "keyboard.h"
134 #include "blockinput.h"
135 #include "dispextern.h"
136 #include "composite.h"
139 Lisp_Object Qprocessp
;
140 Lisp_Object Qrun
, Qstop
, Qsignal
;
141 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
142 Lisp_Object Qlocal
, Qdatagram
;
143 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
144 Lisp_Object QClocal
, QCremote
, QCcoding
;
145 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
146 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
147 Lisp_Object QCfilter_multibyte
;
148 Lisp_Object Qlast_nonmenu_event
;
149 /* QCfamily is declared and initialized in xfaces.c,
150 QCfilter in keyboard.c. */
151 extern Lisp_Object QCfamily
, QCfilter
;
153 /* Qexit is declared and initialized in eval.c. */
155 /* QCfamily is defined in xfaces.c. */
156 extern Lisp_Object QCfamily
;
157 /* QCfilter is defined in keyboard.c. */
158 extern Lisp_Object QCfilter
;
160 /* a process object is a network connection when its childp field is neither
161 Qt nor Qnil but is instead a property list (KEY VAL ...). */
164 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
165 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
167 #define NETCONN_P(p) 0
168 #define NETCONN1_P(p) 0
169 #endif /* HAVE_SOCKETS */
171 /* Define first descriptor number available for subprocesses. */
173 #define FIRST_PROC_DESC 1
175 #define FIRST_PROC_DESC 3
178 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
181 #if !defined (SIGCHLD) && defined (SIGCLD)
182 #define SIGCHLD SIGCLD
185 #include "syssignal.h"
189 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
195 extern char *sys_errlist
[];
202 /* t means use pty, nil means use a pipe,
203 maybe other values to come. */
204 static Lisp_Object Vprocess_connection_type
;
208 #include <sys/socket.h>
212 /* These next two vars are non-static since sysdep.c uses them in the
213 emulation of `select'. */
214 /* Number of events of change of status of a process. */
216 /* Number of events for which the user or sentinel has been notified. */
219 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
221 #ifdef BROKEN_NON_BLOCKING_CONNECT
222 #undef NON_BLOCKING_CONNECT
224 #ifndef NON_BLOCKING_CONNECT
227 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
228 #if defined (O_NONBLOCK) || defined (O_NDELAY)
229 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
230 #define NON_BLOCKING_CONNECT
231 #endif /* EWOULDBLOCK || EINPROGRESS */
232 #endif /* O_NONBLOCK || O_NDELAY */
233 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
234 #endif /* HAVE_SELECT */
235 #endif /* HAVE_SOCKETS */
236 #endif /* NON_BLOCKING_CONNECT */
237 #endif /* BROKEN_NON_BLOCKING_CONNECT */
239 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
240 this system. We need to read full packets, so we need a
241 "non-destructive" select. So we require either native select,
242 or emulation of select using FIONREAD. */
244 #ifdef BROKEN_DATAGRAM_SOCKETS
245 #undef DATAGRAM_SOCKETS
247 #ifndef DATAGRAM_SOCKETS
249 #if defined (HAVE_SELECT) || defined (FIONREAD)
250 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
251 #define DATAGRAM_SOCKETS
252 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
253 #endif /* HAVE_SELECT || FIONREAD */
254 #endif /* HAVE_SOCKETS */
255 #endif /* DATAGRAM_SOCKETS */
256 #endif /* BROKEN_DATAGRAM_SOCKETS */
259 #undef NON_BLOCKING_CONNECT
260 #undef DATAGRAM_SOCKETS
264 #include "sysselect.h"
266 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
268 /* If we support a window system, turn on the code to poll periodically
269 to detect C-g. It isn't actually used when doing interrupt input. */
270 #ifdef HAVE_WINDOW_SYSTEM
271 #define POLL_FOR_INPUT
274 /* Mask of bits indicating the descriptors that we wait for input on. */
276 static SELECT_TYPE input_wait_mask
;
278 /* Mask that excludes keyboard input descriptor (s). */
280 static SELECT_TYPE non_keyboard_wait_mask
;
282 /* Mask that excludes process input descriptor (s). */
284 static SELECT_TYPE non_process_wait_mask
;
286 /* Mask of bits indicating the descriptors that we wait for connect to
287 complete on. Once they complete, they are removed from this mask
288 and added to the input_wait_mask and non_keyboard_wait_mask. */
290 static SELECT_TYPE connect_wait_mask
;
292 /* Number of bits set in connect_wait_mask. */
293 static int num_pending_connects
;
295 /* The largest descriptor currently in use for a process object. */
296 static int max_process_desc
;
298 /* The largest descriptor currently in use for keyboard input. */
299 static int max_keyboard_desc
;
301 /* Nonzero means delete a process right away if it exits. */
302 static int delete_exited_processes
;
304 /* Indexed by descriptor, gives the process (if any) for that descriptor */
305 Lisp_Object chan_process
[MAXDESC
];
307 /* Alist of elements (NAME . PROCESS) */
308 Lisp_Object Vprocess_alist
;
310 /* Buffered-ahead input char from process, indexed by channel.
311 -1 means empty (no char is buffered).
312 Used on sys V where the only way to tell if there is any
313 output from the process is to read at least one char.
314 Always -1 on systems that support FIONREAD. */
316 /* Don't make static; need to access externally. */
317 int proc_buffered_char
[MAXDESC
];
319 /* Table of `struct coding-system' for each process. */
320 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
321 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
323 #ifdef DATAGRAM_SOCKETS
324 /* Table of `partner address' for datagram sockets. */
325 struct sockaddr_and_len
{
328 } datagram_address
[MAXDESC
];
329 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
330 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
332 #define DATAGRAM_CHAN_P(chan) (0)
333 #define DATAGRAM_CONN_P(proc) (0)
336 static Lisp_Object
get_process ();
337 static void exec_sentinel ();
339 extern EMACS_TIME
timer_check ();
340 extern int timers_run
;
342 /* Maximum number of bytes to send to a pty without an eof. */
343 static int pty_max_bytes
;
345 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
351 /* The file name of the pty opened by allocate_pty. */
353 static char pty_name
[24];
356 /* Compute the Lisp form of the process status, p->status, from
357 the numeric status that was returned by `wait'. */
359 Lisp_Object
status_convert ();
363 struct Lisp_Process
*p
;
365 union { int i
; WAITTYPE wt
; } u
;
366 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
367 p
->status
= status_convert (u
.wt
);
368 p
->raw_status_low
= Qnil
;
369 p
->raw_status_high
= Qnil
;
372 /* Convert a process status word in Unix format to
373 the list that we use internally. */
380 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
381 else if (WIFEXITED (w
))
382 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
383 WCOREDUMP (w
) ? Qt
: Qnil
));
384 else if (WIFSIGNALED (w
))
385 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
386 WCOREDUMP (w
) ? Qt
: Qnil
));
391 /* Given a status-list, extract the three pieces of information
392 and store them individually through the three pointers. */
395 decode_status (l
, symbol
, code
, coredump
)
413 *code
= XFASTINT (XCAR (tem
));
415 *coredump
= !NILP (tem
);
419 /* Return a string describing a process status list. */
422 status_message (status
)
427 Lisp_Object string
, string2
;
429 decode_status (status
, &symbol
, &code
, &coredump
);
431 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
434 synchronize_system_messages_locale ();
435 signame
= strsignal (code
);
438 string
= build_string (signame
);
439 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
440 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
441 return concat2 (string
, string2
);
443 else if (EQ (symbol
, Qexit
))
446 return build_string ("finished\n");
447 string
= Fnumber_to_string (make_number (code
));
448 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
449 return concat3 (build_string ("exited abnormally with code "),
452 else if (EQ (symbol
, Qfailed
))
454 string
= Fnumber_to_string (make_number (code
));
455 string2
= build_string ("\n");
456 return concat3 (build_string ("failed with code "),
460 return Fcopy_sequence (Fsymbol_name (symbol
));
465 /* Open an available pty, returning a file descriptor.
466 Return -1 on failure.
467 The file name of the terminal corresponding to the pty
468 is left in the variable pty_name. */
479 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
480 for (i
= 0; i
< 16; i
++)
483 struct stat stb
; /* Used in some PTY_OPEN. */
484 #ifdef PTY_NAME_SPRINTF
487 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
488 #endif /* no PTY_NAME_SPRINTF */
492 #else /* no PTY_OPEN */
495 /* Unusual IRIS code */
496 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
499 if (fstat (fd
, &stb
) < 0)
501 # else /* not IRIS */
502 { /* Some systems name their pseudoterminals so that there are gaps in
503 the usual sequence - for example, on HP9000/S700 systems, there
504 are no pseudoterminals with names ending in 'f'. So we wait for
505 three failures in a row before deciding that we've reached the
507 int failed_count
= 0;
509 if (stat (pty_name
, &stb
) < 0)
512 if (failed_count
>= 3)
519 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
521 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
523 # endif /* not IRIS */
525 #endif /* no PTY_OPEN */
529 /* check to make certain that both sides are available
530 this avoids a nasty yet stupid bug in rlogins */
531 #ifdef PTY_TTY_NAME_SPRINTF
534 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
535 #endif /* no PTY_TTY_NAME_SPRINTF */
537 if (access (pty_name
, 6) != 0)
540 # if !defined(IRIS) && !defined(__sgi)
546 #endif /* not UNIPLUS */
553 #endif /* HAVE_PTYS */
559 register Lisp_Object val
, tem
, name1
;
560 register struct Lisp_Process
*p
;
564 p
= allocate_process ();
566 XSETINT (p
->infd
, -1);
567 XSETINT (p
->outfd
, -1);
568 XSETFASTINT (p
->pid
, 0);
569 XSETFASTINT (p
->tick
, 0);
570 XSETFASTINT (p
->update_tick
, 0);
571 p
->raw_status_low
= Qnil
;
572 p
->raw_status_high
= Qnil
;
574 p
->mark
= Fmake_marker ();
576 /* If name is already in use, modify it until it is unused. */
581 tem
= Fget_process (name1
);
582 if (NILP (tem
)) break;
583 sprintf (suffix
, "<%d>", i
);
584 name1
= concat2 (name
, build_string (suffix
));
588 XSETPROCESS (val
, p
);
589 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
594 remove_process (proc
)
595 register Lisp_Object proc
;
597 register Lisp_Object pair
;
599 pair
= Frassq (proc
, Vprocess_alist
);
600 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
602 deactivate_process (proc
);
605 /* Setup coding systems of PROCESS. */
608 setup_process_coding_systems (process
)
611 struct Lisp_Process
*p
= XPROCESS (process
);
612 int inch
= XINT (p
->infd
);
613 int outch
= XINT (p
->outfd
);
615 if (inch
< 0 || outch
< 0)
618 if (!proc_decode_coding_system
[inch
])
619 proc_decode_coding_system
[inch
]
620 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
621 setup_coding_system (p
->decode_coding_system
,
622 proc_decode_coding_system
[inch
]);
623 if (! NILP (p
->filter
))
625 if (NILP (p
->filter_multibyte
))
626 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
628 else if (BUFFERP (p
->buffer
))
630 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
631 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
634 if (!proc_encode_coding_system
[outch
])
635 proc_encode_coding_system
[outch
]
636 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
637 setup_coding_system (p
->encode_coding_system
,
638 proc_encode_coding_system
[outch
]);
641 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
642 doc
: /* Return t if OBJECT is a process. */)
646 return PROCESSP (object
) ? Qt
: Qnil
;
649 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
650 doc
: /* Return the process named NAME, or nil if there is none. */)
652 register Lisp_Object name
;
657 return Fcdr (Fassoc (name
, Vprocess_alist
));
660 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
661 doc
: /* Return the (or a) process associated with BUFFER.
662 BUFFER may be a buffer or the name of one. */)
664 register Lisp_Object buffer
;
666 register Lisp_Object buf
, tail
, proc
;
668 if (NILP (buffer
)) return Qnil
;
669 buf
= Fget_buffer (buffer
);
670 if (NILP (buf
)) return Qnil
;
672 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
674 proc
= Fcdr (Fcar (tail
));
675 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
681 /* This is how commands for the user decode process arguments. It
682 accepts a process, a process name, a buffer, a buffer name, or nil.
683 Buffers denote the first process in the buffer, and nil denotes the
688 register Lisp_Object name
;
690 register Lisp_Object proc
, obj
;
693 obj
= Fget_process (name
);
695 obj
= Fget_buffer (name
);
697 error ("Process %s does not exist", SDATA (name
));
699 else if (NILP (name
))
700 obj
= Fcurrent_buffer ();
704 /* Now obj should be either a buffer object or a process object.
708 proc
= Fget_buffer_process (obj
);
710 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
720 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
721 doc
: /* Delete PROCESS: kill it and forget about it immediately.
722 PROCESS may be a process, a buffer, the name of a process or buffer, or
723 nil, indicating the current buffer's process. */)
725 register Lisp_Object process
;
727 process
= get_process (process
);
728 XPROCESS (process
)->raw_status_low
= Qnil
;
729 XPROCESS (process
)->raw_status_high
= Qnil
;
730 if (NETCONN_P (process
))
732 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
733 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
735 else if (XINT (XPROCESS (process
)->infd
) >= 0)
737 Fkill_process (process
, Qnil
);
738 /* Do this now, since remove_process will make sigchld_handler do nothing. */
739 XPROCESS (process
)->status
740 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
741 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
744 remove_process (process
);
748 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
749 doc
: /* Return the status of PROCESS.
750 The returned value is one of the following symbols:
751 run -- for a process that is running.
752 stop -- for a process stopped but continuable.
753 exit -- for a process that has exited.
754 signal -- for a process that has got a fatal signal.
755 open -- for a network stream connection that is open.
756 listen -- for a network stream server that is listening.
757 closed -- for a network stream connection that is closed.
758 connect -- when waiting for a non-blocking connection to complete.
759 failed -- when a non-blocking connection has failed.
760 nil -- if arg is a process name and no such process exists.
761 PROCESS may be a process, a buffer, the name of a process, or
762 nil, indicating the current buffer's process. */)
764 register Lisp_Object process
;
766 register struct Lisp_Process
*p
;
767 register Lisp_Object status
;
769 if (STRINGP (process
))
770 process
= Fget_process (process
);
772 process
= get_process (process
);
777 p
= XPROCESS (process
);
778 if (!NILP (p
->raw_status_low
))
782 status
= XCAR (status
);
785 if (EQ (status
, Qexit
))
787 else if (EQ (p
->command
, Qt
))
789 else if (EQ (status
, Qrun
))
795 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
797 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
798 If PROCESS has not yet exited or died, return 0. */)
800 register Lisp_Object process
;
802 CHECK_PROCESS (process
);
803 if (!NILP (XPROCESS (process
)->raw_status_low
))
804 update_status (XPROCESS (process
));
805 if (CONSP (XPROCESS (process
)->status
))
806 return XCAR (XCDR (XPROCESS (process
)->status
));
807 return make_number (0);
810 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
811 doc
: /* Return the process id of PROCESS.
812 This is the pid of the Unix process which PROCESS uses or talks to.
813 For a network connection, this value is nil. */)
815 register Lisp_Object process
;
817 CHECK_PROCESS (process
);
818 return XPROCESS (process
)->pid
;
821 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
822 doc
: /* Return the name of PROCESS, as a string.
823 This is the name of the program invoked in PROCESS,
824 possibly modified to make it unique among process names. */)
826 register Lisp_Object process
;
828 CHECK_PROCESS (process
);
829 return XPROCESS (process
)->name
;
832 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
833 doc
: /* Return the command that was executed to start PROCESS.
834 This is a list of strings, the first string being the program executed
835 and the rest of the strings being the arguments given to it.
836 For a non-child channel, this is nil. */)
838 register Lisp_Object process
;
840 CHECK_PROCESS (process
);
841 return XPROCESS (process
)->command
;
844 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
845 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
846 This is the terminal that the process itself reads and writes on,
847 not the name of the pty that Emacs uses to talk with that terminal. */)
849 register Lisp_Object process
;
851 CHECK_PROCESS (process
);
852 return XPROCESS (process
)->tty_name
;
855 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
857 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
859 register Lisp_Object process
, buffer
;
861 struct Lisp_Process
*p
;
863 CHECK_PROCESS (process
);
865 CHECK_BUFFER (buffer
);
866 p
= XPROCESS (process
);
869 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
870 setup_process_coding_systems (process
);
874 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
876 doc
: /* Return the buffer PROCESS is associated with.
877 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
879 register Lisp_Object process
;
881 CHECK_PROCESS (process
);
882 return XPROCESS (process
)->buffer
;
885 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
887 doc
: /* Return the marker for the end of the last output from PROCESS. */)
889 register Lisp_Object process
;
891 CHECK_PROCESS (process
);
892 return XPROCESS (process
)->mark
;
895 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
897 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
898 t means stop accepting output from the process.
900 When a process has a filter, its buffer is not used for output.
901 Instead, each time it does output, the entire string of output is
902 passed to the filter.
904 The filter gets two arguments: the process and the string of output.
905 The string argument is normally a multibyte string, except:
906 - if the process' input coding system is no-conversion or raw-text,
907 it is a unibyte string (the non-converted input), or else
908 - if `default-enable-multibyte-characters' is nil, it is a unibyte
909 string (the result of converting the decoded input multibyte
910 string to unibyte with `string-make-unibyte'). */)
912 register Lisp_Object process
, filter
;
914 struct Lisp_Process
*p
;
916 CHECK_PROCESS (process
);
917 p
= XPROCESS (process
);
919 /* Don't signal an error if the process' input file descriptor
920 is closed. This could make debugging Lisp more difficult,
921 for example when doing something like
923 (setq process (start-process ...))
925 (set-process-filter process ...) */
927 if (XINT (p
->infd
) >= 0)
929 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
931 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
932 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
934 else if (EQ (p
->filter
, Qt
)
935 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
937 FD_SET (XINT (p
->infd
), &input_wait_mask
);
938 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
944 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
945 setup_process_coding_systems (process
);
949 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
951 doc
: /* Returns the filter function of PROCESS; nil if none.
952 See `set-process-filter' for more info on filter functions. */)
954 register Lisp_Object process
;
956 CHECK_PROCESS (process
);
957 return XPROCESS (process
)->filter
;
960 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
962 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
963 The sentinel is called as a function when the process changes state.
964 It gets two arguments: the process, and a string describing the change. */)
966 register Lisp_Object process
, sentinel
;
968 struct Lisp_Process
*p
;
970 CHECK_PROCESS (process
);
971 p
= XPROCESS (process
);
973 p
->sentinel
= sentinel
;
975 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
979 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
981 doc
: /* Return the sentinel of PROCESS; nil if none.
982 See `set-process-sentinel' for more info on sentinels. */)
984 register Lisp_Object process
;
986 CHECK_PROCESS (process
);
987 return XPROCESS (process
)->sentinel
;
990 DEFUN ("set-process-window-size", Fset_process_window_size
,
991 Sset_process_window_size
, 3, 3, 0,
992 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
993 (process
, height
, width
)
994 register Lisp_Object process
, height
, width
;
996 CHECK_PROCESS (process
);
997 CHECK_NATNUM (height
);
998 CHECK_NATNUM (width
);
1000 if (XINT (XPROCESS (process
)->infd
) < 0
1001 || set_window_size (XINT (XPROCESS (process
)->infd
),
1002 XINT (height
), XINT (width
)) <= 0)
1008 DEFUN ("set-process-inherit-coding-system-flag",
1009 Fset_process_inherit_coding_system_flag
,
1010 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1011 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1012 If the second argument FLAG is non-nil, then the variable
1013 `buffer-file-coding-system' of the buffer associated with PROCESS
1014 will be bound to the value of the coding system used to decode
1017 This is useful when the coding system specified for the process buffer
1018 leaves either the character code conversion or the end-of-line conversion
1019 unspecified, or if the coding system used to decode the process output
1020 is more appropriate for saving the process buffer.
1022 Binding the variable `inherit-process-coding-system' to non-nil before
1023 starting the process is an alternative way of setting the inherit flag
1024 for the process which will run. */)
1026 register Lisp_Object process
, flag
;
1028 CHECK_PROCESS (process
);
1029 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1033 DEFUN ("process-inherit-coding-system-flag",
1034 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1036 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1037 If this flag is t, `buffer-file-coding-system' of the buffer
1038 associated with PROCESS will inherit the coding system used to decode
1039 the process output. */)
1041 register Lisp_Object process
;
1043 CHECK_PROCESS (process
);
1044 return XPROCESS (process
)->inherit_coding_system_flag
;
1047 DEFUN ("set-process-query-on-exit-flag",
1048 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1050 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1051 If the second argument FLAG is non-nil, emacs will query the user before
1052 exiting if PROCESS is running. */)
1054 register Lisp_Object process
, flag
;
1056 CHECK_PROCESS (process
);
1057 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1061 DEFUN ("process-query-on-exit-flag",
1062 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1064 doc
: /* Return the current value of query on exit flag for PROCESS. */)
1066 register Lisp_Object process
;
1068 CHECK_PROCESS (process
);
1069 return Fnull (XPROCESS (process
)->kill_without_query
);
1072 #ifdef DATAGRAM_SOCKETS
1073 Lisp_Object
Fprocess_datagram_address ();
1076 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1078 doc
: /* Return the contact info of PROCESS; t for a real child.
1079 For a net connection, the value depends on the optional KEY arg.
1080 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1081 if KEY is t, the complete contact information for the connection is
1082 returned, else the specific value for the keyword KEY is returned.
1083 See `make-network-process' for a list of keywords. */)
1085 register Lisp_Object process
, key
;
1087 Lisp_Object contact
;
1089 CHECK_PROCESS (process
);
1090 contact
= XPROCESS (process
)->childp
;
1092 #ifdef DATAGRAM_SOCKETS
1093 if (DATAGRAM_CONN_P (process
)
1094 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1095 contact
= Fplist_put (contact
, QCremote
,
1096 Fprocess_datagram_address (process
));
1099 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1102 return Fcons (Fplist_get (contact
, QChost
),
1103 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1104 return Fplist_get (contact
, key
);
1107 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1109 doc
: /* Return the plist of PROCESS. */)
1111 register Lisp_Object process
;
1113 CHECK_PROCESS (process
);
1114 return XPROCESS (process
)->plist
;
1117 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1119 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1121 register Lisp_Object process
, plist
;
1123 CHECK_PROCESS (process
);
1126 XPROCESS (process
)->plist
= plist
;
1130 #if 0 /* Turned off because we don't currently record this info
1131 in the process. Perhaps add it. */
1132 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1133 doc
: /* Return the connection type of PROCESS.
1134 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1135 a socket connection. */)
1137 Lisp_Object process
;
1139 return XPROCESS (process
)->type
;
1144 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1146 doc
: /* Convert network ADDRESS from internal format to a string.
1147 If optional second argument OMIT-PORT is non-nil, don't include a port
1148 number in the string; in this case, interpret a 4 element vector as an
1149 IP address. Returns nil if format of ADDRESS is invalid. */)
1150 (address
, omit_port
)
1151 Lisp_Object address
, omit_port
;
1156 if (STRINGP (address
)) /* AF_LOCAL */
1159 if (VECTORP (address
)) /* AF_INET */
1161 register struct Lisp_Vector
*p
= XVECTOR (address
);
1162 Lisp_Object args
[6];
1165 if (!NILP (omit_port
) && (p
->size
== 4 || p
->size
== 5))
1167 args
[0] = build_string ("%d.%d.%d.%d");
1170 else if (p
->size
== 5)
1172 args
[0] = build_string ("%d.%d.%d.%d:%d");
1178 for (i
= 0; i
< nargs
; i
++)
1179 args
[i
+1] = p
->contents
[i
];
1180 return Fformat (nargs
+1, args
);
1183 if (CONSP (address
))
1185 Lisp_Object args
[2];
1186 args
[0] = build_string ("<Family %d>");
1187 args
[1] = Fcar (address
);
1188 return Fformat (2, args
);
1197 list_processes_1 (query_only
)
1198 Lisp_Object query_only
;
1200 register Lisp_Object tail
, tem
;
1201 Lisp_Object proc
, minspace
, tem1
;
1202 register struct Lisp_Process
*p
;
1204 int w_proc
, w_buffer
, w_tty
;
1205 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1207 w_proc
= 4; /* Proc */
1208 w_buffer
= 6; /* Buffer */
1209 w_tty
= 0; /* Omit if no ttys */
1211 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1215 proc
= Fcdr (Fcar (tail
));
1216 p
= XPROCESS (proc
);
1217 if (NILP (p
->childp
))
1219 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1221 if (STRINGP (p
->name
)
1222 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1224 if (!NILP (p
->buffer
))
1226 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1227 w_buffer
= 8; /* (Killed) */
1228 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1231 if (STRINGP (p
->tty_name
)
1232 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1236 XSETFASTINT (i_status
, w_proc
+ 1);
1237 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1240 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1241 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1244 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1247 XSETFASTINT (minspace
, 1);
1249 set_buffer_internal (XBUFFER (Vstandard_output
));
1250 Fbuffer_disable_undo (Vstandard_output
);
1252 current_buffer
->truncate_lines
= Qt
;
1254 write_string ("Proc", -1);
1255 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1256 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1259 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1261 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1262 write_string ("\n", -1);
1264 write_string ("----", -1);
1265 Findent_to (i_status
, minspace
); write_string ("------", -1);
1266 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1269 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1271 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1272 write_string ("\n", -1);
1274 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1278 proc
= Fcdr (Fcar (tail
));
1279 p
= XPROCESS (proc
);
1280 if (NILP (p
->childp
))
1282 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1285 Finsert (1, &p
->name
);
1286 Findent_to (i_status
, minspace
);
1288 if (!NILP (p
->raw_status_low
))
1291 if (CONSP (p
->status
))
1292 symbol
= XCAR (p
->status
);
1295 if (EQ (symbol
, Qsignal
))
1298 tem
= Fcar (Fcdr (p
->status
));
1300 if (XINT (tem
) < NSIG
)
1301 write_string (sys_errlist
[XINT (tem
)], -1);
1304 Fprinc (symbol
, Qnil
);
1306 else if (NETCONN1_P (p
))
1308 if (EQ (symbol
, Qexit
))
1309 write_string ("closed", -1);
1310 else if (EQ (p
->command
, Qt
))
1311 write_string ("stopped", -1);
1312 else if (EQ (symbol
, Qrun
))
1313 write_string ("open", -1);
1315 Fprinc (symbol
, Qnil
);
1318 Fprinc (symbol
, Qnil
);
1320 if (EQ (symbol
, Qexit
))
1323 tem
= Fcar (Fcdr (p
->status
));
1326 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1327 write_string (tembuf
, -1);
1331 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1332 remove_process (proc
);
1334 Findent_to (i_buffer
, minspace
);
1335 if (NILP (p
->buffer
))
1336 insert_string ("(none)");
1337 else if (NILP (XBUFFER (p
->buffer
)->name
))
1338 insert_string ("(Killed)");
1340 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1344 Findent_to (i_tty
, minspace
);
1345 if (STRINGP (p
->tty_name
))
1346 Finsert (1, &p
->tty_name
);
1349 Findent_to (i_command
, minspace
);
1351 if (EQ (p
->status
, Qlisten
))
1353 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1354 if (INTEGERP (port
))
1355 port
= Fnumber_to_string (port
);
1357 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1358 sprintf (tembuf
, "(network %s server on %s)\n",
1359 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1360 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1361 insert_string (tembuf
);
1363 else if (NETCONN1_P (p
))
1365 /* For a local socket, there is no host name,
1366 so display service instead. */
1367 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1368 if (!STRINGP (host
))
1370 host
= Fplist_get (p
->childp
, QCservice
);
1371 if (INTEGERP (host
))
1372 host
= Fnumber_to_string (host
);
1375 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1376 sprintf (tembuf
, "(network %s connection to %s)\n",
1377 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1378 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1379 insert_string (tembuf
);
1391 insert_string (" ");
1393 insert_string ("\n");
1399 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1400 doc
: /* Display a list of all processes.
1401 If optional argument QUERY-ONLY is non-nil, only processes with
1402 the query-on-exit flag set will be listed.
1403 Any process listed as exited or signaled is actually eliminated
1404 after the listing is made. */)
1406 Lisp_Object query_only
;
1408 internal_with_output_to_temp_buffer ("*Process List*",
1409 list_processes_1
, query_only
);
1413 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1414 doc
: /* Return a list of all processes. */)
1417 return Fmapcar (Qcdr
, Vprocess_alist
);
1420 /* Starting asynchronous inferior processes. */
1422 static Lisp_Object
start_process_unwind ();
1424 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1425 doc
: /* Start a program in a subprocess. Return the process object for it.
1426 NAME is name for process. It is modified if necessary to make it unique.
1427 BUFFER is the buffer or (buffer-name) to associate with the process.
1428 Process output goes at end of that buffer, unless you specify
1429 an output stream or filter function to handle the output.
1430 BUFFER may be also nil, meaning that this process is not associated
1432 Third arg is program file name. It is searched for in PATH.
1433 Remaining arguments are strings to give program as arguments.
1435 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1438 register Lisp_Object
*args
;
1440 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1442 register unsigned char *new_argv
;
1445 register unsigned char **new_argv
;
1448 int count
= SPECPDL_INDEX ();
1452 buffer
= Fget_buffer_create (buffer
);
1454 /* Make sure that the child will be able to chdir to the current
1455 buffer's current directory, or its unhandled equivalent. We
1456 can't just have the child check for an error when it does the
1457 chdir, since it's in a vfork.
1459 We have to GCPRO around this because Fexpand_file_name and
1460 Funhandled_file_name_directory might call a file name handling
1461 function. The argument list is protected by the caller, so all
1462 we really have to worry about is buffer. */
1464 struct gcpro gcpro1
, gcpro2
;
1466 current_dir
= current_buffer
->directory
;
1468 GCPRO2 (buffer
, current_dir
);
1471 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1473 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1474 report_file_error ("Setting current directory",
1475 Fcons (current_buffer
->directory
, Qnil
));
1481 CHECK_STRING (name
);
1485 CHECK_STRING (program
);
1487 proc
= make_process (name
);
1488 /* If an error occurs and we can't start the process, we want to
1489 remove it from the process list. This means that each error
1490 check in create_process doesn't need to call remove_process
1491 itself; it's all taken care of here. */
1492 record_unwind_protect (start_process_unwind
, proc
);
1494 XPROCESS (proc
)->childp
= Qt
;
1495 XPROCESS (proc
)->plist
= Qnil
;
1496 XPROCESS (proc
)->command_channel_p
= Qnil
;
1497 XPROCESS (proc
)->buffer
= buffer
;
1498 XPROCESS (proc
)->sentinel
= Qnil
;
1499 XPROCESS (proc
)->filter
= Qnil
;
1500 XPROCESS (proc
)->filter_multibyte
1501 = buffer_defaults
.enable_multibyte_characters
;
1502 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1504 /* Make the process marker point into the process buffer (if any). */
1506 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1507 BUF_ZV (XBUFFER (buffer
)),
1508 BUF_ZV_BYTE (XBUFFER (buffer
)));
1511 /* Decide coding systems for communicating with the process. Here
1512 we don't setup the structure coding_system nor pay attention to
1513 unibyte mode. They are done in create_process. */
1515 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1516 Lisp_Object coding_systems
= Qt
;
1517 Lisp_Object val
, *args2
;
1518 struct gcpro gcpro1
, gcpro2
;
1520 val
= Vcoding_system_for_read
;
1523 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1524 args2
[0] = Qstart_process
;
1525 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1526 GCPRO2 (proc
, current_dir
);
1527 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1529 if (CONSP (coding_systems
))
1530 val
= XCAR (coding_systems
);
1531 else if (CONSP (Vdefault_process_coding_system
))
1532 val
= XCAR (Vdefault_process_coding_system
);
1534 XPROCESS (proc
)->decode_coding_system
= val
;
1536 val
= Vcoding_system_for_write
;
1539 if (EQ (coding_systems
, Qt
))
1541 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1542 args2
[0] = Qstart_process
;
1543 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1544 GCPRO2 (proc
, current_dir
);
1545 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1548 if (CONSP (coding_systems
))
1549 val
= XCDR (coding_systems
);
1550 else if (CONSP (Vdefault_process_coding_system
))
1551 val
= XCDR (Vdefault_process_coding_system
);
1553 XPROCESS (proc
)->encode_coding_system
= val
;
1557 /* Make a one member argv with all args concatenated
1558 together separated by a blank. */
1559 len
= SBYTES (program
) + 2;
1560 for (i
= 3; i
< nargs
; i
++)
1564 len
+= SBYTES (tem
) + 1; /* count the blank */
1566 new_argv
= (unsigned char *) alloca (len
);
1567 strcpy (new_argv
, SDATA (program
));
1568 for (i
= 3; i
< nargs
; i
++)
1572 strcat (new_argv
, " ");
1573 strcat (new_argv
, SDATA (tem
));
1575 /* Need to add code here to check for program existence on VMS */
1578 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1580 /* If program file name is not absolute, search our path for it.
1581 Put the name we will really use in TEM. */
1582 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1583 && !(SCHARS (program
) > 1
1584 && IS_DEVICE_SEP (SREF (program
, 1))))
1586 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1589 GCPRO4 (name
, program
, buffer
, current_dir
);
1590 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1593 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1594 tem
= Fexpand_file_name (tem
, Qnil
);
1598 if (!NILP (Ffile_directory_p (program
)))
1599 error ("Specified program for new process is a directory");
1603 /* If program file name starts with /: for quoting a magic name,
1605 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1606 && SREF (tem
, 1) == ':')
1607 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1609 /* Encode the file name and put it in NEW_ARGV.
1610 That's where the child will use it to execute the program. */
1611 tem
= ENCODE_FILE (tem
);
1612 new_argv
[0] = SDATA (tem
);
1614 /* Here we encode arguments by the coding system used for sending
1615 data to the process. We don't support using different coding
1616 systems for encoding arguments and for encoding data sent to the
1619 for (i
= 3; i
< nargs
; i
++)
1623 if (STRING_MULTIBYTE (tem
))
1624 tem
= (code_convert_string_norecord
1625 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1626 new_argv
[i
- 2] = SDATA (tem
);
1628 new_argv
[i
- 2] = 0;
1629 #endif /* not VMS */
1631 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1632 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1633 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1634 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1636 XPROCESS (proc
)->inherit_coding_system_flag
1637 = (NILP (buffer
) || !inherit_process_coding_system
1640 create_process (proc
, (char **) new_argv
, current_dir
);
1642 return unbind_to (count
, proc
);
1645 /* This function is the unwind_protect form for Fstart_process. If
1646 PROC doesn't have its pid set, then we know someone has signaled
1647 an error and the process wasn't started successfully, so we should
1648 remove it from the process list. */
1650 start_process_unwind (proc
)
1653 if (!PROCESSP (proc
))
1656 /* Was PROC started successfully? */
1657 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1658 remove_process (proc
);
1664 create_process_1 (timer
)
1665 struct atimer
*timer
;
1667 /* Nothing to do. */
1671 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1674 /* Mimic blocking of signals on system V, which doesn't really have it. */
1676 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1677 int sigchld_deferred
;
1680 create_process_sigchld ()
1682 signal (SIGCHLD
, create_process_sigchld
);
1684 sigchld_deferred
= 1;
1690 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1692 create_process (process
, new_argv
, current_dir
)
1693 Lisp_Object process
;
1695 Lisp_Object current_dir
;
1697 int pid
, inchannel
, outchannel
;
1699 #ifdef POSIX_SIGNALS
1702 struct sigaction sigint_action
;
1703 struct sigaction sigquit_action
;
1705 struct sigaction sighup_action
;
1707 #else /* !POSIX_SIGNALS */
1710 SIGTYPE (*sigchld
)();
1713 #endif /* !POSIX_SIGNALS */
1714 /* Use volatile to protect variables from being clobbered by longjmp. */
1715 volatile int forkin
, forkout
;
1716 volatile int pty_flag
= 0;
1718 extern char **environ
;
1721 inchannel
= outchannel
= -1;
1724 if (!NILP (Vprocess_connection_type
))
1725 outchannel
= inchannel
= allocate_pty ();
1729 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1730 /* On most USG systems it does not work to open the pty's tty here,
1731 then close it and reopen it in the child. */
1733 /* Don't let this terminal become our controlling terminal
1734 (in case we don't have one). */
1735 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1737 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1740 report_file_error ("Opening pty", Qnil
);
1742 forkin
= forkout
= -1;
1743 #endif /* not USG, or USG_SUBTTY_WORKS */
1747 #endif /* HAVE_PTYS */
1750 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1751 report_file_error ("Opening socketpair", Qnil
);
1752 outchannel
= inchannel
= sv
[0];
1753 forkout
= forkin
= sv
[1];
1755 #else /* not SKTPAIR */
1760 report_file_error ("Creating pipe", Qnil
);
1766 emacs_close (inchannel
);
1767 emacs_close (forkout
);
1768 report_file_error ("Creating pipe", Qnil
);
1773 #endif /* not SKTPAIR */
1776 /* Replaced by close_process_descs */
1777 set_exclusive_use (inchannel
);
1778 set_exclusive_use (outchannel
);
1781 /* Stride people say it's a mystery why this is needed
1782 as well as the O_NDELAY, but that it fails without this. */
1783 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1786 ioctl (inchannel
, FIONBIO
, &one
);
1791 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1792 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1795 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1796 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1800 /* Record this as an active process, with its channels.
1801 As a result, child_setup will close Emacs's side of the pipes. */
1802 chan_process
[inchannel
] = process
;
1803 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1804 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1806 /* Previously we recorded the tty descriptor used in the subprocess.
1807 It was only used for getting the foreground tty process, so now
1808 we just reopen the device (see emacs_get_tty_pgrp) as this is
1809 more portable (see USG_SUBTTY_WORKS above). */
1811 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1812 XPROCESS (process
)->status
= Qrun
;
1813 setup_process_coding_systems (process
);
1815 /* Delay interrupts until we have a chance to store
1816 the new fork's pid in its process structure */
1817 #ifdef POSIX_SIGNALS
1818 sigemptyset (&blocked
);
1820 sigaddset (&blocked
, SIGCHLD
);
1822 #ifdef HAVE_WORKING_VFORK
1823 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1824 this sets the parent's signal handlers as well as the child's.
1825 So delay all interrupts whose handlers the child might munge,
1826 and record the current handlers so they can be restored later. */
1827 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1828 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1830 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1832 #endif /* HAVE_WORKING_VFORK */
1833 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1834 #else /* !POSIX_SIGNALS */
1838 #else /* not BSD4_1 */
1839 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1840 sigsetmask (sigmask (SIGCHLD
));
1841 #else /* ordinary USG */
1843 sigchld_deferred
= 0;
1844 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1846 #endif /* ordinary USG */
1847 #endif /* not BSD4_1 */
1848 #endif /* SIGCHLD */
1849 #endif /* !POSIX_SIGNALS */
1851 FD_SET (inchannel
, &input_wait_mask
);
1852 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1853 if (inchannel
> max_process_desc
)
1854 max_process_desc
= inchannel
;
1856 /* Until we store the proper pid, enable sigchld_handler
1857 to recognize an unknown pid as standing for this process.
1858 It is very important not to let this `marker' value stay
1859 in the table after this function has returned; if it does
1860 it might cause call-process to hang and subsequent asynchronous
1861 processes to get their return values scrambled. */
1862 XSETINT (XPROCESS (process
)->pid
, -1);
1867 /* child_setup must clobber environ on systems with true vfork.
1868 Protect it from permanent change. */
1869 char **save_environ
= environ
;
1871 current_dir
= ENCODE_FILE (current_dir
);
1876 #endif /* not WINDOWSNT */
1878 int xforkin
= forkin
;
1879 int xforkout
= forkout
;
1881 #if 0 /* This was probably a mistake--it duplicates code later on,
1882 but fails to handle all the cases. */
1883 /* Make sure SIGCHLD is not blocked in the child. */
1884 sigsetmask (SIGEMPTYMASK
);
1887 /* Make the pty be the controlling terminal of the process. */
1889 /* First, disconnect its current controlling terminal. */
1891 /* We tried doing setsid only if pty_flag, but it caused
1892 process_set_signal to fail on SGI when using a pipe. */
1894 /* Make the pty's terminal the controlling terminal. */
1898 /* We ignore the return value
1899 because faith@cs.unc.edu says that is necessary on Linux. */
1900 ioctl (xforkin
, TIOCSCTTY
, 0);
1903 #else /* not HAVE_SETSID */
1905 /* It's very important to call setpgrp here and no time
1906 afterwards. Otherwise, we lose our controlling tty which
1907 is set when we open the pty. */
1910 #endif /* not HAVE_SETSID */
1911 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1912 if (pty_flag
&& xforkin
>= 0)
1915 tcgetattr (xforkin
, &t
);
1917 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1918 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1921 #if defined (NTTYDISC) && defined (TIOCSETD)
1922 if (pty_flag
&& xforkin
>= 0)
1924 /* Use new line discipline. */
1925 int ldisc
= NTTYDISC
;
1926 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1931 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1932 can do TIOCSPGRP only to the process's controlling tty. */
1935 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1936 I can't test it since I don't have 4.3. */
1937 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1938 ioctl (j
, TIOCNOTTY
, 0);
1941 /* In order to get a controlling terminal on some versions
1942 of BSD, it is necessary to put the process in pgrp 0
1943 before it opens the terminal. */
1951 #endif /* TIOCNOTTY */
1953 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1954 /*** There is a suggestion that this ought to be a
1955 conditional on TIOCSPGRP,
1956 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1957 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1958 that system does seem to need this code, even though
1959 both HAVE_SETSID and TIOCSCTTY are defined. */
1960 /* Now close the pty (if we had it open) and reopen it.
1961 This makes the pty the controlling terminal of the subprocess. */
1964 #ifdef SET_CHILD_PTY_PGRP
1965 int pgrp
= getpid ();
1968 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1971 emacs_close (xforkin
);
1972 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1976 emacs_write (1, "Couldn't open the pty terminal ", 31);
1977 emacs_write (1, pty_name
, strlen (pty_name
));
1978 emacs_write (1, "\n", 1);
1982 #ifdef SET_CHILD_PTY_PGRP
1983 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1984 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1987 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1989 #ifdef SETUP_SLAVE_PTY
1994 #endif /* SETUP_SLAVE_PTY */
1996 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1997 Now reenable it in the child, so it will die when we want it to. */
1999 signal (SIGHUP
, SIG_DFL
);
2001 #endif /* HAVE_PTYS */
2003 signal (SIGINT
, SIG_DFL
);
2004 signal (SIGQUIT
, SIG_DFL
);
2006 /* Stop blocking signals in the child. */
2007 #ifdef POSIX_SIGNALS
2008 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2009 #else /* !POSIX_SIGNALS */
2013 #else /* not BSD4_1 */
2014 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2015 sigsetmask (SIGEMPTYMASK
);
2016 #else /* ordinary USG */
2018 signal (SIGCHLD
, sigchld
);
2020 #endif /* ordinary USG */
2021 #endif /* not BSD4_1 */
2022 #endif /* SIGCHLD */
2023 #endif /* !POSIX_SIGNALS */
2026 child_setup_tty (xforkout
);
2028 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2029 new_argv
, 1, current_dir
);
2030 #else /* not WINDOWSNT */
2031 child_setup (xforkin
, xforkout
, xforkout
,
2032 new_argv
, 1, current_dir
);
2033 #endif /* not WINDOWSNT */
2035 environ
= save_environ
;
2040 /* This runs in the Emacs process. */
2044 emacs_close (forkin
);
2045 if (forkin
!= forkout
&& forkout
>= 0)
2046 emacs_close (forkout
);
2050 /* vfork succeeded. */
2051 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
2054 register_child (pid
, inchannel
);
2055 #endif /* WINDOWSNT */
2057 /* If the subfork execv fails, and it exits,
2058 this close hangs. I don't know why.
2059 So have an interrupt jar it loose. */
2061 struct atimer
*timer
;
2065 EMACS_SET_SECS_USECS (offset
, 1, 0);
2066 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2069 emacs_close (forkin
);
2071 cancel_atimer (timer
);
2075 if (forkin
!= forkout
&& forkout
>= 0)
2076 emacs_close (forkout
);
2080 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2083 XPROCESS (process
)->tty_name
= Qnil
;
2086 /* Restore the signal state whether vfork succeeded or not.
2087 (We will signal an error, below, if it failed.) */
2088 #ifdef POSIX_SIGNALS
2089 #ifdef HAVE_WORKING_VFORK
2090 /* Restore the parent's signal handlers. */
2091 sigaction (SIGINT
, &sigint_action
, 0);
2092 sigaction (SIGQUIT
, &sigquit_action
, 0);
2094 sigaction (SIGHUP
, &sighup_action
, 0);
2096 #endif /* HAVE_WORKING_VFORK */
2097 /* Stop blocking signals in the parent. */
2098 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2099 #else /* !POSIX_SIGNALS */
2103 #else /* not BSD4_1 */
2104 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2105 sigsetmask (SIGEMPTYMASK
);
2106 #else /* ordinary USG */
2108 signal (SIGCHLD
, sigchld
);
2109 /* Now really handle any of these signals
2110 that came in during this function. */
2111 if (sigchld_deferred
)
2112 kill (getpid (), SIGCHLD
);
2114 #endif /* ordinary USG */
2115 #endif /* not BSD4_1 */
2116 #endif /* SIGCHLD */
2117 #endif /* !POSIX_SIGNALS */
2119 /* Now generate the error if vfork failed. */
2121 report_file_error ("Doing vfork", Qnil
);
2123 #endif /* not VMS */
2128 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2129 The address family of sa is not included in the result. */
2132 conv_sockaddr_to_lisp (sa
, len
)
2133 struct sockaddr
*sa
;
2136 Lisp_Object address
;
2139 register struct Lisp_Vector
*p
;
2141 switch (sa
->sa_family
)
2145 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2146 len
= sizeof (sin
->sin_addr
) + 1;
2147 address
= Fmake_vector (make_number (len
), Qnil
);
2148 p
= XVECTOR (address
);
2149 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2150 cp
= (unsigned char *)&sin
->sin_addr
;
2153 #ifdef HAVE_LOCAL_SOCKETS
2156 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2157 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2158 if (sockun
->sun_path
[i
] == 0)
2160 return make_unibyte_string (sockun
->sun_path
, i
);
2164 len
-= sizeof (sa
->sa_family
);
2165 address
= Fcons (make_number (sa
->sa_family
),
2166 Fmake_vector (make_number (len
), Qnil
));
2167 p
= XVECTOR (XCDR (address
));
2168 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2174 p
->contents
[i
++] = make_number (*cp
++);
2180 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2183 get_lisp_to_sockaddr_size (address
, familyp
)
2184 Lisp_Object address
;
2187 register struct Lisp_Vector
*p
;
2189 if (VECTORP (address
))
2191 p
= XVECTOR (address
);
2195 return sizeof (struct sockaddr_in
);
2198 #ifdef HAVE_LOCAL_SOCKETS
2199 else if (STRINGP (address
))
2201 *familyp
= AF_LOCAL
;
2202 return sizeof (struct sockaddr_un
);
2205 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2207 struct sockaddr
*sa
;
2208 *familyp
= XINT (XCAR (address
));
2209 p
= XVECTOR (XCDR (address
));
2210 return p
->size
+ sizeof (sa
->sa_family
);
2215 /* Convert an address object (vector or string) to an internal sockaddr.
2216 Format of address has already been validated by size_lisp_to_sockaddr. */
2219 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2221 Lisp_Object address
;
2222 struct sockaddr
*sa
;
2225 register struct Lisp_Vector
*p
;
2226 register unsigned char *cp
= NULL
;
2230 sa
->sa_family
= family
;
2232 if (VECTORP (address
))
2234 p
= XVECTOR (address
);
2235 if (family
== AF_INET
)
2237 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2238 len
= sizeof (sin
->sin_addr
) + 1;
2239 i
= XINT (p
->contents
[--len
]);
2240 sin
->sin_port
= htons (i
);
2241 cp
= (unsigned char *)&sin
->sin_addr
;
2244 else if (STRINGP (address
))
2246 #ifdef HAVE_LOCAL_SOCKETS
2247 if (family
== AF_LOCAL
)
2249 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2250 cp
= SDATA (address
);
2251 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2252 sockun
->sun_path
[i
] = *cp
++;
2259 p
= XVECTOR (XCDR (address
));
2260 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2263 for (i
= 0; i
< len
; i
++)
2264 if (INTEGERP (p
->contents
[i
]))
2265 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2268 #ifdef DATAGRAM_SOCKETS
2269 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2271 doc
: /* Get the current datagram address associated with PROCESS. */)
2273 Lisp_Object process
;
2277 CHECK_PROCESS (process
);
2279 if (!DATAGRAM_CONN_P (process
))
2282 channel
= XINT (XPROCESS (process
)->infd
);
2283 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2284 datagram_address
[channel
].len
);
2287 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2289 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2290 Returns nil upon error setting address, ADDRESS otherwise. */)
2292 Lisp_Object process
, address
;
2297 CHECK_PROCESS (process
);
2299 if (!DATAGRAM_CONN_P (process
))
2302 channel
= XINT (XPROCESS (process
)->infd
);
2304 len
= get_lisp_to_sockaddr_size (address
, &family
);
2305 if (datagram_address
[channel
].len
!= len
)
2307 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2313 static struct socket_options
{
2314 /* The name of this option. Should be lowercase version of option
2315 name without SO_ prefix. */
2317 /* Option level SOL_... */
2319 /* Option number SO_... */
2321 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_STR
, SOPT_LINGER
} opttype
;
2322 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2323 } socket_options
[] =
2325 #ifdef SO_BINDTODEVICE
2326 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_STR
, OPIX_MISC
},
2329 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2332 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2335 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2338 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2341 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2344 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2347 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2349 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2352 /* Set option OPT to value VAL on socket S.
2354 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2355 Signals an error if setting a known option fails.
2359 set_socket_option (s
, opt
, val
)
2361 Lisp_Object opt
, val
;
2364 struct socket_options
*sopt
;
2369 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2370 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2371 if (strcmp (name
, sopt
->name
) == 0)
2374 switch (sopt
->opttype
)
2379 optval
= NILP (val
) ? 0 : 1;
2380 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2381 &optval
, sizeof (optval
));
2389 optval
= XINT (val
);
2391 error ("Bad option value for %s", name
);
2392 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2393 &optval
, sizeof (optval
));
2403 else if (STRINGP (val
))
2404 arg
= (char *) SDATA (val
);
2405 else if (XSYMBOL (val
))
2406 arg
= (char *) SDATA (SYMBOL_NAME (val
));
2408 error ("Bad option value for %s", name
);
2409 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2416 struct linger linger
;
2419 linger
.l_linger
= 0;
2421 linger
.l_linger
= XINT (val
);
2423 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2424 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2425 &linger
, sizeof (linger
));
2435 report_file_error ("Cannot set network option",
2436 Fcons (opt
, Fcons (val
, Qnil
)));
2437 return (1 << sopt
->optbit
);
2441 DEFUN ("set-network-process-option",
2442 Fset_network_process_option
, Sset_network_process_option
,
2444 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2445 See `make-network-process' for a list of options and values.
2446 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2447 OPTION is not a supported option, return nil instead; otherwise return t. */)
2448 (process
, option
, value
, no_error
)
2449 Lisp_Object process
, option
, value
;
2450 Lisp_Object no_error
;
2454 CHECK_PROCESS (process
);
2456 s
= XINT (XPROCESS (process
)->infd
);
2458 error ("Process is not running");
2460 if (set_socket_option (s
, option
, value
))
2463 if (NILP (no_error
))
2464 error ("Unknown or unsupported option");
2470 /* A version of request_sigio suitable for a record_unwind_protect. */
2473 unwind_request_sigio (dummy
)
2476 if (interrupt_input
)
2481 /* Create a network stream/datagram client/server process. Treated
2482 exactly like a normal process when reading and writing. Primary
2483 differences are in status display and process deletion. A network
2484 connection has no PID; you cannot signal it. All you can do is
2485 stop/continue it and deactivate/close it via delete-process */
2487 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2489 doc
: /* Create and return a network server or client process.
2491 In Emacs, network connections are represented by process objects, so
2492 input and output work as for subprocesses and `delete-process' closes
2493 a network connection. However, a network process has no process id,
2494 it cannot be signalled, and the status codes are different from normal
2497 Arguments are specified as keyword/argument pairs. The following
2498 arguments are defined:
2500 :name NAME -- NAME is name for process. It is modified if necessary
2503 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2504 with the process. Process output goes at end of that buffer, unless
2505 you specify an output stream or filter function to handle the output.
2506 BUFFER may be also nil, meaning that this process is not associated
2509 :host HOST -- HOST is name of the host to connect to, or its IP
2510 address. The symbol `local' specifies the local host. If specified
2511 for a server process, it must be a valid name or address for the local
2512 host, and only clients connecting to that address will be accepted.
2514 :service SERVICE -- SERVICE is name of the service desired, or an
2515 integer specifying a port number to connect to. If SERVICE is t,
2516 a random port number is selected for the server.
2518 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2519 stream type connection, `datagram' creates a datagram type connection.
2521 :family FAMILY -- FAMILY is the address (and protocol) family for the
2522 service specified by HOST and SERVICE. The default address family is
2523 Inet (or IPv4) for the host and port number specified by HOST and
2524 SERVICE. Other address families supported are:
2525 local -- for a local (i.e. UNIX) address specified by SERVICE.
2527 :local ADDRESS -- ADDRESS is the local address used for the connection.
2528 This parameter is ignored when opening a client process. When specified
2529 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2531 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2532 connection. This parameter is ignored when opening a stream server
2533 process. For a datagram server process, it specifies the initial
2534 setting of the remote datagram address. When specified for a client
2535 process, the FAMILY, HOST, and SERVICE args are ignored.
2537 The format of ADDRESS depends on the address family:
2538 - An IPv4 address is represented as an vector of integers [A B C D P]
2539 corresponding to numeric IP address A.B.C.D and port number P.
2540 - A local address is represented as a string with the address in the
2541 local address space.
2542 - An "unsupported family" address is represented by a cons (F . AV)
2543 where F is the family number and AV is a vector containing the socket
2544 address data with one element per address data byte. Do not rely on
2545 this format in portable code, as it may depend on implementation
2546 defined constants, data sizes, and data structure alignment.
2548 :coding CODING -- If CODING is a symbol, it specifies the coding
2549 system used for both reading and writing for this process. If CODING
2550 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2551 ENCODING is used for writing.
2553 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2554 return without waiting for the connection to complete; instead, the
2555 sentinel function will be called with second arg matching "open" (if
2556 successful) or "failed" when the connect completes. Default is to use
2557 a blocking connect (i.e. wait) for stream type connections.
2559 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2560 running when emacs is exited.
2562 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2563 In the stopped state, a server process does not accept new
2564 connections, and a client process does not handle incoming traffic.
2565 The stopped state is cleared by `continue-process' and set by
2568 :filter FILTER -- Install FILTER as the process filter.
2570 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2571 process filter are multibyte, otherwise they are unibyte.
2572 If this keyword is not specified, the strings are multibyte iff
2573 `default-enable-multibyte-characters' is non-nil.
2575 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2577 :log LOG -- Install LOG as the server process log function. This
2578 function is called when the server accepts a network connection from a
2579 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2580 is the server process, CLIENT is the new process for the connection,
2581 and MESSAGE is a string.
2583 :plist PLIST -- Install PLIST as the new process' initial plist.
2585 :server QLEN -- if QLEN is non-nil, create a server process for the
2586 specified FAMILY, SERVICE, and connection type (stream or datagram).
2587 If QLEN is an integer, it is used as the max. length of the server's
2588 pending connection queue (also known as the backlog); the default
2589 queue length is 5. Default is to create a client process.
2591 The following network options can be specified for this connection:
2593 :bindtodevice NAME -- bind to interface NAME.
2594 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2595 :dontroute BOOL -- Only send to directly connected hosts.
2596 :keepalive BOOL -- Send keep-alive messages on network stream.
2597 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2598 :oobinline BOOL -- Place out-of-band data in receive data stream.
2599 :priority INT -- Set protocol defined priority for sent packets.
2600 :reuseaddr BOOL -- Allow reusing a recently used local address
2601 (this is allowed by default for a server process).
2603 Consult the relevant system programmer's manual pages for more
2604 information on using these options.
2607 A server process will listen for and accept connections from clients.
2608 When a client connection is accepted, a new network process is created
2609 for the connection with the following parameters:
2611 - The client's process name is constructed by concatenating the server
2612 process' NAME and a client identification string.
2613 - If the FILTER argument is non-nil, the client process will not get a
2614 separate process buffer; otherwise, the client's process buffer is a newly
2615 created buffer named after the server process' BUFFER name or process
2616 NAME concatenated with the client identification string.
2617 - The connection type and the process filter and sentinel parameters are
2618 inherited from the server process' TYPE, FILTER and SENTINEL.
2619 - The client process' contact info is set according to the client's
2620 addressing information (typically an IP address and a port number).
2621 - The client process' plist is initialized from the server's plist.
2623 Notice that the FILTER and SENTINEL args are never used directly by
2624 the server process. Also, the BUFFER argument is not used directly by
2625 the server process, but via the optional :log function, accepted (and
2626 failed) connections may be logged in the server process' buffer.
2628 The original argument list, modified with the actual connection
2629 information, is available via the `process-contact' function.
2631 usage: (make-network-process &rest ARGS) */)
2637 Lisp_Object contact
;
2638 struct Lisp_Process
*p
;
2639 #ifdef HAVE_GETADDRINFO
2640 struct addrinfo ai
, *res
, *lres
;
2641 struct addrinfo hints
;
2642 char *portstring
, portbuf
[128];
2643 #else /* HAVE_GETADDRINFO */
2644 struct _emacs_addrinfo
2650 struct sockaddr
*ai_addr
;
2651 struct _emacs_addrinfo
*ai_next
;
2653 #endif /* HAVE_GETADDRINFO */
2654 struct sockaddr_in address_in
;
2655 #ifdef HAVE_LOCAL_SOCKETS
2656 struct sockaddr_un address_un
;
2661 int s
= -1, outch
, inch
;
2662 struct gcpro gcpro1
;
2664 int count
= SPECPDL_INDEX ();
2666 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2668 Lisp_Object name
, buffer
, host
, service
, address
;
2669 Lisp_Object filter
, sentinel
;
2670 int is_non_blocking_client
= 0;
2671 int is_server
= 0, backlog
= 5;
2678 /* Save arguments for process-contact and clone-process. */
2679 contact
= Flist (nargs
, args
);
2683 /* Ensure socket support is loaded if available. */
2684 init_winsock (TRUE
);
2687 /* :type TYPE (nil: stream, datagram */
2688 tem
= Fplist_get (contact
, QCtype
);
2690 socktype
= SOCK_STREAM
;
2691 #ifdef DATAGRAM_SOCKETS
2692 else if (EQ (tem
, Qdatagram
))
2693 socktype
= SOCK_DGRAM
;
2696 error ("Unsupported connection type");
2699 tem
= Fplist_get (contact
, QCserver
);
2702 /* Don't support network sockets when non-blocking mode is
2703 not available, since a blocked Emacs is not useful. */
2704 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2705 error ("Network servers not supported");
2709 backlog
= XINT (tem
);
2713 /* Make QCaddress an alias for :local (server) or :remote (client). */
2714 QCaddress
= is_server
? QClocal
: QCremote
;
2717 if (!is_server
&& socktype
== SOCK_STREAM
2718 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2720 #ifndef NON_BLOCKING_CONNECT
2721 error ("Non-blocking connect not supported");
2723 is_non_blocking_client
= 1;
2727 name
= Fplist_get (contact
, QCname
);
2728 buffer
= Fplist_get (contact
, QCbuffer
);
2729 filter
= Fplist_get (contact
, QCfilter
);
2730 sentinel
= Fplist_get (contact
, QCsentinel
);
2732 CHECK_STRING (name
);
2735 /* Let's handle TERM before things get complicated ... */
2736 host
= Fplist_get (contact
, QChost
);
2737 CHECK_STRING (host
);
2739 service
= Fplist_get (contact
, QCservice
);
2740 if (INTEGERP (service
))
2741 port
= htons ((unsigned short) XINT (service
));
2744 struct servent
*svc_info
;
2745 CHECK_STRING (service
);
2746 svc_info
= getservbyname (SDATA (service
), "tcp");
2748 error ("Unknown service: %s", SDATA (service
));
2749 port
= svc_info
->s_port
;
2752 s
= connect_server (0);
2754 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2755 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2756 send_command (s
, C_DUMB
, 1, 0);
2758 #else /* not TERM */
2760 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2761 ai
.ai_socktype
= socktype
;
2766 /* :local ADDRESS or :remote ADDRESS */
2767 address
= Fplist_get (contact
, QCaddress
);
2768 if (!NILP (address
))
2770 host
= service
= Qnil
;
2772 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2773 error ("Malformed :address");
2774 ai
.ai_family
= family
;
2775 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2776 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2780 /* :family FAMILY -- nil (for Inet), local, or integer. */
2781 tem
= Fplist_get (contact
, QCfamily
);
2783 family
= XINT (tem
);
2788 #ifdef HAVE_LOCAL_SOCKETS
2789 else if (EQ (tem
, Qlocal
))
2794 error ("Unknown address family");
2795 ai
.ai_family
= family
;
2797 /* :service SERVICE -- string, integer (port number), or t (random port). */
2798 service
= Fplist_get (contact
, QCservice
);
2800 #ifdef HAVE_LOCAL_SOCKETS
2801 if (family
== AF_LOCAL
)
2803 /* Host is not used. */
2805 CHECK_STRING (service
);
2806 bzero (&address_un
, sizeof address_un
);
2807 address_un
.sun_family
= AF_LOCAL
;
2808 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2809 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2810 ai
.ai_addrlen
= sizeof address_un
;
2815 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2816 host
= Fplist_get (contact
, QChost
);
2819 if (EQ (host
, Qlocal
))
2820 host
= build_string ("localhost");
2821 CHECK_STRING (host
);
2824 /* Slow down polling to every ten seconds.
2825 Some kernels have a bug which causes retrying connect to fail
2826 after a connect. Polling can interfere with gethostbyname too. */
2827 #ifdef POLL_FOR_INPUT
2828 if (socktype
== SOCK_STREAM
)
2830 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2831 bind_polling_period (10);
2835 #ifdef HAVE_GETADDRINFO
2836 /* If we have a host, use getaddrinfo to resolve both host and service.
2837 Otherwise, use getservbyname to lookup the service. */
2841 /* SERVICE can either be a string or int.
2842 Convert to a C string for later use by getaddrinfo. */
2843 if (EQ (service
, Qt
))
2845 else if (INTEGERP (service
))
2847 sprintf (portbuf
, "%ld", (long) XINT (service
));
2848 portstring
= portbuf
;
2852 CHECK_STRING (service
);
2853 portstring
= SDATA (service
);
2858 memset (&hints
, 0, sizeof (hints
));
2860 hints
.ai_family
= NILP (Fplist_member (contact
, QCfamily
)) ? AF_UNSPEC
: family
;
2861 hints
.ai_socktype
= socktype
;
2862 hints
.ai_protocol
= 0;
2863 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
2865 #ifdef HAVE_GAI_STRERROR
2866 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
2868 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
2874 #endif /* HAVE_GETADDRINFO */
2876 /* We end up here if getaddrinfo is not defined, or in case no hostname
2877 has been specified (e.g. for a local server process). */
2879 if (EQ (service
, Qt
))
2881 else if (INTEGERP (service
))
2882 port
= htons ((unsigned short) XINT (service
));
2885 struct servent
*svc_info
;
2886 CHECK_STRING (service
);
2887 svc_info
= getservbyname (SDATA (service
),
2888 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
2890 error ("Unknown service: %s", SDATA (service
));
2891 port
= svc_info
->s_port
;
2894 bzero (&address_in
, sizeof address_in
);
2895 address_in
.sin_family
= family
;
2896 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
2897 address_in
.sin_port
= port
;
2899 #ifndef HAVE_GETADDRINFO
2902 struct hostent
*host_info_ptr
;
2904 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2905 as it may `hang' emacs for a very long time. */
2908 host_info_ptr
= gethostbyname (SDATA (host
));
2913 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
2914 host_info_ptr
->h_length
);
2915 family
= host_info_ptr
->h_addrtype
;
2916 address_in
.sin_family
= family
;
2919 /* Attempt to interpret host as numeric inet address */
2921 IN_ADDR numeric_addr
;
2922 numeric_addr
= inet_addr ((char *) SDATA (host
));
2923 if (NUMERIC_ADDR_ERROR
)
2924 error ("Unknown host \"%s\"", SDATA (host
));
2926 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
2927 sizeof (address_in
.sin_addr
));
2931 #endif /* not HAVE_GETADDRINFO */
2933 ai
.ai_family
= family
;
2934 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
2935 ai
.ai_addrlen
= sizeof address_in
;
2939 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2940 when connect is interrupted. So let's not let it get interrupted.
2941 Note we do not turn off polling, because polling is only used
2942 when not interrupt_input, and thus not normally used on the systems
2943 which have this bug. On systems which use polling, there's no way
2944 to quit if polling is turned off. */
2946 && !is_server
&& socktype
== SOCK_STREAM
)
2948 /* Comment from KFS: The original open-network-stream code
2949 didn't unwind protect this, but it seems like the proper
2950 thing to do. In any case, I don't see how it could harm to
2951 do this -- and it makes cleanup (using unbind_to) easier. */
2952 record_unwind_protect (unwind_request_sigio
, Qnil
);
2956 /* Do this in case we never enter the for-loop below. */
2957 count1
= SPECPDL_INDEX ();
2960 for (lres
= res
; lres
; lres
= lres
->ai_next
)
2964 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
2971 #ifdef DATAGRAM_SOCKETS
2972 if (!is_server
&& socktype
== SOCK_DGRAM
)
2974 #endif /* DATAGRAM_SOCKETS */
2976 #ifdef NON_BLOCKING_CONNECT
2977 if (is_non_blocking_client
)
2980 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
2982 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
2994 /* Make us close S if quit. */
2995 record_unwind_protect (close_file_unwind
, make_number (s
));
2997 /* Parse network options in the arg list.
2998 We simply ignore anything which isn't a known option (including other keywords).
2999 An error is signalled if setting a known option fails. */
3000 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3001 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3005 /* Configure as a server socket. */
3007 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3008 explicit :reuseaddr key to override this. */
3009 #ifdef HAVE_LOCAL_SOCKETS
3010 if (family
!= AF_LOCAL
)
3012 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3015 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3016 report_file_error ("Cannot set reuse option on server socket.", Qnil
);
3019 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3020 report_file_error ("Cannot bind server socket", Qnil
);
3022 #ifdef HAVE_GETSOCKNAME
3023 if (EQ (service
, Qt
))
3025 struct sockaddr_in sa1
;
3026 int len1
= sizeof (sa1
);
3027 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3029 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3030 service
= make_number (ntohs (sa1
.sin_port
));
3031 contact
= Fplist_put (contact
, QCservice
, service
);
3036 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3037 report_file_error ("Cannot listen on server socket", Qnil
);
3047 /* This turns off all alarm-based interrupts; the
3048 bind_polling_period call above doesn't always turn all the
3049 short-interval ones off, especially if interrupt_input is
3052 It'd be nice to be able to control the connect timeout
3053 though. Would non-blocking connect calls be portable?
3055 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3057 turn_on_atimers (0);
3059 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3062 turn_on_atimers (1);
3064 if (ret
== 0 || xerrno
== EISCONN
)
3066 /* The unwind-protect will be discarded afterwards.
3067 Likewise for immediate_quit. */
3071 #ifdef NON_BLOCKING_CONNECT
3073 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3077 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3085 if (xerrno
== EINTR
)
3087 if (xerrno
== EADDRINUSE
&& retry
< 20)
3089 /* A delay here is needed on some FreeBSD systems,
3090 and it is harmless, since this retrying takes time anyway
3091 and should be infrequent. */
3092 Fsleep_for (make_number (1), Qnil
);
3097 /* Discard the unwind protect closing S. */
3098 specpdl_ptr
= specpdl
+ count1
;
3105 #ifdef DATAGRAM_SOCKETS
3106 if (socktype
== SOCK_DGRAM
)
3108 if (datagram_address
[s
].sa
)
3110 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3111 datagram_address
[s
].len
= lres
->ai_addrlen
;
3115 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3116 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3119 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3120 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3121 conv_lisp_to_sockaddr (rfamily
, remote
,
3122 datagram_address
[s
].sa
, rlen
);
3126 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3129 contact
= Fplist_put (contact
, QCaddress
,
3130 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3131 #ifdef HAVE_GETSOCKNAME
3134 struct sockaddr_in sa1
;
3135 int len1
= sizeof (sa1
);
3136 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3137 contact
= Fplist_put (contact
, QClocal
,
3138 conv_sockaddr_to_lisp (&sa1
, len1
));
3143 #ifdef HAVE_GETADDRINFO
3150 /* Discard the unwind protect for closing S, if any. */
3151 specpdl_ptr
= specpdl
+ count1
;
3153 /* Unwind bind_polling_period and request_sigio. */
3154 unbind_to (count
, Qnil
);
3158 /* If non-blocking got this far - and failed - assume non-blocking is
3159 not supported after all. This is probably a wrong assumption, but
3160 the normal blocking calls to open-network-stream handles this error
3162 if (is_non_blocking_client
)
3167 report_file_error ("make server process failed", contact
);
3169 report_file_error ("make client process failed", contact
);
3172 #endif /* not TERM */
3178 buffer
= Fget_buffer_create (buffer
);
3179 proc
= make_process (name
);
3181 chan_process
[inch
] = proc
;
3184 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3187 fcntl (inch
, F_SETFL
, O_NDELAY
);
3191 p
= XPROCESS (proc
);
3193 p
->childp
= contact
;
3194 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3197 p
->sentinel
= sentinel
;
3199 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3200 /* Override the above only if :filter-multibyte is specified. */
3201 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3202 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3203 p
->log
= Fplist_get (contact
, QClog
);
3204 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3205 p
->kill_without_query
= Qt
;
3206 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3209 XSETINT (p
->infd
, inch
);
3210 XSETINT (p
->outfd
, outch
);
3211 if (is_server
&& socktype
== SOCK_STREAM
)
3212 p
->status
= Qlisten
;
3214 #ifdef NON_BLOCKING_CONNECT
3215 if (is_non_blocking_client
)
3217 /* We may get here if connect did succeed immediately. However,
3218 in that case, we still need to signal this like a non-blocking
3220 p
->status
= Qconnect
;
3221 if (!FD_ISSET (inch
, &connect_wait_mask
))
3223 FD_SET (inch
, &connect_wait_mask
);
3224 num_pending_connects
++;
3229 /* A server may have a client filter setting of Qt, but it must
3230 still listen for incoming connects unless it is stopped. */
3231 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3232 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3234 FD_SET (inch
, &input_wait_mask
);
3235 FD_SET (inch
, &non_keyboard_wait_mask
);
3238 if (inch
> max_process_desc
)
3239 max_process_desc
= inch
;
3241 tem
= Fplist_member (contact
, QCcoding
);
3242 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3243 tem
= Qnil
; /* No error message (too late!). */
3246 /* Setup coding systems for communicating with the network stream. */
3247 struct gcpro gcpro1
;
3248 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3249 Lisp_Object coding_systems
= Qt
;
3250 Lisp_Object args
[5], val
;
3254 val
= XCAR (XCDR (tem
));
3258 else if (!NILP (Vcoding_system_for_read
))
3259 val
= Vcoding_system_for_read
;
3260 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3261 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3262 /* We dare not decode end-of-line format by setting VAL to
3263 Qraw_text, because the existing Emacs Lisp libraries
3264 assume that they receive bare code including a sequene of
3269 if (NILP (host
) || NILP (service
))
3270 coding_systems
= Qnil
;
3273 args
[0] = Qopen_network_stream
, args
[1] = name
,
3274 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3276 coding_systems
= Ffind_operation_coding_system (5, args
);
3279 if (CONSP (coding_systems
))
3280 val
= XCAR (coding_systems
);
3281 else if (CONSP (Vdefault_process_coding_system
))
3282 val
= XCAR (Vdefault_process_coding_system
);
3286 p
->decode_coding_system
= val
;
3290 val
= XCAR (XCDR (tem
));
3294 else if (!NILP (Vcoding_system_for_write
))
3295 val
= Vcoding_system_for_write
;
3296 else if (NILP (current_buffer
->enable_multibyte_characters
))
3300 if (EQ (coding_systems
, Qt
))
3302 if (NILP (host
) || NILP (service
))
3303 coding_systems
= Qnil
;
3306 args
[0] = Qopen_network_stream
, args
[1] = name
,
3307 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3309 coding_systems
= Ffind_operation_coding_system (5, args
);
3313 if (CONSP (coding_systems
))
3314 val
= XCDR (coding_systems
);
3315 else if (CONSP (Vdefault_process_coding_system
))
3316 val
= XCDR (Vdefault_process_coding_system
);
3320 p
->encode_coding_system
= val
;
3322 setup_process_coding_systems (proc
);
3324 p
->decoding_buf
= make_uninit_string (0);
3325 p
->decoding_carryover
= make_number (0);
3326 p
->encoding_buf
= make_uninit_string (0);
3327 p
->encoding_carryover
= make_number (0);
3329 p
->inherit_coding_system_flag
3330 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3336 #endif /* HAVE_SOCKETS */
3342 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3343 doc
: /* Return an alist of all network interfaces and their network address.
3344 Each element is a cons, the car of which is a string containing the
3345 interface name, and the cdr is the network address in internal
3346 format; see the description of ADDRESS in 'make-network-process'. */)
3349 struct ifconf ifconf
;
3350 struct ifreq
*ifreqs
= NULL
;
3355 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3361 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3362 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3369 ifconf
.ifc_len
= buf_size
;
3370 ifconf
.ifc_req
= ifreqs
;
3371 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3377 if (ifconf
.ifc_len
== buf_size
)
3381 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3384 while (--ifaces
>= 0)
3386 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3387 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3388 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3390 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3391 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3392 res
= Fcons (Fcons (build_string (namebuf
),
3393 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3394 sizeof (struct sockaddr
))),
3402 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3409 static struct ifflag_def ifflag_table
[] = {
3413 #ifdef IFF_BROADCAST
3414 { IFF_BROADCAST
, "broadcast" },
3417 { IFF_DEBUG
, "debug" },
3420 { IFF_LOOPBACK
, "loopback" },
3422 #ifdef IFF_POINTOPOINT
3423 { IFF_POINTOPOINT
, "pointopoint" },
3426 { IFF_RUNNING
, "running" },
3429 { IFF_NOARP
, "noarp" },
3432 { IFF_PROMISC
, "promisc" },
3434 #ifdef IFF_NOTRAILERS
3435 { IFF_NOTRAILERS
, "notrailers" },
3438 { IFF_ALLMULTI
, "allmulti" },
3441 { IFF_MASTER
, "master" },
3444 { IFF_SLAVE
, "slave" },
3446 #ifdef IFF_MULTICAST
3447 { IFF_MULTICAST
, "multicast" },
3450 { IFF_PORTSEL
, "portsel" },
3452 #ifdef IFF_AUTOMEDIA
3453 { IFF_AUTOMEDIA
, "automedia" },
3456 { IFF_DYNAMIC
, "dynamic" },
3461 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3462 doc
: /* Return information about network interface named IFNAME.
3463 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3464 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3465 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3466 FLAGS is the current flags of the interface. */)
3471 Lisp_Object res
= Qnil
;
3476 CHECK_STRING (ifname
);
3478 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3479 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3481 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3487 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3489 int flags
= rq
.ifr_flags
;
3490 struct ifflag_def
*fp
;
3494 for (fp
= ifflag_table
; flags
!= 0 && fp
; fp
++)
3496 if (flags
& fp
->flag_bit
)
3498 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3499 flags
-= fp
->flag_bit
;
3502 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3504 if (flags
& (1 << fnum
))
3506 elt
= Fcons (make_number (fnum
), elt
);
3511 res
= Fcons (elt
, res
);
3514 #ifdef SIOCGIFHWADDR
3515 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3517 Lisp_Object hwaddr
= Fmake_vector (6, Qnil
);
3518 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3522 for (n
= 0; n
< 6; n
++)
3523 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3524 elt
= Fcons (XINT (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3527 res
= Fcons (elt
, res
);
3530 #ifdef SIOCGIFNETMASK
3531 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3534 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3537 res
= Fcons (elt
, res
);
3540 #ifdef SIOCGIFBRDADDR
3541 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3544 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3547 res
= Fcons (elt
, res
);
3551 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3554 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3557 res
= Fcons (elt
, res
);
3561 return any
? res
: Qnil
;
3564 #endif /* HAVE_SOCKETS */
3567 deactivate_process (proc
)
3570 register int inchannel
, outchannel
;
3571 register struct Lisp_Process
*p
= XPROCESS (proc
);
3573 inchannel
= XINT (p
->infd
);
3574 outchannel
= XINT (p
->outfd
);
3578 /* Beware SIGCHLD hereabouts. */
3579 flush_pending_output (inchannel
);
3582 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3583 sys$
dassgn (outchannel
);
3584 vs
= get_vms_process_pointer (p
->pid
);
3586 give_back_vms_process_stuff (vs
);
3589 emacs_close (inchannel
);
3590 if (outchannel
>= 0 && outchannel
!= inchannel
)
3591 emacs_close (outchannel
);
3594 XSETINT (p
->infd
, -1);
3595 XSETINT (p
->outfd
, -1);
3596 #ifdef DATAGRAM_SOCKETS
3597 if (DATAGRAM_CHAN_P (inchannel
))
3599 xfree (datagram_address
[inchannel
].sa
);
3600 datagram_address
[inchannel
].sa
= 0;
3601 datagram_address
[inchannel
].len
= 0;
3604 chan_process
[inchannel
] = Qnil
;
3605 FD_CLR (inchannel
, &input_wait_mask
);
3606 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3607 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3609 FD_CLR (inchannel
, &connect_wait_mask
);
3610 if (--num_pending_connects
< 0)
3613 if (inchannel
== max_process_desc
)
3616 /* We just closed the highest-numbered process input descriptor,
3617 so recompute the highest-numbered one now. */
3618 max_process_desc
= 0;
3619 for (i
= 0; i
< MAXDESC
; i
++)
3620 if (!NILP (chan_process
[i
]))
3621 max_process_desc
= i
;
3626 /* Close all descriptors currently in use for communication
3627 with subprocess. This is used in a newly-forked subprocess
3628 to get rid of irrelevant descriptors. */
3631 close_process_descs ()
3635 for (i
= 0; i
< MAXDESC
; i
++)
3637 Lisp_Object process
;
3638 process
= chan_process
[i
];
3639 if (!NILP (process
))
3641 int in
= XINT (XPROCESS (process
)->infd
);
3642 int out
= XINT (XPROCESS (process
)->outfd
);
3645 if (out
>= 0 && in
!= out
)
3652 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3654 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3655 It is read into the process' buffers or given to their filter functions.
3656 Non-nil arg PROCESS means do not return until some output has been received
3658 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3659 seconds and microseconds to wait; return after that much time whether
3660 or not there is input.
3661 Return non-nil iff we received any output before the timeout expired. */)
3662 (process
, timeout
, timeout_msecs
)
3663 register Lisp_Object process
, timeout
, timeout_msecs
;
3668 if (! NILP (process
))
3669 CHECK_PROCESS (process
);
3671 if (! NILP (timeout_msecs
))
3673 CHECK_NUMBER (timeout_msecs
);
3674 useconds
= XINT (timeout_msecs
);
3675 if (!INTEGERP (timeout
))
3676 XSETINT (timeout
, 0);
3679 int carry
= useconds
/ 1000000;
3681 XSETINT (timeout
, XINT (timeout
) + carry
);
3682 useconds
-= carry
* 1000000;
3684 /* I think this clause is necessary because C doesn't
3685 guarantee a particular rounding direction for negative
3689 XSETINT (timeout
, XINT (timeout
) - 1);
3690 useconds
+= 1000000;
3697 if (! NILP (timeout
))
3699 CHECK_NUMBER (timeout
);
3700 seconds
= XINT (timeout
);
3701 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3705 seconds
= NILP (process
) ? -1 : 0;
3708 XSETFASTINT (process
, 0);
3711 (wait_reading_process_input (seconds
, useconds
, process
, 0)
3715 /* Accept a connection for server process SERVER on CHANNEL. */
3717 static int connect_counter
= 0;
3720 server_accept_connection (server
, channel
)
3724 Lisp_Object proc
, caller
, name
, buffer
;
3725 Lisp_Object contact
, host
, service
;
3726 struct Lisp_Process
*ps
= XPROCESS (server
);
3727 struct Lisp_Process
*p
;
3731 struct sockaddr_in in
;
3732 #ifdef HAVE_LOCAL_SOCKETS
3733 struct sockaddr_un un
;
3736 int len
= sizeof saddr
;
3738 s
= accept (channel
, &saddr
.sa
, &len
);
3747 if (code
== EWOULDBLOCK
)
3751 if (!NILP (ps
->log
))
3752 call3 (ps
->log
, server
, Qnil
,
3753 concat3 (build_string ("accept failed with code"),
3754 Fnumber_to_string (make_number (code
)),
3755 build_string ("\n")));
3761 /* Setup a new process to handle the connection. */
3763 /* Generate a unique identification of the caller, and build contact
3764 information for this process. */
3767 switch (saddr
.sa
.sa_family
)
3771 Lisp_Object args
[5];
3772 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3773 args
[0] = build_string ("%d.%d.%d.%d");
3774 args
[1] = make_number (*ip
++);
3775 args
[2] = make_number (*ip
++);
3776 args
[3] = make_number (*ip
++);
3777 args
[4] = make_number (*ip
++);
3778 host
= Fformat (5, args
);
3779 service
= make_number (ntohs (saddr
.in
.sin_port
));
3781 args
[0] = build_string (" <%s:%d>");
3784 caller
= Fformat (3, args
);
3788 #ifdef HAVE_LOCAL_SOCKETS
3792 caller
= Fnumber_to_string (make_number (connect_counter
));
3793 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3797 /* Create a new buffer name for this process if it doesn't have a
3798 filter. The new buffer name is based on the buffer name or
3799 process name of the server process concatenated with the caller
3802 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
3806 buffer
= ps
->buffer
;
3808 buffer
= Fbuffer_name (buffer
);
3813 buffer
= concat2 (buffer
, caller
);
3814 buffer
= Fget_buffer_create (buffer
);
3818 /* Generate a unique name for the new server process. Combine the
3819 server process name with the caller identification. */
3821 name
= concat2 (ps
->name
, caller
);
3822 proc
= make_process (name
);
3824 chan_process
[s
] = proc
;
3827 fcntl (s
, F_SETFL
, O_NONBLOCK
);
3830 fcntl (s
, F_SETFL
, O_NDELAY
);
3834 p
= XPROCESS (proc
);
3836 /* Build new contact information for this setup. */
3837 contact
= Fcopy_sequence (ps
->childp
);
3838 contact
= Fplist_put (contact
, QCserver
, Qnil
);
3839 contact
= Fplist_put (contact
, QChost
, host
);
3840 if (!NILP (service
))
3841 contact
= Fplist_put (contact
, QCservice
, service
);
3842 contact
= Fplist_put (contact
, QCremote
,
3843 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3844 #ifdef HAVE_GETSOCKNAME
3846 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
3847 contact
= Fplist_put (contact
, QClocal
,
3848 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3851 p
->childp
= contact
;
3852 p
->plist
= Fcopy_sequence (ps
->plist
);
3855 p
->sentinel
= ps
->sentinel
;
3856 p
->filter
= ps
->filter
;
3859 XSETINT (p
->infd
, s
);
3860 XSETINT (p
->outfd
, s
);
3863 /* Client processes for accepted connections are not stopped initially. */
3864 if (!EQ (p
->filter
, Qt
))
3866 FD_SET (s
, &input_wait_mask
);
3867 FD_SET (s
, &non_keyboard_wait_mask
);
3870 if (s
> max_process_desc
)
3871 max_process_desc
= s
;
3873 /* Setup coding system for new process based on server process.
3874 This seems to be the proper thing to do, as the coding system
3875 of the new process should reflect the settings at the time the
3876 server socket was opened; not the current settings. */
3878 p
->decode_coding_system
= ps
->decode_coding_system
;
3879 p
->encode_coding_system
= ps
->encode_coding_system
;
3880 setup_process_coding_systems (proc
);
3882 p
->decoding_buf
= make_uninit_string (0);
3883 p
->decoding_carryover
= make_number (0);
3884 p
->encoding_buf
= make_uninit_string (0);
3885 p
->encoding_carryover
= make_number (0);
3887 p
->inherit_coding_system_flag
3888 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
3890 if (!NILP (ps
->log
))
3891 call3 (ps
->log
, server
, proc
,
3892 concat3 (build_string ("accept from "),
3893 (STRINGP (host
) ? host
: build_string ("-")),
3894 build_string ("\n")));
3896 if (!NILP (p
->sentinel
))
3897 exec_sentinel (proc
,
3898 concat3 (build_string ("open from "),
3899 (STRINGP (host
) ? host
: build_string ("-")),
3900 build_string ("\n")));
3903 /* This variable is different from waiting_for_input in keyboard.c.
3904 It is used to communicate to a lisp process-filter/sentinel (via the
3905 function Fwaiting_for_user_input_p below) whether emacs was waiting
3906 for user-input when that process-filter was called.
3907 waiting_for_input cannot be used as that is by definition 0 when
3908 lisp code is being evalled.
3909 This is also used in record_asynch_buffer_change.
3910 For that purpose, this must be 0
3911 when not inside wait_reading_process_input. */
3912 static int waiting_for_user_input_p
;
3914 /* This is here so breakpoints can be put on it. */
3916 wait_reading_process_input_1 ()
3920 /* Read and dispose of subprocess output while waiting for timeout to
3921 elapse and/or keyboard input to be available.
3924 timeout in seconds, or
3925 zero for no limit, or
3926 -1 means gobble data immediately available but don't wait for any.
3929 an additional duration to wait, measured in microseconds.
3930 If this is nonzero and time_limit is 0, then the timeout
3931 consists of MICROSECS only.
3933 READ_KBD is a lisp value:
3934 0 to ignore keyboard input, or
3935 1 to return when input is available, or
3936 -1 meaning caller will actually read the input, so don't throw to
3937 the quit handler, or
3938 a cons cell, meaning wait until its car is non-nil
3939 (and gobble terminal input into the buffer if any arrives), or
3940 a process object, meaning wait until something arrives from that
3941 process. The return value is true iff we read some input from
3944 DO_DISPLAY != 0 means redisplay should be done to show subprocess
3945 output that arrives.
3947 If READ_KBD is a pointer to a struct Lisp_Process, then the
3948 function returns true iff we received input from that process
3949 before the timeout elapsed.
3950 Otherwise, return true iff we received input from any process. */
3953 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3954 int time_limit
, microsecs
;
3955 Lisp_Object read_kbd
;
3958 register int channel
, nfds
;
3959 static SELECT_TYPE Available
;
3960 static SELECT_TYPE Connecting
;
3961 int check_connect
, no_avail
;
3964 EMACS_TIME timeout
, end_time
;
3965 int wait_channel
= -1;
3966 struct Lisp_Process
*wait_proc
= 0;
3967 int got_some_input
= 0;
3968 /* Either nil or a cons cell, the car of which is of interest and
3969 may be changed outside of this routine. */
3970 Lisp_Object wait_for_cell
= Qnil
;
3972 FD_ZERO (&Available
);
3973 FD_ZERO (&Connecting
);
3975 /* If read_kbd is a process to watch, set wait_proc and wait_channel
3977 if (PROCESSP (read_kbd
))
3979 wait_proc
= XPROCESS (read_kbd
);
3980 wait_channel
= XINT (wait_proc
->infd
);
3981 XSETFASTINT (read_kbd
, 0);
3984 /* If waiting for non-nil in a cell, record where. */
3985 if (CONSP (read_kbd
))
3987 wait_for_cell
= read_kbd
;
3988 XSETFASTINT (read_kbd
, 0);
3991 waiting_for_user_input_p
= XINT (read_kbd
);
3993 /* Since we may need to wait several times,
3994 compute the absolute time to return at. */
3995 if (time_limit
|| microsecs
)
3997 EMACS_GET_TIME (end_time
);
3998 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3999 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4001 #ifdef POLL_INTERRUPTED_SYS_CALL
4002 /* AlainF 5-Jul-1996
4003 HP-UX 10.10 seem to have problems with signals coming in
4004 Causes "poll: interrupted system call" messages when Emacs is run
4006 Turn off periodic alarms (in case they are in use),
4007 and then turn off any other atimers. */
4009 turn_on_atimers (0);
4010 #endif /* POLL_INTERRUPTED_SYS_CALL */
4014 int timeout_reduced_for_timers
= 0;
4016 /* If calling from keyboard input, do not quit
4017 since we want to return C-g as an input character.
4018 Otherwise, do pending quit if requested. */
4019 if (XINT (read_kbd
) >= 0)
4022 /* Exit now if the cell we're waiting for became non-nil. */
4023 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4026 /* Compute time from now till when time limit is up */
4027 /* Exit if already run out */
4028 if (time_limit
== -1)
4030 /* -1 specified for timeout means
4031 gobble output available now
4032 but don't wait at all. */
4034 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4036 else if (time_limit
|| microsecs
)
4038 EMACS_GET_TIME (timeout
);
4039 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4040 if (EMACS_TIME_NEG_P (timeout
))
4045 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4048 /* Normally we run timers here.
4049 But not if wait_for_cell; in those cases,
4050 the wait is supposed to be short,
4051 and those callers cannot handle running arbitrary Lisp code here. */
4052 if (NILP (wait_for_cell
))
4054 EMACS_TIME timer_delay
;
4058 int old_timers_run
= timers_run
;
4059 struct buffer
*old_buffer
= current_buffer
;
4061 timer_delay
= timer_check (1);
4063 /* If a timer has run, this might have changed buffers
4064 an alike. Make read_key_sequence aware of that. */
4065 if (timers_run
!= old_timers_run
4066 && old_buffer
!= current_buffer
4067 && waiting_for_user_input_p
== -1)
4068 record_asynch_buffer_change ();
4070 if (timers_run
!= old_timers_run
&& do_display
)
4071 /* We must retry, since a timer may have requeued itself
4072 and that could alter the time_delay. */
4073 redisplay_preserve_echo_area (9);
4077 while (!detect_input_pending ());
4079 /* If there is unread keyboard input, also return. */
4080 if (XINT (read_kbd
) != 0
4081 && requeued_events_pending_p ())
4084 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4086 EMACS_TIME difference
;
4087 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4088 if (EMACS_TIME_NEG_P (difference
))
4090 timeout
= timer_delay
;
4091 timeout_reduced_for_timers
= 1;
4094 /* If time_limit is -1, we are not going to wait at all. */
4095 else if (time_limit
!= -1)
4097 /* This is so a breakpoint can be put here. */
4098 wait_reading_process_input_1 ();
4102 /* Cause C-g and alarm signals to take immediate action,
4103 and cause input available signals to zero out timeout.
4105 It is important that we do this before checking for process
4106 activity. If we get a SIGCHLD after the explicit checks for
4107 process activity, timeout is the only way we will know. */
4108 if (XINT (read_kbd
) < 0)
4109 set_waiting_for_input (&timeout
);
4111 /* If status of something has changed, and no input is
4112 available, notify the user of the change right away. After
4113 this explicit check, we'll let the SIGCHLD handler zap
4114 timeout to get our attention. */
4115 if (update_tick
!= process_tick
&& do_display
)
4117 SELECT_TYPE Atemp
, Ctemp
;
4119 Atemp
= input_wait_mask
;
4121 /* On Mac OS X, the SELECT system call always says input is
4122 present (for reading) at stdin, even when none is. This
4123 causes the call to SELECT below to return 1 and
4124 status_notify not to be called. As a result output of
4125 subprocesses are incorrectly discarded. */
4128 Ctemp
= connect_wait_mask
;
4129 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4130 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4132 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4133 (SELECT_TYPE
*)0, &timeout
)
4136 /* It's okay for us to do this and then continue with
4137 the loop, since timeout has already been zeroed out. */
4138 clear_waiting_for_input ();
4143 /* Don't wait for output from a non-running process. Just
4144 read whatever data has already been received. */
4145 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
4146 update_status (wait_proc
);
4148 && ! EQ (wait_proc
->status
, Qrun
)
4149 && ! EQ (wait_proc
->status
, Qconnect
))
4151 int nread
, total_nread
= 0;
4153 clear_waiting_for_input ();
4154 XSETPROCESS (proc
, wait_proc
);
4156 /* Read data from the process, until we exhaust it. */
4157 while (XINT (wait_proc
->infd
) >= 0)
4159 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4165 total_nread
+= nread
;
4167 else if (nread
== -1 && EIO
== errno
)
4171 else if (nread
== -1 && EAGAIN
== errno
)
4175 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4179 if (total_nread
> 0 && do_display
)
4180 redisplay_preserve_echo_area (10);
4185 /* Wait till there is something to do */
4187 if (!NILP (wait_for_cell
))
4189 Available
= non_process_wait_mask
;
4194 if (! XINT (read_kbd
))
4195 Available
= non_keyboard_wait_mask
;
4197 Available
= input_wait_mask
;
4198 check_connect
= (num_pending_connects
> 0);
4201 /* If frame size has changed or the window is newly mapped,
4202 redisplay now, before we start to wait. There is a race
4203 condition here; if a SIGIO arrives between now and the select
4204 and indicates that a frame is trashed, the select may block
4205 displaying a trashed screen. */
4206 if (frame_garbaged
&& do_display
)
4208 clear_waiting_for_input ();
4209 redisplay_preserve_echo_area (11);
4210 if (XINT (read_kbd
) < 0)
4211 set_waiting_for_input (&timeout
);
4215 if (XINT (read_kbd
) && detect_input_pending ())
4223 Connecting
= connect_wait_mask
;
4224 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4226 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4227 (SELECT_TYPE
*)0, &timeout
);
4232 /* Make C-g and alarm signals set flags again */
4233 clear_waiting_for_input ();
4235 /* If we woke up due to SIGWINCH, actually change size now. */
4236 do_pending_window_change (0);
4238 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4239 /* We wanted the full specified time, so return now. */
4243 if (xerrno
== EINTR
)
4246 /* Ultrix select seems to return ENOMEM when it is
4247 interrupted. Treat it just like EINTR. Bleah. Note
4248 that we want to test for the "ultrix" CPP symbol, not
4249 "__ultrix__"; the latter is only defined under GCC, but
4250 not by DEC's bundled CC. -JimB */
4251 else if (xerrno
== ENOMEM
)
4255 /* This happens for no known reason on ALLIANT.
4256 I am guessing that this is the right response. -- RMS. */
4257 else if (xerrno
== EFAULT
)
4260 else if (xerrno
== EBADF
)
4263 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4264 the child's closure of the pts gives the parent a SIGHUP, and
4265 the ptc file descriptor is automatically closed,
4266 yielding EBADF here or at select() call above.
4267 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4268 in m/ibmrt-aix.h), and here we just ignore the select error.
4269 Cleanup occurs c/o status_notify after SIGCLD. */
4270 no_avail
= 1; /* Cannot depend on values returned */
4276 error ("select error: %s", emacs_strerror (xerrno
));
4281 FD_ZERO (&Available
);
4285 #if defined(sun) && !defined(USG5_4)
4286 if (nfds
> 0 && keyboard_bit_set (&Available
)
4288 /* System sometimes fails to deliver SIGIO.
4290 David J. Mackenzie says that Emacs doesn't compile under
4291 Solaris if this code is enabled, thus the USG5_4 in the CPP
4292 conditional. "I haven't noticed any ill effects so far.
4293 If you find a Solaris expert somewhere, they might know
4295 kill (getpid (), SIGIO
);
4298 #if 0 /* When polling is used, interrupt_input is 0,
4299 so get_input_pending should read the input.
4300 So this should not be needed. */
4301 /* If we are using polling for input,
4302 and we see input available, make it get read now.
4303 Otherwise it might not actually get read for a second.
4304 And on hpux, since we turn off polling in wait_reading_process_input,
4305 it might never get read at all if we don't spend much time
4306 outside of wait_reading_process_input. */
4307 if (XINT (read_kbd
) && interrupt_input
4308 && keyboard_bit_set (&Available
)
4309 && input_polling_used ())
4310 kill (getpid (), SIGALRM
);
4313 /* Check for keyboard input */
4314 /* If there is any, return immediately
4315 to give it higher priority than subprocesses */
4317 if (XINT (read_kbd
) != 0)
4319 int old_timers_run
= timers_run
;
4320 struct buffer
*old_buffer
= current_buffer
;
4323 if (detect_input_pending_run_timers (do_display
))
4325 swallow_events (do_display
);
4326 if (detect_input_pending_run_timers (do_display
))
4330 /* If a timer has run, this might have changed buffers
4331 an alike. Make read_key_sequence aware of that. */
4332 if (timers_run
!= old_timers_run
4333 && waiting_for_user_input_p
== -1
4334 && old_buffer
!= current_buffer
)
4335 record_asynch_buffer_change ();
4341 /* If there is unread keyboard input, also return. */
4342 if (XINT (read_kbd
) != 0
4343 && requeued_events_pending_p ())
4346 /* If we are not checking for keyboard input now,
4347 do process events (but don't run any timers).
4348 This is so that X events will be processed.
4349 Otherwise they may have to wait until polling takes place.
4350 That would causes delays in pasting selections, for example.
4352 (We used to do this only if wait_for_cell.) */
4353 if (XINT (read_kbd
) == 0 && detect_input_pending ())
4355 swallow_events (do_display
);
4356 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4357 if (detect_input_pending ())
4362 /* Exit now if the cell we're waiting for became non-nil. */
4363 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4367 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4368 go read it. This can happen with X on BSD after logging out.
4369 In that case, there really is no input and no SIGIO,
4370 but select says there is input. */
4372 if (XINT (read_kbd
) && interrupt_input
4373 && keyboard_bit_set (&Available
) && ! noninteractive
)
4374 kill (getpid (), SIGIO
);
4378 got_some_input
|= nfds
> 0;
4380 /* If checking input just got us a size-change event from X,
4381 obey it now if we should. */
4382 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
4383 do_pending_window_change (0);
4385 /* Check for data from a process. */
4386 if (no_avail
|| nfds
== 0)
4389 /* Really FIRST_PROC_DESC should be 0 on Unix,
4390 but this is safer in the short run. */
4391 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4393 if (FD_ISSET (channel
, &Available
)
4394 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4398 /* If waiting for this channel, arrange to return as
4399 soon as no more input to be processed. No more
4401 if (wait_channel
== channel
)
4407 proc
= chan_process
[channel
];
4411 /* If this is a server stream socket, accept connection. */
4412 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4414 server_accept_connection (proc
, channel
);
4418 /* Read data from the process, starting with our
4419 buffered-ahead character if we have one. */
4421 nread
= read_process_output (proc
, channel
);
4424 /* Since read_process_output can run a filter,
4425 which can call accept-process-output,
4426 don't try to read from any other processes
4427 before doing the select again. */
4428 FD_ZERO (&Available
);
4431 redisplay_preserve_echo_area (12);
4434 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4437 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4438 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4440 else if (nread
== -1 && errno
== EAGAIN
)
4444 else if (nread
== -1 && errno
== EAGAIN
)
4446 /* Note that we cannot distinguish between no input
4447 available now and a closed pipe.
4448 With luck, a closed pipe will be accompanied by
4449 subprocess termination and SIGCHLD. */
4450 else if (nread
== 0 && !NETCONN_P (proc
))
4452 #endif /* O_NDELAY */
4453 #endif /* O_NONBLOCK */
4455 /* On some OSs with ptys, when the process on one end of
4456 a pty exits, the other end gets an error reading with
4457 errno = EIO instead of getting an EOF (0 bytes read).
4458 Therefore, if we get an error reading and errno =
4459 EIO, just continue, because the child process has
4460 exited and should clean itself up soon (e.g. when we
4463 However, it has been known to happen that the SIGCHLD
4464 got lost. So raise the signl again just in case.
4466 else if (nread
== -1 && errno
== EIO
)
4467 kill (getpid (), SIGCHLD
);
4468 #endif /* HAVE_PTYS */
4469 /* If we can detect process termination, don't consider the process
4470 gone just because its pipe is closed. */
4472 else if (nread
== 0 && !NETCONN_P (proc
))
4477 /* Preserve status of processes already terminated. */
4478 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4479 deactivate_process (proc
);
4480 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4481 update_status (XPROCESS (proc
));
4482 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4483 XPROCESS (proc
)->status
4484 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4487 #ifdef NON_BLOCKING_CONNECT
4488 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
4490 struct Lisp_Process
*p
;
4492 FD_CLR (channel
, &connect_wait_mask
);
4493 if (--num_pending_connects
< 0)
4496 proc
= chan_process
[channel
];
4500 p
= XPROCESS (proc
);
4503 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4504 So only use it on systems where it is known to work. */
4506 int xlen
= sizeof(xerrno
);
4507 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4512 struct sockaddr pname
;
4513 int pnamelen
= sizeof(pname
);
4515 /* If connection failed, getpeername will fail. */
4517 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4519 /* Obtain connect failure code through error slippage. */
4522 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4529 XSETINT (p
->tick
, ++process_tick
);
4530 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4531 deactivate_process (proc
);
4536 /* Execute the sentinel here. If we had relied on
4537 status_notify to do it later, it will read input
4538 from the process before calling the sentinel. */
4539 exec_sentinel (proc
, build_string ("open\n"));
4540 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4542 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4543 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4547 #endif /* NON_BLOCKING_CONNECT */
4548 } /* end for each file descriptor */
4549 } /* end while exit conditions not met */
4551 waiting_for_user_input_p
= 0;
4553 /* If calling from keyboard input, do not quit
4554 since we want to return C-g as an input character.
4555 Otherwise, do pending quit if requested. */
4556 if (XINT (read_kbd
) >= 0)
4558 /* Prevent input_pending from remaining set if we quit. */
4559 clear_input_pending ();
4562 #ifdef POLL_INTERRUPTED_SYS_CALL
4563 /* AlainF 5-Jul-1996
4564 HP-UX 10.10 seems to have problems with signals coming in
4565 Causes "poll: interrupted system call" messages when Emacs is run
4567 Turn periodic alarms back on */
4569 #endif /* POLL_INTERRUPTED_SYS_CALL */
4571 return got_some_input
;
4574 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4577 read_process_output_call (fun_and_args
)
4578 Lisp_Object fun_and_args
;
4580 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4584 read_process_output_error_handler (error
)
4587 cmd_error_internal (error
, "error in process filter: ");
4589 update_echo_area ();
4590 Fsleep_for (make_number (2), Qnil
);
4594 /* Read pending output from the process channel,
4595 starting with our buffered-ahead character if we have one.
4596 Yield number of decoded characters read.
4598 This function reads at most 1024 characters.
4599 If you want to read all available subprocess output,
4600 you must call it repeatedly until it returns zero.
4602 The characters read are decoded according to PROC's coding-system
4606 read_process_output (proc
, channel
)
4608 register int channel
;
4610 register int nchars
, nbytes
;
4612 register Lisp_Object outstream
;
4613 register struct buffer
*old
= current_buffer
;
4614 register struct Lisp_Process
*p
= XPROCESS (proc
);
4615 register int opoint
;
4616 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4617 int carryover
= XINT (p
->decoding_carryover
);
4621 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4623 vs
= get_vms_process_pointer (p
->pid
);
4627 return (0); /* Really weird if it does this */
4628 if (!(vs
->iosb
[0] & 1))
4629 return -1; /* I/O error */
4632 error ("Could not get VMS process pointer");
4633 chars
= vs
->inputBuffer
;
4634 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4637 start_vms_process_read (vs
); /* Crank up the next read on the process */
4638 return 1; /* Nothing worth printing, say we got 1 */
4642 /* The data carried over in the previous decoding (which are at
4643 the tail of decoding buffer) should be prepended to the new
4644 data read to decode all together. */
4645 chars
= (char *) alloca (nbytes
+ carryover
);
4646 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4647 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4651 #ifdef DATAGRAM_SOCKETS
4652 /* A datagram is one packet; allow at least 1500+ bytes of data
4653 corresponding to the typical Ethernet frame size. */
4654 if (DATAGRAM_CHAN_P (channel
))
4656 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4661 chars
= (char *) alloca (carryover
+ readmax
);
4663 /* See the comment above. */
4664 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4666 #ifdef DATAGRAM_SOCKETS
4667 /* We have a working select, so proc_buffered_char is always -1. */
4668 if (DATAGRAM_CHAN_P (channel
))
4670 int len
= datagram_address
[channel
].len
;
4671 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
- carryover
,
4672 0, datagram_address
[channel
].sa
, &len
);
4676 if (proc_buffered_char
[channel
] < 0)
4677 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
- carryover
);
4680 chars
[carryover
] = proc_buffered_char
[channel
];
4681 proc_buffered_char
[channel
] = -1;
4682 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1 - carryover
);
4686 nbytes
= nbytes
+ 1;
4688 #endif /* not VMS */
4690 XSETINT (p
->decoding_carryover
, 0);
4692 /* At this point, NBYTES holds number of bytes just received
4693 (including the one in proc_buffered_char[channel]). */
4696 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4698 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4701 /* Now set NBYTES how many bytes we must decode. */
4702 nbytes
+= carryover
;
4704 /* Read and dispose of the process output. */
4705 outstream
= p
->filter
;
4706 if (!NILP (outstream
))
4708 /* We inhibit quit here instead of just catching it so that
4709 hitting ^G when a filter happens to be running won't screw
4711 int count
= SPECPDL_INDEX ();
4712 Lisp_Object odeactivate
;
4713 Lisp_Object obuffer
, okeymap
;
4715 int outer_running_asynch_code
= running_asynch_code
;
4716 int waiting
= waiting_for_user_input_p
;
4718 /* No need to gcpro these, because all we do with them later
4719 is test them for EQness, and none of them should be a string. */
4720 odeactivate
= Vdeactivate_mark
;
4721 XSETBUFFER (obuffer
, current_buffer
);
4722 okeymap
= current_buffer
->keymap
;
4724 specbind (Qinhibit_quit
, Qt
);
4725 specbind (Qlast_nonmenu_event
, Qt
);
4727 /* In case we get recursively called,
4728 and we already saved the match data nonrecursively,
4729 save the same match data in safely recursive fashion. */
4730 if (outer_running_asynch_code
)
4733 /* Don't clobber the CURRENT match data, either! */
4734 tem
= Fmatch_data (Qnil
, Qnil
);
4735 restore_match_data ();
4736 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4737 Fset_match_data (tem
);
4740 /* For speed, if a search happens within this code,
4741 save the match data in a special nonrecursive fashion. */
4742 running_asynch_code
= 1;
4744 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4746 Vlast_coding_system_used
= coding
->symbol
;
4747 /* A new coding system might be found. */
4748 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4750 p
->decode_coding_system
= coding
->symbol
;
4752 /* Don't call setup_coding_system for
4753 proc_decode_coding_system[channel] here. It is done in
4754 detect_coding called via decode_coding above. */
4756 /* If a coding system for encoding is not yet decided, we set
4757 it as the same as coding-system for decoding.
4759 But, before doing that we must check if
4760 proc_encode_coding_system[p->outfd] surely points to a
4761 valid memory because p->outfd will be changed once EOF is
4762 sent to the process. */
4763 if (NILP (p
->encode_coding_system
)
4764 && proc_encode_coding_system
[XINT (p
->outfd
)])
4766 p
->encode_coding_system
= coding
->symbol
;
4767 setup_coding_system (coding
->symbol
,
4768 proc_encode_coding_system
[XINT (p
->outfd
)]);
4772 carryover
= nbytes
- coding
->consumed
;
4773 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
4775 XSETINT (p
->decoding_carryover
, carryover
);
4776 /* Adjust the multibyteness of TEXT to that of the filter. */
4777 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
4778 text
= (STRING_MULTIBYTE (text
)
4779 ? Fstring_as_unibyte (text
)
4780 : Fstring_to_multibyte (text
));
4781 if (SBYTES (text
) > 0)
4782 internal_condition_case_1 (read_process_output_call
,
4784 Fcons (proc
, Fcons (text
, Qnil
))),
4785 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4786 read_process_output_error_handler
);
4788 /* If we saved the match data nonrecursively, restore it now. */
4789 restore_match_data ();
4790 running_asynch_code
= outer_running_asynch_code
;
4792 /* Handling the process output should not deactivate the mark. */
4793 Vdeactivate_mark
= odeactivate
;
4795 /* Restore waiting_for_user_input_p as it was
4796 when we were called, in case the filter clobbered it. */
4797 waiting_for_user_input_p
= waiting
;
4799 #if 0 /* Call record_asynch_buffer_change unconditionally,
4800 because we might have changed minor modes or other things
4801 that affect key bindings. */
4802 if (! EQ (Fcurrent_buffer (), obuffer
)
4803 || ! EQ (current_buffer
->keymap
, okeymap
))
4805 /* But do it only if the caller is actually going to read events.
4806 Otherwise there's no need to make him wake up, and it could
4807 cause trouble (for example it would make Fsit_for return). */
4808 if (waiting_for_user_input_p
== -1)
4809 record_asynch_buffer_change ();
4812 start_vms_process_read (vs
);
4814 unbind_to (count
, Qnil
);
4818 /* If no filter, write into buffer if it isn't dead. */
4819 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
4821 Lisp_Object old_read_only
;
4822 int old_begv
, old_zv
;
4823 int old_begv_byte
, old_zv_byte
;
4824 Lisp_Object odeactivate
;
4825 int before
, before_byte
;
4830 odeactivate
= Vdeactivate_mark
;
4832 Fset_buffer (p
->buffer
);
4834 opoint_byte
= PT_BYTE
;
4835 old_read_only
= current_buffer
->read_only
;
4838 old_begv_byte
= BEGV_BYTE
;
4839 old_zv_byte
= ZV_BYTE
;
4841 current_buffer
->read_only
= Qnil
;
4843 /* Insert new output into buffer
4844 at the current end-of-output marker,
4845 thus preserving logical ordering of input and output. */
4846 if (XMARKER (p
->mark
)->buffer
)
4847 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
4848 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
4851 SET_PT_BOTH (ZV
, ZV_BYTE
);
4853 before_byte
= PT_BYTE
;
4855 /* If the output marker is outside of the visible region, save
4856 the restriction and widen. */
4857 if (! (BEGV
<= PT
&& PT
<= ZV
))
4860 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4862 Vlast_coding_system_used
= coding
->symbol
;
4863 /* A new coding system might be found. See the comment in the
4864 similar code in the previous `if' block. */
4865 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4867 p
->decode_coding_system
= coding
->symbol
;
4868 if (NILP (p
->encode_coding_system
)
4869 && proc_encode_coding_system
[XINT (p
->outfd
)])
4871 p
->encode_coding_system
= coding
->symbol
;
4872 setup_coding_system (coding
->symbol
,
4873 proc_encode_coding_system
[XINT (p
->outfd
)]);
4876 carryover
= nbytes
- coding
->consumed
;
4877 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
4879 XSETINT (p
->decoding_carryover
, carryover
);
4880 /* Adjust the multibyteness of TEXT to that of the buffer. */
4881 if (NILP (current_buffer
->enable_multibyte_characters
)
4882 != ! STRING_MULTIBYTE (text
))
4883 text
= (STRING_MULTIBYTE (text
)
4884 ? Fstring_as_unibyte (text
)
4885 : Fstring_to_multibyte (text
));
4886 /* Insert before markers in case we are inserting where
4887 the buffer's mark is, and the user's next command is Meta-y. */
4888 insert_from_string_before_markers (text
, 0, 0,
4889 SCHARS (text
), SBYTES (text
), 0);
4891 /* Make sure the process marker's position is valid when the
4892 process buffer is changed in the signal_after_change above.
4893 W3 is known to do that. */
4894 if (BUFFERP (p
->buffer
)
4895 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
4896 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
4898 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
4900 update_mode_lines
++;
4902 /* Make sure opoint and the old restrictions
4903 float ahead of any new text just as point would. */
4904 if (opoint
>= before
)
4906 opoint
+= PT
- before
;
4907 opoint_byte
+= PT_BYTE
- before_byte
;
4909 if (old_begv
> before
)
4911 old_begv
+= PT
- before
;
4912 old_begv_byte
+= PT_BYTE
- before_byte
;
4914 if (old_zv
>= before
)
4916 old_zv
+= PT
- before
;
4917 old_zv_byte
+= PT_BYTE
- before_byte
;
4920 /* If the restriction isn't what it should be, set it. */
4921 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
4922 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
4924 /* Handling the process output should not deactivate the mark. */
4925 Vdeactivate_mark
= odeactivate
;
4927 current_buffer
->read_only
= old_read_only
;
4928 SET_PT_BOTH (opoint
, opoint_byte
);
4929 set_buffer_internal (old
);
4932 start_vms_process_read (vs
);
4937 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
4939 doc
: /* Returns non-nil if emacs is waiting for input from the user.
4940 This is intended for use by asynchronous process output filters and sentinels. */)
4943 return (waiting_for_user_input_p
? Qt
: Qnil
);
4946 /* Sending data to subprocess */
4948 jmp_buf send_process_frame
;
4949 Lisp_Object process_sent_to
;
4952 send_process_trap ()
4958 longjmp (send_process_frame
, 1);
4961 /* Send some data to process PROC.
4962 BUF is the beginning of the data; LEN is the number of characters.
4963 OBJECT is the Lisp object that the data comes from. If OBJECT is
4964 nil or t, it means that the data comes from C string.
4966 If OBJECT is not nil, the data is encoded by PROC's coding-system
4967 for encoding before it is sent.
4969 This function can evaluate Lisp code and can garbage collect. */
4972 send_process (proc
, buf
, len
, object
)
4973 volatile Lisp_Object proc
;
4974 unsigned char *volatile buf
;
4976 volatile Lisp_Object object
;
4978 /* Use volatile to protect variables from being clobbered by longjmp. */
4980 struct coding_system
*coding
;
4981 struct gcpro gcpro1
;
4986 struct Lisp_Process
*p
= XPROCESS (proc
);
4987 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4990 if (! NILP (XPROCESS (proc
)->raw_status_low
))
4991 update_status (XPROCESS (proc
));
4992 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
4993 error ("Process %s not running",
4994 SDATA (XPROCESS (proc
)->name
));
4995 if (XINT (XPROCESS (proc
)->outfd
) < 0)
4996 error ("Output file descriptor of %s is closed",
4997 SDATA (XPROCESS (proc
)->name
));
4999 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
5000 Vlast_coding_system_used
= coding
->symbol
;
5002 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5003 || (BUFFERP (object
)
5004 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5007 if (!EQ (coding
->symbol
, XPROCESS (proc
)->encode_coding_system
))
5008 /* The coding system for encoding was changed to raw-text
5009 because we sent a unibyte text previously. Now we are
5010 sending a multibyte text, thus we must encode it by the
5011 original coding system specified for the current
5013 setup_coding_system (XPROCESS (proc
)->encode_coding_system
, coding
);
5014 /* src_multibyte should be set to 1 _after_ a call to
5015 setup_coding_system, since it resets src_multibyte to
5017 coding
->src_multibyte
= 1;
5021 /* For sending a unibyte text, character code conversion should
5022 not take place but EOL conversion should. So, setup raw-text
5023 or one of the subsidiary if we have not yet done it. */
5024 if (coding
->type
!= coding_type_raw_text
)
5026 if (CODING_REQUIRE_FLUSHING (coding
))
5028 /* But, before changing the coding, we must flush out data. */
5029 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5030 send_process (proc
, "", 0, Qt
);
5032 coding
->src_multibyte
= 0;
5033 setup_raw_text_coding_system (coding
);
5036 coding
->dst_multibyte
= 0;
5038 if (CODING_REQUIRE_ENCODING (coding
))
5040 int require
= encoding_buffer_size (coding
, len
);
5041 int from_byte
= -1, from
= -1, to
= -1;
5042 unsigned char *temp_buf
= NULL
;
5044 if (BUFFERP (object
))
5046 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5047 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5048 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5050 else if (STRINGP (object
))
5052 from_byte
= buf
- SDATA (object
);
5053 from
= string_byte_to_char (object
, from_byte
);
5054 to
= string_byte_to_char (object
, from_byte
+ len
);
5057 if (coding
->composing
!= COMPOSITION_DISABLED
)
5060 coding_save_composition (coding
, from
, to
, object
);
5062 coding
->composing
= COMPOSITION_DISABLED
;
5065 if (SBYTES (XPROCESS (proc
)->encoding_buf
) < require
)
5066 XPROCESS (proc
)->encoding_buf
= make_uninit_string (require
);
5069 buf
= (BUFFERP (object
)
5070 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5071 : SDATA (object
) + from_byte
);
5073 object
= XPROCESS (proc
)->encoding_buf
;
5074 encode_coding (coding
, (char *) buf
, SDATA (object
),
5075 len
, SBYTES (object
));
5076 len
= coding
->produced
;
5077 buf
= SDATA (object
);
5083 vs
= get_vms_process_pointer (p
->pid
);
5085 error ("Could not find this process: %x", p
->pid
);
5086 else if (write_to_vms_process (vs
, buf
, len
))
5090 if (pty_max_bytes
== 0)
5092 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5093 pty_max_bytes
= fpathconf (XFASTINT (XPROCESS (proc
)->outfd
),
5095 if (pty_max_bytes
< 0)
5096 pty_max_bytes
= 250;
5098 pty_max_bytes
= 250;
5100 /* Deduct one, to leave space for the eof. */
5104 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5105 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5106 when returning with longjmp despite being declared volatile. */
5107 if (!setjmp (send_process_frame
))
5109 process_sent_to
= proc
;
5113 SIGTYPE (*old_sigpipe
)();
5115 /* Decide how much data we can send in one batch.
5116 Long lines need to be split into multiple batches. */
5117 if (!NILP (XPROCESS (proc
)->pty_flag
))
5119 /* Starting this at zero is always correct when not the first
5120 iteration because the previous iteration ended by sending C-d.
5121 It may not be correct for the first iteration
5122 if a partial line was sent in a separate send_process call.
5123 If that proves worth handling, we need to save linepos
5124 in the process object. */
5126 unsigned char *ptr
= (unsigned char *) buf
;
5127 unsigned char *end
= (unsigned char *) buf
+ len
;
5129 /* Scan through this text for a line that is too long. */
5130 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5138 /* If we found one, break the line there
5139 and put in a C-d to force the buffer through. */
5143 /* Send this batch, using one or more write calls. */
5146 int outfd
= XINT (XPROCESS (proc
)->outfd
);
5147 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5148 #ifdef DATAGRAM_SOCKETS
5149 if (DATAGRAM_CHAN_P (outfd
))
5151 rv
= sendto (outfd
, (char *) buf
, this,
5152 0, datagram_address
[outfd
].sa
,
5153 datagram_address
[outfd
].len
);
5154 if (rv
< 0 && errno
== EMSGSIZE
)
5155 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
5159 rv
= emacs_write (outfd
, (char *) buf
, this);
5160 signal (SIGPIPE
, old_sigpipe
);
5166 || errno
== EWOULDBLOCK
5172 /* Buffer is full. Wait, accepting input;
5173 that may allow the program
5174 to finish doing output and read more. */
5179 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5180 /* A gross hack to work around a bug in FreeBSD.
5181 In the following sequence, read(2) returns
5185 write(2) 954 bytes, get EAGAIN
5186 read(2) 1024 bytes in process_read_output
5187 read(2) 11 bytes in process_read_output
5189 That is, read(2) returns more bytes than have
5190 ever been written successfully. The 1033 bytes
5191 read are the 1022 bytes written successfully
5192 after processing (for example with CRs added if
5193 the terminal is set up that way which it is
5194 here). The same bytes will be seen again in a
5195 later read(2), without the CRs. */
5197 if (errno
== EAGAIN
)
5200 ioctl (XINT (XPROCESS (proc
)->outfd
), TIOCFLUSH
,
5203 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5205 /* Running filters might relocate buffers or strings.
5206 Arrange to relocate BUF. */
5207 if (BUFFERP (object
))
5208 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5209 else if (STRINGP (object
))
5210 offset
= buf
- SDATA (object
);
5212 XSETFASTINT (zero
, 0);
5213 #ifdef EMACS_HAS_USECS
5214 wait_reading_process_input (0, 20000, zero
, 0);
5216 wait_reading_process_input (1, 0, zero
, 0);
5219 if (BUFFERP (object
))
5220 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5221 else if (STRINGP (object
))
5222 buf
= offset
+ SDATA (object
);
5227 /* This is a real error. */
5228 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5235 /* If we sent just part of the string, put in an EOF
5236 to force it through, before we send the rest. */
5238 Fprocess_send_eof (proc
);
5241 #endif /* not VMS */
5245 proc
= process_sent_to
;
5247 XPROCESS (proc
)->raw_status_low
= Qnil
;
5248 XPROCESS (proc
)->raw_status_high
= Qnil
;
5249 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5250 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
5251 deactivate_process (proc
);
5253 error ("Error writing to process %s; closed it",
5254 SDATA (XPROCESS (proc
)->name
));
5256 error ("SIGPIPE raised on process %s; closed it",
5257 SDATA (XPROCESS (proc
)->name
));
5264 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5266 doc
: /* Send current contents of region as input to PROCESS.
5267 PROCESS may be a process, a buffer, the name of a process or buffer, or
5268 nil, indicating the current buffer's process.
5269 Called from program, takes three arguments, PROCESS, START and END.
5270 If the region is more than 500 characters long,
5271 it is sent in several bunches. This may happen even for shorter regions.
5272 Output from processes can arrive in between bunches. */)
5273 (process
, start
, end
)
5274 Lisp_Object process
, start
, end
;
5279 proc
= get_process (process
);
5280 validate_region (&start
, &end
);
5282 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5283 move_gap (XINT (start
));
5285 start1
= CHAR_TO_BYTE (XINT (start
));
5286 end1
= CHAR_TO_BYTE (XINT (end
));
5287 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5288 Fcurrent_buffer ());
5293 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5295 doc
: /* Send PROCESS the contents of STRING as input.
5296 PROCESS may be a process, a buffer, the name of a process or buffer, or
5297 nil, indicating the current buffer's process.
5298 If STRING is more than 500 characters long,
5299 it is sent in several bunches. This may happen even for shorter strings.
5300 Output from processes can arrive in between bunches. */)
5302 Lisp_Object process
, string
;
5305 CHECK_STRING (string
);
5306 proc
= get_process (process
);
5307 send_process (proc
, SDATA (string
),
5308 SBYTES (string
), string
);
5312 /* Return the foreground process group for the tty/pty that
5313 the process P uses. */
5315 emacs_get_tty_pgrp (p
)
5316 struct Lisp_Process
*p
;
5321 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5324 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5325 master side. Try the slave side. */
5326 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5330 ioctl (fd
, TIOCGPGRP
, &gid
);
5334 #endif /* defined (TIOCGPGRP ) */
5339 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5340 Sprocess_running_child_p
, 0, 1, 0,
5341 doc
: /* Return t if PROCESS has given the terminal to a child.
5342 If the operating system does not make it possible to find out,
5343 return t unconditionally. */)
5345 Lisp_Object process
;
5347 /* Initialize in case ioctl doesn't exist or gives an error,
5348 in a way that will cause returning t. */
5351 struct Lisp_Process
*p
;
5353 proc
= get_process (process
);
5354 p
= XPROCESS (proc
);
5356 if (!EQ (p
->childp
, Qt
))
5357 error ("Process %s is not a subprocess",
5359 if (XINT (p
->infd
) < 0)
5360 error ("Process %s is not active",
5363 gid
= emacs_get_tty_pgrp (p
);
5365 if (gid
== XFASTINT (p
->pid
))
5370 /* send a signal number SIGNO to PROCESS.
5371 If CURRENT_GROUP is t, that means send to the process group
5372 that currently owns the terminal being used to communicate with PROCESS.
5373 This is used for various commands in shell mode.
5374 If CURRENT_GROUP is lambda, that means send to the process group
5375 that currently owns the terminal, but only if it is NOT the shell itself.
5377 If NOMSG is zero, insert signal-announcements into process's buffers
5380 If we can, we try to signal PROCESS by sending control characters
5381 down the pty. This allows us to signal inferiors who have changed
5382 their uid, for which killpg would return an EPERM error. */
5385 process_send_signal (process
, signo
, current_group
, nomsg
)
5386 Lisp_Object process
;
5388 Lisp_Object current_group
;
5392 register struct Lisp_Process
*p
;
5396 proc
= get_process (process
);
5397 p
= XPROCESS (proc
);
5399 if (!EQ (p
->childp
, Qt
))
5400 error ("Process %s is not a subprocess",
5402 if (XINT (p
->infd
) < 0)
5403 error ("Process %s is not active",
5406 if (NILP (p
->pty_flag
))
5407 current_group
= Qnil
;
5409 /* If we are using pgrps, get a pgrp number and make it negative. */
5410 if (NILP (current_group
))
5411 /* Send the signal to the shell's process group. */
5412 gid
= XFASTINT (p
->pid
);
5415 #ifdef SIGNALS_VIA_CHARACTERS
5416 /* If possible, send signals to the entire pgrp
5417 by sending an input character to it. */
5419 /* TERMIOS is the latest and bestest, and seems most likely to
5420 work. If the system has it, use it. */
5427 tcgetattr (XINT (p
->infd
), &t
);
5428 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5432 tcgetattr (XINT (p
->infd
), &t
);
5433 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5437 tcgetattr (XINT (p
->infd
), &t
);
5438 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5439 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5441 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
5446 #else /* ! HAVE_TERMIOS */
5448 /* On Berkeley descendants, the following IOCTL's retrieve the
5449 current control characters. */
5450 #if defined (TIOCGLTC) && defined (TIOCGETC)
5458 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5459 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5462 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5463 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5467 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5468 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5470 #endif /* ! defined (SIGTSTP) */
5473 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5475 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5482 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5483 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5486 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5487 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5491 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5492 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5494 #endif /* ! defined (SIGTSTP) */
5496 #else /* ! defined (TCGETA) */
5497 Your configuration files are messed up
.
5498 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5499 you'd better be using one of the alternatives above! */
5500 #endif /* ! defined (TCGETA) */
5501 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5502 #endif /* ! defined HAVE_TERMIOS */
5504 /* The code above always returns from the function. */
5505 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5508 /* Get the current pgrp using the tty itself, if we have that.
5509 Otherwise, use the pty to get the pgrp.
5510 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5511 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5512 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5513 His patch indicates that if TIOCGPGRP returns an error, then
5514 we should just assume that p->pid is also the process group id. */
5516 gid
= emacs_get_tty_pgrp (p
);
5519 /* If we can't get the information, assume
5520 the shell owns the tty. */
5521 gid
= XFASTINT (p
->pid
);
5523 /* It is not clear whether anything really can set GID to -1.
5524 Perhaps on some system one of those ioctls can or could do so.
5525 Or perhaps this is vestigial. */
5528 #else /* ! defined (TIOCGPGRP ) */
5529 /* Can't select pgrps on this system, so we know that
5530 the child itself heads the pgrp. */
5531 gid
= XFASTINT (p
->pid
);
5532 #endif /* ! defined (TIOCGPGRP ) */
5534 /* If current_group is lambda, and the shell owns the terminal,
5535 don't send any signal. */
5536 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5544 p
->raw_status_low
= Qnil
;
5545 p
->raw_status_high
= Qnil
;
5547 XSETINT (p
->tick
, ++process_tick
);
5551 #endif /* ! defined (SIGCONT) */
5554 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5559 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5564 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5567 flush_pending_output (XINT (p
->infd
));
5571 /* If we don't have process groups, send the signal to the immediate
5572 subprocess. That isn't really right, but it's better than any
5573 obvious alternative. */
5576 kill (XFASTINT (p
->pid
), signo
);
5580 /* gid may be a pid, or minus a pgrp's number */
5582 if (!NILP (current_group
))
5584 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5585 EMACS_KILLPG (gid
, signo
);
5589 gid
= - XFASTINT (p
->pid
);
5592 #else /* ! defined (TIOCSIGSEND) */
5593 EMACS_KILLPG (gid
, signo
);
5594 #endif /* ! defined (TIOCSIGSEND) */
5597 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5598 doc
: /* Interrupt process PROCESS.
5599 PROCESS may be a process, a buffer, or the name of a process or buffer.
5600 nil or no arg means current buffer's process.
5601 Second arg CURRENT-GROUP non-nil means send signal to
5602 the current process-group of the process's controlling terminal
5603 rather than to the process's own process group.
5604 If the process is a shell, this means interrupt current subjob
5605 rather than the shell.
5607 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5608 don't send the signal. */)
5609 (process
, current_group
)
5610 Lisp_Object process
, current_group
;
5612 process_send_signal (process
, SIGINT
, current_group
, 0);
5616 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5617 doc
: /* Kill process PROCESS. May be process or name of one.
5618 See function `interrupt-process' for more details on usage. */)
5619 (process
, current_group
)
5620 Lisp_Object process
, current_group
;
5622 process_send_signal (process
, SIGKILL
, current_group
, 0);
5626 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5627 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5628 See function `interrupt-process' for more details on usage. */)
5629 (process
, current_group
)
5630 Lisp_Object process
, current_group
;
5632 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5636 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5637 doc
: /* Stop process PROCESS. May be process or name of one.
5638 See function `interrupt-process' for more details on usage.
5639 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5640 (process
, current_group
)
5641 Lisp_Object process
, current_group
;
5644 if (PROCESSP (process
) && NETCONN_P (process
))
5646 struct Lisp_Process
*p
;
5648 p
= XPROCESS (process
);
5649 if (NILP (p
->command
)
5650 && XINT (p
->infd
) >= 0)
5652 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5653 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5660 error ("no SIGTSTP support");
5662 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5667 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5668 doc
: /* Continue process PROCESS. May be process or name of one.
5669 See function `interrupt-process' for more details on usage.
5670 If PROCESS is a network process, resume handling of incoming traffic. */)
5671 (process
, current_group
)
5672 Lisp_Object process
, current_group
;
5675 if (PROCESSP (process
) && NETCONN_P (process
))
5677 struct Lisp_Process
*p
;
5679 p
= XPROCESS (process
);
5680 if (EQ (p
->command
, Qt
)
5681 && XINT (p
->infd
) >= 0
5682 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5684 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5685 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5692 process_send_signal (process
, SIGCONT
, current_group
, 0);
5694 error ("no SIGCONT support");
5699 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5700 2, 2, "sProcess (name or number): \nnSignal code: ",
5701 doc
: /* Send PROCESS the signal with code SIGCODE.
5702 PROCESS may also be an integer specifying the process id of the
5703 process to signal; in this case, the process need not be a child of
5705 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5707 Lisp_Object process
, sigcode
;
5711 if (INTEGERP (process
))
5717 if (STRINGP (process
))
5720 if (tem
= Fget_process (process
), NILP (tem
))
5722 pid
= Fstring_to_number (process
, make_number (10));
5723 if (XINT (pid
) != 0)
5729 process
= get_process (process
);
5734 CHECK_PROCESS (process
);
5735 pid
= XPROCESS (process
)->pid
;
5736 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
5737 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
5741 #define handle_signal(NAME, VALUE) \
5742 else if (!strcmp (name, NAME)) \
5743 XSETINT (sigcode, VALUE)
5745 if (INTEGERP (sigcode
))
5749 unsigned char *name
;
5751 CHECK_SYMBOL (sigcode
);
5752 name
= SDATA (SYMBOL_NAME (sigcode
));
5757 handle_signal ("SIGHUP", SIGHUP
);
5760 handle_signal ("SIGINT", SIGINT
);
5763 handle_signal ("SIGQUIT", SIGQUIT
);
5766 handle_signal ("SIGILL", SIGILL
);
5769 handle_signal ("SIGABRT", SIGABRT
);
5772 handle_signal ("SIGEMT", SIGEMT
);
5775 handle_signal ("SIGKILL", SIGKILL
);
5778 handle_signal ("SIGFPE", SIGFPE
);
5781 handle_signal ("SIGBUS", SIGBUS
);
5784 handle_signal ("SIGSEGV", SIGSEGV
);
5787 handle_signal ("SIGSYS", SIGSYS
);
5790 handle_signal ("SIGPIPE", SIGPIPE
);
5793 handle_signal ("SIGALRM", SIGALRM
);
5796 handle_signal ("SIGTERM", SIGTERM
);
5799 handle_signal ("SIGURG", SIGURG
);
5802 handle_signal ("SIGSTOP", SIGSTOP
);
5805 handle_signal ("SIGTSTP", SIGTSTP
);
5808 handle_signal ("SIGCONT", SIGCONT
);
5811 handle_signal ("SIGCHLD", SIGCHLD
);
5814 handle_signal ("SIGTTIN", SIGTTIN
);
5817 handle_signal ("SIGTTOU", SIGTTOU
);
5820 handle_signal ("SIGIO", SIGIO
);
5823 handle_signal ("SIGXCPU", SIGXCPU
);
5826 handle_signal ("SIGXFSZ", SIGXFSZ
);
5829 handle_signal ("SIGVTALRM", SIGVTALRM
);
5832 handle_signal ("SIGPROF", SIGPROF
);
5835 handle_signal ("SIGWINCH", SIGWINCH
);
5838 handle_signal ("SIGINFO", SIGINFO
);
5841 handle_signal ("SIGUSR1", SIGUSR1
);
5844 handle_signal ("SIGUSR2", SIGUSR2
);
5847 error ("Undefined signal name %s", name
);
5850 #undef handle_signal
5852 return make_number (kill (XINT (pid
), XINT (sigcode
)));
5855 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
5856 doc
: /* Make PROCESS see end-of-file in its input.
5857 EOF comes after any text already sent to it.
5858 PROCESS may be a process, a buffer, the name of a process or buffer, or
5859 nil, indicating the current buffer's process.
5860 If PROCESS is a network connection, or is a process communicating
5861 through a pipe (as opposed to a pty), then you cannot send any more
5862 text to PROCESS after you call this function. */)
5864 Lisp_Object process
;
5867 struct coding_system
*coding
;
5869 if (DATAGRAM_CONN_P (process
))
5872 proc
= get_process (process
);
5873 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
5875 /* Make sure the process is really alive. */
5876 if (! NILP (XPROCESS (proc
)->raw_status_low
))
5877 update_status (XPROCESS (proc
));
5878 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
5879 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
5881 if (CODING_REQUIRE_FLUSHING (coding
))
5883 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5884 send_process (proc
, "", 0, Qnil
);
5888 send_process (proc
, "\032", 1, Qnil
); /* ^z */
5890 if (!NILP (XPROCESS (proc
)->pty_flag
))
5891 send_process (proc
, "\004", 1, Qnil
);
5894 int old_outfd
, new_outfd
;
5896 #ifdef HAVE_SHUTDOWN
5897 /* If this is a network connection, or socketpair is used
5898 for communication with the subprocess, call shutdown to cause EOF.
5899 (In some old system, shutdown to socketpair doesn't work.
5900 Then we just can't win.) */
5901 if (NILP (XPROCESS (proc
)->pid
)
5902 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
5903 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
5904 /* In case of socketpair, outfd == infd, so don't close it. */
5905 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
5906 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5907 #else /* not HAVE_SHUTDOWN */
5908 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5909 #endif /* not HAVE_SHUTDOWN */
5910 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
5911 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
5913 if (!proc_encode_coding_system
[new_outfd
])
5914 proc_encode_coding_system
[new_outfd
]
5915 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
5916 bcopy (proc_encode_coding_system
[old_outfd
],
5917 proc_encode_coding_system
[new_outfd
],
5918 sizeof (struct coding_system
));
5919 bzero (proc_encode_coding_system
[old_outfd
],
5920 sizeof (struct coding_system
));
5922 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
5928 /* Kill all processes associated with `buffer'.
5929 If `buffer' is nil, kill all processes */
5932 kill_buffer_processes (buffer
)
5935 Lisp_Object tail
, proc
;
5937 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5939 proc
= XCDR (XCAR (tail
));
5940 if (GC_PROCESSP (proc
)
5941 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
5943 if (NETCONN_P (proc
))
5944 Fdelete_process (proc
);
5945 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
5946 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
5951 /* On receipt of a signal that a child status has changed, loop asking
5952 about children with changed statuses until the system says there
5955 All we do is change the status; we do not run sentinels or print
5956 notifications. That is saved for the next time keyboard input is
5957 done, in order to avoid timing errors.
5959 ** WARNING: this can be called during garbage collection.
5960 Therefore, it must not be fooled by the presence of mark bits in
5963 ** USG WARNING: Although it is not obvious from the documentation
5964 in signal(2), on a USG system the SIGCLD handler MUST NOT call
5965 signal() before executing at least one wait(), otherwise the
5966 handler will be called again, resulting in an infinite loop. The
5967 relevant portion of the documentation reads "SIGCLD signals will be
5968 queued and the signal-catching function will be continually
5969 reentered until the queue is empty". Invoking signal() causes the
5970 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
5974 sigchld_handler (signo
)
5977 int old_errno
= errno
;
5979 register struct Lisp_Process
*p
;
5980 extern EMACS_TIME
*input_available_clear_time
;
5984 sigheld
|= sigbit (SIGCHLD
);
5996 #endif /* no WUNTRACED */
5997 /* Keep trying to get a status until we get a definitive result. */
6001 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6003 while (pid
< 0 && errno
== EINTR
);
6007 /* PID == 0 means no processes found, PID == -1 means a real
6008 failure. We have done all our job, so return. */
6010 /* USG systems forget handlers when they are used;
6011 must reestablish each time */
6012 #if defined (USG) && !defined (POSIX_SIGNALS)
6013 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6016 sigheld
&= ~sigbit (SIGCHLD
);
6024 #endif /* no WNOHANG */
6026 /* Find the process that signaled us, and record its status. */
6029 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6031 proc
= XCDR (XCAR (tail
));
6032 p
= XPROCESS (proc
);
6033 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
6038 /* Look for an asynchronous process whose pid hasn't been filled
6041 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6043 proc
= XCDR (XCAR (tail
));
6044 p
= XPROCESS (proc
);
6045 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
6050 /* Change the status of the process that was found. */
6053 union { int i
; WAITTYPE wt
; } u
;
6054 int clear_desc_flag
= 0;
6056 XSETINT (p
->tick
, ++process_tick
);
6058 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
6059 XSETINT (p
->raw_status_high
, u
.i
>> 16);
6061 /* If process has terminated, stop waiting for its output. */
6062 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6063 && XINT (p
->infd
) >= 0)
6064 clear_desc_flag
= 1;
6066 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6067 if (clear_desc_flag
)
6069 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6070 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6073 /* Tell wait_reading_process_input that it needs to wake up and
6075 if (input_available_clear_time
)
6076 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6079 /* There was no asynchronous process found for that id. Check
6080 if we have a synchronous process. */
6083 synch_process_alive
= 0;
6085 /* Report the status of the synchronous process. */
6087 synch_process_retcode
= WRETCODE (w
);
6088 else if (WIFSIGNALED (w
))
6090 int code
= WTERMSIG (w
);
6093 synchronize_system_messages_locale ();
6094 signame
= strsignal (code
);
6097 signame
= "unknown";
6099 synch_process_death
= signame
;
6102 /* Tell wait_reading_process_input that it needs to wake up and
6104 if (input_available_clear_time
)
6105 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6108 /* On some systems, we must return right away.
6109 If any more processes want to signal us, we will
6111 Otherwise (on systems that have WNOHANG), loop around
6112 to use up all the processes that have something to tell us. */
6113 #if (defined WINDOWSNT \
6114 || (defined USG && !defined GNU_LINUX \
6115 && !(defined HPUX && defined WNOHANG)))
6116 #if defined (USG) && ! defined (POSIX_SIGNALS)
6117 signal (signo
, sigchld_handler
);
6121 #endif /* USG, but not HPUX with WNOHANG */
6127 exec_sentinel_unwind (data
)
6130 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6135 exec_sentinel_error_handler (error
)
6138 cmd_error_internal (error
, "error in process sentinel: ");
6140 update_echo_area ();
6141 Fsleep_for (make_number (2), Qnil
);
6146 exec_sentinel (proc
, reason
)
6147 Lisp_Object proc
, reason
;
6149 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6150 register struct Lisp_Process
*p
= XPROCESS (proc
);
6151 int count
= SPECPDL_INDEX ();
6152 int outer_running_asynch_code
= running_asynch_code
;
6153 int waiting
= waiting_for_user_input_p
;
6155 /* No need to gcpro these, because all we do with them later
6156 is test them for EQness, and none of them should be a string. */
6157 odeactivate
= Vdeactivate_mark
;
6158 XSETBUFFER (obuffer
, current_buffer
);
6159 okeymap
= current_buffer
->keymap
;
6161 sentinel
= p
->sentinel
;
6162 if (NILP (sentinel
))
6165 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6166 assure that it gets restored no matter how the sentinel exits. */
6168 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6169 /* Inhibit quit so that random quits don't screw up a running filter. */
6170 specbind (Qinhibit_quit
, Qt
);
6171 specbind (Qlast_nonmenu_event
, Qt
);
6173 /* In case we get recursively called,
6174 and we already saved the match data nonrecursively,
6175 save the same match data in safely recursive fashion. */
6176 if (outer_running_asynch_code
)
6179 tem
= Fmatch_data (Qnil
, Qnil
);
6180 restore_match_data ();
6181 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
6182 Fset_match_data (tem
);
6185 /* For speed, if a search happens within this code,
6186 save the match data in a special nonrecursive fashion. */
6187 running_asynch_code
= 1;
6189 internal_condition_case_1 (read_process_output_call
,
6191 Fcons (proc
, Fcons (reason
, Qnil
))),
6192 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6193 exec_sentinel_error_handler
);
6195 /* If we saved the match data nonrecursively, restore it now. */
6196 restore_match_data ();
6197 running_asynch_code
= outer_running_asynch_code
;
6199 Vdeactivate_mark
= odeactivate
;
6201 /* Restore waiting_for_user_input_p as it was
6202 when we were called, in case the filter clobbered it. */
6203 waiting_for_user_input_p
= waiting
;
6206 if (! EQ (Fcurrent_buffer (), obuffer
)
6207 || ! EQ (current_buffer
->keymap
, okeymap
))
6209 /* But do it only if the caller is actually going to read events.
6210 Otherwise there's no need to make him wake up, and it could
6211 cause trouble (for example it would make Fsit_for return). */
6212 if (waiting_for_user_input_p
== -1)
6213 record_asynch_buffer_change ();
6215 unbind_to (count
, Qnil
);
6218 /* Report all recent events of a change in process status
6219 (either run the sentinel or output a message).
6220 This is usually done while Emacs is waiting for keyboard input
6221 but can be done at other times. */
6226 register Lisp_Object proc
, buffer
;
6227 Lisp_Object tail
, msg
;
6228 struct gcpro gcpro1
, gcpro2
;
6232 /* We need to gcpro tail; if read_process_output calls a filter
6233 which deletes a process and removes the cons to which tail points
6234 from Vprocess_alist, and then causes a GC, tail is an unprotected
6238 /* Set this now, so that if new processes are created by sentinels
6239 that we run, we get called again to handle their status changes. */
6240 update_tick
= process_tick
;
6242 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6245 register struct Lisp_Process
*p
;
6247 proc
= Fcdr (Fcar (tail
));
6248 p
= XPROCESS (proc
);
6250 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6252 XSETINT (p
->update_tick
, XINT (p
->tick
));
6254 /* If process is still active, read any output that remains. */
6255 while (! EQ (p
->filter
, Qt
)
6256 && ! EQ (p
->status
, Qconnect
)
6257 && ! EQ (p
->status
, Qlisten
)
6258 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6259 && XINT (p
->infd
) >= 0
6260 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6264 /* Get the text to use for the message. */
6265 if (!NILP (p
->raw_status_low
))
6267 msg
= status_message (p
->status
);
6269 /* If process is terminated, deactivate it or delete it. */
6271 if (CONSP (p
->status
))
6272 symbol
= XCAR (p
->status
);
6274 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6275 || EQ (symbol
, Qclosed
))
6277 if (delete_exited_processes
)
6278 remove_process (proc
);
6280 deactivate_process (proc
);
6283 /* The actions above may have further incremented p->tick.
6284 So set p->update_tick again
6285 so that an error in the sentinel will not cause
6286 this code to be run again. */
6287 XSETINT (p
->update_tick
, XINT (p
->tick
));
6288 /* Now output the message suitably. */
6289 if (!NILP (p
->sentinel
))
6290 exec_sentinel (proc
, msg
);
6291 /* Don't bother with a message in the buffer
6292 when a process becomes runnable. */
6293 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6295 Lisp_Object ro
, tem
;
6296 struct buffer
*old
= current_buffer
;
6297 int opoint
, opoint_byte
;
6298 int before
, before_byte
;
6300 ro
= XBUFFER (buffer
)->read_only
;
6302 /* Avoid error if buffer is deleted
6303 (probably that's why the process is dead, too) */
6304 if (NILP (XBUFFER (buffer
)->name
))
6306 Fset_buffer (buffer
);
6309 opoint_byte
= PT_BYTE
;
6310 /* Insert new output into buffer
6311 at the current end-of-output marker,
6312 thus preserving logical ordering of input and output. */
6313 if (XMARKER (p
->mark
)->buffer
)
6314 Fgoto_char (p
->mark
);
6316 SET_PT_BOTH (ZV
, ZV_BYTE
);
6319 before_byte
= PT_BYTE
;
6321 tem
= current_buffer
->read_only
;
6322 current_buffer
->read_only
= Qnil
;
6323 insert_string ("\nProcess ");
6324 Finsert (1, &p
->name
);
6325 insert_string (" ");
6327 current_buffer
->read_only
= tem
;
6328 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6330 if (opoint
>= before
)
6331 SET_PT_BOTH (opoint
+ (PT
- before
),
6332 opoint_byte
+ (PT_BYTE
- before_byte
));
6334 SET_PT_BOTH (opoint
, opoint_byte
);
6336 set_buffer_internal (old
);
6341 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6342 redisplay_preserve_echo_area (13);
6348 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6349 Sset_process_coding_system
, 1, 3, 0,
6350 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6351 DECODING will be used to decode subprocess output and ENCODING to
6352 encode subprocess input. */)
6353 (proc
, decoding
, encoding
)
6354 register Lisp_Object proc
, decoding
, encoding
;
6356 register struct Lisp_Process
*p
;
6358 CHECK_PROCESS (proc
);
6359 p
= XPROCESS (proc
);
6360 if (XINT (p
->infd
) < 0)
6361 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6362 if (XINT (p
->outfd
) < 0)
6363 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6364 Fcheck_coding_system (decoding
);
6365 Fcheck_coding_system (encoding
);
6367 p
->decode_coding_system
= decoding
;
6368 p
->encode_coding_system
= encoding
;
6369 setup_process_coding_systems (proc
);
6374 DEFUN ("process-coding-system",
6375 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6376 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6378 register Lisp_Object proc
;
6380 CHECK_PROCESS (proc
);
6381 return Fcons (XPROCESS (proc
)->decode_coding_system
,
6382 XPROCESS (proc
)->encode_coding_system
);
6385 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6386 Sset_process_filter_multibyte
, 2, 2, 0,
6387 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6388 If FLAG is non-nil, the filter is given multibyte strings.
6389 If FLAG is nil, the filter is given unibyte strings. In this case,
6390 all character code conversion except for end-of-line conversion is
6393 Lisp_Object proc
, flag
;
6395 register struct Lisp_Process
*p
;
6397 CHECK_PROCESS (proc
);
6398 p
= XPROCESS (proc
);
6399 p
->filter_multibyte
= flag
;
6400 setup_process_coding_systems (proc
);
6405 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6406 Sprocess_filter_multibyte_p
, 1, 1, 0,
6407 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6411 register struct Lisp_Process
*p
;
6413 CHECK_PROCESS (proc
);
6414 p
= XPROCESS (proc
);
6416 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6421 /* The first time this is called, assume keyboard input comes from DESC
6422 instead of from where we used to expect it.
6423 Subsequent calls mean assume input keyboard can come from DESC
6424 in addition to other places. */
6426 static int add_keyboard_wait_descriptor_called_flag
;
6429 add_keyboard_wait_descriptor (desc
)
6432 if (! add_keyboard_wait_descriptor_called_flag
)
6433 FD_CLR (0, &input_wait_mask
);
6434 add_keyboard_wait_descriptor_called_flag
= 1;
6435 FD_SET (desc
, &input_wait_mask
);
6436 FD_SET (desc
, &non_process_wait_mask
);
6437 if (desc
> max_keyboard_desc
)
6438 max_keyboard_desc
= desc
;
6441 /* From now on, do not expect DESC to give keyboard input. */
6444 delete_keyboard_wait_descriptor (desc
)
6448 int lim
= max_keyboard_desc
;
6450 FD_CLR (desc
, &input_wait_mask
);
6451 FD_CLR (desc
, &non_process_wait_mask
);
6453 if (desc
== max_keyboard_desc
)
6454 for (fd
= 0; fd
< lim
; fd
++)
6455 if (FD_ISSET (fd
, &input_wait_mask
)
6456 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6457 max_keyboard_desc
= fd
;
6460 /* Return nonzero if *MASK has a bit set
6461 that corresponds to one of the keyboard input descriptors. */
6464 keyboard_bit_set (mask
)
6469 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6470 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6471 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6484 if (! noninteractive
|| initialized
)
6486 signal (SIGCHLD
, sigchld_handler
);
6489 FD_ZERO (&input_wait_mask
);
6490 FD_ZERO (&non_keyboard_wait_mask
);
6491 FD_ZERO (&non_process_wait_mask
);
6492 max_process_desc
= 0;
6494 FD_SET (0, &input_wait_mask
);
6496 Vprocess_alist
= Qnil
;
6497 for (i
= 0; i
< MAXDESC
; i
++)
6499 chan_process
[i
] = Qnil
;
6500 proc_buffered_char
[i
] = -1;
6502 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6503 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6504 #ifdef DATAGRAM_SOCKETS
6505 bzero (datagram_address
, sizeof datagram_address
);
6510 Lisp_Object subfeatures
= Qnil
;
6511 struct socket_options
*sopt
;
6513 #define ADD_SUBFEATURE(key, val) \
6514 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6516 #ifdef NON_BLOCKING_CONNECT
6517 ADD_SUBFEATURE (QCnowait
, Qt
);
6519 #ifdef DATAGRAM_SOCKETS
6520 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6522 #ifdef HAVE_LOCAL_SOCKETS
6523 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6525 #ifdef HAVE_GETSOCKNAME
6526 ADD_SUBFEATURE (QCservice
, Qt
);
6528 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6529 ADD_SUBFEATURE (QCserver
, Qt
);
6532 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6533 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6535 Fprovide (intern ("make-network-process"), subfeatures
);
6537 #endif /* HAVE_SOCKETS */
6543 Qprocessp
= intern ("processp");
6544 staticpro (&Qprocessp
);
6545 Qrun
= intern ("run");
6547 Qstop
= intern ("stop");
6549 Qsignal
= intern ("signal");
6550 staticpro (&Qsignal
);
6552 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6555 Qexit = intern ("exit");
6556 staticpro (&Qexit); */
6558 Qopen
= intern ("open");
6560 Qclosed
= intern ("closed");
6561 staticpro (&Qclosed
);
6562 Qconnect
= intern ("connect");
6563 staticpro (&Qconnect
);
6564 Qfailed
= intern ("failed");
6565 staticpro (&Qfailed
);
6566 Qlisten
= intern ("listen");
6567 staticpro (&Qlisten
);
6568 Qlocal
= intern ("local");
6569 staticpro (&Qlocal
);
6570 Qdatagram
= intern ("datagram");
6571 staticpro (&Qdatagram
);
6573 QCname
= intern (":name");
6574 staticpro (&QCname
);
6575 QCbuffer
= intern (":buffer");
6576 staticpro (&QCbuffer
);
6577 QChost
= intern (":host");
6578 staticpro (&QChost
);
6579 QCservice
= intern (":service");
6580 staticpro (&QCservice
);
6581 QCtype
= intern (":type");
6582 staticpro (&QCtype
);
6583 QClocal
= intern (":local");
6584 staticpro (&QClocal
);
6585 QCremote
= intern (":remote");
6586 staticpro (&QCremote
);
6587 QCcoding
= intern (":coding");
6588 staticpro (&QCcoding
);
6589 QCserver
= intern (":server");
6590 staticpro (&QCserver
);
6591 QCnowait
= intern (":nowait");
6592 staticpro (&QCnowait
);
6593 QCsentinel
= intern (":sentinel");
6594 staticpro (&QCsentinel
);
6595 QClog
= intern (":log");
6597 QCnoquery
= intern (":noquery");
6598 staticpro (&QCnoquery
);
6599 QCstop
= intern (":stop");
6600 staticpro (&QCstop
);
6601 QCoptions
= intern (":options");
6602 staticpro (&QCoptions
);
6603 QCplist
= intern (":plist");
6604 staticpro (&QCplist
);
6605 QCfilter_multibyte
= intern (":filter-multibyte");
6606 staticpro (&QCfilter_multibyte
);
6608 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6609 staticpro (&Qlast_nonmenu_event
);
6611 staticpro (&Vprocess_alist
);
6613 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6614 doc
: /* *Non-nil means delete processes immediately when they exit.
6615 nil means don't delete them until `list-processes' is run. */);
6617 delete_exited_processes
= 1;
6619 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6620 doc
: /* Control type of device used to communicate with subprocesses.
6621 Values are nil to use a pipe, or t or `pty' to use a pty.
6622 The value has no effect if the system has no ptys or if all ptys are busy:
6623 then a pipe is used in any case.
6624 The value takes effect when `start-process' is called. */);
6625 Vprocess_connection_type
= Qt
;
6627 defsubr (&Sprocessp
);
6628 defsubr (&Sget_process
);
6629 defsubr (&Sget_buffer_process
);
6630 defsubr (&Sdelete_process
);
6631 defsubr (&Sprocess_status
);
6632 defsubr (&Sprocess_exit_status
);
6633 defsubr (&Sprocess_id
);
6634 defsubr (&Sprocess_name
);
6635 defsubr (&Sprocess_tty_name
);
6636 defsubr (&Sprocess_command
);
6637 defsubr (&Sset_process_buffer
);
6638 defsubr (&Sprocess_buffer
);
6639 defsubr (&Sprocess_mark
);
6640 defsubr (&Sset_process_filter
);
6641 defsubr (&Sprocess_filter
);
6642 defsubr (&Sset_process_sentinel
);
6643 defsubr (&Sprocess_sentinel
);
6644 defsubr (&Sset_process_window_size
);
6645 defsubr (&Sset_process_inherit_coding_system_flag
);
6646 defsubr (&Sprocess_inherit_coding_system_flag
);
6647 defsubr (&Sset_process_query_on_exit_flag
);
6648 defsubr (&Sprocess_query_on_exit_flag
);
6649 defsubr (&Sprocess_contact
);
6650 defsubr (&Sprocess_plist
);
6651 defsubr (&Sset_process_plist
);
6652 defsubr (&Slist_processes
);
6653 defsubr (&Sprocess_list
);
6654 defsubr (&Sstart_process
);
6656 defsubr (&Sset_network_process_option
);
6657 defsubr (&Smake_network_process
);
6658 defsubr (&Sformat_network_address
);
6660 defsubr (&Snetwork_interface_list
);
6662 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
6663 defsubr (&Snetwork_interface_info
);
6665 #endif /* HAVE_SOCKETS */
6666 #ifdef DATAGRAM_SOCKETS
6667 defsubr (&Sprocess_datagram_address
);
6668 defsubr (&Sset_process_datagram_address
);
6670 defsubr (&Saccept_process_output
);
6671 defsubr (&Sprocess_send_region
);
6672 defsubr (&Sprocess_send_string
);
6673 defsubr (&Sinterrupt_process
);
6674 defsubr (&Skill_process
);
6675 defsubr (&Squit_process
);
6676 defsubr (&Sstop_process
);
6677 defsubr (&Scontinue_process
);
6678 defsubr (&Sprocess_running_child_p
);
6679 defsubr (&Sprocess_send_eof
);
6680 defsubr (&Ssignal_process
);
6681 defsubr (&Swaiting_for_user_input_p
);
6682 /* defsubr (&Sprocess_connection); */
6683 defsubr (&Sset_process_coding_system
);
6684 defsubr (&Sprocess_coding_system
);
6685 defsubr (&Sset_process_filter_multibyte
);
6686 defsubr (&Sprocess_filter_multibyte_p
);
6690 #else /* not subprocesses */
6692 #include <sys/types.h>
6696 #include "systime.h"
6697 #include "charset.h"
6699 #include "termopts.h"
6700 #include "sysselect.h"
6702 extern int frame_garbaged
;
6704 extern EMACS_TIME
timer_check ();
6705 extern int timers_run
;
6709 /* As described above, except assuming that there are no subprocesses:
6711 Wait for timeout to elapse and/or keyboard input to be available.
6714 timeout in seconds, or
6715 zero for no limit, or
6716 -1 means gobble data immediately available but don't wait for any.
6718 read_kbd is a Lisp_Object:
6719 0 to ignore keyboard input, or
6720 1 to return when input is available, or
6721 -1 means caller will actually read the input, so don't throw to
6723 a cons cell, meaning wait until its car is non-nil
6724 (and gobble terminal input into the buffer if any arrives), or
6725 We know that read_kbd will never be a Lisp_Process, since
6726 `subprocesses' isn't defined.
6728 do_display != 0 means redisplay should be done to show subprocess
6729 output that arrives.
6731 Return true iff we received input from any process. */
6734 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
6735 int time_limit
, microsecs
;
6736 Lisp_Object read_kbd
;
6740 EMACS_TIME end_time
, timeout
;
6741 SELECT_TYPE waitchannels
;
6743 /* Either nil or a cons cell, the car of which is of interest and
6744 may be changed outside of this routine. */
6745 Lisp_Object wait_for_cell
;
6747 wait_for_cell
= Qnil
;
6749 /* If waiting for non-nil in a cell, record where. */
6750 if (CONSP (read_kbd
))
6752 wait_for_cell
= read_kbd
;
6753 XSETFASTINT (read_kbd
, 0);
6756 /* What does time_limit really mean? */
6757 if (time_limit
|| microsecs
)
6759 EMACS_GET_TIME (end_time
);
6760 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6761 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6764 /* Turn off periodic alarms (in case they are in use)
6765 and then turn off any other atimers,
6766 because the select emulator uses alarms. */
6768 turn_on_atimers (0);
6772 int timeout_reduced_for_timers
= 0;
6774 /* If calling from keyboard input, do not quit
6775 since we want to return C-g as an input character.
6776 Otherwise, do pending quit if requested. */
6777 if (XINT (read_kbd
) >= 0)
6780 /* Exit now if the cell we're waiting for became non-nil. */
6781 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6784 /* Compute time from now till when time limit is up */
6785 /* Exit if already run out */
6786 if (time_limit
== -1)
6788 /* -1 specified for timeout means
6789 gobble output available now
6790 but don't wait at all. */
6792 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6794 else if (time_limit
|| microsecs
)
6796 EMACS_GET_TIME (timeout
);
6797 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6798 if (EMACS_TIME_NEG_P (timeout
))
6803 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6806 /* If our caller will not immediately handle keyboard events,
6807 run timer events directly.
6808 (Callers that will immediately read keyboard events
6809 call timer_delay on their own.) */
6810 if (NILP (wait_for_cell
))
6812 EMACS_TIME timer_delay
;
6816 int old_timers_run
= timers_run
;
6817 timer_delay
= timer_check (1);
6818 if (timers_run
!= old_timers_run
&& do_display
)
6819 /* We must retry, since a timer may have requeued itself
6820 and that could alter the time delay. */
6821 redisplay_preserve_echo_area (14);
6825 while (!detect_input_pending ());
6827 /* If there is unread keyboard input, also return. */
6828 if (XINT (read_kbd
) != 0
6829 && requeued_events_pending_p ())
6832 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6834 EMACS_TIME difference
;
6835 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6836 if (EMACS_TIME_NEG_P (difference
))
6838 timeout
= timer_delay
;
6839 timeout_reduced_for_timers
= 1;
6844 /* Cause C-g and alarm signals to take immediate action,
6845 and cause input available signals to zero out timeout. */
6846 if (XINT (read_kbd
) < 0)
6847 set_waiting_for_input (&timeout
);
6849 /* Wait till there is something to do. */
6851 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
6852 FD_ZERO (&waitchannels
);
6854 FD_SET (0, &waitchannels
);
6856 /* If a frame has been newly mapped and needs updating,
6857 reprocess its display stuff. */
6858 if (frame_garbaged
&& do_display
)
6860 clear_waiting_for_input ();
6861 redisplay_preserve_echo_area (15);
6862 if (XINT (read_kbd
) < 0)
6863 set_waiting_for_input (&timeout
);
6866 if (XINT (read_kbd
) && detect_input_pending ())
6869 FD_ZERO (&waitchannels
);
6872 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
6877 /* Make C-g and alarm signals set flags again */
6878 clear_waiting_for_input ();
6880 /* If we woke up due to SIGWINCH, actually change size now. */
6881 do_pending_window_change (0);
6883 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
6884 /* We waited the full specified time, so return now. */
6889 /* If the system call was interrupted, then go around the
6891 if (xerrno
== EINTR
)
6892 FD_ZERO (&waitchannels
);
6894 error ("select error: %s", emacs_strerror (xerrno
));
6897 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
6898 /* System sometimes fails to deliver SIGIO. */
6899 kill (getpid (), SIGIO
);
6902 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
6903 kill (getpid (), SIGIO
);
6906 /* Check for keyboard input */
6908 if ((XINT (read_kbd
) != 0)
6909 && detect_input_pending_run_timers (do_display
))
6911 swallow_events (do_display
);
6912 if (detect_input_pending_run_timers (do_display
))
6916 /* If there is unread keyboard input, also return. */
6917 if (XINT (read_kbd
) != 0
6918 && requeued_events_pending_p ())
6921 /* If wait_for_cell. check for keyboard input
6922 but don't run any timers.
6923 ??? (It seems wrong to me to check for keyboard
6924 input at all when wait_for_cell, but the code
6925 has been this way since July 1994.
6926 Try changing this after version 19.31.) */
6927 if (! NILP (wait_for_cell
)
6928 && detect_input_pending ())
6930 swallow_events (do_display
);
6931 if (detect_input_pending ())
6935 /* Exit now if the cell we're waiting for became non-nil. */
6936 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6946 /* Don't confuse make-docfile by having two doc strings for this function.
6947 make-docfile does not pay attention to #if, for good reason! */
6948 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
6951 register Lisp_Object name
;
6956 /* Don't confuse make-docfile by having two doc strings for this function.
6957 make-docfile does not pay attention to #if, for good reason! */
6958 DEFUN ("process-inherit-coding-system-flag",
6959 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
6963 register Lisp_Object process
;
6965 /* Ignore the argument and return the value of
6966 inherit-process-coding-system. */
6967 return inherit_process_coding_system
? Qt
: Qnil
;
6970 /* Kill all processes associated with `buffer'.
6971 If `buffer' is nil, kill all processes.
6972 Since we have no subprocesses, this does nothing. */
6975 kill_buffer_processes (buffer
)
6988 QCtype
= intern (":type");
6989 staticpro (&QCtype
);
6991 defsubr (&Sget_buffer_process
);
6992 defsubr (&Sprocess_inherit_coding_system_flag
);
6996 #endif /* not subprocesses */
6998 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
6999 (do not change this comment) */