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 */
102 #include <sys/sysmacros.h> /* for "minor" */
103 #endif /* not IRIS */
106 #include <sys/wait.h>
115 #include "character.h"
118 #include "termhooks.h"
119 #include "termopts.h"
120 #include "commands.h"
121 #include "keyboard.h"
123 #include "blockinput.h"
124 #include "dispextern.h"
125 #include "composite.h"
128 Lisp_Object Qprocessp
;
129 Lisp_Object Qrun
, Qstop
, Qsignal
;
130 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
131 Lisp_Object Qlocal
, Qdatagram
;
132 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
133 Lisp_Object QClocal
, QCremote
, QCcoding
;
134 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
135 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
136 Lisp_Object QCfilter_multibyte
;
137 Lisp_Object Qlast_nonmenu_event
;
138 /* QCfamily is declared and initialized in xfaces.c,
139 QCfilter in keyboard.c. */
140 extern Lisp_Object QCfamily
, QCfilter
;
142 /* Qexit is declared and initialized in eval.c. */
144 /* QCfamily is defined in xfaces.c. */
145 extern Lisp_Object QCfamily
;
146 /* QCfilter is defined in keyboard.c. */
147 extern Lisp_Object QCfilter
;
149 /* a process object is a network connection when its childp field is neither
150 Qt nor Qnil but is instead a property list (KEY VAL ...). */
153 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
154 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
156 #define NETCONN_P(p) 0
157 #define NETCONN1_P(p) 0
158 #endif /* HAVE_SOCKETS */
160 /* Define first descriptor number available for subprocesses. */
162 #define FIRST_PROC_DESC 1
164 #define FIRST_PROC_DESC 3
167 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
170 #if !defined (SIGCHLD) && defined (SIGCLD)
171 #define SIGCHLD SIGCLD
174 #include "syssignal.h"
178 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
184 extern char *sys_errlist
[];
191 /* t means use pty, nil means use a pipe,
192 maybe other values to come. */
193 static Lisp_Object Vprocess_connection_type
;
197 #include <sys/socket.h>
201 /* These next two vars are non-static since sysdep.c uses them in the
202 emulation of `select'. */
203 /* Number of events of change of status of a process. */
205 /* Number of events for which the user or sentinel has been notified. */
208 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
210 #ifdef BROKEN_NON_BLOCKING_CONNECT
211 #undef NON_BLOCKING_CONNECT
213 #ifndef NON_BLOCKING_CONNECT
216 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
217 #if defined (O_NONBLOCK) || defined (O_NDELAY)
218 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
219 #define NON_BLOCKING_CONNECT
220 #endif /* EWOULDBLOCK || EINPROGRESS */
221 #endif /* O_NONBLOCK || O_NDELAY */
222 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
223 #endif /* HAVE_SELECT */
224 #endif /* HAVE_SOCKETS */
225 #endif /* NON_BLOCKING_CONNECT */
226 #endif /* BROKEN_NON_BLOCKING_CONNECT */
228 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
229 this system. We need to read full packets, so we need a
230 "non-destructive" select. So we require either native select,
231 or emulation of select using FIONREAD. */
233 #ifdef BROKEN_DATAGRAM_SOCKETS
234 #undef DATAGRAM_SOCKETS
236 #ifndef DATAGRAM_SOCKETS
238 #if defined (HAVE_SELECT) || defined (FIONREAD)
239 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
240 #define DATAGRAM_SOCKETS
241 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
242 #endif /* HAVE_SELECT || FIONREAD */
243 #endif /* HAVE_SOCKETS */
244 #endif /* DATAGRAM_SOCKETS */
245 #endif /* BROKEN_DATAGRAM_SOCKETS */
248 #undef NON_BLOCKING_CONNECT
249 #undef DATAGRAM_SOCKETS
253 #include "sysselect.h"
255 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
257 /* If we support a window system, turn on the code to poll periodically
258 to detect C-g. It isn't actually used when doing interrupt input. */
259 #ifdef HAVE_WINDOW_SYSTEM
260 #define POLL_FOR_INPUT
263 /* Mask of bits indicating the descriptors that we wait for input on. */
265 static SELECT_TYPE input_wait_mask
;
267 /* Mask that excludes keyboard input descriptor (s). */
269 static SELECT_TYPE non_keyboard_wait_mask
;
271 /* Mask that excludes process input descriptor (s). */
273 static SELECT_TYPE non_process_wait_mask
;
275 /* Mask of bits indicating the descriptors that we wait for connect to
276 complete on. Once they complete, they are removed from this mask
277 and added to the input_wait_mask and non_keyboard_wait_mask. */
279 static SELECT_TYPE connect_wait_mask
;
281 /* Number of bits set in connect_wait_mask. */
282 static int num_pending_connects
;
284 /* The largest descriptor currently in use for a process object. */
285 static int max_process_desc
;
287 /* The largest descriptor currently in use for keyboard input. */
288 static int max_keyboard_desc
;
290 /* Nonzero means delete a process right away if it exits. */
291 static int delete_exited_processes
;
293 /* Indexed by descriptor, gives the process (if any) for that descriptor */
294 Lisp_Object chan_process
[MAXDESC
];
296 /* Alist of elements (NAME . PROCESS) */
297 Lisp_Object Vprocess_alist
;
299 /* Buffered-ahead input char from process, indexed by channel.
300 -1 means empty (no char is buffered).
301 Used on sys V where the only way to tell if there is any
302 output from the process is to read at least one char.
303 Always -1 on systems that support FIONREAD. */
305 /* Don't make static; need to access externally. */
306 int proc_buffered_char
[MAXDESC
];
308 /* Table of `struct coding-system' for each process. */
309 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
310 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
312 #ifdef DATAGRAM_SOCKETS
313 /* Table of `partner address' for datagram sockets. */
314 struct sockaddr_and_len
{
317 } datagram_address
[MAXDESC
];
318 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
319 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
321 #define DATAGRAM_CHAN_P(chan) (0)
322 #define DATAGRAM_CONN_P(proc) (0)
325 static Lisp_Object
get_process ();
326 static void exec_sentinel ();
328 extern EMACS_TIME
timer_check ();
329 extern int timers_run
;
331 /* Maximum number of bytes to send to a pty without an eof. */
332 static int pty_max_bytes
;
334 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
340 /* The file name of the pty opened by allocate_pty. */
342 static char pty_name
[24];
345 /* Compute the Lisp form of the process status, p->status, from
346 the numeric status that was returned by `wait'. */
348 Lisp_Object
status_convert ();
352 struct Lisp_Process
*p
;
354 union { int i
; WAITTYPE wt
; } u
;
355 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
356 p
->status
= status_convert (u
.wt
);
357 p
->raw_status_low
= Qnil
;
358 p
->raw_status_high
= Qnil
;
361 /* Convert a process status word in Unix format to
362 the list that we use internally. */
369 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
370 else if (WIFEXITED (w
))
371 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
372 WCOREDUMP (w
) ? Qt
: Qnil
));
373 else if (WIFSIGNALED (w
))
374 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
375 WCOREDUMP (w
) ? Qt
: Qnil
));
380 /* Given a status-list, extract the three pieces of information
381 and store them individually through the three pointers. */
384 decode_status (l
, symbol
, code
, coredump
)
402 *code
= XFASTINT (XCAR (tem
));
404 *coredump
= !NILP (tem
);
408 /* Return a string describing a process status list. */
411 status_message (status
)
416 Lisp_Object string
, string2
;
418 decode_status (status
, &symbol
, &code
, &coredump
);
420 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
423 synchronize_system_messages_locale ();
424 signame
= strsignal (code
);
427 string
= build_string (signame
);
428 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
429 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
430 return concat2 (string
, string2
);
432 else if (EQ (symbol
, Qexit
))
435 return build_string ("finished\n");
436 string
= Fnumber_to_string (make_number (code
));
437 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
438 return concat3 (build_string ("exited abnormally with code "),
441 else if (EQ (symbol
, Qfailed
))
443 string
= Fnumber_to_string (make_number (code
));
444 string2
= build_string ("\n");
445 return concat3 (build_string ("failed with code "),
449 return Fcopy_sequence (Fsymbol_name (symbol
));
454 /* Open an available pty, returning a file descriptor.
455 Return -1 on failure.
456 The file name of the terminal corresponding to the pty
457 is left in the variable pty_name. */
468 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
469 for (i
= 0; i
< 16; i
++)
472 struct stat stb
; /* Used in some PTY_OPEN. */
473 #ifdef PTY_NAME_SPRINTF
476 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
477 #endif /* no PTY_NAME_SPRINTF */
481 #else /* no PTY_OPEN */
484 /* Unusual IRIS code */
485 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
488 if (fstat (fd
, &stb
) < 0)
490 # else /* not IRIS */
491 { /* Some systems name their pseudoterminals so that there are gaps in
492 the usual sequence - for example, on HP9000/S700 systems, there
493 are no pseudoterminals with names ending in 'f'. So we wait for
494 three failures in a row before deciding that we've reached the
496 int failed_count
= 0;
498 if (stat (pty_name
, &stb
) < 0)
501 if (failed_count
>= 3)
508 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
510 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
512 # endif /* not IRIS */
514 #endif /* no PTY_OPEN */
518 /* check to make certain that both sides are available
519 this avoids a nasty yet stupid bug in rlogins */
520 #ifdef PTY_TTY_NAME_SPRINTF
523 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
524 #endif /* no PTY_TTY_NAME_SPRINTF */
526 if (access (pty_name
, 6) != 0)
529 # if !defined(IRIS) && !defined(__sgi)
535 #endif /* not UNIPLUS */
542 #endif /* HAVE_PTYS */
548 register Lisp_Object val
, tem
, name1
;
549 register struct Lisp_Process
*p
;
553 p
= allocate_process ();
555 XSETINT (p
->infd
, -1);
556 XSETINT (p
->outfd
, -1);
557 XSETFASTINT (p
->pid
, 0);
558 XSETFASTINT (p
->tick
, 0);
559 XSETFASTINT (p
->update_tick
, 0);
560 p
->raw_status_low
= Qnil
;
561 p
->raw_status_high
= Qnil
;
563 p
->mark
= Fmake_marker ();
565 /* If name is already in use, modify it until it is unused. */
570 tem
= Fget_process (name1
);
571 if (NILP (tem
)) break;
572 sprintf (suffix
, "<%d>", i
);
573 name1
= concat2 (name
, build_string (suffix
));
577 XSETPROCESS (val
, p
);
578 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
583 remove_process (proc
)
584 register Lisp_Object proc
;
586 register Lisp_Object pair
;
588 pair
= Frassq (proc
, Vprocess_alist
);
589 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
591 deactivate_process (proc
);
594 /* Setup coding systems of PROCESS. */
597 setup_process_coding_systems (process
)
600 struct Lisp_Process
*p
= XPROCESS (process
);
601 int inch
= XINT (p
->infd
);
602 int outch
= XINT (p
->outfd
);
603 Lisp_Object coding_system
;
605 if (inch
< 0 || outch
< 0)
608 if (!proc_decode_coding_system
[inch
])
609 proc_decode_coding_system
[inch
]
610 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
611 coding_system
= p
->decode_coding_system
;
612 if (! NILP (p
->filter
))
614 if (NILP (p
->filter_multibyte
))
615 coding_system
= raw_text_coding_system (coding_system
);
617 else if (BUFFERP (p
->buffer
))
619 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
620 coding_system
= raw_text_coding_system (coding_system
);
622 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
624 if (!proc_encode_coding_system
[outch
])
625 proc_encode_coding_system
[outch
]
626 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
627 setup_coding_system (p
->encode_coding_system
,
628 proc_encode_coding_system
[outch
]);
631 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
632 doc
: /* Return t if OBJECT is a process. */)
636 return PROCESSP (object
) ? Qt
: Qnil
;
639 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
640 doc
: /* Return the process named NAME, or nil if there is none. */)
642 register Lisp_Object name
;
647 return Fcdr (Fassoc (name
, Vprocess_alist
));
650 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
651 doc
: /* Return the (or a) process associated with BUFFER.
652 BUFFER may be a buffer or the name of one. */)
654 register Lisp_Object buffer
;
656 register Lisp_Object buf
, tail
, proc
;
658 if (NILP (buffer
)) return Qnil
;
659 buf
= Fget_buffer (buffer
);
660 if (NILP (buf
)) return Qnil
;
662 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
664 proc
= Fcdr (Fcar (tail
));
665 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
671 /* This is how commands for the user decode process arguments. It
672 accepts a process, a process name, a buffer, a buffer name, or nil.
673 Buffers denote the first process in the buffer, and nil denotes the
678 register Lisp_Object name
;
680 register Lisp_Object proc
, obj
;
683 obj
= Fget_process (name
);
685 obj
= Fget_buffer (name
);
687 error ("Process %s does not exist", SDATA (name
));
689 else if (NILP (name
))
690 obj
= Fcurrent_buffer ();
694 /* Now obj should be either a buffer object or a process object.
698 proc
= Fget_buffer_process (obj
);
700 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
710 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
711 doc
: /* Delete PROCESS: kill it and forget about it immediately.
712 PROCESS may be a process, a buffer, the name of a process or buffer, or
713 nil, indicating the current buffer's process. */)
715 register Lisp_Object process
;
717 process
= get_process (process
);
718 XPROCESS (process
)->raw_status_low
= Qnil
;
719 XPROCESS (process
)->raw_status_high
= Qnil
;
720 if (NETCONN_P (process
))
722 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
723 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
725 else if (XINT (XPROCESS (process
)->infd
) >= 0)
727 Fkill_process (process
, Qnil
);
728 /* Do this now, since remove_process will make sigchld_handler do nothing. */
729 XPROCESS (process
)->status
730 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
731 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
734 remove_process (process
);
738 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
739 doc
: /* Return the status of PROCESS.
740 The returned value is one of the following symbols:
741 run -- for a process that is running.
742 stop -- for a process stopped but continuable.
743 exit -- for a process that has exited.
744 signal -- for a process that has got a fatal signal.
745 open -- for a network stream connection that is open.
746 listen -- for a network stream server that is listening.
747 closed -- for a network stream connection that is closed.
748 connect -- when waiting for a non-blocking connection to complete.
749 failed -- when a non-blocking connection has failed.
750 nil -- if arg is a process name and no such process exists.
751 PROCESS may be a process, a buffer, the name of a process, or
752 nil, indicating the current buffer's process. */)
754 register Lisp_Object process
;
756 register struct Lisp_Process
*p
;
757 register Lisp_Object status
;
759 if (STRINGP (process
))
760 process
= Fget_process (process
);
762 process
= get_process (process
);
767 p
= XPROCESS (process
);
768 if (!NILP (p
->raw_status_low
))
772 status
= XCAR (status
);
775 if (EQ (status
, Qexit
))
777 else if (EQ (p
->command
, Qt
))
779 else if (EQ (status
, Qrun
))
785 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
787 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
788 If PROCESS has not yet exited or died, return 0. */)
790 register Lisp_Object process
;
792 CHECK_PROCESS (process
);
793 if (!NILP (XPROCESS (process
)->raw_status_low
))
794 update_status (XPROCESS (process
));
795 if (CONSP (XPROCESS (process
)->status
))
796 return XCAR (XCDR (XPROCESS (process
)->status
));
797 return make_number (0);
800 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
801 doc
: /* Return the process id of PROCESS.
802 This is the pid of the Unix process which PROCESS uses or talks to.
803 For a network connection, this value is nil. */)
805 register Lisp_Object process
;
807 CHECK_PROCESS (process
);
808 return XPROCESS (process
)->pid
;
811 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
812 doc
: /* Return the name of PROCESS, as a string.
813 This is the name of the program invoked in PROCESS,
814 possibly modified to make it unique among process names. */)
816 register Lisp_Object process
;
818 CHECK_PROCESS (process
);
819 return XPROCESS (process
)->name
;
822 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
823 doc
: /* Return the command that was executed to start PROCESS.
824 This is a list of strings, the first string being the program executed
825 and the rest of the strings being the arguments given to it.
826 For a non-child channel, this is nil. */)
828 register Lisp_Object process
;
830 CHECK_PROCESS (process
);
831 return XPROCESS (process
)->command
;
834 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
835 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
836 This is the terminal that the process itself reads and writes on,
837 not the name of the pty that Emacs uses to talk with that terminal. */)
839 register Lisp_Object process
;
841 CHECK_PROCESS (process
);
842 return XPROCESS (process
)->tty_name
;
845 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
847 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
849 register Lisp_Object process
, buffer
;
851 struct Lisp_Process
*p
;
853 CHECK_PROCESS (process
);
855 CHECK_BUFFER (buffer
);
856 p
= XPROCESS (process
);
859 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
860 setup_process_coding_systems (process
);
864 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
866 doc
: /* Return the buffer PROCESS is associated with.
867 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
869 register Lisp_Object process
;
871 CHECK_PROCESS (process
);
872 return XPROCESS (process
)->buffer
;
875 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
877 doc
: /* Return the marker for the end of the last output from PROCESS. */)
879 register Lisp_Object process
;
881 CHECK_PROCESS (process
);
882 return XPROCESS (process
)->mark
;
885 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
887 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
888 t means stop accepting output from the process.
890 When a process has a filter, its buffer is not used for output.
891 Instead, each time it does output, the entire string of output is
892 passed to the filter.
894 The filter gets two arguments: the process and the string of output.
895 The string argument is normally a multibyte string, except:
896 - if the process' input coding system is no-conversion or raw-text,
897 it is a unibyte string (the non-converted input), or else
898 - if `default-enable-multibyte-characters' is nil, it is a unibyte
899 string (the result of converting the decoded input multibyte
900 string to unibyte with `string-make-unibyte'). */)
902 register Lisp_Object process
, filter
;
904 struct Lisp_Process
*p
;
906 CHECK_PROCESS (process
);
907 p
= XPROCESS (process
);
909 /* Don't signal an error if the process' input file descriptor
910 is closed. This could make debugging Lisp more difficult,
911 for example when doing something like
913 (setq process (start-process ...))
915 (set-process-filter process ...) */
917 if (XINT (p
->infd
) >= 0)
919 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
921 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
922 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
924 else if (EQ (p
->filter
, Qt
)
925 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
927 FD_SET (XINT (p
->infd
), &input_wait_mask
);
928 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
934 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
935 setup_process_coding_systems (process
);
939 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
941 doc
: /* Returns the filter function of PROCESS; nil if none.
942 See `set-process-filter' for more info on filter functions. */)
944 register Lisp_Object process
;
946 CHECK_PROCESS (process
);
947 return XPROCESS (process
)->filter
;
950 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
952 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
953 The sentinel is called as a function when the process changes state.
954 It gets two arguments: the process, and a string describing the change. */)
956 register Lisp_Object process
, sentinel
;
958 CHECK_PROCESS (process
);
959 XPROCESS (process
)->sentinel
= sentinel
;
963 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
965 doc
: /* Return the sentinel of PROCESS; nil if none.
966 See `set-process-sentinel' for more info on sentinels. */)
968 register Lisp_Object process
;
970 CHECK_PROCESS (process
);
971 return XPROCESS (process
)->sentinel
;
974 DEFUN ("set-process-window-size", Fset_process_window_size
,
975 Sset_process_window_size
, 3, 3, 0,
976 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
977 (process
, height
, width
)
978 register Lisp_Object process
, height
, width
;
980 CHECK_PROCESS (process
);
981 CHECK_NATNUM (height
);
982 CHECK_NATNUM (width
);
984 if (XINT (XPROCESS (process
)->infd
) < 0
985 || set_window_size (XINT (XPROCESS (process
)->infd
),
986 XINT (height
), XINT (width
)) <= 0)
992 DEFUN ("set-process-inherit-coding-system-flag",
993 Fset_process_inherit_coding_system_flag
,
994 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
995 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
996 If the second argument FLAG is non-nil, then the variable
997 `buffer-file-coding-system' of the buffer associated with PROCESS
998 will be bound to the value of the coding system used to decode
1001 This is useful when the coding system specified for the process buffer
1002 leaves either the character code conversion or the end-of-line conversion
1003 unspecified, or if the coding system used to decode the process output
1004 is more appropriate for saving the process buffer.
1006 Binding the variable `inherit-process-coding-system' to non-nil before
1007 starting the process is an alternative way of setting the inherit flag
1008 for the process which will run. */)
1010 register Lisp_Object process
, flag
;
1012 CHECK_PROCESS (process
);
1013 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1017 DEFUN ("process-inherit-coding-system-flag",
1018 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1020 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1021 If this flag is t, `buffer-file-coding-system' of the buffer
1022 associated with PROCESS will inherit the coding system used to decode
1023 the process output. */)
1025 register Lisp_Object process
;
1027 CHECK_PROCESS (process
);
1028 return XPROCESS (process
)->inherit_coding_system_flag
;
1031 DEFUN ("set-process-query-on-exit-flag",
1032 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1034 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1035 If the second argument FLAG is non-nil, emacs will query the user before
1036 exiting if PROCESS is running. */)
1038 register Lisp_Object process
, flag
;
1040 CHECK_PROCESS (process
);
1041 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1045 DEFUN ("process-query-on-exit-flag",
1046 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1048 doc
: /* Return the current value of query on exit flag for PROCESS. */)
1050 register Lisp_Object process
;
1052 CHECK_PROCESS (process
);
1053 return Fnull (XPROCESS (process
)->kill_without_query
);
1056 #ifdef DATAGRAM_SOCKETS
1057 Lisp_Object
Fprocess_datagram_address ();
1060 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1062 doc
: /* Return the contact info of PROCESS; t for a real child.
1063 For a net connection, the value depends on the optional KEY arg.
1064 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1065 if KEY is t, the complete contact information for the connection is
1066 returned, else the specific value for the keyword KEY is returned.
1067 See `make-network-process' for a list of keywords. */)
1069 register Lisp_Object process
, key
;
1071 Lisp_Object contact
;
1073 CHECK_PROCESS (process
);
1074 contact
= XPROCESS (process
)->childp
;
1076 #ifdef DATAGRAM_SOCKETS
1077 if (DATAGRAM_CONN_P (process
)
1078 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1079 contact
= Fplist_put (contact
, QCremote
,
1080 Fprocess_datagram_address (process
));
1083 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1086 return Fcons (Fplist_get (contact
, QChost
),
1087 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1088 return Fplist_get (contact
, key
);
1091 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1093 doc
: /* Return the plist of PROCESS. */)
1095 register Lisp_Object process
;
1097 CHECK_PROCESS (process
);
1098 return XPROCESS (process
)->plist
;
1101 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1103 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1105 register Lisp_Object process
, plist
;
1107 CHECK_PROCESS (process
);
1110 XPROCESS (process
)->plist
= plist
;
1114 #if 0 /* Turned off because we don't currently record this info
1115 in the process. Perhaps add it. */
1116 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1117 doc
: /* Return the connection type of PROCESS.
1118 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1119 a socket connection. */)
1121 Lisp_Object process
;
1123 return XPROCESS (process
)->type
;
1128 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1130 doc
: /* Convert network ADDRESS from internal format to a string.
1131 If optional second argument OMIT-PORT is non-nil, don't include a port
1132 number in the string; in this case, interpret a 4 element vector as an
1133 IP address. Returns nil if format of ADDRESS is invalid. */)
1134 (address
, omit_port
)
1135 Lisp_Object address
, omit_port
;
1140 if (STRINGP (address
)) /* AF_LOCAL */
1143 if (VECTORP (address
)) /* AF_INET */
1145 register struct Lisp_Vector
*p
= XVECTOR (address
);
1146 Lisp_Object args
[6];
1149 if (!NILP (omit_port
) && (p
->size
== 4 || p
->size
== 5))
1151 args
[0] = build_string ("%d.%d.%d.%d");
1154 else if (p
->size
== 5)
1156 args
[0] = build_string ("%d.%d.%d.%d:%d");
1162 for (i
= 0; i
< nargs
; i
++)
1163 args
[i
+1] = p
->contents
[i
];
1164 return Fformat (nargs
+1, args
);
1167 if (CONSP (address
))
1169 Lisp_Object args
[2];
1170 args
[0] = build_string ("<Family %d>");
1171 args
[1] = Fcar (address
);
1172 return Fformat (2, args
);
1181 list_processes_1 (query_only
)
1182 Lisp_Object query_only
;
1184 register Lisp_Object tail
, tem
;
1185 Lisp_Object proc
, minspace
, tem1
;
1186 register struct Lisp_Process
*p
;
1188 int w_proc
, w_buffer
, w_tty
;
1189 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1191 w_proc
= 4; /* Proc */
1192 w_buffer
= 6; /* Buffer */
1193 w_tty
= 0; /* Omit if no ttys */
1195 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1199 proc
= Fcdr (Fcar (tail
));
1200 p
= XPROCESS (proc
);
1201 if (NILP (p
->childp
))
1203 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1205 if (STRINGP (p
->name
)
1206 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1208 if (!NILP (p
->buffer
))
1210 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1211 w_buffer
= 8; /* (Killed) */
1212 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1215 if (STRINGP (p
->tty_name
)
1216 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1220 XSETFASTINT (i_status
, w_proc
+ 1);
1221 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1224 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1225 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1228 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1231 XSETFASTINT (minspace
, 1);
1233 set_buffer_internal (XBUFFER (Vstandard_output
));
1234 Fbuffer_disable_undo (Vstandard_output
);
1236 current_buffer
->truncate_lines
= Qt
;
1238 write_string ("Proc", -1);
1239 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1240 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1243 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1245 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1246 write_string ("\n", -1);
1248 write_string ("----", -1);
1249 Findent_to (i_status
, minspace
); write_string ("------", -1);
1250 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1253 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1255 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1256 write_string ("\n", -1);
1258 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1262 proc
= Fcdr (Fcar (tail
));
1263 p
= XPROCESS (proc
);
1264 if (NILP (p
->childp
))
1266 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1269 Finsert (1, &p
->name
);
1270 Findent_to (i_status
, minspace
);
1272 if (!NILP (p
->raw_status_low
))
1275 if (CONSP (p
->status
))
1276 symbol
= XCAR (p
->status
);
1279 if (EQ (symbol
, Qsignal
))
1282 tem
= Fcar (Fcdr (p
->status
));
1284 if (XINT (tem
) < NSIG
)
1285 write_string (sys_errlist
[XINT (tem
)], -1);
1288 Fprinc (symbol
, Qnil
);
1290 else if (NETCONN1_P (p
))
1292 if (EQ (symbol
, Qexit
))
1293 write_string ("closed", -1);
1294 else if (EQ (p
->command
, Qt
))
1295 write_string ("stopped", -1);
1296 else if (EQ (symbol
, Qrun
))
1297 write_string ("open", -1);
1299 Fprinc (symbol
, Qnil
);
1302 Fprinc (symbol
, Qnil
);
1304 if (EQ (symbol
, Qexit
))
1307 tem
= Fcar (Fcdr (p
->status
));
1310 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1311 write_string (tembuf
, -1);
1315 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1316 remove_process (proc
);
1318 Findent_to (i_buffer
, minspace
);
1319 if (NILP (p
->buffer
))
1320 insert_string ("(none)");
1321 else if (NILP (XBUFFER (p
->buffer
)->name
))
1322 insert_string ("(Killed)");
1324 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1328 Findent_to (i_tty
, minspace
);
1329 if (STRINGP (p
->tty_name
))
1330 Finsert (1, &p
->tty_name
);
1333 Findent_to (i_command
, minspace
);
1335 if (EQ (p
->status
, Qlisten
))
1337 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1338 if (INTEGERP (port
))
1339 port
= Fnumber_to_string (port
);
1341 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1342 sprintf (tembuf
, "(network %s server on %s)\n",
1343 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1344 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1345 insert_string (tembuf
);
1347 else if (NETCONN1_P (p
))
1349 /* For a local socket, there is no host name,
1350 so display service instead. */
1351 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1352 if (!STRINGP (host
))
1354 host
= Fplist_get (p
->childp
, QCservice
);
1355 if (INTEGERP (host
))
1356 host
= Fnumber_to_string (host
);
1359 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1360 sprintf (tembuf
, "(network %s connection to %s)\n",
1361 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1362 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1363 insert_string (tembuf
);
1375 insert_string (" ");
1377 insert_string ("\n");
1383 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1384 doc
: /* Display a list of all processes.
1385 If optional argument QUERY-ONLY is non-nil, only processes with
1386 the query-on-exit flag set will be listed.
1387 Any process listed as exited or signaled is actually eliminated
1388 after the listing is made. */)
1390 Lisp_Object query_only
;
1392 internal_with_output_to_temp_buffer ("*Process List*",
1393 list_processes_1
, query_only
);
1397 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1398 doc
: /* Return a list of all processes. */)
1401 return Fmapcar (Qcdr
, Vprocess_alist
);
1404 /* Starting asynchronous inferior processes. */
1406 static Lisp_Object
start_process_unwind ();
1408 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1409 doc
: /* Start a program in a subprocess. Return the process object for it.
1410 NAME is name for process. It is modified if necessary to make it unique.
1411 BUFFER is the buffer or (buffer-name) to associate with the process.
1412 Process output goes at end of that buffer, unless you specify
1413 an output stream or filter function to handle the output.
1414 BUFFER may be also nil, meaning that this process is not associated
1416 Third arg is program file name. It is searched for in PATH.
1417 Remaining arguments are strings to give program as arguments.
1419 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1422 register Lisp_Object
*args
;
1424 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1426 register unsigned char *new_argv
;
1429 register unsigned char **new_argv
;
1432 int count
= SPECPDL_INDEX ();
1436 buffer
= Fget_buffer_create (buffer
);
1438 /* Make sure that the child will be able to chdir to the current
1439 buffer's current directory, or its unhandled equivalent. We
1440 can't just have the child check for an error when it does the
1441 chdir, since it's in a vfork.
1443 We have to GCPRO around this because Fexpand_file_name and
1444 Funhandled_file_name_directory might call a file name handling
1445 function. The argument list is protected by the caller, so all
1446 we really have to worry about is buffer. */
1448 struct gcpro gcpro1
, gcpro2
;
1450 current_dir
= current_buffer
->directory
;
1452 GCPRO2 (buffer
, current_dir
);
1455 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1457 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1458 report_file_error ("Setting current directory",
1459 Fcons (current_buffer
->directory
, Qnil
));
1465 CHECK_STRING (name
);
1469 CHECK_STRING (program
);
1471 proc
= make_process (name
);
1472 /* If an error occurs and we can't start the process, we want to
1473 remove it from the process list. This means that each error
1474 check in create_process doesn't need to call remove_process
1475 itself; it's all taken care of here. */
1476 record_unwind_protect (start_process_unwind
, proc
);
1478 XPROCESS (proc
)->childp
= Qt
;
1479 XPROCESS (proc
)->plist
= Qnil
;
1480 XPROCESS (proc
)->command_channel_p
= Qnil
;
1481 XPROCESS (proc
)->buffer
= buffer
;
1482 XPROCESS (proc
)->sentinel
= Qnil
;
1483 XPROCESS (proc
)->filter
= Qnil
;
1484 XPROCESS (proc
)->filter_multibyte
1485 = buffer_defaults
.enable_multibyte_characters
;
1486 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1488 /* Make the process marker point into the process buffer (if any). */
1490 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1491 BUF_ZV (XBUFFER (buffer
)),
1492 BUF_ZV_BYTE (XBUFFER (buffer
)));
1495 /* Decide coding systems for communicating with the process. Here
1496 we don't setup the structure coding_system nor pay attention to
1497 unibyte mode. They are done in create_process. */
1499 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1500 Lisp_Object coding_systems
= Qt
;
1501 Lisp_Object val
, *args2
;
1502 struct gcpro gcpro1
, gcpro2
;
1504 val
= Vcoding_system_for_read
;
1507 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1508 args2
[0] = Qstart_process
;
1509 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1510 GCPRO2 (proc
, current_dir
);
1511 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1513 if (CONSP (coding_systems
))
1514 val
= XCAR (coding_systems
);
1515 else if (CONSP (Vdefault_process_coding_system
))
1516 val
= XCAR (Vdefault_process_coding_system
);
1518 XPROCESS (proc
)->decode_coding_system
= val
;
1520 val
= Vcoding_system_for_write
;
1523 if (EQ (coding_systems
, Qt
))
1525 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1526 args2
[0] = Qstart_process
;
1527 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1528 GCPRO2 (proc
, current_dir
);
1529 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1532 if (CONSP (coding_systems
))
1533 val
= XCDR (coding_systems
);
1534 else if (CONSP (Vdefault_process_coding_system
))
1535 val
= XCDR (Vdefault_process_coding_system
);
1537 XPROCESS (proc
)->encode_coding_system
= val
;
1541 /* Make a one member argv with all args concatenated
1542 together separated by a blank. */
1543 len
= SBYTES (program
) + 2;
1544 for (i
= 3; i
< nargs
; i
++)
1548 len
+= SBYTES (tem
) + 1; /* count the blank */
1550 new_argv
= (unsigned char *) alloca (len
);
1551 strcpy (new_argv
, SDATA (program
));
1552 for (i
= 3; i
< nargs
; i
++)
1556 strcat (new_argv
, " ");
1557 strcat (new_argv
, SDATA (tem
));
1559 /* Need to add code here to check for program existence on VMS */
1562 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1564 /* If program file name is not absolute, search our path for it.
1565 Put the name we will really use in TEM. */
1566 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1567 && !(SCHARS (program
) > 1
1568 && IS_DEVICE_SEP (SREF (program
, 1))))
1570 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1573 GCPRO4 (name
, program
, buffer
, current_dir
);
1574 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1577 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1578 tem
= Fexpand_file_name (tem
, Qnil
);
1582 if (!NILP (Ffile_directory_p (program
)))
1583 error ("Specified program for new process is a directory");
1587 /* If program file name starts with /: for quoting a magic name,
1589 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1590 && SREF (tem
, 1) == ':')
1591 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1593 /* Encode the file name and put it in NEW_ARGV.
1594 That's where the child will use it to execute the program. */
1595 tem
= ENCODE_FILE (tem
);
1596 new_argv
[0] = SDATA (tem
);
1598 /* Here we encode arguments by the coding system used for sending
1599 data to the process. We don't support using different coding
1600 systems for encoding arguments and for encoding data sent to the
1603 for (i
= 3; i
< nargs
; i
++)
1607 if (STRING_MULTIBYTE (tem
))
1608 tem
= (code_convert_string_norecord
1609 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1610 new_argv
[i
- 2] = SDATA (tem
);
1612 new_argv
[i
- 2] = 0;
1613 #endif /* not VMS */
1615 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1616 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1617 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1618 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1620 XPROCESS (proc
)->inherit_coding_system_flag
1621 = (NILP (buffer
) || !inherit_process_coding_system
1624 create_process (proc
, (char **) new_argv
, current_dir
);
1626 return unbind_to (count
, proc
);
1629 /* This function is the unwind_protect form for Fstart_process. If
1630 PROC doesn't have its pid set, then we know someone has signaled
1631 an error and the process wasn't started successfully, so we should
1632 remove it from the process list. */
1634 start_process_unwind (proc
)
1637 if (!PROCESSP (proc
))
1640 /* Was PROC started successfully? */
1641 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1642 remove_process (proc
);
1648 create_process_1 (timer
)
1649 struct atimer
*timer
;
1651 /* Nothing to do. */
1655 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1658 /* Mimic blocking of signals on system V, which doesn't really have it. */
1660 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1661 int sigchld_deferred
;
1664 create_process_sigchld ()
1666 signal (SIGCHLD
, create_process_sigchld
);
1668 sigchld_deferred
= 1;
1674 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1676 create_process (process
, new_argv
, current_dir
)
1677 Lisp_Object process
;
1679 Lisp_Object current_dir
;
1681 int pid
, inchannel
, outchannel
;
1683 #ifdef POSIX_SIGNALS
1686 struct sigaction sigint_action
;
1687 struct sigaction sigquit_action
;
1689 struct sigaction sighup_action
;
1691 #else /* !POSIX_SIGNALS */
1694 SIGTYPE (*sigchld
)();
1697 #endif /* !POSIX_SIGNALS */
1698 /* Use volatile to protect variables from being clobbered by longjmp. */
1699 volatile int forkin
, forkout
;
1700 volatile int pty_flag
= 0;
1702 extern char **environ
;
1705 inchannel
= outchannel
= -1;
1708 if (!NILP (Vprocess_connection_type
))
1709 outchannel
= inchannel
= allocate_pty ();
1713 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1714 /* On most USG systems it does not work to open the pty's tty here,
1715 then close it and reopen it in the child. */
1717 /* Don't let this terminal become our controlling terminal
1718 (in case we don't have one). */
1719 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1721 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1724 report_file_error ("Opening pty", Qnil
);
1726 forkin
= forkout
= -1;
1727 #endif /* not USG, or USG_SUBTTY_WORKS */
1731 #endif /* HAVE_PTYS */
1734 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1735 report_file_error ("Opening socketpair", Qnil
);
1736 outchannel
= inchannel
= sv
[0];
1737 forkout
= forkin
= sv
[1];
1739 #else /* not SKTPAIR */
1744 report_file_error ("Creating pipe", Qnil
);
1750 emacs_close (inchannel
);
1751 emacs_close (forkout
);
1752 report_file_error ("Creating pipe", Qnil
);
1757 #endif /* not SKTPAIR */
1760 /* Replaced by close_process_descs */
1761 set_exclusive_use (inchannel
);
1762 set_exclusive_use (outchannel
);
1765 /* Stride people say it's a mystery why this is needed
1766 as well as the O_NDELAY, but that it fails without this. */
1767 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1770 ioctl (inchannel
, FIONBIO
, &one
);
1775 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1776 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1779 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1780 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1784 /* Record this as an active process, with its channels.
1785 As a result, child_setup will close Emacs's side of the pipes. */
1786 chan_process
[inchannel
] = process
;
1787 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1788 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1790 /* Previously we recorded the tty descriptor used in the subprocess.
1791 It was only used for getting the foreground tty process, so now
1792 we just reopen the device (see emacs_get_tty_pgrp) as this is
1793 more portable (see USG_SUBTTY_WORKS above). */
1795 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1796 XPROCESS (process
)->status
= Qrun
;
1797 setup_process_coding_systems (process
);
1799 /* Delay interrupts until we have a chance to store
1800 the new fork's pid in its process structure */
1801 #ifdef POSIX_SIGNALS
1802 sigemptyset (&blocked
);
1804 sigaddset (&blocked
, SIGCHLD
);
1806 #ifdef HAVE_WORKING_VFORK
1807 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1808 this sets the parent's signal handlers as well as the child's.
1809 So delay all interrupts whose handlers the child might munge,
1810 and record the current handlers so they can be restored later. */
1811 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1812 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1814 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1816 #endif /* HAVE_WORKING_VFORK */
1817 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1818 #else /* !POSIX_SIGNALS */
1822 #else /* not BSD4_1 */
1823 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1824 sigsetmask (sigmask (SIGCHLD
));
1825 #else /* ordinary USG */
1827 sigchld_deferred
= 0;
1828 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1830 #endif /* ordinary USG */
1831 #endif /* not BSD4_1 */
1832 #endif /* SIGCHLD */
1833 #endif /* !POSIX_SIGNALS */
1835 FD_SET (inchannel
, &input_wait_mask
);
1836 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1837 if (inchannel
> max_process_desc
)
1838 max_process_desc
= inchannel
;
1840 /* Until we store the proper pid, enable sigchld_handler
1841 to recognize an unknown pid as standing for this process.
1842 It is very important not to let this `marker' value stay
1843 in the table after this function has returned; if it does
1844 it might cause call-process to hang and subsequent asynchronous
1845 processes to get their return values scrambled. */
1846 XSETINT (XPROCESS (process
)->pid
, -1);
1851 /* child_setup must clobber environ on systems with true vfork.
1852 Protect it from permanent change. */
1853 char **save_environ
= environ
;
1855 current_dir
= ENCODE_FILE (current_dir
);
1860 #endif /* not WINDOWSNT */
1862 int xforkin
= forkin
;
1863 int xforkout
= forkout
;
1865 #if 0 /* This was probably a mistake--it duplicates code later on,
1866 but fails to handle all the cases. */
1867 /* Make sure SIGCHLD is not blocked in the child. */
1868 sigsetmask (SIGEMPTYMASK
);
1871 /* Make the pty be the controlling terminal of the process. */
1873 /* First, disconnect its current controlling terminal. */
1875 /* We tried doing setsid only if pty_flag, but it caused
1876 process_set_signal to fail on SGI when using a pipe. */
1878 /* Make the pty's terminal the controlling terminal. */
1882 /* We ignore the return value
1883 because faith@cs.unc.edu says that is necessary on Linux. */
1884 ioctl (xforkin
, TIOCSCTTY
, 0);
1887 #else /* not HAVE_SETSID */
1889 /* It's very important to call setpgrp here and no time
1890 afterwards. Otherwise, we lose our controlling tty which
1891 is set when we open the pty. */
1894 #endif /* not HAVE_SETSID */
1895 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1896 if (pty_flag
&& xforkin
>= 0)
1899 tcgetattr (xforkin
, &t
);
1901 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1902 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1905 #if defined (NTTYDISC) && defined (TIOCSETD)
1906 if (pty_flag
&& xforkin
>= 0)
1908 /* Use new line discipline. */
1909 int ldisc
= NTTYDISC
;
1910 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1915 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1916 can do TIOCSPGRP only to the process's controlling tty. */
1919 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1920 I can't test it since I don't have 4.3. */
1921 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1922 ioctl (j
, TIOCNOTTY
, 0);
1925 /* In order to get a controlling terminal on some versions
1926 of BSD, it is necessary to put the process in pgrp 0
1927 before it opens the terminal. */
1935 #endif /* TIOCNOTTY */
1937 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1938 /*** There is a suggestion that this ought to be a
1939 conditional on TIOCSPGRP,
1940 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1941 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1942 that system does seem to need this code, even though
1943 both HAVE_SETSID and TIOCSCTTY are defined. */
1944 /* Now close the pty (if we had it open) and reopen it.
1945 This makes the pty the controlling terminal of the subprocess. */
1948 #ifdef SET_CHILD_PTY_PGRP
1949 int pgrp
= getpid ();
1952 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1955 emacs_close (xforkin
);
1956 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1960 emacs_write (1, "Couldn't open the pty terminal ", 31);
1961 emacs_write (1, pty_name
, strlen (pty_name
));
1962 emacs_write (1, "\n", 1);
1966 #ifdef SET_CHILD_PTY_PGRP
1967 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1968 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1971 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1973 #ifdef SETUP_SLAVE_PTY
1978 #endif /* SETUP_SLAVE_PTY */
1980 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1981 Now reenable it in the child, so it will die when we want it to. */
1983 signal (SIGHUP
, SIG_DFL
);
1985 #endif /* HAVE_PTYS */
1987 signal (SIGINT
, SIG_DFL
);
1988 signal (SIGQUIT
, SIG_DFL
);
1990 /* Stop blocking signals in the child. */
1991 #ifdef POSIX_SIGNALS
1992 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1993 #else /* !POSIX_SIGNALS */
1997 #else /* not BSD4_1 */
1998 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1999 sigsetmask (SIGEMPTYMASK
);
2000 #else /* ordinary USG */
2002 signal (SIGCHLD
, sigchld
);
2004 #endif /* ordinary USG */
2005 #endif /* not BSD4_1 */
2006 #endif /* SIGCHLD */
2007 #endif /* !POSIX_SIGNALS */
2010 child_setup_tty (xforkout
);
2012 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2013 new_argv
, 1, current_dir
);
2014 #else /* not WINDOWSNT */
2015 child_setup (xforkin
, xforkout
, xforkout
,
2016 new_argv
, 1, current_dir
);
2017 #endif /* not WINDOWSNT */
2019 environ
= save_environ
;
2024 /* This runs in the Emacs process. */
2028 emacs_close (forkin
);
2029 if (forkin
!= forkout
&& forkout
>= 0)
2030 emacs_close (forkout
);
2034 /* vfork succeeded. */
2035 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
2038 register_child (pid
, inchannel
);
2039 #endif /* WINDOWSNT */
2041 /* If the subfork execv fails, and it exits,
2042 this close hangs. I don't know why.
2043 So have an interrupt jar it loose. */
2045 struct atimer
*timer
;
2049 EMACS_SET_SECS_USECS (offset
, 1, 0);
2050 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2053 emacs_close (forkin
);
2055 cancel_atimer (timer
);
2059 if (forkin
!= forkout
&& forkout
>= 0)
2060 emacs_close (forkout
);
2064 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2067 XPROCESS (process
)->tty_name
= Qnil
;
2070 /* Restore the signal state whether vfork succeeded or not.
2071 (We will signal an error, below, if it failed.) */
2072 #ifdef POSIX_SIGNALS
2073 #ifdef HAVE_WORKING_VFORK
2074 /* Restore the parent's signal handlers. */
2075 sigaction (SIGINT
, &sigint_action
, 0);
2076 sigaction (SIGQUIT
, &sigquit_action
, 0);
2078 sigaction (SIGHUP
, &sighup_action
, 0);
2080 #endif /* HAVE_WORKING_VFORK */
2081 /* Stop blocking signals in the parent. */
2082 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2083 #else /* !POSIX_SIGNALS */
2087 #else /* not BSD4_1 */
2088 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2089 sigsetmask (SIGEMPTYMASK
);
2090 #else /* ordinary USG */
2092 signal (SIGCHLD
, sigchld
);
2093 /* Now really handle any of these signals
2094 that came in during this function. */
2095 if (sigchld_deferred
)
2096 kill (getpid (), SIGCHLD
);
2098 #endif /* ordinary USG */
2099 #endif /* not BSD4_1 */
2100 #endif /* SIGCHLD */
2101 #endif /* !POSIX_SIGNALS */
2103 /* Now generate the error if vfork failed. */
2105 report_file_error ("Doing vfork", Qnil
);
2107 #endif /* not VMS */
2112 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2113 The address family of sa is not included in the result. */
2116 conv_sockaddr_to_lisp (sa
, len
)
2117 struct sockaddr
*sa
;
2120 Lisp_Object address
;
2123 register struct Lisp_Vector
*p
;
2125 switch (sa
->sa_family
)
2129 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2130 len
= sizeof (sin
->sin_addr
) + 1;
2131 address
= Fmake_vector (make_number (len
), Qnil
);
2132 p
= XVECTOR (address
);
2133 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2134 cp
= (unsigned char *)&sin
->sin_addr
;
2137 #ifdef HAVE_LOCAL_SOCKETS
2140 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2141 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2142 if (sockun
->sun_path
[i
] == 0)
2144 return make_unibyte_string (sockun
->sun_path
, i
);
2148 len
-= sizeof (sa
->sa_family
);
2149 address
= Fcons (make_number (sa
->sa_family
),
2150 Fmake_vector (make_number (len
), Qnil
));
2151 p
= XVECTOR (XCDR (address
));
2152 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2158 p
->contents
[i
++] = make_number (*cp
++);
2164 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2167 get_lisp_to_sockaddr_size (address
, familyp
)
2168 Lisp_Object address
;
2171 register struct Lisp_Vector
*p
;
2173 if (VECTORP (address
))
2175 p
= XVECTOR (address
);
2179 return sizeof (struct sockaddr_in
);
2182 #ifdef HAVE_LOCAL_SOCKETS
2183 else if (STRINGP (address
))
2185 *familyp
= AF_LOCAL
;
2186 return sizeof (struct sockaddr_un
);
2189 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2191 struct sockaddr
*sa
;
2192 *familyp
= XINT (XCAR (address
));
2193 p
= XVECTOR (XCDR (address
));
2194 return p
->size
+ sizeof (sa
->sa_family
);
2199 /* Convert an address object (vector or string) to an internal sockaddr.
2200 Format of address has already been validated by size_lisp_to_sockaddr. */
2203 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2205 Lisp_Object address
;
2206 struct sockaddr
*sa
;
2209 register struct Lisp_Vector
*p
;
2210 register unsigned char *cp
= NULL
;
2214 sa
->sa_family
= family
;
2216 if (VECTORP (address
))
2218 p
= XVECTOR (address
);
2219 if (family
== AF_INET
)
2221 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2222 len
= sizeof (sin
->sin_addr
) + 1;
2223 i
= XINT (p
->contents
[--len
]);
2224 sin
->sin_port
= htons (i
);
2225 cp
= (unsigned char *)&sin
->sin_addr
;
2228 else if (STRINGP (address
))
2230 #ifdef HAVE_LOCAL_SOCKETS
2231 if (family
== AF_LOCAL
)
2233 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2234 cp
= SDATA (address
);
2235 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2236 sockun
->sun_path
[i
] = *cp
++;
2243 p
= XVECTOR (XCDR (address
));
2244 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2247 for (i
= 0; i
< len
; i
++)
2248 if (INTEGERP (p
->contents
[i
]))
2249 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2252 #ifdef DATAGRAM_SOCKETS
2253 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2255 doc
: /* Get the current datagram address associated with PROCESS. */)
2257 Lisp_Object process
;
2261 CHECK_PROCESS (process
);
2263 if (!DATAGRAM_CONN_P (process
))
2266 channel
= XINT (XPROCESS (process
)->infd
);
2267 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2268 datagram_address
[channel
].len
);
2271 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2273 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2274 Returns nil upon error setting address, ADDRESS otherwise. */)
2276 Lisp_Object process
, address
;
2281 CHECK_PROCESS (process
);
2283 if (!DATAGRAM_CONN_P (process
))
2286 channel
= XINT (XPROCESS (process
)->infd
);
2288 len
= get_lisp_to_sockaddr_size (address
, &family
);
2289 if (datagram_address
[channel
].len
!= len
)
2291 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2297 static struct socket_options
{
2298 /* The name of this option. Should be lowercase version of option
2299 name without SO_ prefix. */
2301 /* Length of name. */
2303 /* Option level SOL_... */
2305 /* Option number SO_... */
2307 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_STR
, SOPT_LINGER
} opttype
;
2308 } socket_options
[] =
2310 #ifdef SO_BINDTODEVICE
2311 { "bindtodevice", 12, SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_STR
},
2314 { "broadcast", 9, SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
},
2317 { "dontroute", 9, SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
},
2320 { "keepalive", 9, SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
},
2323 { "linger", 6, SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
},
2326 { "oobinline", 9, SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
},
2329 { "priority", 8, SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
},
2332 { "reuseaddr", 9, SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
},
2334 { 0, 0, 0, 0, SOPT_UNKNOWN
}
2337 /* Process list of socket options OPTS on socket S.
2338 Only check if options are supported is S < 0.
2339 If NO_ERROR is non-zero, continue silently if an option
2342 Each element specifies one option. An element is either a string
2343 "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
2347 set_socket_options (s
, opts
, no_error
)
2353 opts
= Fcons (opts
, Qnil
);
2355 while (CONSP (opts
))
2360 struct socket_options
*sopt
;
2374 name
= (char *) SDATA (opt
);
2375 else if (SYMBOLP (opt
))
2376 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2378 error ("Mal-formed option list");
2382 if (strncmp (name
, "no", 2) == 0)
2389 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2390 if (strncmp (name
, sopt
->name
, sopt
->nlen
) == 0)
2392 if (name
[sopt
->nlen
] == 0)
2394 if (name
[sopt
->nlen
] == '=')
2396 arg
= name
+ sopt
->nlen
+ 1;
2401 switch (sopt
->opttype
)
2409 optval
= (*arg
== '0' || *arg
== 'n') ? 0 : 1;
2410 else if (INTEGERP (val
))
2411 optval
= XINT (val
) == 0 ? 0 : 1;
2413 optval
= NILP (val
) ? 0 : 1;
2414 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2415 &optval
, sizeof (optval
));
2424 else if (INTEGERP (val
))
2425 optval
= XINT (val
);
2427 error ("Bad option argument for %s", name
);
2430 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2431 &optval
, sizeof (optval
));
2441 else if (STRINGP (val
))
2442 arg
= (char *) SDATA (val
);
2443 else if (XSYMBOL (val
))
2444 arg
= (char *) SDATA (SYMBOL_NAME (val
));
2446 error ("Invalid argument to %s option", name
);
2448 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2455 struct linger linger
;
2458 linger
.l_linger
= 0;
2465 if (*arg
== 'n' || *arg
== 't' || *arg
== 'y')
2466 linger
.l_onoff
= (*arg
== 'n') ? 0 : 1;
2468 linger
.l_linger
= atoi(arg
);
2470 else if (INTEGERP (val
))
2471 linger
.l_linger
= XINT (val
);
2473 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2474 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2475 &linger
, sizeof (linger
));
2484 error ("Unsupported option: %s", name
);
2486 if (ret
< 0 && ! no_error
)
2487 report_file_error ("Cannot set network option: %s", opt
);
2492 DEFUN ("set-network-process-options",
2493 Fset_network_process_options
, Sset_network_process_options
,
2495 doc
: /* Set one or more options for network process PROCESS.
2496 Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
2497 A boolean value is false if it either zero or nil, true otherwise.
2499 The following options are known. Consult the relevant system manual
2500 pages for more information.
2502 bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
2503 broadcast=BOOL -- Allow send and receive of datagram broadcasts.
2504 dontroute=BOOL -- Only send to directly connected hosts.
2505 keepalive=BOOL -- Send keep-alive messages on network stream.
2506 linger=BOOL or TIMEOUT -- Send queued messages before closing.
2507 oobinline=BOOL -- Place out-of-band data in receive data stream.
2508 priority=INT -- Set protocol defined priority for sent packets.
2509 reuseaddr=BOOL -- Allow reusing a recently used address.
2511 usage: (set-network-process-options PROCESS &rest OPTIONS) */)
2516 Lisp_Object process
;
2520 CHECK_PROCESS (process
);
2521 if (nargs
> 1 && XINT (XPROCESS (process
)->infd
) >= 0)
2523 opts
= Flist (nargs
, args
);
2524 set_socket_options (XINT (XPROCESS (process
)->infd
), opts
, 0);
2529 /* A version of request_sigio suitable for a record_unwind_protect. */
2532 unwind_request_sigio (dummy
)
2535 if (interrupt_input
)
2540 /* Create a network stream/datagram client/server process. Treated
2541 exactly like a normal process when reading and writing. Primary
2542 differences are in status display and process deletion. A network
2543 connection has no PID; you cannot signal it. All you can do is
2544 stop/continue it and deactivate/close it via delete-process */
2546 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2548 doc
: /* Create and return a network server or client process.
2550 In Emacs, network connections are represented by process objects, so
2551 input and output work as for subprocesses and `delete-process' closes
2552 a network connection. However, a network process has no process id,
2553 it cannot be signalled, and the status codes are different from normal
2556 Arguments are specified as keyword/argument pairs. The following
2557 arguments are defined:
2559 :name NAME -- NAME is name for process. It is modified if necessary
2562 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2563 with the process. Process output goes at end of that buffer, unless
2564 you specify an output stream or filter function to handle the output.
2565 BUFFER may be also nil, meaning that this process is not associated
2568 :host HOST -- HOST is name of the host to connect to, or its IP
2569 address. The symbol `local' specifies the local host. If specified
2570 for a server process, it must be a valid name or address for the local
2571 host, and only clients connecting to that address will be accepted.
2573 :service SERVICE -- SERVICE is name of the service desired, or an
2574 integer specifying a port number to connect to. If SERVICE is t,
2575 a random port number is selected for the server.
2577 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2578 stream type connection, `datagram' creates a datagram type connection.
2580 :family FAMILY -- FAMILY is the address (and protocol) family for the
2581 service specified by HOST and SERVICE. The default address family is
2582 Inet (or IPv4) for the host and port number specified by HOST and
2583 SERVICE. Other address families supported are:
2584 local -- for a local (i.e. UNIX) address specified by SERVICE.
2586 :local ADDRESS -- ADDRESS is the local address used for the connection.
2587 This parameter is ignored when opening a client process. When specified
2588 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2590 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2591 connection. This parameter is ignored when opening a stream server
2592 process. For a datagram server process, it specifies the initial
2593 setting of the remote datagram address. When specified for a client
2594 process, the FAMILY, HOST, and SERVICE args are ignored.
2596 The format of ADDRESS depends on the address family:
2597 - An IPv4 address is represented as an vector of integers [A B C D P]
2598 corresponding to numeric IP address A.B.C.D and port number P.
2599 - A local address is represented as a string with the address in the
2600 local address space.
2601 - An "unsupported family" address is represented by a cons (F . AV)
2602 where F is the family number and AV is a vector containing the socket
2603 address data with one element per address data byte. Do not rely on
2604 this format in portable code, as it may depend on implementation
2605 defined constants, data sizes, and data structure alignment.
2607 :coding CODING -- CODING is coding system for this process.
2609 :options OPTIONS -- Set the specified options for the network process.
2610 See `set-network-process-options' for details.
2612 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2613 return without waiting for the connection to complete; instead, the
2614 sentinel function will be called with second arg matching "open" (if
2615 successful) or "failed" when the connect completes. Default is to use
2616 a blocking connect (i.e. wait) for stream type connections.
2618 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2619 running when emacs is exited.
2621 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2622 In the stopped state, a server process does not accept new
2623 connections, and a client process does not handle incoming traffic.
2624 The stopped state is cleared by `continue-process' and set by
2627 :filter FILTER -- Install FILTER as the process filter.
2629 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2630 process filter are multibyte, otherwise they are unibyte.
2631 If this keyword is not specified, the strings are multibyte iff
2632 `default-enable-multibyte-characters' is non-nil.
2634 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2636 :log LOG -- Install LOG as the server process log function. This
2637 function is called when the server accepts a network connection from a
2638 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2639 is the server process, CLIENT is the new process for the connection,
2640 and MESSAGE is a string.
2642 :plist PLIST -- Install PLIST as the new process' initial plist.
2644 :server BOOL -- if BOOL is non-nil, create a server process for the
2645 specified FAMILY, SERVICE, and connection type (stream or datagram).
2646 Default is a client process.
2648 A server process will listen for and accept connections from
2649 clients. When a client connection is accepted, a new network process
2650 is created for the connection with the following parameters:
2651 - The client's process name is constructed by concatenating the server
2652 process' NAME and a client identification string.
2653 - If the FILTER argument is non-nil, the client process will not get a
2654 separate process buffer; otherwise, the client's process buffer is a newly
2655 created buffer named after the server process' BUFFER name or process
2656 NAME concatenated with the client identification string.
2657 - The connection type and the process filter and sentinel parameters are
2658 inherited from the server process' TYPE, FILTER and SENTINEL.
2659 - The client process' contact info is set according to the client's
2660 addressing information (typically an IP address and a port number).
2661 - The client process' plist is initialized from the server's plist.
2663 Notice that the FILTER and SENTINEL args are never used directly by
2664 the server process. Also, the BUFFER argument is not used directly by
2665 the server process, but via the optional :log function, accepted (and
2666 failed) connections may be logged in the server process' buffer.
2668 The original argument list, modified with the actual connection
2669 information, is available via the `process-contact' function.
2671 usage: (make-network-process &rest ARGS) */)
2677 Lisp_Object contact
;
2678 struct Lisp_Process
*p
;
2679 #ifdef HAVE_GETADDRINFO
2680 struct addrinfo ai
, *res
, *lres
;
2681 struct addrinfo hints
;
2682 char *portstring
, portbuf
[128];
2683 #else /* HAVE_GETADDRINFO */
2684 struct _emacs_addrinfo
2690 struct sockaddr
*ai_addr
;
2691 struct _emacs_addrinfo
*ai_next
;
2693 #endif /* HAVE_GETADDRINFO */
2694 struct sockaddr_in address_in
;
2695 #ifdef HAVE_LOCAL_SOCKETS
2696 struct sockaddr_un address_un
;
2701 int s
= -1, outch
, inch
;
2702 struct gcpro gcpro1
;
2704 int count
= SPECPDL_INDEX ();
2706 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2708 Lisp_Object name
, buffer
, host
, service
, address
;
2709 Lisp_Object filter
, sentinel
;
2710 int is_non_blocking_client
= 0;
2718 /* Save arguments for process-contact and clone-process. */
2719 contact
= Flist (nargs
, args
);
2723 /* Ensure socket support is loaded if available. */
2724 init_winsock (TRUE
);
2727 /* :type TYPE (nil: stream, datagram */
2728 tem
= Fplist_get (contact
, QCtype
);
2730 socktype
= SOCK_STREAM
;
2731 #ifdef DATAGRAM_SOCKETS
2732 else if (EQ (tem
, Qdatagram
))
2733 socktype
= SOCK_DGRAM
;
2736 error ("Unsupported connection type");
2739 tem
= Fplist_get (contact
, QCserver
);
2742 /* Don't support network sockets when non-blocking mode is
2743 not available, since a blocked Emacs is not useful. */
2744 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2745 error ("Network servers not supported");
2751 /* Make QCaddress an alias for :local (server) or :remote (client). */
2752 QCaddress
= is_server
? QClocal
: QCremote
;
2755 if (!is_server
&& socktype
== SOCK_STREAM
2756 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2758 #ifndef NON_BLOCKING_CONNECT
2759 error ("Non-blocking connect not supported");
2761 is_non_blocking_client
= 1;
2765 name
= Fplist_get (contact
, QCname
);
2766 buffer
= Fplist_get (contact
, QCbuffer
);
2767 filter
= Fplist_get (contact
, QCfilter
);
2768 sentinel
= Fplist_get (contact
, QCsentinel
);
2770 CHECK_STRING (name
);
2773 /* Let's handle TERM before things get complicated ... */
2774 host
= Fplist_get (contact
, QChost
);
2775 CHECK_STRING (host
);
2777 service
= Fplist_get (contact
, QCservice
);
2778 if (INTEGERP (service
))
2779 port
= htons ((unsigned short) XINT (service
));
2782 struct servent
*svc_info
;
2783 CHECK_STRING (service
);
2784 svc_info
= getservbyname (SDATA (service
), "tcp");
2786 error ("Unknown service: %s", SDATA (service
));
2787 port
= svc_info
->s_port
;
2790 s
= connect_server (0);
2792 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2793 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2794 send_command (s
, C_DUMB
, 1, 0);
2796 #else /* not TERM */
2798 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2799 ai
.ai_socktype
= socktype
;
2804 /* :local ADDRESS or :remote ADDRESS */
2805 address
= Fplist_get (contact
, QCaddress
);
2806 if (!NILP (address
))
2808 host
= service
= Qnil
;
2810 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2811 error ("Malformed :address");
2812 ai
.ai_family
= family
;
2813 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2814 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2818 /* :family FAMILY -- nil (for Inet), local, or integer. */
2819 tem
= Fplist_get (contact
, QCfamily
);
2821 family
= XINT (tem
);
2826 #ifdef HAVE_LOCAL_SOCKETS
2827 else if (EQ (tem
, Qlocal
))
2832 error ("Unknown address family");
2833 ai
.ai_family
= family
;
2835 /* :service SERVICE -- string, integer (port number), or t (random port). */
2836 service
= Fplist_get (contact
, QCservice
);
2838 #ifdef HAVE_LOCAL_SOCKETS
2839 if (family
== AF_LOCAL
)
2841 /* Host is not used. */
2843 CHECK_STRING (service
);
2844 bzero (&address_un
, sizeof address_un
);
2845 address_un
.sun_family
= AF_LOCAL
;
2846 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2847 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2848 ai
.ai_addrlen
= sizeof address_un
;
2853 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2854 host
= Fplist_get (contact
, QChost
);
2857 if (EQ (host
, Qlocal
))
2858 host
= build_string ("localhost");
2859 CHECK_STRING (host
);
2862 /* Slow down polling to every ten seconds.
2863 Some kernels have a bug which causes retrying connect to fail
2864 after a connect. Polling can interfere with gethostbyname too. */
2865 #ifdef POLL_FOR_INPUT
2866 if (socktype
== SOCK_STREAM
)
2868 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2869 bind_polling_period (10);
2873 #ifdef HAVE_GETADDRINFO
2874 /* If we have a host, use getaddrinfo to resolve both host and service.
2875 Otherwise, use getservbyname to lookup the service. */
2879 /* SERVICE can either be a string or int.
2880 Convert to a C string for later use by getaddrinfo. */
2881 if (EQ (service
, Qt
))
2883 else if (INTEGERP (service
))
2885 sprintf (portbuf
, "%ld", (long) XINT (service
));
2886 portstring
= portbuf
;
2890 CHECK_STRING (service
);
2891 portstring
= SDATA (service
);
2896 memset (&hints
, 0, sizeof (hints
));
2898 hints
.ai_family
= NILP (Fplist_member (contact
, QCfamily
)) ? AF_UNSPEC
: family
;
2899 hints
.ai_socktype
= socktype
;
2900 hints
.ai_protocol
= 0;
2901 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
2903 #ifdef HAVE_GAI_STRERROR
2904 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
2906 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
2912 #endif /* HAVE_GETADDRINFO */
2914 /* We end up here if getaddrinfo is not defined, or in case no hostname
2915 has been specified (e.g. for a local server process). */
2917 if (EQ (service
, Qt
))
2919 else if (INTEGERP (service
))
2920 port
= htons ((unsigned short) XINT (service
));
2923 struct servent
*svc_info
;
2924 CHECK_STRING (service
);
2925 svc_info
= getservbyname (SDATA (service
),
2926 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
2928 error ("Unknown service: %s", SDATA (service
));
2929 port
= svc_info
->s_port
;
2932 bzero (&address_in
, sizeof address_in
);
2933 address_in
.sin_family
= family
;
2934 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
2935 address_in
.sin_port
= port
;
2937 #ifndef HAVE_GETADDRINFO
2940 struct hostent
*host_info_ptr
;
2942 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2943 as it may `hang' emacs for a very long time. */
2946 host_info_ptr
= gethostbyname (SDATA (host
));
2951 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
2952 host_info_ptr
->h_length
);
2953 family
= host_info_ptr
->h_addrtype
;
2954 address_in
.sin_family
= family
;
2957 /* Attempt to interpret host as numeric inet address */
2959 IN_ADDR numeric_addr
;
2960 numeric_addr
= inet_addr ((char *) SDATA (host
));
2961 if (NUMERIC_ADDR_ERROR
)
2962 error ("Unknown host \"%s\"", SDATA (host
));
2964 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
2965 sizeof (address_in
.sin_addr
));
2969 #endif /* not HAVE_GETADDRINFO */
2971 ai
.ai_family
= family
;
2972 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
2973 ai
.ai_addrlen
= sizeof address_in
;
2977 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2978 when connect is interrupted. So let's not let it get interrupted.
2979 Note we do not turn off polling, because polling is only used
2980 when not interrupt_input, and thus not normally used on the systems
2981 which have this bug. On systems which use polling, there's no way
2982 to quit if polling is turned off. */
2984 && !is_server
&& socktype
== SOCK_STREAM
)
2986 /* Comment from KFS: The original open-network-stream code
2987 didn't unwind protect this, but it seems like the proper
2988 thing to do. In any case, I don't see how it could harm to
2989 do this -- and it makes cleanup (using unbind_to) easier. */
2990 record_unwind_protect (unwind_request_sigio
, Qnil
);
2994 /* Do this in case we never enter the for-loop below. */
2995 count1
= SPECPDL_INDEX ();
2998 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3000 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3007 #ifdef DATAGRAM_SOCKETS
3008 if (!is_server
&& socktype
== SOCK_DGRAM
)
3010 #endif /* DATAGRAM_SOCKETS */
3012 #ifdef NON_BLOCKING_CONNECT
3013 if (is_non_blocking_client
)
3016 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3018 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3030 /* Make us close S if quit. */
3031 record_unwind_protect (close_file_unwind
, make_number (s
));
3035 /* Configure as a server socket. */
3036 #ifdef HAVE_LOCAL_SOCKETS
3037 if (family
!= AF_LOCAL
)
3041 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3042 report_file_error ("Cannot set reuse option on server socket.", Qnil
);
3045 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3046 report_file_error ("Cannot bind server socket", Qnil
);
3048 #ifdef HAVE_GETSOCKNAME
3049 if (EQ (service
, Qt
))
3051 struct sockaddr_in sa1
;
3052 int len1
= sizeof (sa1
);
3053 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3055 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3056 service
= make_number (ntohs (sa1
.sin_port
));
3057 contact
= Fplist_put (contact
, QCservice
, service
);
3062 if (socktype
== SOCK_STREAM
&& listen (s
, 5))
3063 report_file_error ("Cannot listen on server socket", Qnil
);
3073 /* This turns off all alarm-based interrupts; the
3074 bind_polling_period call above doesn't always turn all the
3075 short-interval ones off, especially if interrupt_input is
3078 It'd be nice to be able to control the connect timeout
3079 though. Would non-blocking connect calls be portable?
3081 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3083 turn_on_atimers (0);
3085 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3088 turn_on_atimers (1);
3090 if (ret
== 0 || xerrno
== EISCONN
)
3092 /* The unwind-protect will be discarded afterwards.
3093 Likewise for immediate_quit. */
3097 #ifdef NON_BLOCKING_CONNECT
3099 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3103 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3111 if (xerrno
== EINTR
)
3113 if (xerrno
== EADDRINUSE
&& retry
< 20)
3115 /* A delay here is needed on some FreeBSD systems,
3116 and it is harmless, since this retrying takes time anyway
3117 and should be infrequent. */
3118 Fsleep_for (make_number (1), Qnil
);
3123 /* Discard the unwind protect closing S. */
3124 specpdl_ptr
= specpdl
+ count1
;
3131 #ifdef DATAGRAM_SOCKETS
3132 if (socktype
== SOCK_DGRAM
)
3134 if (datagram_address
[s
].sa
)
3136 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3137 datagram_address
[s
].len
= lres
->ai_addrlen
;
3141 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3142 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3145 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3146 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3147 conv_lisp_to_sockaddr (rfamily
, remote
,
3148 datagram_address
[s
].sa
, rlen
);
3152 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3155 contact
= Fplist_put (contact
, QCaddress
,
3156 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3157 #ifdef HAVE_GETSOCKNAME
3160 struct sockaddr_in sa1
;
3161 int len1
= sizeof (sa1
);
3162 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3163 contact
= Fplist_put (contact
, QClocal
,
3164 conv_sockaddr_to_lisp (&sa1
, len1
));
3169 #ifdef HAVE_GETADDRINFO
3176 /* Discard the unwind protect for closing S, if any. */
3177 specpdl_ptr
= specpdl
+ count1
;
3179 /* Unwind bind_polling_period and request_sigio. */
3180 unbind_to (count
, Qnil
);
3184 /* If non-blocking got this far - and failed - assume non-blocking is
3185 not supported after all. This is probably a wrong assumption, but
3186 the normal blocking calls to open-network-stream handles this error
3188 if (is_non_blocking_client
)
3193 report_file_error ("make server process failed", contact
);
3195 report_file_error ("make client process failed", contact
);
3198 tem
= Fplist_get (contact
, QCoptions
);
3200 set_socket_options (s
, tem
, 1);
3202 #endif /* not TERM */
3208 buffer
= Fget_buffer_create (buffer
);
3209 proc
= make_process (name
);
3211 chan_process
[inch
] = proc
;
3214 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3217 fcntl (inch
, F_SETFL
, O_NDELAY
);
3221 p
= XPROCESS (proc
);
3223 p
->childp
= contact
;
3224 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3227 p
->sentinel
= sentinel
;
3229 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3230 /* Override the above only if :filter-multibyte is specified. */
3231 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3232 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3233 p
->log
= Fplist_get (contact
, QClog
);
3234 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3235 p
->kill_without_query
= Qt
;
3236 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3239 XSETINT (p
->infd
, inch
);
3240 XSETINT (p
->outfd
, outch
);
3241 if (is_server
&& socktype
== SOCK_STREAM
)
3242 p
->status
= Qlisten
;
3244 #ifdef NON_BLOCKING_CONNECT
3245 if (is_non_blocking_client
)
3247 /* We may get here if connect did succeed immediately. However,
3248 in that case, we still need to signal this like a non-blocking
3250 p
->status
= Qconnect
;
3251 if (!FD_ISSET (inch
, &connect_wait_mask
))
3253 FD_SET (inch
, &connect_wait_mask
);
3254 num_pending_connects
++;
3259 /* A server may have a client filter setting of Qt, but it must
3260 still listen for incoming connects unless it is stopped. */
3261 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3262 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3264 FD_SET (inch
, &input_wait_mask
);
3265 FD_SET (inch
, &non_keyboard_wait_mask
);
3268 if (inch
> max_process_desc
)
3269 max_process_desc
= inch
;
3271 tem
= Fplist_member (contact
, QCcoding
);
3272 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3273 tem
= Qnil
; /* No error message (too late!). */
3276 /* Setup coding systems for communicating with the network stream. */
3277 struct gcpro gcpro1
;
3278 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3279 Lisp_Object coding_systems
= Qt
;
3280 Lisp_Object args
[5], val
;
3283 val
= XCAR (XCDR (tem
));
3284 else if (!NILP (Vcoding_system_for_read
))
3285 val
= Vcoding_system_for_read
;
3286 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3287 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3288 /* We dare not decode end-of-line format by setting VAL to
3289 Qraw_text, because the existing Emacs Lisp libraries
3290 assume that they receive bare code including a sequene of
3295 if (NILP (host
) || NILP (service
))
3296 coding_systems
= Qnil
;
3299 args
[0] = Qopen_network_stream
, args
[1] = name
,
3300 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3302 coding_systems
= Ffind_operation_coding_system (5, args
);
3305 if (CONSP (coding_systems
))
3306 val
= XCAR (coding_systems
);
3307 else if (CONSP (Vdefault_process_coding_system
))
3308 val
= XCAR (Vdefault_process_coding_system
);
3312 p
->decode_coding_system
= val
;
3315 val
= XCAR (XCDR (tem
));
3316 else if (!NILP (Vcoding_system_for_write
))
3317 val
= Vcoding_system_for_write
;
3318 else if (NILP (current_buffer
->enable_multibyte_characters
))
3322 if (EQ (coding_systems
, Qt
))
3324 if (NILP (host
) || NILP (service
))
3325 coding_systems
= Qnil
;
3328 args
[0] = Qopen_network_stream
, args
[1] = name
,
3329 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3331 coding_systems
= Ffind_operation_coding_system (5, args
);
3335 if (CONSP (coding_systems
))
3336 val
= XCDR (coding_systems
);
3337 else if (CONSP (Vdefault_process_coding_system
))
3338 val
= XCDR (Vdefault_process_coding_system
);
3342 p
->encode_coding_system
= val
;
3344 setup_process_coding_systems (proc
);
3346 p
->decoding_buf
= make_uninit_string (0);
3347 p
->decoding_carryover
= make_number (0);
3348 p
->encoding_buf
= make_uninit_string (0);
3349 p
->encoding_carryover
= make_number (0);
3351 p
->inherit_coding_system_flag
3352 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3358 #endif /* HAVE_SOCKETS */
3361 deactivate_process (proc
)
3364 register int inchannel
, outchannel
;
3365 register struct Lisp_Process
*p
= XPROCESS (proc
);
3367 inchannel
= XINT (p
->infd
);
3368 outchannel
= XINT (p
->outfd
);
3372 /* Beware SIGCHLD hereabouts. */
3373 flush_pending_output (inchannel
);
3376 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3377 sys$
dassgn (outchannel
);
3378 vs
= get_vms_process_pointer (p
->pid
);
3380 give_back_vms_process_stuff (vs
);
3383 emacs_close (inchannel
);
3384 if (outchannel
>= 0 && outchannel
!= inchannel
)
3385 emacs_close (outchannel
);
3388 XSETINT (p
->infd
, -1);
3389 XSETINT (p
->outfd
, -1);
3390 #ifdef DATAGRAM_SOCKETS
3391 if (DATAGRAM_CHAN_P (inchannel
))
3393 xfree (datagram_address
[inchannel
].sa
);
3394 datagram_address
[inchannel
].sa
= 0;
3395 datagram_address
[inchannel
].len
= 0;
3398 chan_process
[inchannel
] = Qnil
;
3399 FD_CLR (inchannel
, &input_wait_mask
);
3400 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3401 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3403 FD_CLR (inchannel
, &connect_wait_mask
);
3404 if (--num_pending_connects
< 0)
3407 if (inchannel
== max_process_desc
)
3410 /* We just closed the highest-numbered process input descriptor,
3411 so recompute the highest-numbered one now. */
3412 max_process_desc
= 0;
3413 for (i
= 0; i
< MAXDESC
; i
++)
3414 if (!NILP (chan_process
[i
]))
3415 max_process_desc
= i
;
3420 /* Close all descriptors currently in use for communication
3421 with subprocess. This is used in a newly-forked subprocess
3422 to get rid of irrelevant descriptors. */
3425 close_process_descs ()
3429 for (i
= 0; i
< MAXDESC
; i
++)
3431 Lisp_Object process
;
3432 process
= chan_process
[i
];
3433 if (!NILP (process
))
3435 int in
= XINT (XPROCESS (process
)->infd
);
3436 int out
= XINT (XPROCESS (process
)->outfd
);
3439 if (out
>= 0 && in
!= out
)
3446 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3448 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3449 It is read into the process' buffers or given to their filter functions.
3450 Non-nil arg PROCESS means do not return until some output has been received
3452 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3453 seconds and microseconds to wait; return after that much time whether
3454 or not there is input.
3455 Return non-nil iff we received any output before the timeout expired. */)
3456 (process
, timeout
, timeout_msecs
)
3457 register Lisp_Object process
, timeout
, timeout_msecs
;
3462 if (! NILP (process
))
3463 CHECK_PROCESS (process
);
3465 if (! NILP (timeout_msecs
))
3467 CHECK_NUMBER (timeout_msecs
);
3468 useconds
= XINT (timeout_msecs
);
3469 if (!INTEGERP (timeout
))
3470 XSETINT (timeout
, 0);
3473 int carry
= useconds
/ 1000000;
3475 XSETINT (timeout
, XINT (timeout
) + carry
);
3476 useconds
-= carry
* 1000000;
3478 /* I think this clause is necessary because C doesn't
3479 guarantee a particular rounding direction for negative
3483 XSETINT (timeout
, XINT (timeout
) - 1);
3484 useconds
+= 1000000;
3491 if (! NILP (timeout
))
3493 CHECK_NUMBER (timeout
);
3494 seconds
= XINT (timeout
);
3495 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3499 seconds
= NILP (process
) ? -1 : 0;
3502 XSETFASTINT (process
, 0);
3505 (wait_reading_process_input (seconds
, useconds
, process
, 0)
3509 /* Accept a connection for server process SERVER on CHANNEL. */
3511 static int connect_counter
= 0;
3514 server_accept_connection (server
, channel
)
3518 Lisp_Object proc
, caller
, name
, buffer
;
3519 Lisp_Object contact
, host
, service
;
3520 struct Lisp_Process
*ps
= XPROCESS (server
);
3521 struct Lisp_Process
*p
;
3525 struct sockaddr_in in
;
3526 #ifdef HAVE_LOCAL_SOCKETS
3527 struct sockaddr_un un
;
3530 int len
= sizeof saddr
;
3532 s
= accept (channel
, &saddr
.sa
, &len
);
3541 if (code
== EWOULDBLOCK
)
3545 if (!NILP (ps
->log
))
3546 call3 (ps
->log
, server
, Qnil
,
3547 concat3 (build_string ("accept failed with code"),
3548 Fnumber_to_string (make_number (code
)),
3549 build_string ("\n")));
3555 /* Setup a new process to handle the connection. */
3557 /* Generate a unique identification of the caller, and build contact
3558 information for this process. */
3561 switch (saddr
.sa
.sa_family
)
3565 Lisp_Object args
[5];
3566 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3567 args
[0] = build_string ("%d.%d.%d.%d");
3568 args
[1] = make_number (*ip
++);
3569 args
[2] = make_number (*ip
++);
3570 args
[3] = make_number (*ip
++);
3571 args
[4] = make_number (*ip
++);
3572 host
= Fformat (5, args
);
3573 service
= make_number (ntohs (saddr
.in
.sin_port
));
3575 args
[0] = build_string (" <%s:%d>");
3578 caller
= Fformat (3, args
);
3582 #ifdef HAVE_LOCAL_SOCKETS
3586 caller
= Fnumber_to_string (make_number (connect_counter
));
3587 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3591 /* Create a new buffer name for this process if it doesn't have a
3592 filter. The new buffer name is based on the buffer name or
3593 process name of the server process concatenated with the caller
3596 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
3600 buffer
= ps
->buffer
;
3602 buffer
= Fbuffer_name (buffer
);
3607 buffer
= concat2 (buffer
, caller
);
3608 buffer
= Fget_buffer_create (buffer
);
3612 /* Generate a unique name for the new server process. Combine the
3613 server process name with the caller identification. */
3615 name
= concat2 (ps
->name
, caller
);
3616 proc
= make_process (name
);
3618 chan_process
[s
] = proc
;
3621 fcntl (s
, F_SETFL
, O_NONBLOCK
);
3624 fcntl (s
, F_SETFL
, O_NDELAY
);
3628 p
= XPROCESS (proc
);
3630 /* Build new contact information for this setup. */
3631 contact
= Fcopy_sequence (ps
->childp
);
3632 contact
= Fplist_put (contact
, QCserver
, Qnil
);
3633 contact
= Fplist_put (contact
, QChost
, host
);
3634 if (!NILP (service
))
3635 contact
= Fplist_put (contact
, QCservice
, service
);
3636 contact
= Fplist_put (contact
, QCremote
,
3637 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3638 #ifdef HAVE_GETSOCKNAME
3640 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
3641 contact
= Fplist_put (contact
, QClocal
,
3642 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3645 p
->childp
= contact
;
3646 p
->plist
= Fcopy_sequence (ps
->plist
);
3649 p
->sentinel
= ps
->sentinel
;
3650 p
->filter
= ps
->filter
;
3653 XSETINT (p
->infd
, s
);
3654 XSETINT (p
->outfd
, s
);
3657 /* Client processes for accepted connections are not stopped initially. */
3658 if (!EQ (p
->filter
, Qt
))
3660 FD_SET (s
, &input_wait_mask
);
3661 FD_SET (s
, &non_keyboard_wait_mask
);
3664 if (s
> max_process_desc
)
3665 max_process_desc
= s
;
3667 /* Setup coding system for new process based on server process.
3668 This seems to be the proper thing to do, as the coding system
3669 of the new process should reflect the settings at the time the
3670 server socket was opened; not the current settings. */
3672 p
->decode_coding_system
= ps
->decode_coding_system
;
3673 p
->encode_coding_system
= ps
->encode_coding_system
;
3674 setup_process_coding_systems (proc
);
3676 p
->decoding_buf
= make_uninit_string (0);
3677 p
->decoding_carryover
= make_number (0);
3678 p
->encoding_buf
= make_uninit_string (0);
3679 p
->encoding_carryover
= make_number (0);
3681 p
->inherit_coding_system_flag
3682 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
3684 if (!NILP (ps
->log
))
3685 call3 (ps
->log
, server
, proc
,
3686 concat3 (build_string ("accept from "),
3687 (STRINGP (host
) ? host
: build_string ("-")),
3688 build_string ("\n")));
3690 if (!NILP (p
->sentinel
))
3691 exec_sentinel (proc
,
3692 concat3 (build_string ("open from "),
3693 (STRINGP (host
) ? host
: build_string ("-")),
3694 build_string ("\n")));
3697 /* This variable is different from waiting_for_input in keyboard.c.
3698 It is used to communicate to a lisp process-filter/sentinel (via the
3699 function Fwaiting_for_user_input_p below) whether emacs was waiting
3700 for user-input when that process-filter was called.
3701 waiting_for_input cannot be used as that is by definition 0 when
3702 lisp code is being evalled.
3703 This is also used in record_asynch_buffer_change.
3704 For that purpose, this must be 0
3705 when not inside wait_reading_process_input. */
3706 static int waiting_for_user_input_p
;
3708 /* This is here so breakpoints can be put on it. */
3710 wait_reading_process_input_1 ()
3714 /* Read and dispose of subprocess output while waiting for timeout to
3715 elapse and/or keyboard input to be available.
3718 timeout in seconds, or
3719 zero for no limit, or
3720 -1 means gobble data immediately available but don't wait for any.
3723 an additional duration to wait, measured in microseconds.
3724 If this is nonzero and time_limit is 0, then the timeout
3725 consists of MICROSECS only.
3727 READ_KBD is a lisp value:
3728 0 to ignore keyboard input, or
3729 1 to return when input is available, or
3730 -1 meaning caller will actually read the input, so don't throw to
3731 the quit handler, or
3732 a cons cell, meaning wait until its car is non-nil
3733 (and gobble terminal input into the buffer if any arrives), or
3734 a process object, meaning wait until something arrives from that
3735 process. The return value is true iff we read some input from
3738 DO_DISPLAY != 0 means redisplay should be done to show subprocess
3739 output that arrives.
3741 If READ_KBD is a pointer to a struct Lisp_Process, then the
3742 function returns true iff we received input from that process
3743 before the timeout elapsed.
3744 Otherwise, return true iff we received input from any process. */
3747 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3748 int time_limit
, microsecs
;
3749 Lisp_Object read_kbd
;
3752 register int channel
, nfds
;
3753 static SELECT_TYPE Available
;
3754 static SELECT_TYPE Connecting
;
3755 int check_connect
, no_avail
;
3758 EMACS_TIME timeout
, end_time
;
3759 int wait_channel
= -1;
3760 struct Lisp_Process
*wait_proc
= 0;
3761 int got_some_input
= 0;
3762 /* Either nil or a cons cell, the car of which is of interest and
3763 may be changed outside of this routine. */
3764 Lisp_Object wait_for_cell
= Qnil
;
3766 FD_ZERO (&Available
);
3767 FD_ZERO (&Connecting
);
3769 /* If read_kbd is a process to watch, set wait_proc and wait_channel
3771 if (PROCESSP (read_kbd
))
3773 wait_proc
= XPROCESS (read_kbd
);
3774 wait_channel
= XINT (wait_proc
->infd
);
3775 XSETFASTINT (read_kbd
, 0);
3778 /* If waiting for non-nil in a cell, record where. */
3779 if (CONSP (read_kbd
))
3781 wait_for_cell
= read_kbd
;
3782 XSETFASTINT (read_kbd
, 0);
3785 waiting_for_user_input_p
= XINT (read_kbd
);
3787 /* Since we may need to wait several times,
3788 compute the absolute time to return at. */
3789 if (time_limit
|| microsecs
)
3791 EMACS_GET_TIME (end_time
);
3792 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3793 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3795 #ifdef POLL_INTERRUPTED_SYS_CALL
3796 /* AlainF 5-Jul-1996
3797 HP-UX 10.10 seem to have problems with signals coming in
3798 Causes "poll: interrupted system call" messages when Emacs is run
3800 Turn off periodic alarms (in case they are in use),
3801 and then turn off any other atimers. */
3803 turn_on_atimers (0);
3804 #endif /* POLL_INTERRUPTED_SYS_CALL */
3808 int timeout_reduced_for_timers
= 0;
3810 /* If calling from keyboard input, do not quit
3811 since we want to return C-g as an input character.
3812 Otherwise, do pending quit if requested. */
3813 if (XINT (read_kbd
) >= 0)
3816 /* Exit now if the cell we're waiting for became non-nil. */
3817 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
3820 /* Compute time from now till when time limit is up */
3821 /* Exit if already run out */
3822 if (time_limit
== -1)
3824 /* -1 specified for timeout means
3825 gobble output available now
3826 but don't wait at all. */
3828 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3830 else if (time_limit
|| microsecs
)
3832 EMACS_GET_TIME (timeout
);
3833 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
3834 if (EMACS_TIME_NEG_P (timeout
))
3839 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
3842 /* Normally we run timers here.
3843 But not if wait_for_cell; in those cases,
3844 the wait is supposed to be short,
3845 and those callers cannot handle running arbitrary Lisp code here. */
3846 if (NILP (wait_for_cell
))
3848 EMACS_TIME timer_delay
;
3852 int old_timers_run
= timers_run
;
3853 struct buffer
*old_buffer
= current_buffer
;
3855 timer_delay
= timer_check (1);
3857 /* If a timer has run, this might have changed buffers
3858 an alike. Make read_key_sequence aware of that. */
3859 if (timers_run
!= old_timers_run
3860 && old_buffer
!= current_buffer
3861 && waiting_for_user_input_p
== -1)
3862 record_asynch_buffer_change ();
3864 if (timers_run
!= old_timers_run
&& do_display
)
3865 /* We must retry, since a timer may have requeued itself
3866 and that could alter the time_delay. */
3867 redisplay_preserve_echo_area (9);
3871 while (!detect_input_pending ());
3873 /* If there is unread keyboard input, also return. */
3874 if (XINT (read_kbd
) != 0
3875 && requeued_events_pending_p ())
3878 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
3880 EMACS_TIME difference
;
3881 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
3882 if (EMACS_TIME_NEG_P (difference
))
3884 timeout
= timer_delay
;
3885 timeout_reduced_for_timers
= 1;
3888 /* If time_limit is -1, we are not going to wait at all. */
3889 else if (time_limit
!= -1)
3891 /* This is so a breakpoint can be put here. */
3892 wait_reading_process_input_1 ();
3896 /* Cause C-g and alarm signals to take immediate action,
3897 and cause input available signals to zero out timeout.
3899 It is important that we do this before checking for process
3900 activity. If we get a SIGCHLD after the explicit checks for
3901 process activity, timeout is the only way we will know. */
3902 if (XINT (read_kbd
) < 0)
3903 set_waiting_for_input (&timeout
);
3905 /* If status of something has changed, and no input is
3906 available, notify the user of the change right away. After
3907 this explicit check, we'll let the SIGCHLD handler zap
3908 timeout to get our attention. */
3909 if (update_tick
!= process_tick
&& do_display
)
3911 SELECT_TYPE Atemp
, Ctemp
;
3913 Atemp
= input_wait_mask
;
3915 /* On Mac OS X, the SELECT system call always says input is
3916 present (for reading) at stdin, even when none is. This
3917 causes the call to SELECT below to return 1 and
3918 status_notify not to be called. As a result output of
3919 subprocesses are incorrectly discarded. */
3922 Ctemp
= connect_wait_mask
;
3923 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3924 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
3926 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
3927 (SELECT_TYPE
*)0, &timeout
)
3930 /* It's okay for us to do this and then continue with
3931 the loop, since timeout has already been zeroed out. */
3932 clear_waiting_for_input ();
3937 /* Don't wait for output from a non-running process. Just
3938 read whatever data has already been received. */
3939 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
3940 update_status (wait_proc
);
3942 && ! EQ (wait_proc
->status
, Qrun
)
3943 && ! EQ (wait_proc
->status
, Qconnect
))
3945 int nread
, total_nread
= 0;
3947 clear_waiting_for_input ();
3948 XSETPROCESS (proc
, wait_proc
);
3950 /* Read data from the process, until we exhaust it. */
3951 while (XINT (wait_proc
->infd
) >= 0)
3953 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
3959 total_nread
+= nread
;
3961 else if (nread
== -1 && EIO
== errno
)
3965 else if (nread
== -1 && EAGAIN
== errno
)
3969 else if (nread
== -1 && EWOULDBLOCK
== errno
)
3973 if (total_nread
> 0 && do_display
)
3974 redisplay_preserve_echo_area (10);
3979 /* Wait till there is something to do */
3981 if (!NILP (wait_for_cell
))
3983 Available
= non_process_wait_mask
;
3988 if (! XINT (read_kbd
))
3989 Available
= non_keyboard_wait_mask
;
3991 Available
= input_wait_mask
;
3992 check_connect
= (num_pending_connects
> 0);
3995 /* If frame size has changed or the window is newly mapped,
3996 redisplay now, before we start to wait. There is a race
3997 condition here; if a SIGIO arrives between now and the select
3998 and indicates that a frame is trashed, the select may block
3999 displaying a trashed screen. */
4000 if (frame_garbaged
&& do_display
)
4002 clear_waiting_for_input ();
4003 redisplay_preserve_echo_area (11);
4004 if (XINT (read_kbd
) < 0)
4005 set_waiting_for_input (&timeout
);
4009 if (XINT (read_kbd
) && detect_input_pending ())
4017 Connecting
= connect_wait_mask
;
4018 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4020 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4021 (SELECT_TYPE
*)0, &timeout
);
4026 /* Make C-g and alarm signals set flags again */
4027 clear_waiting_for_input ();
4029 /* If we woke up due to SIGWINCH, actually change size now. */
4030 do_pending_window_change (0);
4032 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4033 /* We wanted the full specified time, so return now. */
4037 if (xerrno
== EINTR
)
4040 /* Ultrix select seems to return ENOMEM when it is
4041 interrupted. Treat it just like EINTR. Bleah. Note
4042 that we want to test for the "ultrix" CPP symbol, not
4043 "__ultrix__"; the latter is only defined under GCC, but
4044 not by DEC's bundled CC. -JimB */
4045 else if (xerrno
== ENOMEM
)
4049 /* This happens for no known reason on ALLIANT.
4050 I am guessing that this is the right response. -- RMS. */
4051 else if (xerrno
== EFAULT
)
4054 else if (xerrno
== EBADF
)
4057 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4058 the child's closure of the pts gives the parent a SIGHUP, and
4059 the ptc file descriptor is automatically closed,
4060 yielding EBADF here or at select() call above.
4061 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4062 in m/ibmrt-aix.h), and here we just ignore the select error.
4063 Cleanup occurs c/o status_notify after SIGCLD. */
4064 no_avail
= 1; /* Cannot depend on values returned */
4070 error ("select error: %s", emacs_strerror (xerrno
));
4075 FD_ZERO (&Available
);
4079 #if defined(sun) && !defined(USG5_4)
4080 if (nfds
> 0 && keyboard_bit_set (&Available
)
4082 /* System sometimes fails to deliver SIGIO.
4084 David J. Mackenzie says that Emacs doesn't compile under
4085 Solaris if this code is enabled, thus the USG5_4 in the CPP
4086 conditional. "I haven't noticed any ill effects so far.
4087 If you find a Solaris expert somewhere, they might know
4089 kill (getpid (), SIGIO
);
4092 #if 0 /* When polling is used, interrupt_input is 0,
4093 so get_input_pending should read the input.
4094 So this should not be needed. */
4095 /* If we are using polling for input,
4096 and we see input available, make it get read now.
4097 Otherwise it might not actually get read for a second.
4098 And on hpux, since we turn off polling in wait_reading_process_input,
4099 it might never get read at all if we don't spend much time
4100 outside of wait_reading_process_input. */
4101 if (XINT (read_kbd
) && interrupt_input
4102 && keyboard_bit_set (&Available
)
4103 && input_polling_used ())
4104 kill (getpid (), SIGALRM
);
4107 /* Check for keyboard input */
4108 /* If there is any, return immediately
4109 to give it higher priority than subprocesses */
4111 if (XINT (read_kbd
) != 0)
4113 int old_timers_run
= timers_run
;
4114 struct buffer
*old_buffer
= current_buffer
;
4117 if (detect_input_pending_run_timers (do_display
))
4119 swallow_events (do_display
);
4120 if (detect_input_pending_run_timers (do_display
))
4124 /* If a timer has run, this might have changed buffers
4125 an alike. Make read_key_sequence aware of that. */
4126 if (timers_run
!= old_timers_run
4127 && waiting_for_user_input_p
== -1
4128 && old_buffer
!= current_buffer
)
4129 record_asynch_buffer_change ();
4135 /* If there is unread keyboard input, also return. */
4136 if (XINT (read_kbd
) != 0
4137 && requeued_events_pending_p ())
4140 /* If we are not checking for keyboard input now,
4141 do process events (but don't run any timers).
4142 This is so that X events will be processed.
4143 Otherwise they may have to wait until polling takes place.
4144 That would causes delays in pasting selections, for example.
4146 (We used to do this only if wait_for_cell.) */
4147 if (XINT (read_kbd
) == 0 && detect_input_pending ())
4149 swallow_events (do_display
);
4150 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4151 if (detect_input_pending ())
4156 /* Exit now if the cell we're waiting for became non-nil. */
4157 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4161 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4162 go read it. This can happen with X on BSD after logging out.
4163 In that case, there really is no input and no SIGIO,
4164 but select says there is input. */
4166 if (XINT (read_kbd
) && interrupt_input
4167 && keyboard_bit_set (&Available
) && ! noninteractive
)
4168 kill (getpid (), SIGIO
);
4172 got_some_input
|= nfds
> 0;
4174 /* If checking input just got us a size-change event from X,
4175 obey it now if we should. */
4176 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
4177 do_pending_window_change (0);
4179 /* Check for data from a process. */
4180 if (no_avail
|| nfds
== 0)
4183 /* Really FIRST_PROC_DESC should be 0 on Unix,
4184 but this is safer in the short run. */
4185 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4187 if (FD_ISSET (channel
, &Available
)
4188 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4192 /* If waiting for this channel, arrange to return as
4193 soon as no more input to be processed. No more
4195 if (wait_channel
== channel
)
4201 proc
= chan_process
[channel
];
4205 /* If this is a server stream socket, accept connection. */
4206 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4208 server_accept_connection (proc
, channel
);
4212 /* Read data from the process, starting with our
4213 buffered-ahead character if we have one. */
4215 nread
= read_process_output (proc
, channel
);
4218 /* Since read_process_output can run a filter,
4219 which can call accept-process-output,
4220 don't try to read from any other processes
4221 before doing the select again. */
4222 FD_ZERO (&Available
);
4225 redisplay_preserve_echo_area (12);
4228 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4231 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4232 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4234 else if (nread
== -1 && errno
== EAGAIN
)
4238 else if (nread
== -1 && errno
== EAGAIN
)
4240 /* Note that we cannot distinguish between no input
4241 available now and a closed pipe.
4242 With luck, a closed pipe will be accompanied by
4243 subprocess termination and SIGCHLD. */
4244 else if (nread
== 0 && !NETCONN_P (proc
))
4246 #endif /* O_NDELAY */
4247 #endif /* O_NONBLOCK */
4249 /* On some OSs with ptys, when the process on one end of
4250 a pty exits, the other end gets an error reading with
4251 errno = EIO instead of getting an EOF (0 bytes read).
4252 Therefore, if we get an error reading and errno =
4253 EIO, just continue, because the child process has
4254 exited and should clean itself up soon (e.g. when we
4257 However, it has been known to happen that the SIGCHLD
4258 got lost. So raise the signl again just in case.
4260 else if (nread
== -1 && errno
== EIO
)
4261 kill (getpid (), SIGCHLD
);
4262 #endif /* HAVE_PTYS */
4263 /* If we can detect process termination, don't consider the process
4264 gone just because its pipe is closed. */
4266 else if (nread
== 0 && !NETCONN_P (proc
))
4271 /* Preserve status of processes already terminated. */
4272 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4273 deactivate_process (proc
);
4274 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4275 update_status (XPROCESS (proc
));
4276 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4277 XPROCESS (proc
)->status
4278 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4281 #ifdef NON_BLOCKING_CONNECT
4282 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
4284 struct Lisp_Process
*p
;
4286 FD_CLR (channel
, &connect_wait_mask
);
4287 if (--num_pending_connects
< 0)
4290 proc
= chan_process
[channel
];
4294 p
= XPROCESS (proc
);
4297 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4298 So only use it on systems where it is known to work. */
4300 int xlen
= sizeof(xerrno
);
4301 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4306 struct sockaddr pname
;
4307 int pnamelen
= sizeof(pname
);
4309 /* If connection failed, getpeername will fail. */
4311 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4313 /* Obtain connect failure code through error slippage. */
4316 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4323 XSETINT (p
->tick
, ++process_tick
);
4324 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4325 deactivate_process (proc
);
4330 /* Execute the sentinel here. If we had relied on
4331 status_notify to do it later, it will read input
4332 from the process before calling the sentinel. */
4333 exec_sentinel (proc
, build_string ("open\n"));
4334 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4336 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4337 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4341 #endif /* NON_BLOCKING_CONNECT */
4342 } /* end for each file descriptor */
4343 } /* end while exit conditions not met */
4345 waiting_for_user_input_p
= 0;
4347 /* If calling from keyboard input, do not quit
4348 since we want to return C-g as an input character.
4349 Otherwise, do pending quit if requested. */
4350 if (XINT (read_kbd
) >= 0)
4352 /* Prevent input_pending from remaining set if we quit. */
4353 clear_input_pending ();
4356 #ifdef POLL_INTERRUPTED_SYS_CALL
4357 /* AlainF 5-Jul-1996
4358 HP-UX 10.10 seems to have problems with signals coming in
4359 Causes "poll: interrupted system call" messages when Emacs is run
4361 Turn periodic alarms back on */
4363 #endif /* POLL_INTERRUPTED_SYS_CALL */
4365 return got_some_input
;
4368 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4371 read_process_output_call (fun_and_args
)
4372 Lisp_Object fun_and_args
;
4374 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4378 read_process_output_error_handler (error
)
4381 cmd_error_internal (error
, "error in process filter: ");
4383 update_echo_area ();
4384 Fsleep_for (make_number (2), Qnil
);
4388 /* Read pending output from the process channel,
4389 starting with our buffered-ahead character if we have one.
4390 Yield number of decoded characters read.
4392 This function reads at most 1024 characters.
4393 If you want to read all available subprocess output,
4394 you must call it repeatedly until it returns zero.
4396 The characters read are decoded according to PROC's coding-system
4400 read_process_output (proc
, channel
)
4402 register int channel
;
4404 register int nbytes
;
4406 register Lisp_Object outstream
;
4407 register struct buffer
*old
= current_buffer
;
4408 register struct Lisp_Process
*p
= XPROCESS (proc
);
4409 register int opoint
;
4410 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4411 int carryover
= XINT (p
->decoding_carryover
);
4415 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4417 vs
= get_vms_process_pointer (p
->pid
);
4421 return (0); /* Really weird if it does this */
4422 if (!(vs
->iosb
[0] & 1))
4423 return -1; /* I/O error */
4426 error ("Could not get VMS process pointer");
4427 chars
= vs
->inputBuffer
;
4428 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4431 start_vms_process_read (vs
); /* Crank up the next read on the process */
4432 return 1; /* Nothing worth printing, say we got 1 */
4436 /* The data carried over in the previous decoding (which are at
4437 the tail of decoding buffer) should be prepended to the new
4438 data read to decode all together. */
4439 chars
= (char *) alloca (nbytes
+ carryover
);
4440 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4441 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4445 #ifdef DATAGRAM_SOCKETS
4446 /* A datagram is one packet; allow at least 1500+ bytes of data
4447 corresponding to the typical Ethernet frame size. */
4448 if (DATAGRAM_CHAN_P (channel
))
4450 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4455 chars
= (char *) alloca (carryover
+ readmax
);
4457 /* See the comment above. */
4458 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4460 #ifdef DATAGRAM_SOCKETS
4461 /* We have a working select, so proc_buffered_char is always -1. */
4462 if (DATAGRAM_CHAN_P (channel
))
4464 int len
= datagram_address
[channel
].len
;
4465 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
- carryover
,
4466 0, datagram_address
[channel
].sa
, &len
);
4470 if (proc_buffered_char
[channel
] < 0)
4471 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
- carryover
);
4474 chars
[carryover
] = proc_buffered_char
[channel
];
4475 proc_buffered_char
[channel
] = -1;
4476 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1 - carryover
);
4480 nbytes
= nbytes
+ 1;
4482 #endif /* not VMS */
4484 XSETINT (p
->decoding_carryover
, 0);
4486 /* At this point, NBYTES holds number of bytes just received
4487 (including the one in proc_buffered_char[channel]). */
4490 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4492 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4495 /* Now set NBYTES how many bytes we must decode. */
4496 nbytes
+= carryover
;
4498 /* Read and dispose of the process output. */
4499 outstream
= p
->filter
;
4500 if (!NILP (outstream
))
4502 /* We inhibit quit here instead of just catching it so that
4503 hitting ^G when a filter happens to be running won't screw
4505 int count
= SPECPDL_INDEX ();
4506 Lisp_Object odeactivate
;
4507 Lisp_Object obuffer
, okeymap
;
4509 int outer_running_asynch_code
= running_asynch_code
;
4510 int waiting
= waiting_for_user_input_p
;
4512 /* No need to gcpro these, because all we do with them later
4513 is test them for EQness, and none of them should be a string. */
4514 odeactivate
= Vdeactivate_mark
;
4515 XSETBUFFER (obuffer
, current_buffer
);
4516 okeymap
= current_buffer
->keymap
;
4518 specbind (Qinhibit_quit
, Qt
);
4519 specbind (Qlast_nonmenu_event
, Qt
);
4521 /* In case we get recursively called,
4522 and we already saved the match data nonrecursively,
4523 save the same match data in safely recursive fashion. */
4524 if (outer_running_asynch_code
)
4527 /* Don't clobber the CURRENT match data, either! */
4528 tem
= Fmatch_data (Qnil
, Qnil
);
4529 restore_match_data ();
4530 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4531 Fset_match_data (tem
);
4534 /* For speed, if a search happens within this code,
4535 save the match data in a special nonrecursive fashion. */
4536 running_asynch_code
= 1;
4538 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
4539 text
= coding
->dst_object
;
4540 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
4541 /* A new coding system might be found. */
4542 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
4544 p
->decode_coding_system
= Vlast_coding_system_used
;
4546 /* Don't call setup_coding_system for
4547 proc_decode_coding_system[channel] here. It is done in
4548 detect_coding called via decode_coding above. */
4550 /* If a coding system for encoding is not yet decided, we set
4551 it as the same as coding-system for decoding.
4553 But, before doing that we must check if
4554 proc_encode_coding_system[p->outfd] surely points to a
4555 valid memory because p->outfd will be changed once EOF is
4556 sent to the process. */
4557 if (NILP (p
->encode_coding_system
)
4558 && proc_encode_coding_system
[XINT (p
->outfd
)])
4560 p
->encode_coding_system
= Vlast_coding_system_used
;
4561 setup_coding_system (p
->encode_coding_system
,
4562 proc_encode_coding_system
[XINT (p
->outfd
)]);
4566 if (coding
->carryover_bytes
> 0)
4568 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
4569 coding
->carryover_bytes
);
4570 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
4572 /* Adjust the multibyteness of TEXT to that of the filter. */
4573 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
4574 text
= (STRING_MULTIBYTE (text
)
4575 ? Fstring_as_unibyte (text
)
4576 : Fstring_to_multibyte (text
));
4577 if (SBYTES (text
) > 0)
4578 internal_condition_case_1 (read_process_output_call
,
4580 Fcons (proc
, Fcons (text
, Qnil
))),
4581 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4582 read_process_output_error_handler
);
4584 /* If we saved the match data nonrecursively, restore it now. */
4585 restore_match_data ();
4586 running_asynch_code
= outer_running_asynch_code
;
4588 /* Handling the process output should not deactivate the mark. */
4589 Vdeactivate_mark
= odeactivate
;
4591 /* Restore waiting_for_user_input_p as it was
4592 when we were called, in case the filter clobbered it. */
4593 waiting_for_user_input_p
= waiting
;
4595 #if 0 /* Call record_asynch_buffer_change unconditionally,
4596 because we might have changed minor modes or other things
4597 that affect key bindings. */
4598 if (! EQ (Fcurrent_buffer (), obuffer
)
4599 || ! EQ (current_buffer
->keymap
, okeymap
))
4601 /* But do it only if the caller is actually going to read events.
4602 Otherwise there's no need to make him wake up, and it could
4603 cause trouble (for example it would make Fsit_for return). */
4604 if (waiting_for_user_input_p
== -1)
4605 record_asynch_buffer_change ();
4608 start_vms_process_read (vs
);
4610 unbind_to (count
, Qnil
);
4614 /* If no filter, write into buffer if it isn't dead. */
4615 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
4617 Lisp_Object old_read_only
;
4618 int old_begv
, old_zv
;
4619 int old_begv_byte
, old_zv_byte
;
4620 Lisp_Object odeactivate
;
4621 int before
, before_byte
;
4626 odeactivate
= Vdeactivate_mark
;
4628 Fset_buffer (p
->buffer
);
4630 opoint_byte
= PT_BYTE
;
4631 old_read_only
= current_buffer
->read_only
;
4634 old_begv_byte
= BEGV_BYTE
;
4635 old_zv_byte
= ZV_BYTE
;
4637 current_buffer
->read_only
= Qnil
;
4639 /* Insert new output into buffer
4640 at the current end-of-output marker,
4641 thus preserving logical ordering of input and output. */
4642 if (XMARKER (p
->mark
)->buffer
)
4643 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
4644 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
4647 SET_PT_BOTH (ZV
, ZV_BYTE
);
4649 before_byte
= PT_BYTE
;
4651 /* If the output marker is outside of the visible region, save
4652 the restriction and widen. */
4653 if (! (BEGV
<= PT
&& PT
<= ZV
))
4656 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
4657 text
= coding
->dst_object
;
4658 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
4659 /* A new coding system might be found. See the comment in the
4660 similar code in the previous `if' block. */
4661 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
4663 p
->decode_coding_system
= Vlast_coding_system_used
;
4664 if (NILP (p
->encode_coding_system
)
4665 && proc_encode_coding_system
[XINT (p
->outfd
)])
4667 p
->encode_coding_system
= Vlast_coding_system_used
;
4668 setup_coding_system (p
->encode_coding_system
,
4669 proc_encode_coding_system
[XINT (p
->outfd
)]);
4672 if (coding
->carryover_bytes
> 0)
4674 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
4675 coding
->carryover_bytes
);
4676 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
4678 /* Adjust the multibyteness of TEXT to that of the buffer. */
4679 if (NILP (current_buffer
->enable_multibyte_characters
)
4680 != ! STRING_MULTIBYTE (text
))
4681 text
= (STRING_MULTIBYTE (text
)
4682 ? Fstring_as_unibyte (text
)
4683 : Fstring_to_multibyte (text
));
4684 /* Insert before markers in case we are inserting where
4685 the buffer's mark is, and the user's next command is Meta-y. */
4686 insert_from_string_before_markers (text
, 0, 0,
4687 SCHARS (text
), SBYTES (text
), 0);
4689 /* Make sure the process marker's position is valid when the
4690 process buffer is changed in the signal_after_change above.
4691 W3 is known to do that. */
4692 if (BUFFERP (p
->buffer
)
4693 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
4694 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
4696 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
4698 update_mode_lines
++;
4700 /* Make sure opoint and the old restrictions
4701 float ahead of any new text just as point would. */
4702 if (opoint
>= before
)
4704 opoint
+= PT
- before
;
4705 opoint_byte
+= PT_BYTE
- before_byte
;
4707 if (old_begv
> before
)
4709 old_begv
+= PT
- before
;
4710 old_begv_byte
+= PT_BYTE
- before_byte
;
4712 if (old_zv
>= before
)
4714 old_zv
+= PT
- before
;
4715 old_zv_byte
+= PT_BYTE
- before_byte
;
4718 /* If the restriction isn't what it should be, set it. */
4719 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
4720 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
4722 /* Handling the process output should not deactivate the mark. */
4723 Vdeactivate_mark
= odeactivate
;
4725 current_buffer
->read_only
= old_read_only
;
4726 SET_PT_BOTH (opoint
, opoint_byte
);
4727 set_buffer_internal (old
);
4730 start_vms_process_read (vs
);
4735 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
4737 doc
: /* Returns non-nil if emacs is waiting for input from the user.
4738 This is intended for use by asynchronous process output filters and sentinels. */)
4741 return (waiting_for_user_input_p
? Qt
: Qnil
);
4744 /* Sending data to subprocess */
4746 jmp_buf send_process_frame
;
4747 Lisp_Object process_sent_to
;
4750 send_process_trap ()
4756 longjmp (send_process_frame
, 1);
4759 /* Send some data to process PROC.
4760 BUF is the beginning of the data; LEN is the number of characters.
4761 OBJECT is the Lisp object that the data comes from. If OBJECT is
4762 nil or t, it means that the data comes from C string.
4764 If OBJECT is not nil, the data is encoded by PROC's coding-system
4765 for encoding before it is sent.
4767 This function can evaluate Lisp code and can garbage collect. */
4770 send_process (proc
, buf
, len
, object
)
4771 volatile Lisp_Object proc
;
4772 unsigned char *volatile buf
;
4774 volatile Lisp_Object object
;
4776 /* Use volatile to protect variables from being clobbered by longjmp. */
4778 struct coding_system
*coding
;
4779 struct gcpro gcpro1
;
4784 struct Lisp_Process
*p
= XPROCESS (proc
);
4785 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4788 if (! NILP (XPROCESS (proc
)->raw_status_low
))
4789 update_status (XPROCESS (proc
));
4790 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
4791 error ("Process %s not running",
4792 SDATA (XPROCESS (proc
)->name
));
4793 if (XINT (XPROCESS (proc
)->outfd
) < 0)
4794 error ("Output file descriptor of %s is closed",
4795 SDATA (XPROCESS (proc
)->name
));
4797 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
4798 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
4800 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
4801 || (BUFFERP (object
)
4802 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
4805 if (!EQ (Vlast_coding_system_used
,
4806 XPROCESS (proc
)->encode_coding_system
))
4807 /* The coding system for encoding was changed to raw-text
4808 because we sent a unibyte text previously. Now we are
4809 sending a multibyte text, thus we must encode it by the
4810 original coding system specified for the current
4812 setup_coding_system (XPROCESS (proc
)->encode_coding_system
, coding
);
4816 /* For sending a unibyte text, character code conversion should
4817 not take place but EOL conversion should. So, setup raw-text
4818 or one of the subsidiary if we have not yet done it. */
4819 if (CODING_REQUIRE_ENCODING (coding
))
4821 if (CODING_REQUIRE_FLUSHING (coding
))
4823 /* But, before changing the coding, we must flush out data. */
4824 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4825 send_process (proc
, "", 0, Qt
);
4826 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
4828 coding
->src_multibyte
= 0;
4829 setup_coding_system (raw_text_coding_system
4830 (Vlast_coding_system_used
),
4834 coding
->dst_multibyte
= 0;
4836 if (CODING_REQUIRE_ENCODING (coding
))
4838 coding
->dst_object
= Qt
;
4839 if (BUFFERP (object
))
4841 int from_byte
, from
, to
;
4842 int save_pt
, save_pt_byte
;
4843 struct buffer
*cur
= current_buffer
;
4845 set_buffer_internal (XBUFFER (object
));
4846 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
4848 from_byte
= PTR_BYTE_POS (buf
);
4849 from
= BYTE_TO_CHAR (from_byte
);
4850 to
= BYTE_TO_CHAR (from_byte
+ len
);
4851 TEMP_SET_PT_BOTH (from
, from_byte
);
4852 encode_coding_object (coding
, object
, from
, from_byte
,
4853 to
, from_byte
+ len
, Qt
);
4854 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
4855 set_buffer_internal (cur
);
4857 else if (STRINGP (object
))
4859 encode_coding_string (coding
, object
, 1);
4863 coding
->dst_object
= make_unibyte_string (buf
, len
);
4864 coding
->produced
= len
;
4867 len
= coding
->produced
;
4868 buf
= SDATA (coding
->dst_object
);
4872 vs
= get_vms_process_pointer (p
->pid
);
4874 error ("Could not find this process: %x", p
->pid
);
4875 else if (write_to_vms_process (vs
, buf
, len
))
4879 if (pty_max_bytes
== 0)
4881 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
4882 pty_max_bytes
= fpathconf (XFASTINT (XPROCESS (proc
)->outfd
),
4884 if (pty_max_bytes
< 0)
4885 pty_max_bytes
= 250;
4887 pty_max_bytes
= 250;
4889 /* Deduct one, to leave space for the eof. */
4893 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
4894 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
4895 when returning with longjmp despite being declared volatile. */
4896 if (!setjmp (send_process_frame
))
4898 process_sent_to
= proc
;
4902 SIGTYPE (*old_sigpipe
)();
4904 /* Decide how much data we can send in one batch.
4905 Long lines need to be split into multiple batches. */
4906 if (!NILP (XPROCESS (proc
)->pty_flag
))
4908 /* Starting this at zero is always correct when not the first
4909 iteration because the previous iteration ended by sending C-d.
4910 It may not be correct for the first iteration
4911 if a partial line was sent in a separate send_process call.
4912 If that proves worth handling, we need to save linepos
4913 in the process object. */
4915 unsigned char *ptr
= (unsigned char *) buf
;
4916 unsigned char *end
= (unsigned char *) buf
+ len
;
4918 /* Scan through this text for a line that is too long. */
4919 while (ptr
!= end
&& linepos
< pty_max_bytes
)
4927 /* If we found one, break the line there
4928 and put in a C-d to force the buffer through. */
4932 /* Send this batch, using one or more write calls. */
4935 int outfd
= XINT (XPROCESS (proc
)->outfd
);
4936 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
4937 #ifdef DATAGRAM_SOCKETS
4938 if (DATAGRAM_CHAN_P (outfd
))
4940 rv
= sendto (outfd
, (char *) buf
, this,
4941 0, datagram_address
[outfd
].sa
,
4942 datagram_address
[outfd
].len
);
4943 if (rv
< 0 && errno
== EMSGSIZE
)
4944 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
4948 rv
= emacs_write (outfd
, (char *) buf
, this);
4949 signal (SIGPIPE
, old_sigpipe
);
4955 || errno
== EWOULDBLOCK
4961 /* Buffer is full. Wait, accepting input;
4962 that may allow the program
4963 to finish doing output and read more. */
4968 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
4969 /* A gross hack to work around a bug in FreeBSD.
4970 In the following sequence, read(2) returns
4974 write(2) 954 bytes, get EAGAIN
4975 read(2) 1024 bytes in process_read_output
4976 read(2) 11 bytes in process_read_output
4978 That is, read(2) returns more bytes than have
4979 ever been written successfully. The 1033 bytes
4980 read are the 1022 bytes written successfully
4981 after processing (for example with CRs added if
4982 the terminal is set up that way which it is
4983 here). The same bytes will be seen again in a
4984 later read(2), without the CRs. */
4986 if (errno
== EAGAIN
)
4989 ioctl (XINT (XPROCESS (proc
)->outfd
), TIOCFLUSH
,
4992 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
4994 /* Running filters might relocate buffers or strings.
4995 Arrange to relocate BUF. */
4996 if (BUFFERP (object
))
4997 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
4998 else if (STRINGP (object
))
4999 offset
= buf
- SDATA (object
);
5001 XSETFASTINT (zero
, 0);
5002 #ifdef EMACS_HAS_USECS
5003 wait_reading_process_input (0, 20000, zero
, 0);
5005 wait_reading_process_input (1, 0, zero
, 0);
5008 if (BUFFERP (object
))
5009 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5010 else if (STRINGP (object
))
5011 buf
= offset
+ SDATA (object
);
5016 /* This is a real error. */
5017 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5024 /* If we sent just part of the string, put in an EOF
5025 to force it through, before we send the rest. */
5027 Fprocess_send_eof (proc
);
5030 #endif /* not VMS */
5034 proc
= process_sent_to
;
5036 XPROCESS (proc
)->raw_status_low
= Qnil
;
5037 XPROCESS (proc
)->raw_status_high
= Qnil
;
5038 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5039 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
5040 deactivate_process (proc
);
5042 error ("Error writing to process %s; closed it",
5043 SDATA (XPROCESS (proc
)->name
));
5045 error ("SIGPIPE raised on process %s; closed it",
5046 SDATA (XPROCESS (proc
)->name
));
5053 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5055 doc
: /* Send current contents of region as input to PROCESS.
5056 PROCESS may be a process, a buffer, the name of a process or buffer, or
5057 nil, indicating the current buffer's process.
5058 Called from program, takes three arguments, PROCESS, START and END.
5059 If the region is more than 500 characters long,
5060 it is sent in several bunches. This may happen even for shorter regions.
5061 Output from processes can arrive in between bunches. */)
5062 (process
, start
, end
)
5063 Lisp_Object process
, start
, end
;
5068 proc
= get_process (process
);
5069 validate_region (&start
, &end
);
5071 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5072 move_gap (XINT (start
));
5074 start1
= CHAR_TO_BYTE (XINT (start
));
5075 end1
= CHAR_TO_BYTE (XINT (end
));
5076 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5077 Fcurrent_buffer ());
5082 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5084 doc
: /* Send PROCESS the contents of STRING as input.
5085 PROCESS may be a process, a buffer, the name of a process or buffer, or
5086 nil, indicating the current buffer's process.
5087 If STRING is more than 500 characters long,
5088 it is sent in several bunches. This may happen even for shorter strings.
5089 Output from processes can arrive in between bunches. */)
5091 Lisp_Object process
, string
;
5094 CHECK_STRING (string
);
5095 proc
= get_process (process
);
5096 send_process (proc
, SDATA (string
),
5097 SBYTES (string
), string
);
5101 /* Return the foreground process group for the tty/pty that
5102 the process P uses. */
5104 emacs_get_tty_pgrp (p
)
5105 struct Lisp_Process
*p
;
5110 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5113 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5114 master side. Try the slave side. */
5115 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5119 ioctl (fd
, TIOCGPGRP
, &gid
);
5123 #endif /* defined (TIOCGPGRP ) */
5128 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5129 Sprocess_running_child_p
, 0, 1, 0,
5130 doc
: /* Return t if PROCESS has given the terminal to a child.
5131 If the operating system does not make it possible to find out,
5132 return t unconditionally. */)
5134 Lisp_Object process
;
5136 /* Initialize in case ioctl doesn't exist or gives an error,
5137 in a way that will cause returning t. */
5140 struct Lisp_Process
*p
;
5142 proc
= get_process (process
);
5143 p
= XPROCESS (proc
);
5145 if (!EQ (p
->childp
, Qt
))
5146 error ("Process %s is not a subprocess",
5148 if (XINT (p
->infd
) < 0)
5149 error ("Process %s is not active",
5152 gid
= emacs_get_tty_pgrp (p
);
5154 if (gid
== XFASTINT (p
->pid
))
5159 /* send a signal number SIGNO to PROCESS.
5160 If CURRENT_GROUP is t, that means send to the process group
5161 that currently owns the terminal being used to communicate with PROCESS.
5162 This is used for various commands in shell mode.
5163 If CURRENT_GROUP is lambda, that means send to the process group
5164 that currently owns the terminal, but only if it is NOT the shell itself.
5166 If NOMSG is zero, insert signal-announcements into process's buffers
5169 If we can, we try to signal PROCESS by sending control characters
5170 down the pty. This allows us to signal inferiors who have changed
5171 their uid, for which killpg would return an EPERM error. */
5174 process_send_signal (process
, signo
, current_group
, nomsg
)
5175 Lisp_Object process
;
5177 Lisp_Object current_group
;
5181 register struct Lisp_Process
*p
;
5185 proc
= get_process (process
);
5186 p
= XPROCESS (proc
);
5188 if (!EQ (p
->childp
, Qt
))
5189 error ("Process %s is not a subprocess",
5191 if (XINT (p
->infd
) < 0)
5192 error ("Process %s is not active",
5195 if (NILP (p
->pty_flag
))
5196 current_group
= Qnil
;
5198 /* If we are using pgrps, get a pgrp number and make it negative. */
5199 if (NILP (current_group
))
5200 /* Send the signal to the shell's process group. */
5201 gid
= XFASTINT (p
->pid
);
5204 #ifdef SIGNALS_VIA_CHARACTERS
5205 /* If possible, send signals to the entire pgrp
5206 by sending an input character to it. */
5208 /* TERMIOS is the latest and bestest, and seems most likely to
5209 work. If the system has it, use it. */
5216 tcgetattr (XINT (p
->infd
), &t
);
5217 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5221 tcgetattr (XINT (p
->infd
), &t
);
5222 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5226 tcgetattr (XINT (p
->infd
), &t
);
5227 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5228 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5230 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
5235 #else /* ! HAVE_TERMIOS */
5237 /* On Berkeley descendants, the following IOCTL's retrieve the
5238 current control characters. */
5239 #if defined (TIOCGLTC) && defined (TIOCGETC)
5247 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5248 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5251 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5252 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5256 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5257 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5259 #endif /* ! defined (SIGTSTP) */
5262 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5264 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5271 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5272 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5275 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5276 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5280 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5281 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5283 #endif /* ! defined (SIGTSTP) */
5285 #else /* ! defined (TCGETA) */
5286 Your configuration files are messed up
.
5287 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5288 you'd better be using one of the alternatives above! */
5289 #endif /* ! defined (TCGETA) */
5290 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5291 #endif /* ! defined HAVE_TERMIOS */
5293 /* The code above always returns from the function. */
5294 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5297 /* Get the current pgrp using the tty itself, if we have that.
5298 Otherwise, use the pty to get the pgrp.
5299 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5300 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5301 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5302 His patch indicates that if TIOCGPGRP returns an error, then
5303 we should just assume that p->pid is also the process group id. */
5305 gid
= emacs_get_tty_pgrp (p
);
5308 /* If we can't get the information, assume
5309 the shell owns the tty. */
5310 gid
= XFASTINT (p
->pid
);
5312 /* It is not clear whether anything really can set GID to -1.
5313 Perhaps on some system one of those ioctls can or could do so.
5314 Or perhaps this is vestigial. */
5317 #else /* ! defined (TIOCGPGRP ) */
5318 /* Can't select pgrps on this system, so we know that
5319 the child itself heads the pgrp. */
5320 gid
= XFASTINT (p
->pid
);
5321 #endif /* ! defined (TIOCGPGRP ) */
5323 /* If current_group is lambda, and the shell owns the terminal,
5324 don't send any signal. */
5325 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5333 p
->raw_status_low
= Qnil
;
5334 p
->raw_status_high
= Qnil
;
5336 XSETINT (p
->tick
, ++process_tick
);
5340 #endif /* ! defined (SIGCONT) */
5343 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5348 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5353 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5356 flush_pending_output (XINT (p
->infd
));
5360 /* If we don't have process groups, send the signal to the immediate
5361 subprocess. That isn't really right, but it's better than any
5362 obvious alternative. */
5365 kill (XFASTINT (p
->pid
), signo
);
5369 /* gid may be a pid, or minus a pgrp's number */
5371 if (!NILP (current_group
))
5373 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5374 EMACS_KILLPG (gid
, signo
);
5378 gid
= - XFASTINT (p
->pid
);
5381 #else /* ! defined (TIOCSIGSEND) */
5382 EMACS_KILLPG (gid
, signo
);
5383 #endif /* ! defined (TIOCSIGSEND) */
5386 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5387 doc
: /* Interrupt process PROCESS.
5388 PROCESS may be a process, a buffer, or the name of a process or buffer.
5389 nil or no arg means current buffer's process.
5390 Second arg CURRENT-GROUP non-nil means send signal to
5391 the current process-group of the process's controlling terminal
5392 rather than to the process's own process group.
5393 If the process is a shell, this means interrupt current subjob
5394 rather than the shell.
5396 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5397 don't send the signal. */)
5398 (process
, current_group
)
5399 Lisp_Object process
, current_group
;
5401 process_send_signal (process
, SIGINT
, current_group
, 0);
5405 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5406 doc
: /* Kill process PROCESS. May be process or name of one.
5407 See function `interrupt-process' for more details on usage. */)
5408 (process
, current_group
)
5409 Lisp_Object process
, current_group
;
5411 process_send_signal (process
, SIGKILL
, current_group
, 0);
5415 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5416 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5417 See function `interrupt-process' for more details on usage. */)
5418 (process
, current_group
)
5419 Lisp_Object process
, current_group
;
5421 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5425 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5426 doc
: /* Stop process PROCESS. May be process or name of one.
5427 See function `interrupt-process' for more details on usage.
5428 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5429 (process
, current_group
)
5430 Lisp_Object process
, current_group
;
5433 if (PROCESSP (process
) && NETCONN_P (process
))
5435 struct Lisp_Process
*p
;
5437 p
= XPROCESS (process
);
5438 if (NILP (p
->command
)
5439 && XINT (p
->infd
) >= 0)
5441 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5442 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5449 error ("no SIGTSTP support");
5451 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5456 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5457 doc
: /* Continue process PROCESS. May be process or name of one.
5458 See function `interrupt-process' for more details on usage.
5459 If PROCESS is a network process, resume handling of incoming traffic. */)
5460 (process
, current_group
)
5461 Lisp_Object process
, current_group
;
5464 if (PROCESSP (process
) && NETCONN_P (process
))
5466 struct Lisp_Process
*p
;
5468 p
= XPROCESS (process
);
5469 if (EQ (p
->command
, Qt
)
5470 && XINT (p
->infd
) >= 0
5471 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5473 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5474 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5481 process_send_signal (process
, SIGCONT
, current_group
, 0);
5483 error ("no SIGCONT support");
5488 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5489 2, 2, "sProcess (name or number): \nnSignal code: ",
5490 doc
: /* Send PROCESS the signal with code SIGCODE.
5491 PROCESS may also be an integer specifying the process id of the
5492 process to signal; in this case, the process need not be a child of
5494 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5496 Lisp_Object process
, sigcode
;
5500 if (INTEGERP (process
))
5506 if (STRINGP (process
))
5509 if (tem
= Fget_process (process
), NILP (tem
))
5511 pid
= Fstring_to_number (process
, make_number (10));
5512 if (XINT (pid
) != 0)
5518 process
= get_process (process
);
5523 CHECK_PROCESS (process
);
5524 pid
= XPROCESS (process
)->pid
;
5525 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
5526 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
5530 #define handle_signal(NAME, VALUE) \
5531 else if (!strcmp (name, NAME)) \
5532 XSETINT (sigcode, VALUE)
5534 if (INTEGERP (sigcode
))
5538 unsigned char *name
;
5540 CHECK_SYMBOL (sigcode
);
5541 name
= SDATA (SYMBOL_NAME (sigcode
));
5546 handle_signal ("SIGHUP", SIGHUP
);
5549 handle_signal ("SIGINT", SIGINT
);
5552 handle_signal ("SIGQUIT", SIGQUIT
);
5555 handle_signal ("SIGILL", SIGILL
);
5558 handle_signal ("SIGABRT", SIGABRT
);
5561 handle_signal ("SIGEMT", SIGEMT
);
5564 handle_signal ("SIGKILL", SIGKILL
);
5567 handle_signal ("SIGFPE", SIGFPE
);
5570 handle_signal ("SIGBUS", SIGBUS
);
5573 handle_signal ("SIGSEGV", SIGSEGV
);
5576 handle_signal ("SIGSYS", SIGSYS
);
5579 handle_signal ("SIGPIPE", SIGPIPE
);
5582 handle_signal ("SIGALRM", SIGALRM
);
5585 handle_signal ("SIGTERM", SIGTERM
);
5588 handle_signal ("SIGURG", SIGURG
);
5591 handle_signal ("SIGSTOP", SIGSTOP
);
5594 handle_signal ("SIGTSTP", SIGTSTP
);
5597 handle_signal ("SIGCONT", SIGCONT
);
5600 handle_signal ("SIGCHLD", SIGCHLD
);
5603 handle_signal ("SIGTTIN", SIGTTIN
);
5606 handle_signal ("SIGTTOU", SIGTTOU
);
5609 handle_signal ("SIGIO", SIGIO
);
5612 handle_signal ("SIGXCPU", SIGXCPU
);
5615 handle_signal ("SIGXFSZ", SIGXFSZ
);
5618 handle_signal ("SIGVTALRM", SIGVTALRM
);
5621 handle_signal ("SIGPROF", SIGPROF
);
5624 handle_signal ("SIGWINCH", SIGWINCH
);
5627 handle_signal ("SIGINFO", SIGINFO
);
5630 handle_signal ("SIGUSR1", SIGUSR1
);
5633 handle_signal ("SIGUSR2", SIGUSR2
);
5636 error ("Undefined signal name %s", name
);
5639 #undef handle_signal
5641 return make_number (kill (XINT (pid
), XINT (sigcode
)));
5644 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
5645 doc
: /* Make PROCESS see end-of-file in its input.
5646 EOF comes after any text already sent to it.
5647 PROCESS may be a process, a buffer, the name of a process or buffer, or
5648 nil, indicating the current buffer's process.
5649 If PROCESS is a network connection, or is a process communicating
5650 through a pipe (as opposed to a pty), then you cannot send any more
5651 text to PROCESS after you call this function. */)
5653 Lisp_Object process
;
5656 struct coding_system
*coding
;
5658 if (DATAGRAM_CONN_P (process
))
5661 proc
= get_process (process
);
5662 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
5664 /* Make sure the process is really alive. */
5665 if (! NILP (XPROCESS (proc
)->raw_status_low
))
5666 update_status (XPROCESS (proc
));
5667 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
5668 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
5670 if (CODING_REQUIRE_FLUSHING (coding
))
5672 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5673 send_process (proc
, "", 0, Qnil
);
5677 send_process (proc
, "\032", 1, Qnil
); /* ^z */
5679 if (!NILP (XPROCESS (proc
)->pty_flag
))
5680 send_process (proc
, "\004", 1, Qnil
);
5683 int old_outfd
, new_outfd
;
5685 #ifdef HAVE_SHUTDOWN
5686 /* If this is a network connection, or socketpair is used
5687 for communication with the subprocess, call shutdown to cause EOF.
5688 (In some old system, shutdown to socketpair doesn't work.
5689 Then we just can't win.) */
5690 if (NILP (XPROCESS (proc
)->pid
)
5691 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
5692 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
5693 /* In case of socketpair, outfd == infd, so don't close it. */
5694 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
5695 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5696 #else /* not HAVE_SHUTDOWN */
5697 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5698 #endif /* not HAVE_SHUTDOWN */
5699 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
5700 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
5702 if (!proc_encode_coding_system
[new_outfd
])
5703 proc_encode_coding_system
[new_outfd
]
5704 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
5705 bcopy (proc_encode_coding_system
[old_outfd
],
5706 proc_encode_coding_system
[new_outfd
],
5707 sizeof (struct coding_system
));
5708 bzero (proc_encode_coding_system
[old_outfd
],
5709 sizeof (struct coding_system
));
5711 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
5717 /* Kill all processes associated with `buffer'.
5718 If `buffer' is nil, kill all processes */
5721 kill_buffer_processes (buffer
)
5724 Lisp_Object tail
, proc
;
5726 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5728 proc
= XCDR (XCAR (tail
));
5729 if (GC_PROCESSP (proc
)
5730 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
5732 if (NETCONN_P (proc
))
5733 Fdelete_process (proc
);
5734 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
5735 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
5740 /* On receipt of a signal that a child status has changed, loop asking
5741 about children with changed statuses until the system says there
5744 All we do is change the status; we do not run sentinels or print
5745 notifications. That is saved for the next time keyboard input is
5746 done, in order to avoid timing errors.
5748 ** WARNING: this can be called during garbage collection.
5749 Therefore, it must not be fooled by the presence of mark bits in
5752 ** USG WARNING: Although it is not obvious from the documentation
5753 in signal(2), on a USG system the SIGCLD handler MUST NOT call
5754 signal() before executing at least one wait(), otherwise the
5755 handler will be called again, resulting in an infinite loop. The
5756 relevant portion of the documentation reads "SIGCLD signals will be
5757 queued and the signal-catching function will be continually
5758 reentered until the queue is empty". Invoking signal() causes the
5759 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
5763 sigchld_handler (signo
)
5766 int old_errno
= errno
;
5768 register struct Lisp_Process
*p
;
5769 extern EMACS_TIME
*input_available_clear_time
;
5773 sigheld
|= sigbit (SIGCHLD
);
5785 #endif /* no WUNTRACED */
5786 /* Keep trying to get a status until we get a definitive result. */
5790 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
5792 while (pid
< 0 && errno
== EINTR
);
5796 /* PID == 0 means no processes found, PID == -1 means a real
5797 failure. We have done all our job, so return. */
5799 /* USG systems forget handlers when they are used;
5800 must reestablish each time */
5801 #if defined (USG) && !defined (POSIX_SIGNALS)
5802 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
5805 sigheld
&= ~sigbit (SIGCHLD
);
5813 #endif /* no WNOHANG */
5815 /* Find the process that signaled us, and record its status. */
5818 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5820 proc
= XCDR (XCAR (tail
));
5821 p
= XPROCESS (proc
);
5822 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
5827 /* Look for an asynchronous process whose pid hasn't been filled
5830 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5832 proc
= XCDR (XCAR (tail
));
5833 p
= XPROCESS (proc
);
5834 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
5839 /* Change the status of the process that was found. */
5842 union { int i
; WAITTYPE wt
; } u
;
5843 int clear_desc_flag
= 0;
5845 XSETINT (p
->tick
, ++process_tick
);
5847 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
5848 XSETINT (p
->raw_status_high
, u
.i
>> 16);
5850 /* If process has terminated, stop waiting for its output. */
5851 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
5852 && XINT (p
->infd
) >= 0)
5853 clear_desc_flag
= 1;
5855 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
5856 if (clear_desc_flag
)
5858 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5859 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5862 /* Tell wait_reading_process_input that it needs to wake up and
5864 if (input_available_clear_time
)
5865 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
5868 /* There was no asynchronous process found for that id. Check
5869 if we have a synchronous process. */
5872 synch_process_alive
= 0;
5874 /* Report the status of the synchronous process. */
5876 synch_process_retcode
= WRETCODE (w
);
5877 else if (WIFSIGNALED (w
))
5879 int code
= WTERMSIG (w
);
5882 synchronize_system_messages_locale ();
5883 signame
= strsignal (code
);
5886 signame
= "unknown";
5888 synch_process_death
= signame
;
5891 /* Tell wait_reading_process_input that it needs to wake up and
5893 if (input_available_clear_time
)
5894 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
5897 /* On some systems, we must return right away.
5898 If any more processes want to signal us, we will
5900 Otherwise (on systems that have WNOHANG), loop around
5901 to use up all the processes that have something to tell us. */
5902 #if (defined WINDOWSNT \
5903 || (defined USG && !defined GNU_LINUX \
5904 && !(defined HPUX && defined WNOHANG)))
5905 #if defined (USG) && ! defined (POSIX_SIGNALS)
5906 signal (signo
, sigchld_handler
);
5910 #endif /* USG, but not HPUX with WNOHANG */
5916 exec_sentinel_unwind (data
)
5919 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
5924 exec_sentinel_error_handler (error
)
5927 cmd_error_internal (error
, "error in process sentinel: ");
5929 update_echo_area ();
5930 Fsleep_for (make_number (2), Qnil
);
5935 exec_sentinel (proc
, reason
)
5936 Lisp_Object proc
, reason
;
5938 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
5939 register struct Lisp_Process
*p
= XPROCESS (proc
);
5940 int count
= SPECPDL_INDEX ();
5941 int outer_running_asynch_code
= running_asynch_code
;
5942 int waiting
= waiting_for_user_input_p
;
5944 /* No need to gcpro these, because all we do with them later
5945 is test them for EQness, and none of them should be a string. */
5946 odeactivate
= Vdeactivate_mark
;
5947 XSETBUFFER (obuffer
, current_buffer
);
5948 okeymap
= current_buffer
->keymap
;
5950 sentinel
= p
->sentinel
;
5951 if (NILP (sentinel
))
5954 /* Zilch the sentinel while it's running, to avoid recursive invocations;
5955 assure that it gets restored no matter how the sentinel exits. */
5957 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
5958 /* Inhibit quit so that random quits don't screw up a running filter. */
5959 specbind (Qinhibit_quit
, Qt
);
5960 specbind (Qlast_nonmenu_event
, Qt
);
5962 /* In case we get recursively called,
5963 and we already saved the match data nonrecursively,
5964 save the same match data in safely recursive fashion. */
5965 if (outer_running_asynch_code
)
5968 tem
= Fmatch_data (Qnil
, Qnil
);
5969 restore_match_data ();
5970 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
5971 Fset_match_data (tem
);
5974 /* For speed, if a search happens within this code,
5975 save the match data in a special nonrecursive fashion. */
5976 running_asynch_code
= 1;
5978 internal_condition_case_1 (read_process_output_call
,
5980 Fcons (proc
, Fcons (reason
, Qnil
))),
5981 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5982 exec_sentinel_error_handler
);
5984 /* If we saved the match data nonrecursively, restore it now. */
5985 restore_match_data ();
5986 running_asynch_code
= outer_running_asynch_code
;
5988 Vdeactivate_mark
= odeactivate
;
5990 /* Restore waiting_for_user_input_p as it was
5991 when we were called, in case the filter clobbered it. */
5992 waiting_for_user_input_p
= waiting
;
5995 if (! EQ (Fcurrent_buffer (), obuffer
)
5996 || ! EQ (current_buffer
->keymap
, okeymap
))
5998 /* But do it only if the caller is actually going to read events.
5999 Otherwise there's no need to make him wake up, and it could
6000 cause trouble (for example it would make Fsit_for return). */
6001 if (waiting_for_user_input_p
== -1)
6002 record_asynch_buffer_change ();
6004 unbind_to (count
, Qnil
);
6007 /* Report all recent events of a change in process status
6008 (either run the sentinel or output a message).
6009 This is usually done while Emacs is waiting for keyboard input
6010 but can be done at other times. */
6015 register Lisp_Object proc
, buffer
;
6016 Lisp_Object tail
, msg
;
6017 struct gcpro gcpro1
, gcpro2
;
6021 /* We need to gcpro tail; if read_process_output calls a filter
6022 which deletes a process and removes the cons to which tail points
6023 from Vprocess_alist, and then causes a GC, tail is an unprotected
6027 /* Set this now, so that if new processes are created by sentinels
6028 that we run, we get called again to handle their status changes. */
6029 update_tick
= process_tick
;
6031 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6034 register struct Lisp_Process
*p
;
6036 proc
= Fcdr (Fcar (tail
));
6037 p
= XPROCESS (proc
);
6039 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6041 XSETINT (p
->update_tick
, XINT (p
->tick
));
6043 /* If process is still active, read any output that remains. */
6044 while (! EQ (p
->filter
, Qt
)
6045 && ! EQ (p
->status
, Qconnect
)
6046 && ! EQ (p
->status
, Qlisten
)
6047 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6048 && XINT (p
->infd
) >= 0
6049 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6053 /* Get the text to use for the message. */
6054 if (!NILP (p
->raw_status_low
))
6056 msg
= status_message (p
->status
);
6058 /* If process is terminated, deactivate it or delete it. */
6060 if (CONSP (p
->status
))
6061 symbol
= XCAR (p
->status
);
6063 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6064 || EQ (symbol
, Qclosed
))
6066 if (delete_exited_processes
)
6067 remove_process (proc
);
6069 deactivate_process (proc
);
6072 /* The actions above may have further incremented p->tick.
6073 So set p->update_tick again
6074 so that an error in the sentinel will not cause
6075 this code to be run again. */
6076 XSETINT (p
->update_tick
, XINT (p
->tick
));
6077 /* Now output the message suitably. */
6078 if (!NILP (p
->sentinel
))
6079 exec_sentinel (proc
, msg
);
6080 /* Don't bother with a message in the buffer
6081 when a process becomes runnable. */
6082 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6084 Lisp_Object ro
, tem
;
6085 struct buffer
*old
= current_buffer
;
6086 int opoint
, opoint_byte
;
6087 int before
, before_byte
;
6089 ro
= XBUFFER (buffer
)->read_only
;
6091 /* Avoid error if buffer is deleted
6092 (probably that's why the process is dead, too) */
6093 if (NILP (XBUFFER (buffer
)->name
))
6095 Fset_buffer (buffer
);
6098 opoint_byte
= PT_BYTE
;
6099 /* Insert new output into buffer
6100 at the current end-of-output marker,
6101 thus preserving logical ordering of input and output. */
6102 if (XMARKER (p
->mark
)->buffer
)
6103 Fgoto_char (p
->mark
);
6105 SET_PT_BOTH (ZV
, ZV_BYTE
);
6108 before_byte
= PT_BYTE
;
6110 tem
= current_buffer
->read_only
;
6111 current_buffer
->read_only
= Qnil
;
6112 insert_string ("\nProcess ");
6113 Finsert (1, &p
->name
);
6114 insert_string (" ");
6116 current_buffer
->read_only
= tem
;
6117 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6119 if (opoint
>= before
)
6120 SET_PT_BOTH (opoint
+ (PT
- before
),
6121 opoint_byte
+ (PT_BYTE
- before_byte
));
6123 SET_PT_BOTH (opoint
, opoint_byte
);
6125 set_buffer_internal (old
);
6130 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6131 redisplay_preserve_echo_area (13);
6137 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6138 Sset_process_coding_system
, 1, 3, 0,
6139 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6140 DECODING will be used to decode subprocess output and ENCODING to
6141 encode subprocess input. */)
6142 (proc
, decoding
, encoding
)
6143 register Lisp_Object proc
, decoding
, encoding
;
6145 register struct Lisp_Process
*p
;
6147 CHECK_PROCESS (proc
);
6148 p
= XPROCESS (proc
);
6149 if (XINT (p
->infd
) < 0)
6150 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6151 if (XINT (p
->outfd
) < 0)
6152 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6153 Fcheck_coding_system (decoding
);
6154 Fcheck_coding_system (encoding
);
6156 p
->decode_coding_system
= decoding
;
6157 p
->encode_coding_system
= encoding
;
6158 setup_process_coding_systems (proc
);
6163 DEFUN ("process-coding-system",
6164 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6165 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6167 register Lisp_Object proc
;
6169 CHECK_PROCESS (proc
);
6170 return Fcons (XPROCESS (proc
)->decode_coding_system
,
6171 XPROCESS (proc
)->encode_coding_system
);
6174 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6175 Sset_process_filter_multibyte
, 2, 2, 0,
6176 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6177 If FLAG is non-nil, the filter is given multibyte strings.
6178 If FLAG is nil, the filter is given unibyte strings. In this case,
6179 all character code conversion except for end-of-line conversion is
6182 Lisp_Object proc
, flag
;
6184 register struct Lisp_Process
*p
;
6186 CHECK_PROCESS (proc
);
6187 p
= XPROCESS (proc
);
6188 p
->filter_multibyte
= flag
;
6189 setup_process_coding_systems (proc
);
6194 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6195 Sprocess_filter_multibyte_p
, 1, 1, 0,
6196 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6200 register struct Lisp_Process
*p
;
6202 CHECK_PROCESS (proc
);
6203 p
= XPROCESS (proc
);
6205 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6210 /* The first time this is called, assume keyboard input comes from DESC
6211 instead of from where we used to expect it.
6212 Subsequent calls mean assume input keyboard can come from DESC
6213 in addition to other places. */
6215 static int add_keyboard_wait_descriptor_called_flag
;
6218 add_keyboard_wait_descriptor (desc
)
6221 if (! add_keyboard_wait_descriptor_called_flag
)
6222 FD_CLR (0, &input_wait_mask
);
6223 add_keyboard_wait_descriptor_called_flag
= 1;
6224 FD_SET (desc
, &input_wait_mask
);
6225 FD_SET (desc
, &non_process_wait_mask
);
6226 if (desc
> max_keyboard_desc
)
6227 max_keyboard_desc
= desc
;
6230 /* From now on, do not expect DESC to give keyboard input. */
6233 delete_keyboard_wait_descriptor (desc
)
6237 int lim
= max_keyboard_desc
;
6239 FD_CLR (desc
, &input_wait_mask
);
6240 FD_CLR (desc
, &non_process_wait_mask
);
6242 if (desc
== max_keyboard_desc
)
6243 for (fd
= 0; fd
< lim
; fd
++)
6244 if (FD_ISSET (fd
, &input_wait_mask
)
6245 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6246 max_keyboard_desc
= fd
;
6249 /* Return nonzero if *MASK has a bit set
6250 that corresponds to one of the keyboard input descriptors. */
6253 keyboard_bit_set (mask
)
6258 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6259 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6260 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6273 if (! noninteractive
|| initialized
)
6275 signal (SIGCHLD
, sigchld_handler
);
6278 FD_ZERO (&input_wait_mask
);
6279 FD_ZERO (&non_keyboard_wait_mask
);
6280 FD_ZERO (&non_process_wait_mask
);
6281 max_process_desc
= 0;
6283 FD_SET (0, &input_wait_mask
);
6285 Vprocess_alist
= Qnil
;
6286 for (i
= 0; i
< MAXDESC
; i
++)
6288 chan_process
[i
] = Qnil
;
6289 proc_buffered_char
[i
] = -1;
6291 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6292 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6293 #ifdef DATAGRAM_SOCKETS
6294 bzero (datagram_address
, sizeof datagram_address
);
6299 Lisp_Object subfeatures
= Qnil
;
6300 #define ADD_SUBFEATURE(key, val) \
6301 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6303 #ifdef NON_BLOCKING_CONNECT
6304 ADD_SUBFEATURE (QCnowait
, Qt
);
6306 #ifdef DATAGRAM_SOCKETS
6307 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6309 #ifdef HAVE_LOCAL_SOCKETS
6310 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6312 #ifdef HAVE_GETSOCKNAME
6313 ADD_SUBFEATURE (QCservice
, Qt
);
6315 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6316 ADD_SUBFEATURE (QCserver
, Qt
);
6318 #ifdef SO_BINDTODEVICE
6319 ADD_SUBFEATURE (QCoptions
, intern ("bindtodevice"));
6322 ADD_SUBFEATURE (QCoptions
, intern ("broadcast"));
6325 ADD_SUBFEATURE (QCoptions
, intern ("dontroute"));
6328 ADD_SUBFEATURE (QCoptions
, intern ("keepalive"));
6331 ADD_SUBFEATURE (QCoptions
, intern ("linger"));
6334 ADD_SUBFEATURE (QCoptions
, intern ("oobinline"));
6337 ADD_SUBFEATURE (QCoptions
, intern ("priority"));
6340 ADD_SUBFEATURE (QCoptions
, intern ("reuseaddr"));
6342 Fprovide (intern ("make-network-process"), subfeatures
);
6344 #endif /* HAVE_SOCKETS */
6350 Qprocessp
= intern ("processp");
6351 staticpro (&Qprocessp
);
6352 Qrun
= intern ("run");
6354 Qstop
= intern ("stop");
6356 Qsignal
= intern ("signal");
6357 staticpro (&Qsignal
);
6359 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6362 Qexit = intern ("exit");
6363 staticpro (&Qexit); */
6365 Qopen
= intern ("open");
6367 Qclosed
= intern ("closed");
6368 staticpro (&Qclosed
);
6369 Qconnect
= intern ("connect");
6370 staticpro (&Qconnect
);
6371 Qfailed
= intern ("failed");
6372 staticpro (&Qfailed
);
6373 Qlisten
= intern ("listen");
6374 staticpro (&Qlisten
);
6375 Qlocal
= intern ("local");
6376 staticpro (&Qlocal
);
6377 Qdatagram
= intern ("datagram");
6378 staticpro (&Qdatagram
);
6380 QCname
= intern (":name");
6381 staticpro (&QCname
);
6382 QCbuffer
= intern (":buffer");
6383 staticpro (&QCbuffer
);
6384 QChost
= intern (":host");
6385 staticpro (&QChost
);
6386 QCservice
= intern (":service");
6387 staticpro (&QCservice
);
6388 QCtype
= intern (":type");
6389 staticpro (&QCtype
);
6390 QClocal
= intern (":local");
6391 staticpro (&QClocal
);
6392 QCremote
= intern (":remote");
6393 staticpro (&QCremote
);
6394 QCcoding
= intern (":coding");
6395 staticpro (&QCcoding
);
6396 QCserver
= intern (":server");
6397 staticpro (&QCserver
);
6398 QCnowait
= intern (":nowait");
6399 staticpro (&QCnowait
);
6400 QCsentinel
= intern (":sentinel");
6401 staticpro (&QCsentinel
);
6402 QClog
= intern (":log");
6404 QCnoquery
= intern (":noquery");
6405 staticpro (&QCnoquery
);
6406 QCstop
= intern (":stop");
6407 staticpro (&QCstop
);
6408 QCoptions
= intern (":options");
6409 staticpro (&QCoptions
);
6410 QCplist
= intern (":plist");
6411 staticpro (&QCplist
);
6412 QCfilter_multibyte
= intern (":filter-multibyte");
6413 staticpro (&QCfilter_multibyte
);
6415 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6416 staticpro (&Qlast_nonmenu_event
);
6418 staticpro (&Vprocess_alist
);
6420 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6421 doc
: /* *Non-nil means delete processes immediately when they exit.
6422 nil means don't delete them until `list-processes' is run. */);
6424 delete_exited_processes
= 1;
6426 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6427 doc
: /* Control type of device used to communicate with subprocesses.
6428 Values are nil to use a pipe, or t or `pty' to use a pty.
6429 The value has no effect if the system has no ptys or if all ptys are busy:
6430 then a pipe is used in any case.
6431 The value takes effect when `start-process' is called. */);
6432 Vprocess_connection_type
= Qt
;
6434 defsubr (&Sprocessp
);
6435 defsubr (&Sget_process
);
6436 defsubr (&Sget_buffer_process
);
6437 defsubr (&Sdelete_process
);
6438 defsubr (&Sprocess_status
);
6439 defsubr (&Sprocess_exit_status
);
6440 defsubr (&Sprocess_id
);
6441 defsubr (&Sprocess_name
);
6442 defsubr (&Sprocess_tty_name
);
6443 defsubr (&Sprocess_command
);
6444 defsubr (&Sset_process_buffer
);
6445 defsubr (&Sprocess_buffer
);
6446 defsubr (&Sprocess_mark
);
6447 defsubr (&Sset_process_filter
);
6448 defsubr (&Sprocess_filter
);
6449 defsubr (&Sset_process_sentinel
);
6450 defsubr (&Sprocess_sentinel
);
6451 defsubr (&Sset_process_window_size
);
6452 defsubr (&Sset_process_inherit_coding_system_flag
);
6453 defsubr (&Sprocess_inherit_coding_system_flag
);
6454 defsubr (&Sset_process_query_on_exit_flag
);
6455 defsubr (&Sprocess_query_on_exit_flag
);
6456 defsubr (&Sprocess_contact
);
6457 defsubr (&Sprocess_plist
);
6458 defsubr (&Sset_process_plist
);
6459 defsubr (&Slist_processes
);
6460 defsubr (&Sprocess_list
);
6461 defsubr (&Sstart_process
);
6463 defsubr (&Sset_network_process_options
);
6464 defsubr (&Smake_network_process
);
6465 defsubr (&Sformat_network_address
);
6466 #endif /* HAVE_SOCKETS */
6467 #ifdef DATAGRAM_SOCKETS
6468 defsubr (&Sprocess_datagram_address
);
6469 defsubr (&Sset_process_datagram_address
);
6471 defsubr (&Saccept_process_output
);
6472 defsubr (&Sprocess_send_region
);
6473 defsubr (&Sprocess_send_string
);
6474 defsubr (&Sinterrupt_process
);
6475 defsubr (&Skill_process
);
6476 defsubr (&Squit_process
);
6477 defsubr (&Sstop_process
);
6478 defsubr (&Scontinue_process
);
6479 defsubr (&Sprocess_running_child_p
);
6480 defsubr (&Sprocess_send_eof
);
6481 defsubr (&Ssignal_process
);
6482 defsubr (&Swaiting_for_user_input_p
);
6483 /* defsubr (&Sprocess_connection); */
6484 defsubr (&Sset_process_coding_system
);
6485 defsubr (&Sprocess_coding_system
);
6486 defsubr (&Sset_process_filter_multibyte
);
6487 defsubr (&Sprocess_filter_multibyte_p
);
6491 #else /* not subprocesses */
6493 #include <sys/types.h>
6497 #include "systime.h"
6498 #include "character.h"
6500 #include "termopts.h"
6501 #include "sysselect.h"
6503 extern int frame_garbaged
;
6505 extern EMACS_TIME
timer_check ();
6506 extern int timers_run
;
6510 /* As described above, except assuming that there are no subprocesses:
6512 Wait for timeout to elapse and/or keyboard input to be available.
6515 timeout in seconds, or
6516 zero for no limit, or
6517 -1 means gobble data immediately available but don't wait for any.
6519 read_kbd is a Lisp_Object:
6520 0 to ignore keyboard input, or
6521 1 to return when input is available, or
6522 -1 means caller will actually read the input, so don't throw to
6524 a cons cell, meaning wait until its car is non-nil
6525 (and gobble terminal input into the buffer if any arrives), or
6526 We know that read_kbd will never be a Lisp_Process, since
6527 `subprocesses' isn't defined.
6529 do_display != 0 means redisplay should be done to show subprocess
6530 output that arrives.
6532 Return true iff we received input from any process. */
6535 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
6536 int time_limit
, microsecs
;
6537 Lisp_Object read_kbd
;
6541 EMACS_TIME end_time
, timeout
;
6542 SELECT_TYPE waitchannels
;
6544 /* Either nil or a cons cell, the car of which is of interest and
6545 may be changed outside of this routine. */
6546 Lisp_Object wait_for_cell
;
6548 wait_for_cell
= Qnil
;
6550 /* If waiting for non-nil in a cell, record where. */
6551 if (CONSP (read_kbd
))
6553 wait_for_cell
= read_kbd
;
6554 XSETFASTINT (read_kbd
, 0);
6557 /* What does time_limit really mean? */
6558 if (time_limit
|| microsecs
)
6560 EMACS_GET_TIME (end_time
);
6561 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6562 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6565 /* Turn off periodic alarms (in case they are in use)
6566 and then turn off any other atimers,
6567 because the select emulator uses alarms. */
6569 turn_on_atimers (0);
6573 int timeout_reduced_for_timers
= 0;
6575 /* If calling from keyboard input, do not quit
6576 since we want to return C-g as an input character.
6577 Otherwise, do pending quit if requested. */
6578 if (XINT (read_kbd
) >= 0)
6581 /* Exit now if the cell we're waiting for became non-nil. */
6582 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6585 /* Compute time from now till when time limit is up */
6586 /* Exit if already run out */
6587 if (time_limit
== -1)
6589 /* -1 specified for timeout means
6590 gobble output available now
6591 but don't wait at all. */
6593 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6595 else if (time_limit
|| microsecs
)
6597 EMACS_GET_TIME (timeout
);
6598 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6599 if (EMACS_TIME_NEG_P (timeout
))
6604 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6607 /* If our caller will not immediately handle keyboard events,
6608 run timer events directly.
6609 (Callers that will immediately read keyboard events
6610 call timer_delay on their own.) */
6611 if (NILP (wait_for_cell
))
6613 EMACS_TIME timer_delay
;
6617 int old_timers_run
= timers_run
;
6618 timer_delay
= timer_check (1);
6619 if (timers_run
!= old_timers_run
&& do_display
)
6620 /* We must retry, since a timer may have requeued itself
6621 and that could alter the time delay. */
6622 redisplay_preserve_echo_area (14);
6626 while (!detect_input_pending ());
6628 /* If there is unread keyboard input, also return. */
6629 if (XINT (read_kbd
) != 0
6630 && requeued_events_pending_p ())
6633 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6635 EMACS_TIME difference
;
6636 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6637 if (EMACS_TIME_NEG_P (difference
))
6639 timeout
= timer_delay
;
6640 timeout_reduced_for_timers
= 1;
6645 /* Cause C-g and alarm signals to take immediate action,
6646 and cause input available signals to zero out timeout. */
6647 if (XINT (read_kbd
) < 0)
6648 set_waiting_for_input (&timeout
);
6650 /* Wait till there is something to do. */
6652 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
6653 FD_ZERO (&waitchannels
);
6655 FD_SET (0, &waitchannels
);
6657 /* If a frame has been newly mapped and needs updating,
6658 reprocess its display stuff. */
6659 if (frame_garbaged
&& do_display
)
6661 clear_waiting_for_input ();
6662 redisplay_preserve_echo_area (15);
6663 if (XINT (read_kbd
) < 0)
6664 set_waiting_for_input (&timeout
);
6667 if (XINT (read_kbd
) && detect_input_pending ())
6670 FD_ZERO (&waitchannels
);
6673 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
6678 /* Make C-g and alarm signals set flags again */
6679 clear_waiting_for_input ();
6681 /* If we woke up due to SIGWINCH, actually change size now. */
6682 do_pending_window_change (0);
6684 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
6685 /* We waited the full specified time, so return now. */
6690 /* If the system call was interrupted, then go around the
6692 if (xerrno
== EINTR
)
6693 FD_ZERO (&waitchannels
);
6695 error ("select error: %s", emacs_strerror (xerrno
));
6698 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
6699 /* System sometimes fails to deliver SIGIO. */
6700 kill (getpid (), SIGIO
);
6703 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
6704 kill (getpid (), SIGIO
);
6707 /* Check for keyboard input */
6709 if ((XINT (read_kbd
) != 0)
6710 && detect_input_pending_run_timers (do_display
))
6712 swallow_events (do_display
);
6713 if (detect_input_pending_run_timers (do_display
))
6717 /* If there is unread keyboard input, also return. */
6718 if (XINT (read_kbd
) != 0
6719 && requeued_events_pending_p ())
6722 /* If wait_for_cell. check for keyboard input
6723 but don't run any timers.
6724 ??? (It seems wrong to me to check for keyboard
6725 input at all when wait_for_cell, but the code
6726 has been this way since July 1994.
6727 Try changing this after version 19.31.) */
6728 if (! NILP (wait_for_cell
)
6729 && detect_input_pending ())
6731 swallow_events (do_display
);
6732 if (detect_input_pending ())
6736 /* Exit now if the cell we're waiting for became non-nil. */
6737 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6747 /* Don't confuse make-docfile by having two doc strings for this function.
6748 make-docfile does not pay attention to #if, for good reason! */
6749 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
6752 register Lisp_Object name
;
6757 /* Don't confuse make-docfile by having two doc strings for this function.
6758 make-docfile does not pay attention to #if, for good reason! */
6759 DEFUN ("process-inherit-coding-system-flag",
6760 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
6764 register Lisp_Object process
;
6766 /* Ignore the argument and return the value of
6767 inherit-process-coding-system. */
6768 return inherit_process_coding_system
? Qt
: Qnil
;
6771 /* Kill all processes associated with `buffer'.
6772 If `buffer' is nil, kill all processes.
6773 Since we have no subprocesses, this does nothing. */
6776 kill_buffer_processes (buffer
)
6789 QCtype
= intern (":type");
6790 staticpro (&QCtype
);
6792 defsubr (&Sget_buffer_process
);
6793 defsubr (&Sprocess_inherit_coding_system_flag
);
6797 #endif /* not subprocesses */