1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1996, 1998, 1999, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
27 /* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
40 #include <sys/types.h> /* some typedefs are used in sys/file.h */
43 #ifdef HAVE_INTTYPES_H
50 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
53 #endif /* not WINDOWSNT */
55 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
56 #include <sys/socket.h>
58 #include <netinet/in.h>
59 #include <arpa/inet.h>
60 #ifdef NEED_NET_ERRNO_H
61 #include <net/errno.h>
62 #endif /* NEED_NET_ERRNO_H */
64 /* Are local (unix) sockets supported? */
65 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
66 #if !defined (AF_LOCAL) && defined (AF_UNIX)
67 #define AF_LOCAL AF_UNIX
70 #define HAVE_LOCAL_SOCKETS
74 #endif /* HAVE_SOCKETS */
76 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
81 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
82 #ifdef HAVE_BROKEN_INET_ADDR
83 #define IN_ADDR struct in_addr
84 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
86 #define IN_ADDR unsigned long
87 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
90 #if defined(BSD_SYSTEM) || defined(STRIDE)
91 #include <sys/ioctl.h>
92 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
94 #endif /* HAVE_PTYS and no O_NDELAY */
95 #endif /* BSD_SYSTEM || STRIDE */
97 #ifdef BROKEN_O_NONBLOCK
99 #endif /* BROKEN_O_NONBLOCK */
105 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
107 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
108 /* sys/ioctl.h may have been included already */
110 #include <sys/ioctl.h>
117 #include <sys/sysmacros.h> /* for "minor" */
118 #endif /* not IRIS */
121 #include <sys/wait.h>
124 /* Disable IPv6 support for w32 until someone figures out how to do it
138 #include "character.h"
141 #include "termhooks.h"
142 #include "termopts.h"
143 #include "commands.h"
144 #include "keyboard.h"
146 #include "blockinput.h"
147 #include "dispextern.h"
148 #include "composite.h"
151 Lisp_Object Qprocessp
;
152 Lisp_Object Qrun
, Qstop
, Qsignal
;
153 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
154 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
158 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
159 Lisp_Object QClocal
, QCremote
, QCcoding
;
160 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
161 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
162 Lisp_Object QCfilter_multibyte
;
163 Lisp_Object Qlast_nonmenu_event
;
164 /* QCfamily is declared and initialized in xfaces.c,
165 QCfilter in keyboard.c. */
166 extern Lisp_Object QCfamily
, QCfilter
;
168 /* Qexit is declared and initialized in eval.c. */
170 /* QCfamily is defined in xfaces.c. */
171 extern Lisp_Object QCfamily
;
172 /* QCfilter is defined in keyboard.c. */
173 extern Lisp_Object QCfilter
;
175 /* a process object is a network connection when its childp field is neither
176 Qt nor Qnil but is instead a property list (KEY VAL ...). */
179 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
180 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
182 #define NETCONN_P(p) 0
183 #define NETCONN1_P(p) 0
184 #endif /* HAVE_SOCKETS */
186 /* Define first descriptor number available for subprocesses. */
188 #define FIRST_PROC_DESC 1
190 #define FIRST_PROC_DESC 3
193 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
196 #if !defined (SIGCHLD) && defined (SIGCLD)
197 #define SIGCHLD SIGCLD
200 #include "syssignal.h"
204 extern char *get_operating_system_release ();
210 extern char *sys_errlist
[];
217 /* t means use pty, nil means use a pipe,
218 maybe other values to come. */
219 static Lisp_Object Vprocess_connection_type
;
223 #include <sys/socket.h>
227 /* These next two vars are non-static since sysdep.c uses them in the
228 emulation of `select'. */
229 /* Number of events of change of status of a process. */
231 /* Number of events for which the user or sentinel has been notified. */
234 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
236 #ifdef BROKEN_NON_BLOCKING_CONNECT
237 #undef NON_BLOCKING_CONNECT
239 #ifndef NON_BLOCKING_CONNECT
242 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
243 #if defined (O_NONBLOCK) || defined (O_NDELAY)
244 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
245 #define NON_BLOCKING_CONNECT
246 #endif /* EWOULDBLOCK || EINPROGRESS */
247 #endif /* O_NONBLOCK || O_NDELAY */
248 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
249 #endif /* HAVE_SELECT */
250 #endif /* HAVE_SOCKETS */
251 #endif /* NON_BLOCKING_CONNECT */
252 #endif /* BROKEN_NON_BLOCKING_CONNECT */
254 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
255 this system. We need to read full packets, so we need a
256 "non-destructive" select. So we require either native select,
257 or emulation of select using FIONREAD. */
259 #ifdef BROKEN_DATAGRAM_SOCKETS
260 #undef DATAGRAM_SOCKETS
262 #ifndef DATAGRAM_SOCKETS
264 #if defined (HAVE_SELECT) || defined (FIONREAD)
265 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
266 #define DATAGRAM_SOCKETS
267 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
268 #endif /* HAVE_SELECT || FIONREAD */
269 #endif /* HAVE_SOCKETS */
270 #endif /* DATAGRAM_SOCKETS */
271 #endif /* BROKEN_DATAGRAM_SOCKETS */
274 #undef NON_BLOCKING_CONNECT
275 #undef DATAGRAM_SOCKETS
278 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
279 #ifdef EMACS_HAS_USECS
280 #define ADAPTIVE_READ_BUFFERING
284 #ifdef ADAPTIVE_READ_BUFFERING
285 #define READ_OUTPUT_DELAY_INCREMENT 10000
286 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
287 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
289 /* Number of processes which have a non-zero read_output_delay,
290 and therefore might be delayed for adaptive read buffering. */
292 static int process_output_delay_count
;
294 /* Non-zero if any process has non-nil read_output_skip. */
296 static int process_output_skip
;
298 /* Non-nil means to delay reading process output to improve buffering.
299 A value of t means that delay is reset after each send, any other
300 non-nil value does not reset the delay. A value of nil disables
301 adaptive read buffering completely. */
302 static Lisp_Object Vprocess_adaptive_read_buffering
;
304 #define process_output_delay_count 0
308 #include "sysselect.h"
310 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
311 static void deactivate_process
P_ ((Lisp_Object
));
312 static void status_notify
P_ ((struct Lisp_Process
*));
313 static int read_process_output
P_ ((Lisp_Object
, int));
315 /* If we support a window system, turn on the code to poll periodically
316 to detect C-g. It isn't actually used when doing interrupt input. */
317 #ifdef HAVE_WINDOW_SYSTEM
318 #define POLL_FOR_INPUT
321 /* Mask of bits indicating the descriptors that we wait for input on. */
323 static SELECT_TYPE input_wait_mask
;
325 /* Mask that excludes keyboard input descriptor (s). */
327 static SELECT_TYPE non_keyboard_wait_mask
;
329 /* Mask that excludes process input descriptor (s). */
331 static SELECT_TYPE non_process_wait_mask
;
333 #ifdef NON_BLOCKING_CONNECT
334 /* Mask of bits indicating the descriptors that we wait for connect to
335 complete on. Once they complete, they are removed from this mask
336 and added to the input_wait_mask and non_keyboard_wait_mask. */
338 static SELECT_TYPE connect_wait_mask
;
340 /* Number of bits set in connect_wait_mask. */
341 static int num_pending_connects
;
343 #define IF_NON_BLOCKING_CONNECT(s) s
345 #define IF_NON_BLOCKING_CONNECT(s)
348 /* The largest descriptor currently in use for a process object. */
349 static int max_process_desc
;
351 /* The largest descriptor currently in use for keyboard input. */
352 static int max_keyboard_desc
;
354 /* Nonzero means delete a process right away if it exits. */
355 static int delete_exited_processes
;
357 /* Indexed by descriptor, gives the process (if any) for that descriptor */
358 Lisp_Object chan_process
[MAXDESC
];
360 /* Alist of elements (NAME . PROCESS) */
361 Lisp_Object Vprocess_alist
;
363 /* Buffered-ahead input char from process, indexed by channel.
364 -1 means empty (no char is buffered).
365 Used on sys V where the only way to tell if there is any
366 output from the process is to read at least one char.
367 Always -1 on systems that support FIONREAD. */
369 /* Don't make static; need to access externally. */
370 int proc_buffered_char
[MAXDESC
];
372 /* Table of `struct coding-system' for each process. */
373 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
374 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
376 #ifdef DATAGRAM_SOCKETS
377 /* Table of `partner address' for datagram sockets. */
378 struct sockaddr_and_len
{
381 } datagram_address
[MAXDESC
];
382 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
383 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
385 #define DATAGRAM_CHAN_P(chan) (0)
386 #define DATAGRAM_CONN_P(proc) (0)
389 static Lisp_Object
get_process ();
390 static void exec_sentinel ();
392 extern EMACS_TIME
timer_check ();
393 extern int timers_run
;
395 /* Maximum number of bytes to send to a pty without an eof. */
396 static int pty_max_bytes
;
402 /* The file name of the pty opened by allocate_pty. */
404 static char pty_name
[24];
407 /* Compute the Lisp form of the process status, p->status, from
408 the numeric status that was returned by `wait'. */
410 static Lisp_Object
status_convert ();
414 struct Lisp_Process
*p
;
416 union { int i
; WAITTYPE wt
; } u
;
417 eassert (p
->raw_status_new
);
419 p
->status
= status_convert (u
.wt
);
420 p
->raw_status_new
= 0;
423 /* Convert a process status word in Unix format to
424 the list that we use internally. */
431 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
432 else if (WIFEXITED (w
))
433 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
434 WCOREDUMP (w
) ? Qt
: Qnil
));
435 else if (WIFSIGNALED (w
))
436 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
437 WCOREDUMP (w
) ? Qt
: Qnil
));
442 /* Given a status-list, extract the three pieces of information
443 and store them individually through the three pointers. */
446 decode_status (l
, symbol
, code
, coredump
)
464 *code
= XFASTINT (XCAR (tem
));
466 *coredump
= !NILP (tem
);
470 /* Return a string describing a process status list. */
474 struct Lisp_Process
*p
;
476 Lisp_Object status
= p
->status
;
479 Lisp_Object string
, string2
;
481 decode_status (status
, &symbol
, &code
, &coredump
);
483 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
486 synchronize_system_messages_locale ();
487 signame
= strsignal (code
);
490 string
= build_string (signame
);
491 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
492 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
493 return concat2 (string
, string2
);
495 else if (EQ (symbol
, Qexit
))
498 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
500 return build_string ("finished\n");
501 string
= Fnumber_to_string (make_number (code
));
502 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
503 return concat3 (build_string ("exited abnormally with code "),
506 else if (EQ (symbol
, Qfailed
))
508 string
= Fnumber_to_string (make_number (code
));
509 string2
= build_string ("\n");
510 return concat3 (build_string ("failed with code "),
514 return Fcopy_sequence (Fsymbol_name (symbol
));
519 /* Open an available pty, returning a file descriptor.
520 Return -1 on failure.
521 The file name of the terminal corresponding to the pty
522 is left in the variable pty_name. */
533 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
534 for (i
= 0; i
< 16; i
++)
537 struct stat stb
; /* Used in some PTY_OPEN. */
538 #ifdef PTY_NAME_SPRINTF
541 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
542 #endif /* no PTY_NAME_SPRINTF */
546 #else /* no PTY_OPEN */
549 /* Unusual IRIS code */
550 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
553 if (fstat (fd
, &stb
) < 0)
555 # else /* not IRIS */
556 { /* Some systems name their pseudoterminals so that there are gaps in
557 the usual sequence - for example, on HP9000/S700 systems, there
558 are no pseudoterminals with names ending in 'f'. So we wait for
559 three failures in a row before deciding that we've reached the
561 int failed_count
= 0;
563 if (stat (pty_name
, &stb
) < 0)
566 if (failed_count
>= 3)
573 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
575 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
577 # endif /* not IRIS */
579 #endif /* no PTY_OPEN */
583 /* check to make certain that both sides are available
584 this avoids a nasty yet stupid bug in rlogins */
585 #ifdef PTY_TTY_NAME_SPRINTF
588 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
589 #endif /* no PTY_TTY_NAME_SPRINTF */
591 if (access (pty_name
, 6) != 0)
594 # if !defined(IRIS) && !defined(__sgi)
600 #endif /* not UNIPLUS */
607 #endif /* HAVE_PTYS */
613 register Lisp_Object val
, tem
, name1
;
614 register struct Lisp_Process
*p
;
618 p
= allocate_process ();
620 XSETINT (p
->infd
, -1);
621 XSETINT (p
->outfd
, -1);
622 XSETFASTINT (p
->tick
, 0);
623 XSETFASTINT (p
->update_tick
, 0);
625 p
->raw_status_new
= 0;
627 p
->mark
= Fmake_marker ();
629 #ifdef ADAPTIVE_READ_BUFFERING
630 p
->adaptive_read_buffering
= Qnil
;
631 XSETFASTINT (p
->read_output_delay
, 0);
632 p
->read_output_skip
= Qnil
;
635 /* If name is already in use, modify it until it is unused. */
640 tem
= Fget_process (name1
);
641 if (NILP (tem
)) break;
642 sprintf (suffix
, "<%d>", i
);
643 name1
= concat2 (name
, build_string (suffix
));
647 XSETPROCESS (val
, p
);
648 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
653 remove_process (proc
)
654 register Lisp_Object proc
;
656 register Lisp_Object pair
;
658 pair
= Frassq (proc
, Vprocess_alist
);
659 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
661 deactivate_process (proc
);
664 /* Setup coding systems of PROCESS. */
667 setup_process_coding_systems (process
)
670 struct Lisp_Process
*p
= XPROCESS (process
);
671 int inch
= XINT (p
->infd
);
672 int outch
= XINT (p
->outfd
);
673 Lisp_Object coding_system
;
675 if (inch
< 0 || outch
< 0)
678 if (!proc_decode_coding_system
[inch
])
679 proc_decode_coding_system
[inch
]
680 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
681 coding_system
= p
->decode_coding_system
;
682 if (! NILP (p
->filter
))
684 if (NILP (p
->filter_multibyte
))
685 coding_system
= raw_text_coding_system (coding_system
);
687 else if (BUFFERP (p
->buffer
))
689 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
690 coding_system
= raw_text_coding_system (coding_system
);
692 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
694 if (!proc_encode_coding_system
[outch
])
695 proc_encode_coding_system
[outch
]
696 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
697 setup_coding_system (p
->encode_coding_system
,
698 proc_encode_coding_system
[outch
]);
701 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
702 doc
: /* Return t if OBJECT is a process. */)
706 return PROCESSP (object
) ? Qt
: Qnil
;
709 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
710 doc
: /* Return the process named NAME, or nil if there is none. */)
712 register Lisp_Object name
;
717 return Fcdr (Fassoc (name
, Vprocess_alist
));
720 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
721 doc
: /* Return the (or a) process associated with BUFFER.
722 BUFFER may be a buffer or the name of one. */)
724 register Lisp_Object buffer
;
726 register Lisp_Object buf
, tail
, proc
;
728 if (NILP (buffer
)) return Qnil
;
729 buf
= Fget_buffer (buffer
);
730 if (NILP (buf
)) return Qnil
;
732 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
734 proc
= Fcdr (Fcar (tail
));
735 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
741 /* This is how commands for the user decode process arguments. It
742 accepts a process, a process name, a buffer, a buffer name, or nil.
743 Buffers denote the first process in the buffer, and nil denotes the
748 register Lisp_Object name
;
750 register Lisp_Object proc
, obj
;
753 obj
= Fget_process (name
);
755 obj
= Fget_buffer (name
);
757 error ("Process %s does not exist", SDATA (name
));
759 else if (NILP (name
))
760 obj
= Fcurrent_buffer ();
764 /* Now obj should be either a buffer object or a process object.
768 proc
= Fget_buffer_process (obj
);
770 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
782 /* Fdelete_process promises to immediately forget about the process, but in
783 reality, Emacs needs to remember those processes until they have been
784 treated by sigchld_handler; otherwise this handler would consider the
785 process as being synchronous and say that the synchronous process is
787 static Lisp_Object deleted_pid_list
;
790 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
791 doc
: /* Delete PROCESS: kill it and forget about it immediately.
792 PROCESS may be a process, a buffer, the name of a process or buffer, or
793 nil, indicating the current buffer's process. */)
795 register Lisp_Object process
;
797 register struct Lisp_Process
*p
;
799 process
= get_process (process
);
800 p
= XPROCESS (process
);
802 p
->raw_status_new
= 0;
805 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
806 XSETINT (p
->tick
, ++process_tick
);
809 else if (XINT (p
->infd
) >= 0)
814 /* No problem storing the pid here, as it is still in Vprocess_alist. */
815 deleted_pid_list
= Fcons (make_fixnum_or_float (p
->pid
),
816 /* GC treated elements set to nil. */
817 Fdelq (Qnil
, deleted_pid_list
));
818 /* If the process has already signaled, remove it from the list. */
819 if (p
->raw_status_new
)
822 if (CONSP (p
->status
))
823 symbol
= XCAR (p
->status
);
824 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
825 Fdelete (make_fixnum_or_float (p
->pid
), deleted_pid_list
);
829 Fkill_process (process
, Qnil
);
830 /* Do this now, since remove_process will make sigchld_handler do nothing. */
832 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
833 XSETINT (p
->tick
, ++process_tick
);
837 remove_process (process
);
841 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
842 doc
: /* Return the status of PROCESS.
843 The returned value is one of the following symbols:
844 run -- for a process that is running.
845 stop -- for a process stopped but continuable.
846 exit -- for a process that has exited.
847 signal -- for a process that has got a fatal signal.
848 open -- for a network stream connection that is open.
849 listen -- for a network stream server that is listening.
850 closed -- for a network stream connection that is closed.
851 connect -- when waiting for a non-blocking connection to complete.
852 failed -- when a non-blocking connection has failed.
853 nil -- if arg is a process name and no such process exists.
854 PROCESS may be a process, a buffer, the name of a process, or
855 nil, indicating the current buffer's process. */)
857 register Lisp_Object process
;
859 register struct Lisp_Process
*p
;
860 register Lisp_Object status
;
862 if (STRINGP (process
))
863 process
= Fget_process (process
);
865 process
= get_process (process
);
870 p
= XPROCESS (process
);
871 if (p
->raw_status_new
)
875 status
= XCAR (status
);
878 if (EQ (status
, Qexit
))
880 else if (EQ (p
->command
, Qt
))
882 else if (EQ (status
, Qrun
))
888 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
890 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
891 If PROCESS has not yet exited or died, return 0. */)
893 register Lisp_Object process
;
895 CHECK_PROCESS (process
);
896 if (XPROCESS (process
)->raw_status_new
)
897 update_status (XPROCESS (process
));
898 if (CONSP (XPROCESS (process
)->status
))
899 return XCAR (XCDR (XPROCESS (process
)->status
));
900 return make_number (0);
903 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
904 doc
: /* Return the process id of PROCESS.
905 This is the pid of the external process which PROCESS uses or talks to.
906 For a network connection, this value is nil. */)
908 register Lisp_Object process
;
910 CHECK_PROCESS (process
);
911 return (XPROCESS (process
)->pid
912 ? make_fixnum_or_float (XPROCESS (process
)->pid
)
916 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
917 doc
: /* Return the name of PROCESS, as a string.
918 This is the name of the program invoked in PROCESS,
919 possibly modified to make it unique among process names. */)
921 register Lisp_Object process
;
923 CHECK_PROCESS (process
);
924 return XPROCESS (process
)->name
;
927 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
928 doc
: /* Return the command that was executed to start PROCESS.
929 This is a list of strings, the first string being the program executed
930 and the rest of the strings being the arguments given to it.
931 For a non-child channel, this is nil. */)
933 register Lisp_Object process
;
935 CHECK_PROCESS (process
);
936 return XPROCESS (process
)->command
;
939 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
940 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
941 This is the terminal that the process itself reads and writes on,
942 not the name of the pty that Emacs uses to talk with that terminal. */)
944 register Lisp_Object process
;
946 CHECK_PROCESS (process
);
947 return XPROCESS (process
)->tty_name
;
950 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
952 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
954 register Lisp_Object process
, buffer
;
956 struct Lisp_Process
*p
;
958 CHECK_PROCESS (process
);
960 CHECK_BUFFER (buffer
);
961 p
= XPROCESS (process
);
964 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
965 setup_process_coding_systems (process
);
969 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
971 doc
: /* Return the buffer PROCESS is associated with.
972 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
974 register Lisp_Object process
;
976 CHECK_PROCESS (process
);
977 return XPROCESS (process
)->buffer
;
980 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
982 doc
: /* Return the marker for the end of the last output from PROCESS. */)
984 register Lisp_Object process
;
986 CHECK_PROCESS (process
);
987 return XPROCESS (process
)->mark
;
990 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
992 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
993 t means stop accepting output from the process.
995 When a process has a filter, its buffer is not used for output.
996 Instead, each time it does output, the entire string of output is
997 passed to the filter.
999 The filter gets two arguments: the process and the string of output.
1000 The string argument is normally a multibyte string, except:
1001 - if the process' input coding system is no-conversion or raw-text,
1002 it is a unibyte string (the non-converted input), or else
1003 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1004 string (the result of converting the decoded input multibyte
1005 string to unibyte with `string-make-unibyte'). */)
1007 register Lisp_Object process
, filter
;
1009 struct Lisp_Process
*p
;
1011 CHECK_PROCESS (process
);
1012 p
= XPROCESS (process
);
1014 /* Don't signal an error if the process' input file descriptor
1015 is closed. This could make debugging Lisp more difficult,
1016 for example when doing something like
1018 (setq process (start-process ...))
1020 (set-process-filter process ...) */
1022 if (XINT (p
->infd
) >= 0)
1024 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1026 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
1027 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
1029 else if (EQ (p
->filter
, Qt
)
1030 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1032 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1033 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1039 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1040 setup_process_coding_systems (process
);
1044 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1046 doc
: /* Returns the filter function of PROCESS; nil if none.
1047 See `set-process-filter' for more info on filter functions. */)
1049 register Lisp_Object process
;
1051 CHECK_PROCESS (process
);
1052 return XPROCESS (process
)->filter
;
1055 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1057 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1058 The sentinel is called as a function when the process changes state.
1059 It gets two arguments: the process, and a string describing the change. */)
1061 register Lisp_Object process
, sentinel
;
1063 struct Lisp_Process
*p
;
1065 CHECK_PROCESS (process
);
1066 p
= XPROCESS (process
);
1068 p
->sentinel
= sentinel
;
1070 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1074 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1076 doc
: /* Return the sentinel of PROCESS; nil if none.
1077 See `set-process-sentinel' for more info on sentinels. */)
1079 register Lisp_Object process
;
1081 CHECK_PROCESS (process
);
1082 return XPROCESS (process
)->sentinel
;
1085 DEFUN ("set-process-window-size", Fset_process_window_size
,
1086 Sset_process_window_size
, 3, 3, 0,
1087 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1088 (process
, height
, width
)
1089 register Lisp_Object process
, height
, width
;
1091 CHECK_PROCESS (process
);
1092 CHECK_NATNUM (height
);
1093 CHECK_NATNUM (width
);
1095 if (XINT (XPROCESS (process
)->infd
) < 0
1096 || set_window_size (XINT (XPROCESS (process
)->infd
),
1097 XINT (height
), XINT (width
)) <= 0)
1103 DEFUN ("set-process-inherit-coding-system-flag",
1104 Fset_process_inherit_coding_system_flag
,
1105 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1106 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1107 If the second argument FLAG is non-nil, then the variable
1108 `buffer-file-coding-system' of the buffer associated with PROCESS
1109 will be bound to the value of the coding system used to decode
1112 This is useful when the coding system specified for the process buffer
1113 leaves either the character code conversion or the end-of-line conversion
1114 unspecified, or if the coding system used to decode the process output
1115 is more appropriate for saving the process buffer.
1117 Binding the variable `inherit-process-coding-system' to non-nil before
1118 starting the process is an alternative way of setting the inherit flag
1119 for the process which will run. */)
1121 register Lisp_Object process
, flag
;
1123 CHECK_PROCESS (process
);
1124 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1128 DEFUN ("process-inherit-coding-system-flag",
1129 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1131 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1132 If this flag is t, `buffer-file-coding-system' of the buffer
1133 associated with PROCESS will inherit the coding system used to decode
1134 the process output. */)
1136 register Lisp_Object process
;
1138 CHECK_PROCESS (process
);
1139 return XPROCESS (process
)->inherit_coding_system_flag
;
1142 DEFUN ("set-process-query-on-exit-flag",
1143 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1145 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1146 If the second argument FLAG is non-nil, Emacs will query the user before
1147 exiting if PROCESS is running. */)
1149 register Lisp_Object process
, flag
;
1151 CHECK_PROCESS (process
);
1152 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1156 DEFUN ("process-query-on-exit-flag",
1157 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1159 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1161 register Lisp_Object process
;
1163 CHECK_PROCESS (process
);
1164 return Fnull (XPROCESS (process
)->kill_without_query
);
1167 #ifdef DATAGRAM_SOCKETS
1168 Lisp_Object
Fprocess_datagram_address ();
1171 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1173 doc
: /* Return the contact info of PROCESS; t for a real child.
1174 For a net connection, the value depends on the optional KEY arg.
1175 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1176 if KEY is t, the complete contact information for the connection is
1177 returned, else the specific value for the keyword KEY is returned.
1178 See `make-network-process' for a list of keywords. */)
1180 register Lisp_Object process
, key
;
1182 Lisp_Object contact
;
1184 CHECK_PROCESS (process
);
1185 contact
= XPROCESS (process
)->childp
;
1187 #ifdef DATAGRAM_SOCKETS
1188 if (DATAGRAM_CONN_P (process
)
1189 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1190 contact
= Fplist_put (contact
, QCremote
,
1191 Fprocess_datagram_address (process
));
1194 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1197 return Fcons (Fplist_get (contact
, QChost
),
1198 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1199 return Fplist_get (contact
, key
);
1202 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1204 doc
: /* Return the plist of PROCESS. */)
1206 register Lisp_Object process
;
1208 CHECK_PROCESS (process
);
1209 return XPROCESS (process
)->plist
;
1212 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1214 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1216 register Lisp_Object process
, plist
;
1218 CHECK_PROCESS (process
);
1221 XPROCESS (process
)->plist
= plist
;
1225 #if 0 /* Turned off because we don't currently record this info
1226 in the process. Perhaps add it. */
1227 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1228 doc
: /* Return the connection type of PROCESS.
1229 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1230 a socket connection. */)
1232 Lisp_Object process
;
1234 return XPROCESS (process
)->type
;
1239 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1241 doc
: /* Convert network ADDRESS from internal format to a string.
1242 A 4 or 5 element vector represents an IPv4 address (with port number).
1243 An 8 or 9 element vector represents an IPv6 address (with port number).
1244 If optional second argument OMIT-PORT is non-nil, don't include a port
1245 number in the string, even when present in ADDRESS.
1246 Returns nil if format of ADDRESS is invalid. */)
1247 (address
, omit_port
)
1248 Lisp_Object address
, omit_port
;
1253 if (STRINGP (address
)) /* AF_LOCAL */
1256 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1258 register struct Lisp_Vector
*p
= XVECTOR (address
);
1259 Lisp_Object args
[6];
1262 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1264 args
[0] = build_string ("%d.%d.%d.%d");
1267 else if (p
->size
== 5)
1269 args
[0] = build_string ("%d.%d.%d.%d:%d");
1272 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1274 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1277 else if (p
->size
== 9)
1279 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1285 for (i
= 0; i
< nargs
; i
++)
1286 args
[i
+1] = p
->contents
[i
];
1287 return Fformat (nargs
+1, args
);
1290 if (CONSP (address
))
1292 Lisp_Object args
[2];
1293 args
[0] = build_string ("<Family %d>");
1294 args
[1] = Fcar (address
);
1295 return Fformat (2, args
);
1304 list_processes_1 (query_only
)
1305 Lisp_Object query_only
;
1307 register Lisp_Object tail
, tem
;
1308 Lisp_Object proc
, minspace
, tem1
;
1309 register struct Lisp_Process
*p
;
1311 int w_proc
, w_buffer
, w_tty
;
1312 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1314 w_proc
= 4; /* Proc */
1315 w_buffer
= 6; /* Buffer */
1316 w_tty
= 0; /* Omit if no ttys */
1318 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1322 proc
= Fcdr (Fcar (tail
));
1323 p
= XPROCESS (proc
);
1324 if (NILP (p
->childp
))
1326 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1328 if (STRINGP (p
->name
)
1329 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1331 if (!NILP (p
->buffer
))
1333 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1334 w_buffer
= 8; /* (Killed) */
1335 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1338 if (STRINGP (p
->tty_name
)
1339 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1343 XSETFASTINT (i_status
, w_proc
+ 1);
1344 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1347 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1348 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1351 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1354 XSETFASTINT (minspace
, 1);
1356 set_buffer_internal (XBUFFER (Vstandard_output
));
1357 current_buffer
->undo_list
= Qt
;
1359 current_buffer
->truncate_lines
= Qt
;
1361 write_string ("Proc", -1);
1362 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1363 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1366 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1368 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1369 write_string ("\n", -1);
1371 write_string ("----", -1);
1372 Findent_to (i_status
, minspace
); write_string ("------", -1);
1373 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1376 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1378 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1379 write_string ("\n", -1);
1381 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1385 proc
= Fcdr (Fcar (tail
));
1386 p
= XPROCESS (proc
);
1387 if (NILP (p
->childp
))
1389 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1392 Finsert (1, &p
->name
);
1393 Findent_to (i_status
, minspace
);
1395 if (p
->raw_status_new
)
1398 if (CONSP (p
->status
))
1399 symbol
= XCAR (p
->status
);
1402 if (EQ (symbol
, Qsignal
))
1405 tem
= Fcar (Fcdr (p
->status
));
1407 if (XINT (tem
) < NSIG
)
1408 write_string (sys_errlist
[XINT (tem
)], -1);
1411 Fprinc (symbol
, Qnil
);
1413 else if (NETCONN1_P (p
))
1415 if (EQ (symbol
, Qexit
))
1416 write_string ("closed", -1);
1417 else if (EQ (p
->command
, Qt
))
1418 write_string ("stopped", -1);
1419 else if (EQ (symbol
, Qrun
))
1420 write_string ("open", -1);
1422 Fprinc (symbol
, Qnil
);
1425 Fprinc (symbol
, Qnil
);
1427 if (EQ (symbol
, Qexit
))
1430 tem
= Fcar (Fcdr (p
->status
));
1433 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1434 write_string (tembuf
, -1);
1438 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1439 remove_process (proc
);
1441 Findent_to (i_buffer
, minspace
);
1442 if (NILP (p
->buffer
))
1443 insert_string ("(none)");
1444 else if (NILP (XBUFFER (p
->buffer
)->name
))
1445 insert_string ("(Killed)");
1447 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1451 Findent_to (i_tty
, minspace
);
1452 if (STRINGP (p
->tty_name
))
1453 Finsert (1, &p
->tty_name
);
1456 Findent_to (i_command
, minspace
);
1458 if (EQ (p
->status
, Qlisten
))
1460 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1461 if (INTEGERP (port
))
1462 port
= Fnumber_to_string (port
);
1464 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1465 sprintf (tembuf
, "(network %s server on %s)\n",
1466 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1467 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1468 insert_string (tembuf
);
1470 else if (NETCONN1_P (p
))
1472 /* For a local socket, there is no host name,
1473 so display service instead. */
1474 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1475 if (!STRINGP (host
))
1477 host
= Fplist_get (p
->childp
, QCservice
);
1478 if (INTEGERP (host
))
1479 host
= Fnumber_to_string (host
);
1482 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1483 sprintf (tembuf
, "(network %s connection to %s)\n",
1484 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1485 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1486 insert_string (tembuf
);
1498 insert_string (" ");
1500 insert_string ("\n");
1506 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1507 doc
: /* Display a list of all processes.
1508 If optional argument QUERY-ONLY is non-nil, only processes with
1509 the query-on-exit flag set will be listed.
1510 Any process listed as exited or signaled is actually eliminated
1511 after the listing is made. */)
1513 Lisp_Object query_only
;
1515 internal_with_output_to_temp_buffer ("*Process List*",
1516 list_processes_1
, query_only
);
1520 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1521 doc
: /* Return a list of all processes. */)
1524 return Fmapcar (Qcdr
, Vprocess_alist
);
1527 /* Starting asynchronous inferior processes. */
1529 static Lisp_Object
start_process_unwind ();
1531 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1532 doc
: /* Start a program in a subprocess. Return the process object for it.
1533 NAME is name for process. It is modified if necessary to make it unique.
1534 BUFFER is the buffer (or buffer name) to associate with the process.
1535 Process output goes at end of that buffer, unless you specify
1536 an output stream or filter function to handle the output.
1537 BUFFER may be also nil, meaning that this process is not associated
1539 PROGRAM is the program file name. It is searched for in PATH.
1540 Remaining arguments are strings to give program as arguments.
1542 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1545 register Lisp_Object
*args
;
1547 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1549 register unsigned char *new_argv
;
1552 register unsigned char **new_argv
;
1555 int count
= SPECPDL_INDEX ();
1559 buffer
= Fget_buffer_create (buffer
);
1561 /* Make sure that the child will be able to chdir to the current
1562 buffer's current directory, or its unhandled equivalent. We
1563 can't just have the child check for an error when it does the
1564 chdir, since it's in a vfork.
1566 We have to GCPRO around this because Fexpand_file_name and
1567 Funhandled_file_name_directory might call a file name handling
1568 function. The argument list is protected by the caller, so all
1569 we really have to worry about is buffer. */
1571 struct gcpro gcpro1
, gcpro2
;
1573 current_dir
= current_buffer
->directory
;
1575 GCPRO2 (buffer
, current_dir
);
1578 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1580 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1581 report_file_error ("Setting current directory",
1582 Fcons (current_buffer
->directory
, Qnil
));
1588 CHECK_STRING (name
);
1592 CHECK_STRING (program
);
1594 proc
= make_process (name
);
1595 /* If an error occurs and we can't start the process, we want to
1596 remove it from the process list. This means that each error
1597 check in create_process doesn't need to call remove_process
1598 itself; it's all taken care of here. */
1599 record_unwind_protect (start_process_unwind
, proc
);
1601 XPROCESS (proc
)->childp
= Qt
;
1602 XPROCESS (proc
)->plist
= Qnil
;
1603 XPROCESS (proc
)->buffer
= buffer
;
1604 XPROCESS (proc
)->sentinel
= Qnil
;
1605 XPROCESS (proc
)->filter
= Qnil
;
1606 XPROCESS (proc
)->filter_multibyte
1607 = buffer_defaults
.enable_multibyte_characters
;
1608 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1610 #ifdef ADAPTIVE_READ_BUFFERING
1611 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1614 /* Make the process marker point into the process buffer (if any). */
1615 if (BUFFERP (buffer
))
1616 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1617 BUF_ZV (XBUFFER (buffer
)),
1618 BUF_ZV_BYTE (XBUFFER (buffer
)));
1621 /* Decide coding systems for communicating with the process. Here
1622 we don't setup the structure coding_system nor pay attention to
1623 unibyte mode. They are done in create_process. */
1625 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1626 Lisp_Object coding_systems
= Qt
;
1627 Lisp_Object val
, *args2
;
1628 struct gcpro gcpro1
, gcpro2
;
1630 val
= Vcoding_system_for_read
;
1633 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1634 args2
[0] = Qstart_process
;
1635 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1636 GCPRO2 (proc
, current_dir
);
1637 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1639 if (CONSP (coding_systems
))
1640 val
= XCAR (coding_systems
);
1641 else if (CONSP (Vdefault_process_coding_system
))
1642 val
= XCAR (Vdefault_process_coding_system
);
1644 XPROCESS (proc
)->decode_coding_system
= val
;
1646 val
= Vcoding_system_for_write
;
1649 if (EQ (coding_systems
, Qt
))
1651 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1652 args2
[0] = Qstart_process
;
1653 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1654 GCPRO2 (proc
, current_dir
);
1655 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1658 if (CONSP (coding_systems
))
1659 val
= XCDR (coding_systems
);
1660 else if (CONSP (Vdefault_process_coding_system
))
1661 val
= XCDR (Vdefault_process_coding_system
);
1663 XPROCESS (proc
)->encode_coding_system
= val
;
1667 /* Make a one member argv with all args concatenated
1668 together separated by a blank. */
1669 len
= SBYTES (program
) + 2;
1670 for (i
= 3; i
< nargs
; i
++)
1674 len
+= SBYTES (tem
) + 1; /* count the blank */
1676 new_argv
= (unsigned char *) alloca (len
);
1677 strcpy (new_argv
, SDATA (program
));
1678 for (i
= 3; i
< nargs
; i
++)
1682 strcat (new_argv
, " ");
1683 strcat (new_argv
, SDATA (tem
));
1685 /* Need to add code here to check for program existence on VMS */
1688 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1690 /* If program file name is not absolute, search our path for it.
1691 Put the name we will really use in TEM. */
1692 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1693 && !(SCHARS (program
) > 1
1694 && IS_DEVICE_SEP (SREF (program
, 1))))
1696 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1699 GCPRO4 (name
, program
, buffer
, current_dir
);
1700 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1703 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1704 tem
= Fexpand_file_name (tem
, Qnil
);
1708 if (!NILP (Ffile_directory_p (program
)))
1709 error ("Specified program for new process is a directory");
1713 /* If program file name starts with /: for quoting a magic name,
1715 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1716 && SREF (tem
, 1) == ':')
1717 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1719 /* Encode the file name and put it in NEW_ARGV.
1720 That's where the child will use it to execute the program. */
1721 tem
= ENCODE_FILE (tem
);
1722 new_argv
[0] = SDATA (tem
);
1724 /* Here we encode arguments by the coding system used for sending
1725 data to the process. We don't support using different coding
1726 systems for encoding arguments and for encoding data sent to the
1729 for (i
= 3; i
< nargs
; i
++)
1733 if (STRING_MULTIBYTE (tem
))
1734 tem
= (code_convert_string_norecord
1735 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1736 new_argv
[i
- 2] = SDATA (tem
);
1738 new_argv
[i
- 2] = 0;
1739 #endif /* not VMS */
1741 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1742 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1743 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1744 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1746 XPROCESS (proc
)->inherit_coding_system_flag
1747 = (NILP (buffer
) || !inherit_process_coding_system
1750 create_process (proc
, (char **) new_argv
, current_dir
);
1752 return unbind_to (count
, proc
);
1755 /* This function is the unwind_protect form for Fstart_process. If
1756 PROC doesn't have its pid set, then we know someone has signaled
1757 an error and the process wasn't started successfully, so we should
1758 remove it from the process list. */
1760 start_process_unwind (proc
)
1763 if (!PROCESSP (proc
))
1766 /* Was PROC started successfully? */
1767 if (XPROCESS (proc
)->pid
<= 0)
1768 remove_process (proc
);
1774 create_process_1 (timer
)
1775 struct atimer
*timer
;
1777 /* Nothing to do. */
1781 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1784 /* Mimic blocking of signals on system V, which doesn't really have it. */
1786 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1787 int sigchld_deferred
;
1790 create_process_sigchld ()
1792 signal (SIGCHLD
, create_process_sigchld
);
1794 sigchld_deferred
= 1;
1800 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1802 create_process (process
, new_argv
, current_dir
)
1803 Lisp_Object process
;
1805 Lisp_Object current_dir
;
1807 int pid
, inchannel
, outchannel
;
1809 #ifdef POSIX_SIGNALS
1812 struct sigaction sigint_action
;
1813 struct sigaction sigquit_action
;
1815 struct sigaction sighup_action
;
1817 #else /* !POSIX_SIGNALS */
1820 SIGTYPE (*sigchld
)();
1823 #endif /* !POSIX_SIGNALS */
1824 /* Use volatile to protect variables from being clobbered by longjmp. */
1825 volatile int forkin
, forkout
;
1826 volatile int pty_flag
= 0;
1828 extern char **environ
;
1831 inchannel
= outchannel
= -1;
1834 if (!NILP (Vprocess_connection_type
))
1835 outchannel
= inchannel
= allocate_pty ();
1839 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1840 /* On most USG systems it does not work to open the pty's tty here,
1841 then close it and reopen it in the child. */
1843 /* Don't let this terminal become our controlling terminal
1844 (in case we don't have one). */
1845 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1847 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1850 report_file_error ("Opening pty", Qnil
);
1851 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1852 /* In the case that vfork is defined as fork, the parent process
1853 (Emacs) may send some data before the child process completes
1854 tty options setup. So we setup tty before forking. */
1855 child_setup_tty (forkout
);
1856 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1858 forkin
= forkout
= -1;
1859 #endif /* not USG, or USG_SUBTTY_WORKS */
1863 #endif /* HAVE_PTYS */
1866 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1867 report_file_error ("Opening socketpair", Qnil
);
1868 outchannel
= inchannel
= sv
[0];
1869 forkout
= forkin
= sv
[1];
1871 #else /* not SKTPAIR */
1876 report_file_error ("Creating pipe", Qnil
);
1882 emacs_close (inchannel
);
1883 emacs_close (forkout
);
1884 report_file_error ("Creating pipe", Qnil
);
1889 #endif /* not SKTPAIR */
1892 /* Replaced by close_process_descs */
1893 set_exclusive_use (inchannel
);
1894 set_exclusive_use (outchannel
);
1897 /* Stride people say it's a mystery why this is needed
1898 as well as the O_NDELAY, but that it fails without this. */
1899 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1902 ioctl (inchannel
, FIONBIO
, &one
);
1907 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1908 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1911 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1912 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1916 /* Record this as an active process, with its channels.
1917 As a result, child_setup will close Emacs's side of the pipes. */
1918 chan_process
[inchannel
] = process
;
1919 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1920 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1922 /* Previously we recorded the tty descriptor used in the subprocess.
1923 It was only used for getting the foreground tty process, so now
1924 we just reopen the device (see emacs_get_tty_pgrp) as this is
1925 more portable (see USG_SUBTTY_WORKS above). */
1927 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1928 XPROCESS (process
)->status
= Qrun
;
1929 setup_process_coding_systems (process
);
1931 /* Delay interrupts until we have a chance to store
1932 the new fork's pid in its process structure */
1933 #ifdef POSIX_SIGNALS
1934 sigemptyset (&blocked
);
1936 sigaddset (&blocked
, SIGCHLD
);
1938 #ifdef HAVE_WORKING_VFORK
1939 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1940 this sets the parent's signal handlers as well as the child's.
1941 So delay all interrupts whose handlers the child might munge,
1942 and record the current handlers so they can be restored later. */
1943 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1944 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1946 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1948 #endif /* HAVE_WORKING_VFORK */
1949 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1950 #else /* !POSIX_SIGNALS */
1954 #else /* not BSD4_1 */
1955 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1956 sigsetmask (sigmask (SIGCHLD
));
1957 #else /* ordinary USG */
1959 sigchld_deferred
= 0;
1960 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1962 #endif /* ordinary USG */
1963 #endif /* not BSD4_1 */
1964 #endif /* SIGCHLD */
1965 #endif /* !POSIX_SIGNALS */
1967 FD_SET (inchannel
, &input_wait_mask
);
1968 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1969 if (inchannel
> max_process_desc
)
1970 max_process_desc
= inchannel
;
1972 /* Until we store the proper pid, enable sigchld_handler
1973 to recognize an unknown pid as standing for this process.
1974 It is very important not to let this `marker' value stay
1975 in the table after this function has returned; if it does
1976 it might cause call-process to hang and subsequent asynchronous
1977 processes to get their return values scrambled. */
1978 XPROCESS (process
)->pid
= -1;
1983 /* child_setup must clobber environ on systems with true vfork.
1984 Protect it from permanent change. */
1985 char **save_environ
= environ
;
1987 current_dir
= ENCODE_FILE (current_dir
);
1992 #endif /* not WINDOWSNT */
1994 int xforkin
= forkin
;
1995 int xforkout
= forkout
;
1997 #if 0 /* This was probably a mistake--it duplicates code later on,
1998 but fails to handle all the cases. */
1999 /* Make sure SIGCHLD is not blocked in the child. */
2000 sigsetmask (SIGEMPTYMASK
);
2003 /* Make the pty be the controlling terminal of the process. */
2005 /* First, disconnect its current controlling terminal. */
2007 /* We tried doing setsid only if pty_flag, but it caused
2008 process_set_signal to fail on SGI when using a pipe. */
2010 /* Make the pty's terminal the controlling terminal. */
2014 /* We ignore the return value
2015 because faith@cs.unc.edu says that is necessary on Linux. */
2016 ioctl (xforkin
, TIOCSCTTY
, 0);
2019 #else /* not HAVE_SETSID */
2021 /* It's very important to call setpgrp here and no time
2022 afterwards. Otherwise, we lose our controlling tty which
2023 is set when we open the pty. */
2026 #endif /* not HAVE_SETSID */
2027 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2028 if (pty_flag
&& xforkin
>= 0)
2031 tcgetattr (xforkin
, &t
);
2033 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2034 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2037 #if defined (NTTYDISC) && defined (TIOCSETD)
2038 if (pty_flag
&& xforkin
>= 0)
2040 /* Use new line discipline. */
2041 int ldisc
= NTTYDISC
;
2042 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2047 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2048 can do TIOCSPGRP only to the process's controlling tty. */
2051 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2052 I can't test it since I don't have 4.3. */
2053 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2054 ioctl (j
, TIOCNOTTY
, 0);
2057 /* In order to get a controlling terminal on some versions
2058 of BSD, it is necessary to put the process in pgrp 0
2059 before it opens the terminal. */
2067 #endif /* TIOCNOTTY */
2069 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2070 /*** There is a suggestion that this ought to be a
2071 conditional on TIOCSPGRP,
2072 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2073 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2074 that system does seem to need this code, even though
2075 both HAVE_SETSID and TIOCSCTTY are defined. */
2076 /* Now close the pty (if we had it open) and reopen it.
2077 This makes the pty the controlling terminal of the subprocess. */
2080 #ifdef SET_CHILD_PTY_PGRP
2081 int pgrp
= getpid ();
2084 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2087 emacs_close (xforkin
);
2088 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2092 emacs_write (1, "Couldn't open the pty terminal ", 31);
2093 emacs_write (1, pty_name
, strlen (pty_name
));
2094 emacs_write (1, "\n", 1);
2098 #ifdef SET_CHILD_PTY_PGRP
2099 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2100 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2103 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2105 #ifdef SETUP_SLAVE_PTY
2110 #endif /* SETUP_SLAVE_PTY */
2112 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2113 Now reenable it in the child, so it will die when we want it to. */
2115 signal (SIGHUP
, SIG_DFL
);
2117 #endif /* HAVE_PTYS */
2119 signal (SIGINT
, SIG_DFL
);
2120 signal (SIGQUIT
, SIG_DFL
);
2122 /* Stop blocking signals in the child. */
2123 #ifdef POSIX_SIGNALS
2124 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2125 #else /* !POSIX_SIGNALS */
2129 #else /* not BSD4_1 */
2130 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2131 sigsetmask (SIGEMPTYMASK
);
2132 #else /* ordinary USG */
2134 signal (SIGCHLD
, sigchld
);
2136 #endif /* ordinary USG */
2137 #endif /* not BSD4_1 */
2138 #endif /* SIGCHLD */
2139 #endif /* !POSIX_SIGNALS */
2141 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2143 child_setup_tty (xforkout
);
2144 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2146 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2147 new_argv
, 1, current_dir
);
2148 #else /* not WINDOWSNT */
2149 child_setup (xforkin
, xforkout
, xforkout
,
2150 new_argv
, 1, current_dir
);
2151 #endif /* not WINDOWSNT */
2153 environ
= save_environ
;
2158 /* This runs in the Emacs process. */
2162 emacs_close (forkin
);
2163 if (forkin
!= forkout
&& forkout
>= 0)
2164 emacs_close (forkout
);
2168 /* vfork succeeded. */
2169 XPROCESS (process
)->pid
= pid
;
2172 register_child (pid
, inchannel
);
2173 #endif /* WINDOWSNT */
2175 /* If the subfork execv fails, and it exits,
2176 this close hangs. I don't know why.
2177 So have an interrupt jar it loose. */
2179 struct atimer
*timer
;
2183 EMACS_SET_SECS_USECS (offset
, 1, 0);
2184 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2187 emacs_close (forkin
);
2189 cancel_atimer (timer
);
2193 if (forkin
!= forkout
&& forkout
>= 0)
2194 emacs_close (forkout
);
2198 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2201 XPROCESS (process
)->tty_name
= Qnil
;
2204 /* Restore the signal state whether vfork succeeded or not.
2205 (We will signal an error, below, if it failed.) */
2206 #ifdef POSIX_SIGNALS
2207 #ifdef HAVE_WORKING_VFORK
2208 /* Restore the parent's signal handlers. */
2209 sigaction (SIGINT
, &sigint_action
, 0);
2210 sigaction (SIGQUIT
, &sigquit_action
, 0);
2212 sigaction (SIGHUP
, &sighup_action
, 0);
2214 #endif /* HAVE_WORKING_VFORK */
2215 /* Stop blocking signals in the parent. */
2216 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2217 #else /* !POSIX_SIGNALS */
2221 #else /* not BSD4_1 */
2222 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2223 sigsetmask (SIGEMPTYMASK
);
2224 #else /* ordinary USG */
2226 signal (SIGCHLD
, sigchld
);
2227 /* Now really handle any of these signals
2228 that came in during this function. */
2229 if (sigchld_deferred
)
2230 kill (getpid (), SIGCHLD
);
2232 #endif /* ordinary USG */
2233 #endif /* not BSD4_1 */
2234 #endif /* SIGCHLD */
2235 #endif /* !POSIX_SIGNALS */
2237 /* Now generate the error if vfork failed. */
2239 report_file_error ("Doing vfork", Qnil
);
2241 #endif /* not VMS */
2246 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2247 The address family of sa is not included in the result. */
2250 conv_sockaddr_to_lisp (sa
, len
)
2251 struct sockaddr
*sa
;
2254 Lisp_Object address
;
2257 register struct Lisp_Vector
*p
;
2259 switch (sa
->sa_family
)
2263 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2264 len
= sizeof (sin
->sin_addr
) + 1;
2265 address
= Fmake_vector (make_number (len
), Qnil
);
2266 p
= XVECTOR (address
);
2267 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2268 cp
= (unsigned char *)&sin
->sin_addr
;
2274 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2275 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2276 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2277 address
= Fmake_vector (make_number (len
), Qnil
);
2278 p
= XVECTOR (address
);
2279 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2280 for (i
= 0; i
< len
; i
++)
2281 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2285 #ifdef HAVE_LOCAL_SOCKETS
2288 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2289 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2290 if (sockun
->sun_path
[i
] == 0)
2292 return make_unibyte_string (sockun
->sun_path
, i
);
2296 len
-= sizeof (sa
->sa_family
);
2297 address
= Fcons (make_number (sa
->sa_family
),
2298 Fmake_vector (make_number (len
), Qnil
));
2299 p
= XVECTOR (XCDR (address
));
2300 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2306 p
->contents
[i
++] = make_number (*cp
++);
2312 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2315 get_lisp_to_sockaddr_size (address
, familyp
)
2316 Lisp_Object address
;
2319 register struct Lisp_Vector
*p
;
2321 if (VECTORP (address
))
2323 p
= XVECTOR (address
);
2327 return sizeof (struct sockaddr_in
);
2330 else if (p
->size
== 9)
2332 *familyp
= AF_INET6
;
2333 return sizeof (struct sockaddr_in6
);
2337 #ifdef HAVE_LOCAL_SOCKETS
2338 else if (STRINGP (address
))
2340 *familyp
= AF_LOCAL
;
2341 return sizeof (struct sockaddr_un
);
2344 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2346 struct sockaddr
*sa
;
2347 *familyp
= XINT (XCAR (address
));
2348 p
= XVECTOR (XCDR (address
));
2349 return p
->size
+ sizeof (sa
->sa_family
);
2354 /* Convert an address object (vector or string) to an internal sockaddr.
2356 The address format has been basically validated by
2357 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2358 it could have come from user data. So if FAMILY is not valid,
2359 we return after zeroing *SA. */
2362 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2364 Lisp_Object address
;
2365 struct sockaddr
*sa
;
2368 register struct Lisp_Vector
*p
;
2369 register unsigned char *cp
= NULL
;
2374 if (VECTORP (address
))
2376 p
= XVECTOR (address
);
2377 if (family
== AF_INET
)
2379 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2380 len
= sizeof (sin
->sin_addr
) + 1;
2381 i
= XINT (p
->contents
[--len
]);
2382 sin
->sin_port
= htons (i
);
2383 cp
= (unsigned char *)&sin
->sin_addr
;
2384 sa
->sa_family
= family
;
2387 else if (family
== AF_INET6
)
2389 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2390 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2391 len
= sizeof (sin6
->sin6_addr
) + 1;
2392 i
= XINT (p
->contents
[--len
]);
2393 sin6
->sin6_port
= htons (i
);
2394 for (i
= 0; i
< len
; i
++)
2395 if (INTEGERP (p
->contents
[i
]))
2397 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2400 sa
->sa_family
= family
;
2405 else if (STRINGP (address
))
2407 #ifdef HAVE_LOCAL_SOCKETS
2408 if (family
== AF_LOCAL
)
2410 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2411 cp
= SDATA (address
);
2412 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2413 sockun
->sun_path
[i
] = *cp
++;
2414 sa
->sa_family
= family
;
2421 p
= XVECTOR (XCDR (address
));
2422 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2425 for (i
= 0; i
< len
; i
++)
2426 if (INTEGERP (p
->contents
[i
]))
2427 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2430 #ifdef DATAGRAM_SOCKETS
2431 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2433 doc
: /* Get the current datagram address associated with PROCESS. */)
2435 Lisp_Object process
;
2439 CHECK_PROCESS (process
);
2441 if (!DATAGRAM_CONN_P (process
))
2444 channel
= XINT (XPROCESS (process
)->infd
);
2445 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2446 datagram_address
[channel
].len
);
2449 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2451 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2452 Returns nil upon error setting address, ADDRESS otherwise. */)
2454 Lisp_Object process
, address
;
2459 CHECK_PROCESS (process
);
2461 if (!DATAGRAM_CONN_P (process
))
2464 channel
= XINT (XPROCESS (process
)->infd
);
2466 len
= get_lisp_to_sockaddr_size (address
, &family
);
2467 if (datagram_address
[channel
].len
!= len
)
2469 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2475 static struct socket_options
{
2476 /* The name of this option. Should be lowercase version of option
2477 name without SO_ prefix. */
2479 /* Option level SOL_... */
2481 /* Option number SO_... */
2483 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2484 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2485 } socket_options
[] =
2487 #ifdef SO_BINDTODEVICE
2488 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2491 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2494 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2497 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2500 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2503 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2506 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2509 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2511 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2514 /* Set option OPT to value VAL on socket S.
2516 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2517 Signals an error if setting a known option fails.
2521 set_socket_option (s
, opt
, val
)
2523 Lisp_Object opt
, val
;
2526 struct socket_options
*sopt
;
2531 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2532 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2533 if (strcmp (name
, sopt
->name
) == 0)
2536 switch (sopt
->opttype
)
2541 optval
= NILP (val
) ? 0 : 1;
2542 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2543 &optval
, sizeof (optval
));
2551 optval
= XINT (val
);
2553 error ("Bad option value for %s", name
);
2554 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2555 &optval
, sizeof (optval
));
2559 #ifdef SO_BINDTODEVICE
2562 char devname
[IFNAMSIZ
+1];
2564 /* This is broken, at least in the Linux 2.4 kernel.
2565 To unbind, the arg must be a zero integer, not the empty string.
2566 This should work on all systems. KFS. 2003-09-23. */
2567 bzero (devname
, sizeof devname
);
2570 char *arg
= (char *) SDATA (val
);
2571 int len
= min (strlen (arg
), IFNAMSIZ
);
2572 bcopy (arg
, devname
, len
);
2574 else if (!NILP (val
))
2575 error ("Bad option value for %s", name
);
2576 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2585 struct linger linger
;
2588 linger
.l_linger
= 0;
2590 linger
.l_linger
= XINT (val
);
2592 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2593 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2594 &linger
, sizeof (linger
));
2604 report_file_error ("Cannot set network option",
2605 Fcons (opt
, Fcons (val
, Qnil
)));
2606 return (1 << sopt
->optbit
);
2610 DEFUN ("set-network-process-option",
2611 Fset_network_process_option
, Sset_network_process_option
,
2613 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2614 See `make-network-process' for a list of options and values.
2615 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2616 OPTION is not a supported option, return nil instead; otherwise return t. */)
2617 (process
, option
, value
, no_error
)
2618 Lisp_Object process
, option
, value
;
2619 Lisp_Object no_error
;
2622 struct Lisp_Process
*p
;
2624 CHECK_PROCESS (process
);
2625 p
= XPROCESS (process
);
2626 if (!NETCONN1_P (p
))
2627 error ("Process is not a network process");
2631 error ("Process is not running");
2633 if (set_socket_option (s
, option
, value
))
2635 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2639 if (NILP (no_error
))
2640 error ("Unknown or unsupported option");
2646 /* A version of request_sigio suitable for a record_unwind_protect. */
2649 unwind_request_sigio (dummy
)
2652 if (interrupt_input
)
2657 /* Create a network stream/datagram client/server process. Treated
2658 exactly like a normal process when reading and writing. Primary
2659 differences are in status display and process deletion. A network
2660 connection has no PID; you cannot signal it. All you can do is
2661 stop/continue it and deactivate/close it via delete-process */
2663 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2665 doc
: /* Create and return a network server or client process.
2667 In Emacs, network connections are represented by process objects, so
2668 input and output work as for subprocesses and `delete-process' closes
2669 a network connection. However, a network process has no process id,
2670 it cannot be signaled, and the status codes are different from normal
2673 Arguments are specified as keyword/argument pairs. The following
2674 arguments are defined:
2676 :name NAME -- NAME is name for process. It is modified if necessary
2679 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2680 with the process. Process output goes at end of that buffer, unless
2681 you specify an output stream or filter function to handle the output.
2682 BUFFER may be also nil, meaning that this process is not associated
2685 :host HOST -- HOST is name of the host to connect to, or its IP
2686 address. The symbol `local' specifies the local host. If specified
2687 for a server process, it must be a valid name or address for the local
2688 host, and only clients connecting to that address will be accepted.
2690 :service SERVICE -- SERVICE is name of the service desired, or an
2691 integer specifying a port number to connect to. If SERVICE is t,
2692 a random port number is selected for the server.
2694 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2695 stream type connection, `datagram' creates a datagram type connection.
2697 :family FAMILY -- FAMILY is the address (and protocol) family for the
2698 service specified by HOST and SERVICE. The default (nil) is to use
2699 whatever address family (IPv4 or IPv6) that is defined for the host
2700 and port number specified by HOST and SERVICE. Other address families
2702 local -- for a local (i.e. UNIX) address specified by SERVICE.
2703 ipv4 -- use IPv4 address family only.
2704 ipv6 -- use IPv6 address family only.
2706 :local ADDRESS -- ADDRESS is the local address used for the connection.
2707 This parameter is ignored when opening a client process. When specified
2708 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2710 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2711 connection. This parameter is ignored when opening a stream server
2712 process. For a datagram server process, it specifies the initial
2713 setting of the remote datagram address. When specified for a client
2714 process, the FAMILY, HOST, and SERVICE args are ignored.
2716 The format of ADDRESS depends on the address family:
2717 - An IPv4 address is represented as an vector of integers [A B C D P]
2718 corresponding to numeric IP address A.B.C.D and port number P.
2719 - A local address is represented as a string with the address in the
2720 local address space.
2721 - An "unsupported family" address is represented by a cons (F . AV)
2722 where F is the family number and AV is a vector containing the socket
2723 address data with one element per address data byte. Do not rely on
2724 this format in portable code, as it may depend on implementation
2725 defined constants, data sizes, and data structure alignment.
2727 :coding CODING -- If CODING is a symbol, it specifies the coding
2728 system used for both reading and writing for this process. If CODING
2729 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2730 ENCODING is used for writing.
2732 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2733 return without waiting for the connection to complete; instead, the
2734 sentinel function will be called with second arg matching "open" (if
2735 successful) or "failed" when the connect completes. Default is to use
2736 a blocking connect (i.e. wait) for stream type connections.
2738 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2739 running when Emacs is exited.
2741 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2742 In the stopped state, a server process does not accept new
2743 connections, and a client process does not handle incoming traffic.
2744 The stopped state is cleared by `continue-process' and set by
2747 :filter FILTER -- Install FILTER as the process filter.
2749 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2750 process filter are multibyte, otherwise they are unibyte.
2751 If this keyword is not specified, the strings are multibyte iff
2752 `default-enable-multibyte-characters' is non-nil.
2754 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2756 :log LOG -- Install LOG as the server process log function. This
2757 function is called when the server accepts a network connection from a
2758 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2759 is the server process, CLIENT is the new process for the connection,
2760 and MESSAGE is a string.
2762 :plist PLIST -- Install PLIST as the new process' initial plist.
2764 :server QLEN -- if QLEN is non-nil, create a server process for the
2765 specified FAMILY, SERVICE, and connection type (stream or datagram).
2766 If QLEN is an integer, it is used as the max. length of the server's
2767 pending connection queue (also known as the backlog); the default
2768 queue length is 5. Default is to create a client process.
2770 The following network options can be specified for this connection:
2772 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2773 :dontroute BOOL -- Only send to directly connected hosts.
2774 :keepalive BOOL -- Send keep-alive messages on network stream.
2775 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2776 :oobinline BOOL -- Place out-of-band data in receive data stream.
2777 :priority INT -- Set protocol defined priority for sent packets.
2778 :reuseaddr BOOL -- Allow reusing a recently used local address
2779 (this is allowed by default for a server process).
2780 :bindtodevice NAME -- bind to interface NAME. Using this may require
2781 special privileges on some systems.
2783 Consult the relevant system programmer's manual pages for more
2784 information on using these options.
2787 A server process will listen for and accept connections from clients.
2788 When a client connection is accepted, a new network process is created
2789 for the connection with the following parameters:
2791 - The client's process name is constructed by concatenating the server
2792 process' NAME and a client identification string.
2793 - If the FILTER argument is non-nil, the client process will not get a
2794 separate process buffer; otherwise, the client's process buffer is a newly
2795 created buffer named after the server process' BUFFER name or process
2796 NAME concatenated with the client identification string.
2797 - The connection type and the process filter and sentinel parameters are
2798 inherited from the server process' TYPE, FILTER and SENTINEL.
2799 - The client process' contact info is set according to the client's
2800 addressing information (typically an IP address and a port number).
2801 - The client process' plist is initialized from the server's plist.
2803 Notice that the FILTER and SENTINEL args are never used directly by
2804 the server process. Also, the BUFFER argument is not used directly by
2805 the server process, but via the optional :log function, accepted (and
2806 failed) connections may be logged in the server process' buffer.
2808 The original argument list, modified with the actual connection
2809 information, is available via the `process-contact' function.
2811 usage: (make-network-process &rest ARGS) */)
2817 Lisp_Object contact
;
2818 struct Lisp_Process
*p
;
2819 #ifdef HAVE_GETADDRINFO
2820 struct addrinfo ai
, *res
, *lres
;
2821 struct addrinfo hints
;
2822 char *portstring
, portbuf
[128];
2823 #else /* HAVE_GETADDRINFO */
2824 struct _emacs_addrinfo
2830 struct sockaddr
*ai_addr
;
2831 struct _emacs_addrinfo
*ai_next
;
2833 #endif /* HAVE_GETADDRINFO */
2834 struct sockaddr_in address_in
;
2835 #ifdef HAVE_LOCAL_SOCKETS
2836 struct sockaddr_un address_un
;
2841 int s
= -1, outch
, inch
;
2842 struct gcpro gcpro1
;
2843 int count
= SPECPDL_INDEX ();
2845 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2847 Lisp_Object name
, buffer
, host
, service
, address
;
2848 Lisp_Object filter
, sentinel
;
2849 int is_non_blocking_client
= 0;
2850 int is_server
= 0, backlog
= 5;
2857 /* Save arguments for process-contact and clone-process. */
2858 contact
= Flist (nargs
, args
);
2862 /* Ensure socket support is loaded if available. */
2863 init_winsock (TRUE
);
2866 /* :type TYPE (nil: stream, datagram */
2867 tem
= Fplist_get (contact
, QCtype
);
2869 socktype
= SOCK_STREAM
;
2870 #ifdef DATAGRAM_SOCKETS
2871 else if (EQ (tem
, Qdatagram
))
2872 socktype
= SOCK_DGRAM
;
2875 error ("Unsupported connection type");
2878 tem
= Fplist_get (contact
, QCserver
);
2881 /* Don't support network sockets when non-blocking mode is
2882 not available, since a blocked Emacs is not useful. */
2883 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2884 error ("Network servers not supported");
2888 backlog
= XINT (tem
);
2892 /* Make QCaddress an alias for :local (server) or :remote (client). */
2893 QCaddress
= is_server
? QClocal
: QCremote
;
2896 if (!is_server
&& socktype
== SOCK_STREAM
2897 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2899 #ifndef NON_BLOCKING_CONNECT
2900 error ("Non-blocking connect not supported");
2902 is_non_blocking_client
= 1;
2906 name
= Fplist_get (contact
, QCname
);
2907 buffer
= Fplist_get (contact
, QCbuffer
);
2908 filter
= Fplist_get (contact
, QCfilter
);
2909 sentinel
= Fplist_get (contact
, QCsentinel
);
2911 CHECK_STRING (name
);
2914 /* Let's handle TERM before things get complicated ... */
2915 host
= Fplist_get (contact
, QChost
);
2916 CHECK_STRING (host
);
2918 service
= Fplist_get (contact
, QCservice
);
2919 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
), "tcp");
2927 error ("Unknown service: %s", SDATA (service
));
2928 port
= svc_info
->s_port
;
2931 s
= connect_server (0);
2933 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2934 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2935 send_command (s
, C_DUMB
, 1, 0);
2937 #else /* not TERM */
2939 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2940 ai
.ai_socktype
= socktype
;
2945 /* :local ADDRESS or :remote ADDRESS */
2946 address
= Fplist_get (contact
, QCaddress
);
2947 if (!NILP (address
))
2949 host
= service
= Qnil
;
2951 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2952 error ("Malformed :address");
2953 ai
.ai_family
= family
;
2954 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2955 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2959 /* :family FAMILY -- nil (for Inet), local, or integer. */
2960 tem
= Fplist_get (contact
, QCfamily
);
2963 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2969 #ifdef HAVE_LOCAL_SOCKETS
2970 else if (EQ (tem
, Qlocal
))
2974 else if (EQ (tem
, Qipv6
))
2977 else if (EQ (tem
, Qipv4
))
2979 else if (INTEGERP (tem
))
2980 family
= XINT (tem
);
2982 error ("Unknown address family");
2984 ai
.ai_family
= family
;
2986 /* :service SERVICE -- string, integer (port number), or t (random port). */
2987 service
= Fplist_get (contact
, QCservice
);
2989 #ifdef HAVE_LOCAL_SOCKETS
2990 if (family
== AF_LOCAL
)
2992 /* Host is not used. */
2994 CHECK_STRING (service
);
2995 bzero (&address_un
, sizeof address_un
);
2996 address_un
.sun_family
= AF_LOCAL
;
2997 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2998 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2999 ai
.ai_addrlen
= sizeof address_un
;
3004 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3005 host
= Fplist_get (contact
, QChost
);
3008 if (EQ (host
, Qlocal
))
3009 host
= build_string ("localhost");
3010 CHECK_STRING (host
);
3013 /* Slow down polling to every ten seconds.
3014 Some kernels have a bug which causes retrying connect to fail
3015 after a connect. Polling can interfere with gethostbyname too. */
3016 #ifdef POLL_FOR_INPUT
3017 if (socktype
== SOCK_STREAM
)
3019 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3020 bind_polling_period (10);
3024 #ifdef HAVE_GETADDRINFO
3025 /* If we have a host, use getaddrinfo to resolve both host and service.
3026 Otherwise, use getservbyname to lookup the service. */
3030 /* SERVICE can either be a string or int.
3031 Convert to a C string for later use by getaddrinfo. */
3032 if (EQ (service
, Qt
))
3034 else if (INTEGERP (service
))
3036 sprintf (portbuf
, "%ld", (long) XINT (service
));
3037 portstring
= portbuf
;
3041 CHECK_STRING (service
);
3042 portstring
= SDATA (service
);
3047 memset (&hints
, 0, sizeof (hints
));
3049 hints
.ai_family
= family
;
3050 hints
.ai_socktype
= socktype
;
3051 hints
.ai_protocol
= 0;
3052 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3054 #ifdef HAVE_GAI_STRERROR
3055 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3057 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3063 #endif /* HAVE_GETADDRINFO */
3065 /* We end up here if getaddrinfo is not defined, or in case no hostname
3066 has been specified (e.g. for a local server process). */
3068 if (EQ (service
, Qt
))
3070 else if (INTEGERP (service
))
3071 port
= htons ((unsigned short) XINT (service
));
3074 struct servent
*svc_info
;
3075 CHECK_STRING (service
);
3076 svc_info
= getservbyname (SDATA (service
),
3077 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3079 error ("Unknown service: %s", SDATA (service
));
3080 port
= svc_info
->s_port
;
3083 bzero (&address_in
, sizeof address_in
);
3084 address_in
.sin_family
= family
;
3085 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3086 address_in
.sin_port
= port
;
3088 #ifndef HAVE_GETADDRINFO
3091 struct hostent
*host_info_ptr
;
3093 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3094 as it may `hang' Emacs for a very long time. */
3097 host_info_ptr
= gethostbyname (SDATA (host
));
3102 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3103 host_info_ptr
->h_length
);
3104 family
= host_info_ptr
->h_addrtype
;
3105 address_in
.sin_family
= family
;
3108 /* Attempt to interpret host as numeric inet address */
3110 IN_ADDR numeric_addr
;
3111 numeric_addr
= inet_addr ((char *) SDATA (host
));
3112 if (NUMERIC_ADDR_ERROR
)
3113 error ("Unknown host \"%s\"", SDATA (host
));
3115 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3116 sizeof (address_in
.sin_addr
));
3120 #endif /* not HAVE_GETADDRINFO */
3122 ai
.ai_family
= family
;
3123 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3124 ai
.ai_addrlen
= sizeof address_in
;
3128 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3129 when connect is interrupted. So let's not let it get interrupted.
3130 Note we do not turn off polling, because polling is only used
3131 when not interrupt_input, and thus not normally used on the systems
3132 which have this bug. On systems which use polling, there's no way
3133 to quit if polling is turned off. */
3135 && !is_server
&& socktype
== SOCK_STREAM
)
3137 /* Comment from KFS: The original open-network-stream code
3138 didn't unwind protect this, but it seems like the proper
3139 thing to do. In any case, I don't see how it could harm to
3140 do this -- and it makes cleanup (using unbind_to) easier. */
3141 record_unwind_protect (unwind_request_sigio
, Qnil
);
3145 /* Do this in case we never enter the for-loop below. */
3146 count1
= SPECPDL_INDEX ();
3149 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3155 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3162 #ifdef DATAGRAM_SOCKETS
3163 if (!is_server
&& socktype
== SOCK_DGRAM
)
3165 #endif /* DATAGRAM_SOCKETS */
3167 #ifdef NON_BLOCKING_CONNECT
3168 if (is_non_blocking_client
)
3171 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3173 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3185 /* Make us close S if quit. */
3186 record_unwind_protect (close_file_unwind
, make_number (s
));
3188 /* Parse network options in the arg list.
3189 We simply ignore anything which isn't a known option (including other keywords).
3190 An error is signalled if setting a known option fails. */
3191 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3192 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3196 /* Configure as a server socket. */
3198 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3199 explicit :reuseaddr key to override this. */
3200 #ifdef HAVE_LOCAL_SOCKETS
3201 if (family
!= AF_LOCAL
)
3203 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3206 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3207 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3210 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3211 report_file_error ("Cannot bind server socket", Qnil
);
3213 #ifdef HAVE_GETSOCKNAME
3214 if (EQ (service
, Qt
))
3216 struct sockaddr_in sa1
;
3217 int len1
= sizeof (sa1
);
3218 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3220 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3221 service
= make_number (ntohs (sa1
.sin_port
));
3222 contact
= Fplist_put (contact
, QCservice
, service
);
3227 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3228 report_file_error ("Cannot listen on server socket", Qnil
);
3236 /* This turns off all alarm-based interrupts; the
3237 bind_polling_period call above doesn't always turn all the
3238 short-interval ones off, especially if interrupt_input is
3241 It'd be nice to be able to control the connect timeout
3242 though. Would non-blocking connect calls be portable?
3244 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3246 turn_on_atimers (0);
3248 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3251 turn_on_atimers (1);
3253 if (ret
== 0 || xerrno
== EISCONN
)
3255 /* The unwind-protect will be discarded afterwards.
3256 Likewise for immediate_quit. */
3260 #ifdef NON_BLOCKING_CONNECT
3262 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3266 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3274 /* Discard the unwind protect closing S. */
3275 specpdl_ptr
= specpdl
+ count1
;
3279 if (xerrno
== EINTR
)
3285 #ifdef DATAGRAM_SOCKETS
3286 if (socktype
== SOCK_DGRAM
)
3288 if (datagram_address
[s
].sa
)
3290 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3291 datagram_address
[s
].len
= lres
->ai_addrlen
;
3295 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3296 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3299 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3300 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3301 conv_lisp_to_sockaddr (rfamily
, remote
,
3302 datagram_address
[s
].sa
, rlen
);
3306 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3309 contact
= Fplist_put (contact
, QCaddress
,
3310 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3311 #ifdef HAVE_GETSOCKNAME
3314 struct sockaddr_in sa1
;
3315 int len1
= sizeof (sa1
);
3316 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3317 contact
= Fplist_put (contact
, QClocal
,
3318 conv_sockaddr_to_lisp (&sa1
, len1
));
3323 #ifdef HAVE_GETADDRINFO
3330 /* Discard the unwind protect for closing S, if any. */
3331 specpdl_ptr
= specpdl
+ count1
;
3333 /* Unwind bind_polling_period and request_sigio. */
3334 unbind_to (count
, Qnil
);
3338 /* If non-blocking got this far - and failed - assume non-blocking is
3339 not supported after all. This is probably a wrong assumption, but
3340 the normal blocking calls to open-network-stream handles this error
3342 if (is_non_blocking_client
)
3347 report_file_error ("make server process failed", contact
);
3349 report_file_error ("make client process failed", contact
);
3352 #endif /* not TERM */
3358 buffer
= Fget_buffer_create (buffer
);
3359 proc
= make_process (name
);
3361 chan_process
[inch
] = proc
;
3364 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3367 fcntl (inch
, F_SETFL
, O_NDELAY
);
3371 p
= XPROCESS (proc
);
3373 p
->childp
= contact
;
3374 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3377 p
->sentinel
= sentinel
;
3379 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3380 /* Override the above only if :filter-multibyte is specified. */
3381 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3382 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3383 p
->log
= Fplist_get (contact
, QClog
);
3384 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3385 p
->kill_without_query
= Qt
;
3386 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3389 XSETINT (p
->infd
, inch
);
3390 XSETINT (p
->outfd
, outch
);
3391 if (is_server
&& socktype
== SOCK_STREAM
)
3392 p
->status
= Qlisten
;
3394 /* Make the process marker point into the process buffer (if any). */
3395 if (BUFFERP (buffer
))
3396 set_marker_both (p
->mark
, buffer
,
3397 BUF_ZV (XBUFFER (buffer
)),
3398 BUF_ZV_BYTE (XBUFFER (buffer
)));
3400 #ifdef NON_BLOCKING_CONNECT
3401 if (is_non_blocking_client
)
3403 /* We may get here if connect did succeed immediately. However,
3404 in that case, we still need to signal this like a non-blocking
3406 p
->status
= Qconnect
;
3407 if (!FD_ISSET (inch
, &connect_wait_mask
))
3409 FD_SET (inch
, &connect_wait_mask
);
3410 num_pending_connects
++;
3415 /* A server may have a client filter setting of Qt, but it must
3416 still listen for incoming connects unless it is stopped. */
3417 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3418 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3420 FD_SET (inch
, &input_wait_mask
);
3421 FD_SET (inch
, &non_keyboard_wait_mask
);
3424 if (inch
> max_process_desc
)
3425 max_process_desc
= inch
;
3427 tem
= Fplist_member (contact
, QCcoding
);
3428 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3429 tem
= Qnil
; /* No error message (too late!). */
3432 /* Setup coding systems for communicating with the network stream. */
3433 struct gcpro gcpro1
;
3434 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3435 Lisp_Object coding_systems
= Qt
;
3436 Lisp_Object args
[5], val
;
3440 val
= XCAR (XCDR (tem
));
3444 else if (!NILP (Vcoding_system_for_read
))
3445 val
= Vcoding_system_for_read
;
3446 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3447 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3448 /* We dare not decode end-of-line format by setting VAL to
3449 Qraw_text, because the existing Emacs Lisp libraries
3450 assume that they receive bare code including a sequene of
3455 if (NILP (host
) || NILP (service
))
3456 coding_systems
= Qnil
;
3459 args
[0] = Qopen_network_stream
, args
[1] = name
,
3460 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3462 coding_systems
= Ffind_operation_coding_system (5, args
);
3465 if (CONSP (coding_systems
))
3466 val
= XCAR (coding_systems
);
3467 else if (CONSP (Vdefault_process_coding_system
))
3468 val
= XCAR (Vdefault_process_coding_system
);
3472 p
->decode_coding_system
= val
;
3476 val
= XCAR (XCDR (tem
));
3480 else if (!NILP (Vcoding_system_for_write
))
3481 val
= Vcoding_system_for_write
;
3482 else if (NILP (current_buffer
->enable_multibyte_characters
))
3486 if (EQ (coding_systems
, Qt
))
3488 if (NILP (host
) || NILP (service
))
3489 coding_systems
= Qnil
;
3492 args
[0] = Qopen_network_stream
, args
[1] = name
,
3493 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3495 coding_systems
= Ffind_operation_coding_system (5, args
);
3499 if (CONSP (coding_systems
))
3500 val
= XCDR (coding_systems
);
3501 else if (CONSP (Vdefault_process_coding_system
))
3502 val
= XCDR (Vdefault_process_coding_system
);
3506 p
->encode_coding_system
= val
;
3508 setup_process_coding_systems (proc
);
3510 p
->decoding_buf
= make_uninit_string (0);
3511 p
->decoding_carryover
= make_number (0);
3512 p
->encoding_buf
= make_uninit_string (0);
3513 p
->encoding_carryover
= make_number (0);
3515 p
->inherit_coding_system_flag
3516 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3522 #endif /* HAVE_SOCKETS */
3525 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3528 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3529 doc
: /* Return an alist of all network interfaces and their network address.
3530 Each element is a cons, the car of which is a string containing the
3531 interface name, and the cdr is the network address in internal
3532 format; see the description of ADDRESS in `make-network-process'. */)
3535 struct ifconf ifconf
;
3536 struct ifreq
*ifreqs
= NULL
;
3541 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3547 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3548 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3555 ifconf
.ifc_len
= buf_size
;
3556 ifconf
.ifc_req
= ifreqs
;
3557 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3563 if (ifconf
.ifc_len
== buf_size
)
3567 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3570 while (--ifaces
>= 0)
3572 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3573 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3574 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3576 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3577 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3578 res
= Fcons (Fcons (build_string (namebuf
),
3579 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3580 sizeof (struct sockaddr
))),
3586 #endif /* SIOCGIFCONF */
3588 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3595 static struct ifflag_def ifflag_table
[] = {
3599 #ifdef IFF_BROADCAST
3600 { IFF_BROADCAST
, "broadcast" },
3603 { IFF_DEBUG
, "debug" },
3606 { IFF_LOOPBACK
, "loopback" },
3608 #ifdef IFF_POINTOPOINT
3609 { IFF_POINTOPOINT
, "pointopoint" },
3612 { IFF_RUNNING
, "running" },
3615 { IFF_NOARP
, "noarp" },
3618 { IFF_PROMISC
, "promisc" },
3620 #ifdef IFF_NOTRAILERS
3621 { IFF_NOTRAILERS
, "notrailers" },
3624 { IFF_ALLMULTI
, "allmulti" },
3627 { IFF_MASTER
, "master" },
3630 { IFF_SLAVE
, "slave" },
3632 #ifdef IFF_MULTICAST
3633 { IFF_MULTICAST
, "multicast" },
3636 { IFF_PORTSEL
, "portsel" },
3638 #ifdef IFF_AUTOMEDIA
3639 { IFF_AUTOMEDIA
, "automedia" },
3642 { IFF_DYNAMIC
, "dynamic" },
3645 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3648 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3651 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3654 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3657 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3662 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3663 doc
: /* Return information about network interface named IFNAME.
3664 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3665 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3666 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3667 FLAGS is the current flags of the interface. */)
3672 Lisp_Object res
= Qnil
;
3677 CHECK_STRING (ifname
);
3679 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3680 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3682 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3687 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3688 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3690 int flags
= rq
.ifr_flags
;
3691 struct ifflag_def
*fp
;
3695 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3697 if (flags
& fp
->flag_bit
)
3699 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3700 flags
-= fp
->flag_bit
;
3703 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3705 if (flags
& (1 << fnum
))
3707 elt
= Fcons (make_number (fnum
), elt
);
3712 res
= Fcons (elt
, res
);
3715 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3716 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3718 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3719 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3723 for (n
= 0; n
< 6; n
++)
3724 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3725 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3728 res
= Fcons (elt
, res
);
3731 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3732 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3735 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3736 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3738 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3742 res
= Fcons (elt
, res
);
3745 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3746 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3749 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3752 res
= Fcons (elt
, res
);
3755 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3756 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3759 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3762 res
= Fcons (elt
, res
);
3766 return any
? res
: Qnil
;
3769 #endif /* HAVE_SOCKETS */
3771 /* Turn off input and output for process PROC. */
3774 deactivate_process (proc
)
3777 register int inchannel
, outchannel
;
3778 register struct Lisp_Process
*p
= XPROCESS (proc
);
3780 inchannel
= XINT (p
->infd
);
3781 outchannel
= XINT (p
->outfd
);
3783 #ifdef ADAPTIVE_READ_BUFFERING
3784 if (XINT (p
->read_output_delay
) > 0)
3786 if (--process_output_delay_count
< 0)
3787 process_output_delay_count
= 0;
3788 XSETINT (p
->read_output_delay
, 0);
3789 p
->read_output_skip
= Qnil
;
3795 /* Beware SIGCHLD hereabouts. */
3796 flush_pending_output (inchannel
);
3799 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3800 sys$
dassgn (outchannel
);
3801 vs
= get_vms_process_pointer (p
->pid
);
3803 give_back_vms_process_stuff (vs
);
3806 emacs_close (inchannel
);
3807 if (outchannel
>= 0 && outchannel
!= inchannel
)
3808 emacs_close (outchannel
);
3811 XSETINT (p
->infd
, -1);
3812 XSETINT (p
->outfd
, -1);
3813 #ifdef DATAGRAM_SOCKETS
3814 if (DATAGRAM_CHAN_P (inchannel
))
3816 xfree (datagram_address
[inchannel
].sa
);
3817 datagram_address
[inchannel
].sa
= 0;
3818 datagram_address
[inchannel
].len
= 0;
3821 chan_process
[inchannel
] = Qnil
;
3822 FD_CLR (inchannel
, &input_wait_mask
);
3823 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3824 #ifdef NON_BLOCKING_CONNECT
3825 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3827 FD_CLR (inchannel
, &connect_wait_mask
);
3828 if (--num_pending_connects
< 0)
3832 if (inchannel
== max_process_desc
)
3835 /* We just closed the highest-numbered process input descriptor,
3836 so recompute the highest-numbered one now. */
3837 max_process_desc
= 0;
3838 for (i
= 0; i
< MAXDESC
; i
++)
3839 if (!NILP (chan_process
[i
]))
3840 max_process_desc
= i
;
3845 /* Close all descriptors currently in use for communication
3846 with subprocess. This is used in a newly-forked subprocess
3847 to get rid of irrelevant descriptors. */
3850 close_process_descs ()
3854 for (i
= 0; i
< MAXDESC
; i
++)
3856 Lisp_Object process
;
3857 process
= chan_process
[i
];
3858 if (!NILP (process
))
3860 int in
= XINT (XPROCESS (process
)->infd
);
3861 int out
= XINT (XPROCESS (process
)->outfd
);
3864 if (out
>= 0 && in
!= out
)
3871 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3873 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3874 It is read into the process' buffers or given to their filter functions.
3875 Non-nil arg PROCESS means do not return until some output has been received
3878 Non-nil second arg SECONDS and third arg MILLISEC are number of
3879 seconds and milliseconds to wait; return after that much time whether
3880 or not there is input. If SECONDS is a floating point number,
3881 it specifies a fractional number of seconds to wait.
3883 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3884 from PROCESS, suspending reading output from other processes.
3885 If JUST-THIS-ONE is an integer, don't run any timers either.
3886 Return non-nil iff we received any output before the timeout expired. */)
3887 (process
, seconds
, millisec
, just_this_one
)
3888 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3890 int secs
, usecs
= 0;
3892 if (! NILP (process
))
3893 CHECK_PROCESS (process
);
3895 just_this_one
= Qnil
;
3897 if (!NILP (seconds
))
3899 if (INTEGERP (seconds
))
3900 secs
= XINT (seconds
);
3901 else if (FLOATP (seconds
))
3903 double timeout
= XFLOAT_DATA (seconds
);
3904 secs
= (int) timeout
;
3905 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3908 wrong_type_argument (Qnumberp
, seconds
);
3910 if (INTEGERP (millisec
))
3913 usecs
+= XINT (millisec
) * 1000;
3914 carry
= usecs
/ 1000000;
3916 if ((usecs
-= carry
* 1000000) < 0)
3923 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3924 secs
= -1, usecs
= 0;
3927 secs
= NILP (process
) ? -1 : 0;
3930 (wait_reading_process_output (secs
, usecs
, 0, 0,
3932 !NILP (process
) ? XPROCESS (process
) : NULL
,
3933 NILP (just_this_one
) ? 0 :
3934 !INTEGERP (just_this_one
) ? 1 : -1)
3938 /* Accept a connection for server process SERVER on CHANNEL. */
3940 static int connect_counter
= 0;
3943 server_accept_connection (server
, channel
)
3947 Lisp_Object proc
, caller
, name
, buffer
;
3948 Lisp_Object contact
, host
, service
;
3949 struct Lisp_Process
*ps
= XPROCESS (server
);
3950 struct Lisp_Process
*p
;
3954 struct sockaddr_in in
;
3956 struct sockaddr_in6 in6
;
3958 #ifdef HAVE_LOCAL_SOCKETS
3959 struct sockaddr_un un
;
3962 int len
= sizeof saddr
;
3964 s
= accept (channel
, &saddr
.sa
, &len
);
3973 if (code
== EWOULDBLOCK
)
3977 if (!NILP (ps
->log
))
3978 call3 (ps
->log
, server
, Qnil
,
3979 concat3 (build_string ("accept failed with code"),
3980 Fnumber_to_string (make_number (code
)),
3981 build_string ("\n")));
3987 /* Setup a new process to handle the connection. */
3989 /* Generate a unique identification of the caller, and build contact
3990 information for this process. */
3993 switch (saddr
.sa
.sa_family
)
3997 Lisp_Object args
[5];
3998 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3999 args
[0] = build_string ("%d.%d.%d.%d");
4000 args
[1] = make_number (*ip
++);
4001 args
[2] = make_number (*ip
++);
4002 args
[3] = make_number (*ip
++);
4003 args
[4] = make_number (*ip
++);
4004 host
= Fformat (5, args
);
4005 service
= make_number (ntohs (saddr
.in
.sin_port
));
4007 args
[0] = build_string (" <%s:%d>");
4010 caller
= Fformat (3, args
);
4017 Lisp_Object args
[9];
4018 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4020 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4021 for (i
= 0; i
< 8; i
++)
4022 args
[i
+1] = make_number (ntohs(ip6
[i
]));
4023 host
= Fformat (9, args
);
4024 service
= make_number (ntohs (saddr
.in
.sin_port
));
4026 args
[0] = build_string (" <[%s]:%d>");
4029 caller
= Fformat (3, args
);
4034 #ifdef HAVE_LOCAL_SOCKETS
4038 caller
= Fnumber_to_string (make_number (connect_counter
));
4039 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4043 /* Create a new buffer name for this process if it doesn't have a
4044 filter. The new buffer name is based on the buffer name or
4045 process name of the server process concatenated with the caller
4048 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4052 buffer
= ps
->buffer
;
4054 buffer
= Fbuffer_name (buffer
);
4059 buffer
= concat2 (buffer
, caller
);
4060 buffer
= Fget_buffer_create (buffer
);
4064 /* Generate a unique name for the new server process. Combine the
4065 server process name with the caller identification. */
4067 name
= concat2 (ps
->name
, caller
);
4068 proc
= make_process (name
);
4070 chan_process
[s
] = proc
;
4073 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4076 fcntl (s
, F_SETFL
, O_NDELAY
);
4080 p
= XPROCESS (proc
);
4082 /* Build new contact information for this setup. */
4083 contact
= Fcopy_sequence (ps
->childp
);
4084 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4085 contact
= Fplist_put (contact
, QChost
, host
);
4086 if (!NILP (service
))
4087 contact
= Fplist_put (contact
, QCservice
, service
);
4088 contact
= Fplist_put (contact
, QCremote
,
4089 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4090 #ifdef HAVE_GETSOCKNAME
4092 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4093 contact
= Fplist_put (contact
, QClocal
,
4094 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4097 p
->childp
= contact
;
4098 p
->plist
= Fcopy_sequence (ps
->plist
);
4101 p
->sentinel
= ps
->sentinel
;
4102 p
->filter
= ps
->filter
;
4105 XSETINT (p
->infd
, s
);
4106 XSETINT (p
->outfd
, s
);
4109 /* Client processes for accepted connections are not stopped initially. */
4110 if (!EQ (p
->filter
, Qt
))
4112 FD_SET (s
, &input_wait_mask
);
4113 FD_SET (s
, &non_keyboard_wait_mask
);
4116 if (s
> max_process_desc
)
4117 max_process_desc
= s
;
4119 /* Setup coding system for new process based on server process.
4120 This seems to be the proper thing to do, as the coding system
4121 of the new process should reflect the settings at the time the
4122 server socket was opened; not the current settings. */
4124 p
->decode_coding_system
= ps
->decode_coding_system
;
4125 p
->encode_coding_system
= ps
->encode_coding_system
;
4126 setup_process_coding_systems (proc
);
4128 p
->decoding_buf
= make_uninit_string (0);
4129 p
->decoding_carryover
= make_number (0);
4130 p
->encoding_buf
= make_uninit_string (0);
4131 p
->encoding_carryover
= make_number (0);
4133 p
->inherit_coding_system_flag
4134 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4136 if (!NILP (ps
->log
))
4137 call3 (ps
->log
, server
, proc
,
4138 concat3 (build_string ("accept from "),
4139 (STRINGP (host
) ? host
: build_string ("-")),
4140 build_string ("\n")));
4142 if (!NILP (p
->sentinel
))
4143 exec_sentinel (proc
,
4144 concat3 (build_string ("open from "),
4145 (STRINGP (host
) ? host
: build_string ("-")),
4146 build_string ("\n")));
4149 /* This variable is different from waiting_for_input in keyboard.c.
4150 It is used to communicate to a lisp process-filter/sentinel (via the
4151 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4152 for user-input when that process-filter was called.
4153 waiting_for_input cannot be used as that is by definition 0 when
4154 lisp code is being evalled.
4155 This is also used in record_asynch_buffer_change.
4156 For that purpose, this must be 0
4157 when not inside wait_reading_process_output. */
4158 static int waiting_for_user_input_p
;
4160 /* This is here so breakpoints can be put on it. */
4162 wait_reading_process_output_1 ()
4166 /* Use a wrapper around select to work around a bug in gdb 5.3.
4167 Normally, the wrapper is optimzed away by inlining.
4169 If emacs is stopped inside select, the gdb backtrace doesn't
4170 show the function which called select, so it is practically
4171 impossible to step through wait_reading_process_output. */
4175 select_wrapper (n
, rfd
, wfd
, xfd
, tmo
)
4177 SELECT_TYPE
*rfd
, *wfd
, *xfd
;
4180 return select (n
, rfd
, wfd
, xfd
, tmo
);
4182 #define select select_wrapper
4185 /* Read and dispose of subprocess output while waiting for timeout to
4186 elapse and/or keyboard input to be available.
4189 timeout in seconds, or
4190 zero for no limit, or
4191 -1 means gobble data immediately available but don't wait for any.
4194 an additional duration to wait, measured in microseconds.
4195 If this is nonzero and time_limit is 0, then the timeout
4196 consists of MICROSECS only.
4198 READ_KBD is a lisp value:
4199 0 to ignore keyboard input, or
4200 1 to return when input is available, or
4201 -1 meaning caller will actually read the input, so don't throw to
4202 the quit handler, or
4204 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4205 output that arrives.
4207 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4208 (and gobble terminal input into the buffer if any arrives).
4210 If WAIT_PROC is specified, wait until something arrives from that
4211 process. The return value is true iff we read some input from
4214 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4215 (suspending output from other processes). A negative value
4216 means don't run any timers either.
4218 If WAIT_PROC is specified, then the function returns true iff we
4219 received input from that process before the timeout elapsed.
4220 Otherwise, return true iff we received input from any process. */
4223 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4224 wait_for_cell
, wait_proc
, just_wait_proc
)
4225 int time_limit
, microsecs
, read_kbd
, do_display
;
4226 Lisp_Object wait_for_cell
;
4227 struct Lisp_Process
*wait_proc
;
4230 register int channel
, nfds
;
4231 SELECT_TYPE Available
;
4232 #ifdef NON_BLOCKING_CONNECT
4233 SELECT_TYPE Connecting
;
4236 int check_delay
, no_avail
;
4239 EMACS_TIME timeout
, end_time
;
4240 int wait_channel
= -1;
4241 int got_some_input
= 0;
4242 /* Either nil or a cons cell, the car of which is of interest and
4243 may be changed outside of this routine. */
4244 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4246 FD_ZERO (&Available
);
4247 #ifdef NON_BLOCKING_CONNECT
4248 FD_ZERO (&Connecting
);
4251 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4252 if (wait_proc
!= NULL
)
4253 wait_channel
= XINT (wait_proc
->infd
);
4255 waiting_for_user_input_p
= read_kbd
;
4257 /* Since we may need to wait several times,
4258 compute the absolute time to return at. */
4259 if (time_limit
|| microsecs
)
4261 EMACS_GET_TIME (end_time
);
4262 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4263 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4265 #ifdef POLL_INTERRUPTED_SYS_CALL
4266 /* AlainF 5-Jul-1996
4267 HP-UX 10.10 seem to have problems with signals coming in
4268 Causes "poll: interrupted system call" messages when Emacs is run
4270 Turn off periodic alarms (in case they are in use),
4271 and then turn off any other atimers. */
4273 turn_on_atimers (0);
4274 #endif /* POLL_INTERRUPTED_SYS_CALL */
4278 int timeout_reduced_for_timers
= 0;
4280 /* If calling from keyboard input, do not quit
4281 since we want to return C-g as an input character.
4282 Otherwise, do pending quit if requested. */
4286 else if (interrupt_input_pending
)
4287 handle_async_input ();
4290 /* Exit now if the cell we're waiting for became non-nil. */
4291 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4294 /* Compute time from now till when time limit is up */
4295 /* Exit if already run out */
4296 if (time_limit
== -1)
4298 /* -1 specified for timeout means
4299 gobble output available now
4300 but don't wait at all. */
4302 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4304 else if (time_limit
|| microsecs
)
4306 EMACS_GET_TIME (timeout
);
4307 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4308 if (EMACS_TIME_NEG_P (timeout
))
4313 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4316 /* Normally we run timers here.
4317 But not if wait_for_cell; in those cases,
4318 the wait is supposed to be short,
4319 and those callers cannot handle running arbitrary Lisp code here. */
4320 if (NILP (wait_for_cell
)
4321 && just_wait_proc
>= 0)
4323 EMACS_TIME timer_delay
;
4327 int old_timers_run
= timers_run
;
4328 struct buffer
*old_buffer
= current_buffer
;
4330 timer_delay
= timer_check (1);
4332 /* If a timer has run, this might have changed buffers
4333 an alike. Make read_key_sequence aware of that. */
4334 if (timers_run
!= old_timers_run
4335 && old_buffer
!= current_buffer
4336 && waiting_for_user_input_p
== -1)
4337 record_asynch_buffer_change ();
4339 if (timers_run
!= old_timers_run
&& do_display
)
4340 /* We must retry, since a timer may have requeued itself
4341 and that could alter the time_delay. */
4342 redisplay_preserve_echo_area (9);
4346 while (!detect_input_pending ());
4348 /* If there is unread keyboard input, also return. */
4350 && requeued_events_pending_p ())
4353 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4355 EMACS_TIME difference
;
4356 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4357 if (EMACS_TIME_NEG_P (difference
))
4359 timeout
= timer_delay
;
4360 timeout_reduced_for_timers
= 1;
4363 /* If time_limit is -1, we are not going to wait at all. */
4364 else if (time_limit
!= -1)
4366 /* This is so a breakpoint can be put here. */
4367 wait_reading_process_output_1 ();
4371 /* Cause C-g and alarm signals to take immediate action,
4372 and cause input available signals to zero out timeout.
4374 It is important that we do this before checking for process
4375 activity. If we get a SIGCHLD after the explicit checks for
4376 process activity, timeout is the only way we will know. */
4378 set_waiting_for_input (&timeout
);
4380 /* If status of something has changed, and no input is
4381 available, notify the user of the change right away. After
4382 this explicit check, we'll let the SIGCHLD handler zap
4383 timeout to get our attention. */
4384 if (update_tick
!= process_tick
&& do_display
)
4387 #ifdef NON_BLOCKING_CONNECT
4391 Atemp
= input_wait_mask
;
4393 /* On Mac OS X 10.0, the SELECT system call always says input is
4394 present (for reading) at stdin, even when none is. This
4395 causes the call to SELECT below to return 1 and
4396 status_notify not to be called. As a result output of
4397 subprocesses are incorrectly discarded.
4401 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4403 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4404 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4406 #ifdef NON_BLOCKING_CONNECT
4407 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4411 (SELECT_TYPE
*)0, &timeout
)
4414 /* It's okay for us to do this and then continue with
4415 the loop, since timeout has already been zeroed out. */
4416 clear_waiting_for_input ();
4417 status_notify (NULL
);
4421 /* Don't wait for output from a non-running process. Just
4422 read whatever data has already been received. */
4423 if (wait_proc
&& wait_proc
->raw_status_new
)
4424 update_status (wait_proc
);
4426 && ! EQ (wait_proc
->status
, Qrun
)
4427 && ! EQ (wait_proc
->status
, Qconnect
))
4429 int nread
, total_nread
= 0;
4431 clear_waiting_for_input ();
4432 XSETPROCESS (proc
, wait_proc
);
4434 /* Read data from the process, until we exhaust it. */
4435 while (XINT (wait_proc
->infd
) >= 0)
4437 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4443 total_nread
+= nread
;
4445 else if (nread
== -1 && EIO
== errno
)
4449 else if (nread
== -1 && EAGAIN
== errno
)
4453 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4457 if (total_nread
> 0 && do_display
)
4458 redisplay_preserve_echo_area (10);
4463 /* Wait till there is something to do */
4465 if (wait_proc
&& just_wait_proc
)
4467 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4469 FD_SET (XINT (wait_proc
->infd
), &Available
);
4471 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4473 else if (!NILP (wait_for_cell
))
4475 Available
= non_process_wait_mask
;
4477 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4482 Available
= non_keyboard_wait_mask
;
4484 Available
= input_wait_mask
;
4485 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4486 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4489 /* If frame size has changed or the window is newly mapped,
4490 redisplay now, before we start to wait. There is a race
4491 condition here; if a SIGIO arrives between now and the select
4492 and indicates that a frame is trashed, the select may block
4493 displaying a trashed screen. */
4494 if (frame_garbaged
&& do_display
)
4496 clear_waiting_for_input ();
4497 redisplay_preserve_echo_area (11);
4499 set_waiting_for_input (&timeout
);
4503 if (read_kbd
&& detect_input_pending ())
4510 #ifdef NON_BLOCKING_CONNECT
4512 Connecting
= connect_wait_mask
;
4515 #ifdef ADAPTIVE_READ_BUFFERING
4516 /* Set the timeout for adaptive read buffering if any
4517 process has non-nil read_output_skip and non-zero
4518 read_output_delay, and we are not reading output for a
4519 specific wait_channel. It is not executed if
4520 Vprocess_adaptive_read_buffering is nil. */
4521 if (process_output_skip
&& check_delay
> 0)
4523 int usecs
= EMACS_USECS (timeout
);
4524 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4525 usecs
= READ_OUTPUT_DELAY_MAX
;
4526 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4528 proc
= chan_process
[channel
];
4531 /* Find minimum non-zero read_output_delay among the
4532 processes with non-nil read_output_skip. */
4533 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4536 if (NILP (XPROCESS (proc
)->read_output_skip
))
4538 FD_CLR (channel
, &Available
);
4539 XPROCESS (proc
)->read_output_skip
= Qnil
;
4540 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4541 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4544 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4545 process_output_skip
= 0;
4549 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4551 #ifdef NON_BLOCKING_CONNECT
4552 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4556 (SELECT_TYPE
*)0, &timeout
);
4561 /* Make C-g and alarm signals set flags again */
4562 clear_waiting_for_input ();
4564 /* If we woke up due to SIGWINCH, actually change size now. */
4565 do_pending_window_change (0);
4567 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4568 /* We wanted the full specified time, so return now. */
4572 if (xerrno
== EINTR
)
4575 /* Ultrix select seems to return ENOMEM when it is
4576 interrupted. Treat it just like EINTR. Bleah. Note
4577 that we want to test for the "ultrix" CPP symbol, not
4578 "__ultrix__"; the latter is only defined under GCC, but
4579 not by DEC's bundled CC. -JimB */
4580 else if (xerrno
== ENOMEM
)
4584 /* This happens for no known reason on ALLIANT.
4585 I am guessing that this is the right response. -- RMS. */
4586 else if (xerrno
== EFAULT
)
4589 else if (xerrno
== EBADF
)
4592 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4593 the child's closure of the pts gives the parent a SIGHUP, and
4594 the ptc file descriptor is automatically closed,
4595 yielding EBADF here or at select() call above.
4596 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4597 in m/ibmrt-aix.h), and here we just ignore the select error.
4598 Cleanup occurs c/o status_notify after SIGCLD. */
4599 no_avail
= 1; /* Cannot depend on values returned */
4605 error ("select error: %s", emacs_strerror (xerrno
));
4610 FD_ZERO (&Available
);
4611 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4614 #if defined(sun) && !defined(USG5_4)
4615 if (nfds
> 0 && keyboard_bit_set (&Available
)
4617 /* System sometimes fails to deliver SIGIO.
4619 David J. Mackenzie says that Emacs doesn't compile under
4620 Solaris if this code is enabled, thus the USG5_4 in the CPP
4621 conditional. "I haven't noticed any ill effects so far.
4622 If you find a Solaris expert somewhere, they might know
4624 kill (getpid (), SIGIO
);
4627 #if 0 /* When polling is used, interrupt_input is 0,
4628 so get_input_pending should read the input.
4629 So this should not be needed. */
4630 /* If we are using polling for input,
4631 and we see input available, make it get read now.
4632 Otherwise it might not actually get read for a second.
4633 And on hpux, since we turn off polling in wait_reading_process_output,
4634 it might never get read at all if we don't spend much time
4635 outside of wait_reading_process_output. */
4636 if (read_kbd
&& interrupt_input
4637 && keyboard_bit_set (&Available
)
4638 && input_polling_used ())
4639 kill (getpid (), SIGALRM
);
4642 /* Check for keyboard input */
4643 /* If there is any, return immediately
4644 to give it higher priority than subprocesses */
4648 int old_timers_run
= timers_run
;
4649 struct buffer
*old_buffer
= current_buffer
;
4652 if (detect_input_pending_run_timers (do_display
))
4654 swallow_events (do_display
);
4655 if (detect_input_pending_run_timers (do_display
))
4659 /* If a timer has run, this might have changed buffers
4660 an alike. Make read_key_sequence aware of that. */
4661 if (timers_run
!= old_timers_run
4662 && waiting_for_user_input_p
== -1
4663 && old_buffer
!= current_buffer
)
4664 record_asynch_buffer_change ();
4670 /* If there is unread keyboard input, also return. */
4672 && requeued_events_pending_p ())
4675 /* If we are not checking for keyboard input now,
4676 do process events (but don't run any timers).
4677 This is so that X events will be processed.
4678 Otherwise they may have to wait until polling takes place.
4679 That would causes delays in pasting selections, for example.
4681 (We used to do this only if wait_for_cell.) */
4682 if (read_kbd
== 0 && detect_input_pending ())
4684 swallow_events (do_display
);
4685 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4686 if (detect_input_pending ())
4691 /* Exit now if the cell we're waiting for became non-nil. */
4692 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4696 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4697 go read it. This can happen with X on BSD after logging out.
4698 In that case, there really is no input and no SIGIO,
4699 but select says there is input. */
4701 if (read_kbd
&& interrupt_input
4702 && keyboard_bit_set (&Available
) && ! noninteractive
)
4703 kill (getpid (), SIGIO
);
4707 got_some_input
|= nfds
> 0;
4709 /* If checking input just got us a size-change event from X,
4710 obey it now if we should. */
4711 if (read_kbd
|| ! NILP (wait_for_cell
))
4712 do_pending_window_change (0);
4714 /* Check for data from a process. */
4715 if (no_avail
|| nfds
== 0)
4718 /* Really FIRST_PROC_DESC should be 0 on Unix,
4719 but this is safer in the short run. */
4720 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4722 if (FD_ISSET (channel
, &Available
)
4723 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4727 /* If waiting for this channel, arrange to return as
4728 soon as no more input to be processed. No more
4730 if (wait_channel
== channel
)
4736 proc
= chan_process
[channel
];
4740 /* If this is a server stream socket, accept connection. */
4741 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4743 server_accept_connection (proc
, channel
);
4747 /* Read data from the process, starting with our
4748 buffered-ahead character if we have one. */
4750 nread
= read_process_output (proc
, channel
);
4753 /* Since read_process_output can run a filter,
4754 which can call accept-process-output,
4755 don't try to read from any other processes
4756 before doing the select again. */
4757 FD_ZERO (&Available
);
4760 redisplay_preserve_echo_area (12);
4763 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4766 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4767 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4769 else if (nread
== -1 && errno
== EAGAIN
)
4773 else if (nread
== -1 && errno
== EAGAIN
)
4775 /* Note that we cannot distinguish between no input
4776 available now and a closed pipe.
4777 With luck, a closed pipe will be accompanied by
4778 subprocess termination and SIGCHLD. */
4779 else if (nread
== 0 && !NETCONN_P (proc
))
4781 #endif /* O_NDELAY */
4782 #endif /* O_NONBLOCK */
4784 /* On some OSs with ptys, when the process on one end of
4785 a pty exits, the other end gets an error reading with
4786 errno = EIO instead of getting an EOF (0 bytes read).
4787 Therefore, if we get an error reading and errno =
4788 EIO, just continue, because the child process has
4789 exited and should clean itself up soon (e.g. when we
4792 However, it has been known to happen that the SIGCHLD
4793 got lost. So raise the signl again just in case.
4795 else if (nread
== -1 && errno
== EIO
)
4796 kill (getpid (), SIGCHLD
);
4797 #endif /* HAVE_PTYS */
4798 /* If we can detect process termination, don't consider the process
4799 gone just because its pipe is closed. */
4801 else if (nread
== 0 && !NETCONN_P (proc
))
4806 /* Preserve status of processes already terminated. */
4807 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4808 deactivate_process (proc
);
4809 if (XPROCESS (proc
)->raw_status_new
)
4810 update_status (XPROCESS (proc
));
4811 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4812 XPROCESS (proc
)->status
4813 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4816 #ifdef NON_BLOCKING_CONNECT
4817 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4818 && FD_ISSET (channel
, &connect_wait_mask
))
4820 struct Lisp_Process
*p
;
4822 FD_CLR (channel
, &connect_wait_mask
);
4823 if (--num_pending_connects
< 0)
4826 proc
= chan_process
[channel
];
4830 p
= XPROCESS (proc
);
4833 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4834 So only use it on systems where it is known to work. */
4836 int xlen
= sizeof(xerrno
);
4837 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4842 struct sockaddr pname
;
4843 int pnamelen
= sizeof(pname
);
4845 /* If connection failed, getpeername will fail. */
4847 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4849 /* Obtain connect failure code through error slippage. */
4852 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4859 XSETINT (p
->tick
, ++process_tick
);
4860 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4861 deactivate_process (proc
);
4866 /* Execute the sentinel here. If we had relied on
4867 status_notify to do it later, it will read input
4868 from the process before calling the sentinel. */
4869 exec_sentinel (proc
, build_string ("open\n"));
4870 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4872 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4873 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4877 #endif /* NON_BLOCKING_CONNECT */
4878 } /* end for each file descriptor */
4879 } /* end while exit conditions not met */
4881 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4883 /* If calling from keyboard input, do not quit
4884 since we want to return C-g as an input character.
4885 Otherwise, do pending quit if requested. */
4888 /* Prevent input_pending from remaining set if we quit. */
4889 clear_input_pending ();
4892 #ifdef POLL_INTERRUPTED_SYS_CALL
4893 /* AlainF 5-Jul-1996
4894 HP-UX 10.10 seems to have problems with signals coming in
4895 Causes "poll: interrupted system call" messages when Emacs is run
4897 Turn periodic alarms back on */
4899 #endif /* POLL_INTERRUPTED_SYS_CALL */
4901 return got_some_input
;
4904 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4907 read_process_output_call (fun_and_args
)
4908 Lisp_Object fun_and_args
;
4910 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4914 read_process_output_error_handler (error
)
4917 cmd_error_internal (error
, "error in process filter: ");
4919 update_echo_area ();
4920 Fsleep_for (make_number (2), Qnil
);
4924 /* Read pending output from the process channel,
4925 starting with our buffered-ahead character if we have one.
4926 Yield number of decoded characters read.
4928 This function reads at most 4096 characters.
4929 If you want to read all available subprocess output,
4930 you must call it repeatedly until it returns zero.
4932 The characters read are decoded according to PROC's coding-system
4936 read_process_output (proc
, channel
)
4938 register int channel
;
4940 register int nbytes
;
4942 register Lisp_Object outstream
;
4943 register struct buffer
*old
= current_buffer
;
4944 register struct Lisp_Process
*p
= XPROCESS (proc
);
4945 register int opoint
;
4946 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4947 int carryover
= XINT (p
->decoding_carryover
);
4951 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4953 vs
= get_vms_process_pointer (p
->pid
);
4957 return (0); /* Really weird if it does this */
4958 if (!(vs
->iosb
[0] & 1))
4959 return -1; /* I/O error */
4962 error ("Could not get VMS process pointer");
4963 chars
= vs
->inputBuffer
;
4964 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4967 start_vms_process_read (vs
); /* Crank up the next read on the process */
4968 return 1; /* Nothing worth printing, say we got 1 */
4972 /* The data carried over in the previous decoding (which are at
4973 the tail of decoding buffer) should be prepended to the new
4974 data read to decode all together. */
4975 chars
= (char *) alloca (nbytes
+ carryover
);
4976 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4977 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4981 chars
= (char *) alloca (carryover
+ readmax
);
4983 /* See the comment above. */
4984 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4986 #ifdef DATAGRAM_SOCKETS
4987 /* We have a working select, so proc_buffered_char is always -1. */
4988 if (DATAGRAM_CHAN_P (channel
))
4990 int len
= datagram_address
[channel
].len
;
4991 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4992 0, datagram_address
[channel
].sa
, &len
);
4996 if (proc_buffered_char
[channel
] < 0)
4998 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
4999 #ifdef ADAPTIVE_READ_BUFFERING
5000 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
5002 int delay
= XINT (p
->read_output_delay
);
5005 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5008 process_output_delay_count
++;
5009 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5012 else if (delay
> 0 && (nbytes
== readmax
))
5014 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5016 process_output_delay_count
--;
5018 XSETINT (p
->read_output_delay
, delay
);
5021 p
->read_output_skip
= Qt
;
5022 process_output_skip
= 1;
5029 chars
[carryover
] = proc_buffered_char
[channel
];
5030 proc_buffered_char
[channel
] = -1;
5031 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5035 nbytes
= nbytes
+ 1;
5037 #endif /* not VMS */
5039 XSETINT (p
->decoding_carryover
, 0);
5041 /* At this point, NBYTES holds number of bytes just received
5042 (including the one in proc_buffered_char[channel]). */
5045 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5047 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5050 /* Now set NBYTES how many bytes we must decode. */
5051 nbytes
+= carryover
;
5053 /* Read and dispose of the process output. */
5054 outstream
= p
->filter
;
5055 if (!NILP (outstream
))
5057 /* We inhibit quit here instead of just catching it so that
5058 hitting ^G when a filter happens to be running won't screw
5060 int count
= SPECPDL_INDEX ();
5061 Lisp_Object odeactivate
;
5062 Lisp_Object obuffer
, okeymap
;
5064 int outer_running_asynch_code
= running_asynch_code
;
5065 int waiting
= waiting_for_user_input_p
;
5067 /* No need to gcpro these, because all we do with them later
5068 is test them for EQness, and none of them should be a string. */
5069 odeactivate
= Vdeactivate_mark
;
5070 XSETBUFFER (obuffer
, current_buffer
);
5071 okeymap
= current_buffer
->keymap
;
5073 specbind (Qinhibit_quit
, Qt
);
5074 specbind (Qlast_nonmenu_event
, Qt
);
5076 /* In case we get recursively called,
5077 and we already saved the match data nonrecursively,
5078 save the same match data in safely recursive fashion. */
5079 if (outer_running_asynch_code
)
5082 /* Don't clobber the CURRENT match data, either! */
5083 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5084 restore_search_regs ();
5085 record_unwind_save_match_data ();
5086 Fset_match_data (tem
, Qt
);
5089 /* For speed, if a search happens within this code,
5090 save the match data in a special nonrecursive fashion. */
5091 running_asynch_code
= 1;
5093 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5094 text
= coding
->dst_object
;
5095 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5096 /* A new coding system might be found. */
5097 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5099 p
->decode_coding_system
= Vlast_coding_system_used
;
5101 /* Don't call setup_coding_system for
5102 proc_decode_coding_system[channel] here. It is done in
5103 detect_coding called via decode_coding above. */
5105 /* If a coding system for encoding is not yet decided, we set
5106 it as the same as coding-system for decoding.
5108 But, before doing that we must check if
5109 proc_encode_coding_system[p->outfd] surely points to a
5110 valid memory because p->outfd will be changed once EOF is
5111 sent to the process. */
5112 if (NILP (p
->encode_coding_system
)
5113 && proc_encode_coding_system
[XINT (p
->outfd
)])
5115 p
->encode_coding_system
5116 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5117 setup_coding_system (p
->encode_coding_system
,
5118 proc_encode_coding_system
[XINT (p
->outfd
)]);
5122 if (coding
->carryover_bytes
> 0)
5124 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5125 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5126 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5127 coding
->carryover_bytes
);
5128 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
5130 /* Adjust the multibyteness of TEXT to that of the filter. */
5131 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5132 text
= (STRING_MULTIBYTE (text
)
5133 ? Fstring_as_unibyte (text
)
5134 : Fstring_to_multibyte (text
));
5135 if (SBYTES (text
) > 0)
5136 internal_condition_case_1 (read_process_output_call
,
5138 Fcons (proc
, Fcons (text
, Qnil
))),
5139 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5140 read_process_output_error_handler
);
5142 /* If we saved the match data nonrecursively, restore it now. */
5143 restore_search_regs ();
5144 running_asynch_code
= outer_running_asynch_code
;
5146 /* Handling the process output should not deactivate the mark. */
5147 Vdeactivate_mark
= odeactivate
;
5149 /* Restore waiting_for_user_input_p as it was
5150 when we were called, in case the filter clobbered it. */
5151 waiting_for_user_input_p
= waiting
;
5153 #if 0 /* Call record_asynch_buffer_change unconditionally,
5154 because we might have changed minor modes or other things
5155 that affect key bindings. */
5156 if (! EQ (Fcurrent_buffer (), obuffer
)
5157 || ! EQ (current_buffer
->keymap
, okeymap
))
5159 /* But do it only if the caller is actually going to read events.
5160 Otherwise there's no need to make him wake up, and it could
5161 cause trouble (for example it would make sit_for return). */
5162 if (waiting_for_user_input_p
== -1)
5163 record_asynch_buffer_change ();
5166 start_vms_process_read (vs
);
5168 unbind_to (count
, Qnil
);
5172 /* If no filter, write into buffer if it isn't dead. */
5173 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5175 Lisp_Object old_read_only
;
5176 int old_begv
, old_zv
;
5177 int old_begv_byte
, old_zv_byte
;
5178 Lisp_Object odeactivate
;
5179 int before
, before_byte
;
5184 odeactivate
= Vdeactivate_mark
;
5186 Fset_buffer (p
->buffer
);
5188 opoint_byte
= PT_BYTE
;
5189 old_read_only
= current_buffer
->read_only
;
5192 old_begv_byte
= BEGV_BYTE
;
5193 old_zv_byte
= ZV_BYTE
;
5195 current_buffer
->read_only
= Qnil
;
5197 /* Insert new output into buffer
5198 at the current end-of-output marker,
5199 thus preserving logical ordering of input and output. */
5200 if (XMARKER (p
->mark
)->buffer
)
5201 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5202 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5205 SET_PT_BOTH (ZV
, ZV_BYTE
);
5207 before_byte
= PT_BYTE
;
5209 /* If the output marker is outside of the visible region, save
5210 the restriction and widen. */
5211 if (! (BEGV
<= PT
&& PT
<= ZV
))
5214 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5215 text
= coding
->dst_object
;
5216 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5217 /* A new coding system might be found. See the comment in the
5218 similar code in the previous `if' block. */
5219 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5221 p
->decode_coding_system
= Vlast_coding_system_used
;
5222 if (NILP (p
->encode_coding_system
)
5223 && proc_encode_coding_system
[XINT (p
->outfd
)])
5225 p
->encode_coding_system
5226 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5227 setup_coding_system (p
->encode_coding_system
,
5228 proc_encode_coding_system
[XINT (p
->outfd
)]);
5231 if (coding
->carryover_bytes
> 0)
5233 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5234 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5235 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5236 coding
->carryover_bytes
);
5237 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
5239 /* Adjust the multibyteness of TEXT to that of the buffer. */
5240 if (NILP (current_buffer
->enable_multibyte_characters
)
5241 != ! STRING_MULTIBYTE (text
))
5242 text
= (STRING_MULTIBYTE (text
)
5243 ? Fstring_as_unibyte (text
)
5244 : Fstring_to_multibyte (text
));
5245 /* Insert before markers in case we are inserting where
5246 the buffer's mark is, and the user's next command is Meta-y. */
5247 insert_from_string_before_markers (text
, 0, 0,
5248 SCHARS (text
), SBYTES (text
), 0);
5250 /* Make sure the process marker's position is valid when the
5251 process buffer is changed in the signal_after_change above.
5252 W3 is known to do that. */
5253 if (BUFFERP (p
->buffer
)
5254 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5255 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5257 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5259 update_mode_lines
++;
5261 /* Make sure opoint and the old restrictions
5262 float ahead of any new text just as point would. */
5263 if (opoint
>= before
)
5265 opoint
+= PT
- before
;
5266 opoint_byte
+= PT_BYTE
- before_byte
;
5268 if (old_begv
> before
)
5270 old_begv
+= PT
- before
;
5271 old_begv_byte
+= PT_BYTE
- before_byte
;
5273 if (old_zv
>= before
)
5275 old_zv
+= PT
- before
;
5276 old_zv_byte
+= PT_BYTE
- before_byte
;
5279 /* If the restriction isn't what it should be, set it. */
5280 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5281 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5283 /* Handling the process output should not deactivate the mark. */
5284 Vdeactivate_mark
= odeactivate
;
5286 current_buffer
->read_only
= old_read_only
;
5287 SET_PT_BOTH (opoint
, opoint_byte
);
5288 set_buffer_internal (old
);
5291 start_vms_process_read (vs
);
5296 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5298 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5299 This is intended for use by asynchronous process output filters and sentinels. */)
5302 return (waiting_for_user_input_p
? Qt
: Qnil
);
5305 /* Sending data to subprocess */
5307 jmp_buf send_process_frame
;
5308 Lisp_Object process_sent_to
;
5311 send_process_trap ()
5313 SIGNAL_THREAD_CHECK (SIGPIPE
);
5318 sigunblock (sigmask (SIGPIPE
));
5319 longjmp (send_process_frame
, 1);
5322 /* Send some data to process PROC.
5323 BUF is the beginning of the data; LEN is the number of characters.
5324 OBJECT is the Lisp object that the data comes from. If OBJECT is
5325 nil or t, it means that the data comes from C string.
5327 If OBJECT is not nil, the data is encoded by PROC's coding-system
5328 for encoding before it is sent.
5330 This function can evaluate Lisp code and can garbage collect. */
5333 send_process (proc
, buf
, len
, object
)
5334 volatile Lisp_Object proc
;
5335 unsigned char *volatile buf
;
5337 volatile Lisp_Object object
;
5339 /* Use volatile to protect variables from being clobbered by longjmp. */
5340 struct Lisp_Process
*p
= XPROCESS (proc
);
5342 struct coding_system
*coding
;
5343 struct gcpro gcpro1
;
5344 SIGTYPE (*volatile old_sigpipe
) ();
5349 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5352 if (p
->raw_status_new
)
5354 if (! EQ (p
->status
, Qrun
))
5355 error ("Process %s not running", SDATA (p
->name
));
5356 if (XINT (p
->outfd
) < 0)
5357 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5359 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5360 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5362 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5363 || (BUFFERP (object
)
5364 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5367 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5368 /* The coding system for encoding was changed to raw-text
5369 because we sent a unibyte text previously. Now we are
5370 sending a multibyte text, thus we must encode it by the
5371 original coding system specified for the current process. */
5372 setup_coding_system (p
->encode_coding_system
, coding
);
5373 coding
->src_multibyte
= 1;
5377 /* For sending a unibyte text, character code conversion should
5378 not take place but EOL conversion should. So, setup raw-text
5379 or one of the subsidiary if we have not yet done it. */
5380 if (CODING_REQUIRE_ENCODING (coding
))
5382 if (CODING_REQUIRE_FLUSHING (coding
))
5384 /* But, before changing the coding, we must flush out data. */
5385 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5386 send_process (proc
, "", 0, Qt
);
5387 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5389 setup_coding_system (raw_text_coding_system
5390 (Vlast_coding_system_used
),
5392 coding
->src_multibyte
= 0;
5395 coding
->dst_multibyte
= 0;
5397 if (CODING_REQUIRE_ENCODING (coding
))
5399 coding
->dst_object
= Qt
;
5400 if (BUFFERP (object
))
5402 int from_byte
, from
, to
;
5403 int save_pt
, save_pt_byte
;
5404 struct buffer
*cur
= current_buffer
;
5406 set_buffer_internal (XBUFFER (object
));
5407 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5409 from_byte
= PTR_BYTE_POS (buf
);
5410 from
= BYTE_TO_CHAR (from_byte
);
5411 to
= BYTE_TO_CHAR (from_byte
+ len
);
5412 TEMP_SET_PT_BOTH (from
, from_byte
);
5413 encode_coding_object (coding
, object
, from
, from_byte
,
5414 to
, from_byte
+ len
, Qt
);
5415 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5416 set_buffer_internal (cur
);
5418 else if (STRINGP (object
))
5420 encode_coding_string (coding
, object
, 1);
5424 coding
->dst_object
= make_unibyte_string (buf
, len
);
5425 coding
->produced
= len
;
5428 len
= coding
->produced
;
5429 buf
= SDATA (coding
->dst_object
);
5433 vs
= get_vms_process_pointer (p
->pid
);
5435 error ("Could not find this process: %x", p
->pid
);
5436 else if (write_to_vms_process (vs
, buf
, len
))
5440 if (pty_max_bytes
== 0)
5442 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5443 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5444 if (pty_max_bytes
< 0)
5445 pty_max_bytes
= 250;
5447 pty_max_bytes
= 250;
5449 /* Deduct one, to leave space for the eof. */
5453 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5454 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5455 when returning with longjmp despite being declared volatile. */
5456 if (!setjmp (send_process_frame
))
5458 process_sent_to
= proc
;
5463 /* Decide how much data we can send in one batch.
5464 Long lines need to be split into multiple batches. */
5465 if (!NILP (p
->pty_flag
))
5467 /* Starting this at zero is always correct when not the first
5468 iteration because the previous iteration ended by sending C-d.
5469 It may not be correct for the first iteration
5470 if a partial line was sent in a separate send_process call.
5471 If that proves worth handling, we need to save linepos
5472 in the process object. */
5474 unsigned char *ptr
= (unsigned char *) buf
;
5475 unsigned char *end
= (unsigned char *) buf
+ len
;
5477 /* Scan through this text for a line that is too long. */
5478 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5486 /* If we found one, break the line there
5487 and put in a C-d to force the buffer through. */
5491 /* Send this batch, using one or more write calls. */
5494 int outfd
= XINT (p
->outfd
);
5495 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5496 #ifdef DATAGRAM_SOCKETS
5497 if (DATAGRAM_CHAN_P (outfd
))
5499 rv
= sendto (outfd
, (char *) buf
, this,
5500 0, datagram_address
[outfd
].sa
,
5501 datagram_address
[outfd
].len
);
5502 if (rv
< 0 && errno
== EMSGSIZE
)
5504 signal (SIGPIPE
, old_sigpipe
);
5505 report_file_error ("sending datagram",
5506 Fcons (proc
, Qnil
));
5512 rv
= emacs_write (outfd
, (char *) buf
, this);
5513 #ifdef ADAPTIVE_READ_BUFFERING
5514 if (XINT (p
->read_output_delay
) > 0
5515 && EQ (p
->adaptive_read_buffering
, Qt
))
5517 XSETFASTINT (p
->read_output_delay
, 0);
5518 process_output_delay_count
--;
5519 p
->read_output_skip
= Qnil
;
5523 signal (SIGPIPE
, old_sigpipe
);
5529 || errno
== EWOULDBLOCK
5535 /* Buffer is full. Wait, accepting input;
5536 that may allow the program
5537 to finish doing output and read more. */
5541 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5542 /* A gross hack to work around a bug in FreeBSD.
5543 In the following sequence, read(2) returns
5547 write(2) 954 bytes, get EAGAIN
5548 read(2) 1024 bytes in process_read_output
5549 read(2) 11 bytes in process_read_output
5551 That is, read(2) returns more bytes than have
5552 ever been written successfully. The 1033 bytes
5553 read are the 1022 bytes written successfully
5554 after processing (for example with CRs added if
5555 the terminal is set up that way which it is
5556 here). The same bytes will be seen again in a
5557 later read(2), without the CRs. */
5559 if (errno
== EAGAIN
)
5562 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5564 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5566 /* Running filters might relocate buffers or strings.
5567 Arrange to relocate BUF. */
5568 if (BUFFERP (object
))
5569 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5570 else if (STRINGP (object
))
5571 offset
= buf
- SDATA (object
);
5573 #ifdef EMACS_HAS_USECS
5574 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5576 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5579 if (BUFFERP (object
))
5580 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5581 else if (STRINGP (object
))
5582 buf
= offset
+ SDATA (object
);
5587 /* This is a real error. */
5588 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5595 /* If we sent just part of the string, put in an EOF
5596 to force it through, before we send the rest. */
5598 Fprocess_send_eof (proc
);
5601 #endif /* not VMS */
5604 signal (SIGPIPE
, old_sigpipe
);
5606 proc
= process_sent_to
;
5607 p
= XPROCESS (proc
);
5609 p
->raw_status_new
= 0;
5610 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5611 XSETINT (p
->tick
, ++process_tick
);
5612 deactivate_process (proc
);
5614 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5616 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5623 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5625 doc
: /* Send current contents of region as input to PROCESS.
5626 PROCESS may be a process, a buffer, the name of a process or buffer, or
5627 nil, indicating the current buffer's process.
5628 Called from program, takes three arguments, PROCESS, START and END.
5629 If the region is more than 500 characters long,
5630 it is sent in several bunches. This may happen even for shorter regions.
5631 Output from processes can arrive in between bunches. */)
5632 (process
, start
, end
)
5633 Lisp_Object process
, start
, end
;
5638 proc
= get_process (process
);
5639 validate_region (&start
, &end
);
5641 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5642 move_gap (XINT (start
));
5644 start1
= CHAR_TO_BYTE (XINT (start
));
5645 end1
= CHAR_TO_BYTE (XINT (end
));
5646 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5647 Fcurrent_buffer ());
5652 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5654 doc
: /* Send PROCESS the contents of STRING as input.
5655 PROCESS may be a process, a buffer, the name of a process or buffer, or
5656 nil, indicating the current buffer's process.
5657 If STRING is more than 500 characters long,
5658 it is sent in several bunches. This may happen even for shorter strings.
5659 Output from processes can arrive in between bunches. */)
5661 Lisp_Object process
, string
;
5664 CHECK_STRING (string
);
5665 proc
= get_process (process
);
5666 send_process (proc
, SDATA (string
),
5667 SBYTES (string
), string
);
5671 /* Return the foreground process group for the tty/pty that
5672 the process P uses. */
5674 emacs_get_tty_pgrp (p
)
5675 struct Lisp_Process
*p
;
5680 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5683 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5684 master side. Try the slave side. */
5685 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5689 ioctl (fd
, TIOCGPGRP
, &gid
);
5693 #endif /* defined (TIOCGPGRP ) */
5698 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5699 Sprocess_running_child_p
, 0, 1, 0,
5700 doc
: /* Return t if PROCESS has given the terminal to a child.
5701 If the operating system does not make it possible to find out,
5702 return t unconditionally. */)
5704 Lisp_Object process
;
5706 /* Initialize in case ioctl doesn't exist or gives an error,
5707 in a way that will cause returning t. */
5710 struct Lisp_Process
*p
;
5712 proc
= get_process (process
);
5713 p
= XPROCESS (proc
);
5715 if (!EQ (p
->childp
, Qt
))
5716 error ("Process %s is not a subprocess",
5718 if (XINT (p
->infd
) < 0)
5719 error ("Process %s is not active",
5722 gid
= emacs_get_tty_pgrp (p
);
5729 /* send a signal number SIGNO to PROCESS.
5730 If CURRENT_GROUP is t, that means send to the process group
5731 that currently owns the terminal being used to communicate with PROCESS.
5732 This is used for various commands in shell mode.
5733 If CURRENT_GROUP is lambda, that means send to the process group
5734 that currently owns the terminal, but only if it is NOT the shell itself.
5736 If NOMSG is zero, insert signal-announcements into process's buffers
5739 If we can, we try to signal PROCESS by sending control characters
5740 down the pty. This allows us to signal inferiors who have changed
5741 their uid, for which killpg would return an EPERM error. */
5744 process_send_signal (process
, signo
, current_group
, nomsg
)
5745 Lisp_Object process
;
5747 Lisp_Object current_group
;
5751 register struct Lisp_Process
*p
;
5755 proc
= get_process (process
);
5756 p
= XPROCESS (proc
);
5758 if (!EQ (p
->childp
, Qt
))
5759 error ("Process %s is not a subprocess",
5761 if (XINT (p
->infd
) < 0)
5762 error ("Process %s is not active",
5765 if (NILP (p
->pty_flag
))
5766 current_group
= Qnil
;
5768 /* If we are using pgrps, get a pgrp number and make it negative. */
5769 if (NILP (current_group
))
5770 /* Send the signal to the shell's process group. */
5774 #ifdef SIGNALS_VIA_CHARACTERS
5775 /* If possible, send signals to the entire pgrp
5776 by sending an input character to it. */
5778 /* TERMIOS is the latest and bestest, and seems most likely to
5779 work. If the system has it, use it. */
5782 cc_t
*sig_char
= NULL
;
5784 tcgetattr (XINT (p
->infd
), &t
);
5789 sig_char
= &t
.c_cc
[VINTR
];
5793 sig_char
= &t
.c_cc
[VQUIT
];
5797 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5798 sig_char
= &t
.c_cc
[VSWTCH
];
5800 sig_char
= &t
.c_cc
[VSUSP
];
5805 if (sig_char
&& *sig_char
!= CDISABLE
)
5807 send_process (proc
, sig_char
, 1, Qnil
);
5810 /* If we can't send the signal with a character,
5811 fall through and send it another way. */
5812 #else /* ! HAVE_TERMIOS */
5814 /* On Berkeley descendants, the following IOCTL's retrieve the
5815 current control characters. */
5816 #if defined (TIOCGLTC) && defined (TIOCGETC)
5824 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5825 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5828 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5829 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5833 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5834 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5836 #endif /* ! defined (SIGTSTP) */
5839 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5841 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5848 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5849 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5852 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5853 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5857 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5858 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5860 #endif /* ! defined (SIGTSTP) */
5862 #else /* ! defined (TCGETA) */
5863 Your configuration files are messed up
.
5864 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5865 you'd better be using one of the alternatives above! */
5866 #endif /* ! defined (TCGETA) */
5867 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5868 /* In this case, the code above should alway returns. */
5870 #endif /* ! defined HAVE_TERMIOS */
5872 /* The code above may fall through if it can't
5873 handle the signal. */
5874 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5877 /* Get the current pgrp using the tty itself, if we have that.
5878 Otherwise, use the pty to get the pgrp.
5879 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5880 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5881 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5882 His patch indicates that if TIOCGPGRP returns an error, then
5883 we should just assume that p->pid is also the process group id. */
5885 gid
= emacs_get_tty_pgrp (p
);
5888 /* If we can't get the information, assume
5889 the shell owns the tty. */
5892 /* It is not clear whether anything really can set GID to -1.
5893 Perhaps on some system one of those ioctls can or could do so.
5894 Or perhaps this is vestigial. */
5897 #else /* ! defined (TIOCGPGRP ) */
5898 /* Can't select pgrps on this system, so we know that
5899 the child itself heads the pgrp. */
5901 #endif /* ! defined (TIOCGPGRP ) */
5903 /* If current_group is lambda, and the shell owns the terminal,
5904 don't send any signal. */
5905 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5913 p
->raw_status_new
= 0;
5915 XSETINT (p
->tick
, ++process_tick
);
5917 status_notify (NULL
);
5919 #endif /* ! defined (SIGCONT) */
5922 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5927 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5932 sys$
forcex (&(p
->pid
), 0, 1);
5935 flush_pending_output (XINT (p
->infd
));
5939 /* If we don't have process groups, send the signal to the immediate
5940 subprocess. That isn't really right, but it's better than any
5941 obvious alternative. */
5944 kill (p
->pid
, signo
);
5948 /* gid may be a pid, or minus a pgrp's number */
5950 if (!NILP (current_group
))
5952 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5953 EMACS_KILLPG (gid
, signo
);
5960 #else /* ! defined (TIOCSIGSEND) */
5961 EMACS_KILLPG (gid
, signo
);
5962 #endif /* ! defined (TIOCSIGSEND) */
5965 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5966 doc
: /* Interrupt process PROCESS.
5967 PROCESS may be a process, a buffer, or the name of a process or buffer.
5968 No arg or nil means current buffer's process.
5969 Second arg CURRENT-GROUP non-nil means send signal to
5970 the current process-group of the process's controlling terminal
5971 rather than to the process's own process group.
5972 If the process is a shell, this means interrupt current subjob
5973 rather than the shell.
5975 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5976 don't send the signal. */)
5977 (process
, current_group
)
5978 Lisp_Object process
, current_group
;
5980 process_send_signal (process
, SIGINT
, current_group
, 0);
5984 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5985 doc
: /* Kill process PROCESS. May be process or name of one.
5986 See function `interrupt-process' for more details on usage. */)
5987 (process
, current_group
)
5988 Lisp_Object process
, current_group
;
5990 process_send_signal (process
, SIGKILL
, current_group
, 0);
5994 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5995 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5996 See function `interrupt-process' for more details on usage. */)
5997 (process
, current_group
)
5998 Lisp_Object process
, current_group
;
6000 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6004 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6005 doc
: /* Stop process PROCESS. May be process or name of one.
6006 See function `interrupt-process' for more details on usage.
6007 If PROCESS is a network process, inhibit handling of incoming traffic. */)
6008 (process
, current_group
)
6009 Lisp_Object process
, current_group
;
6012 if (PROCESSP (process
) && NETCONN_P (process
))
6014 struct Lisp_Process
*p
;
6016 p
= XPROCESS (process
);
6017 if (NILP (p
->command
)
6018 && XINT (p
->infd
) >= 0)
6020 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6021 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6028 error ("No SIGTSTP support");
6030 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6035 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6036 doc
: /* Continue process PROCESS. May be process or name of one.
6037 See function `interrupt-process' for more details on usage.
6038 If PROCESS is a network process, resume handling of incoming traffic. */)
6039 (process
, current_group
)
6040 Lisp_Object process
, current_group
;
6043 if (PROCESSP (process
) && NETCONN_P (process
))
6045 struct Lisp_Process
*p
;
6047 p
= XPROCESS (process
);
6048 if (EQ (p
->command
, Qt
)
6049 && XINT (p
->infd
) >= 0
6050 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6052 FD_SET (XINT (p
->infd
), &input_wait_mask
);
6053 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6060 process_send_signal (process
, SIGCONT
, current_group
, 0);
6062 error ("No SIGCONT support");
6067 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6068 2, 2, "sProcess (name or number): \nnSignal code: ",
6069 doc
: /* Send PROCESS the signal with code SIGCODE.
6070 PROCESS may also be an integer specifying the process id of the
6071 process to signal; in this case, the process need not be a child of
6073 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6075 Lisp_Object process
, sigcode
;
6079 if (INTEGERP (process
))
6081 pid
= XINT (process
);
6085 if (FLOATP (process
))
6087 pid
= (pid_t
) XFLOAT (process
);
6091 if (STRINGP (process
))
6094 if (tem
= Fget_process (process
), NILP (tem
))
6096 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6103 process
= get_process (process
);
6108 CHECK_PROCESS (process
);
6109 pid
= XPROCESS (process
)->pid
;
6111 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6115 #define handle_signal(NAME, VALUE) \
6116 else if (!strcmp (name, NAME)) \
6117 XSETINT (sigcode, VALUE)
6119 if (INTEGERP (sigcode
))
6123 unsigned char *name
;
6125 CHECK_SYMBOL (sigcode
);
6126 name
= SDATA (SYMBOL_NAME (sigcode
));
6128 if (!strncmp(name
, "SIG", 3))
6134 handle_signal ("HUP", SIGHUP
);
6137 handle_signal ("INT", SIGINT
);
6140 handle_signal ("QUIT", SIGQUIT
);
6143 handle_signal ("ILL", SIGILL
);
6146 handle_signal ("ABRT", SIGABRT
);
6149 handle_signal ("EMT", SIGEMT
);
6152 handle_signal ("KILL", SIGKILL
);
6155 handle_signal ("FPE", SIGFPE
);
6158 handle_signal ("BUS", SIGBUS
);
6161 handle_signal ("SEGV", SIGSEGV
);
6164 handle_signal ("SYS", SIGSYS
);
6167 handle_signal ("PIPE", SIGPIPE
);
6170 handle_signal ("ALRM", SIGALRM
);
6173 handle_signal ("TERM", SIGTERM
);
6176 handle_signal ("URG", SIGURG
);
6179 handle_signal ("STOP", SIGSTOP
);
6182 handle_signal ("TSTP", SIGTSTP
);
6185 handle_signal ("CONT", SIGCONT
);
6188 handle_signal ("CHLD", SIGCHLD
);
6191 handle_signal ("TTIN", SIGTTIN
);
6194 handle_signal ("TTOU", SIGTTOU
);
6197 handle_signal ("IO", SIGIO
);
6200 handle_signal ("XCPU", SIGXCPU
);
6203 handle_signal ("XFSZ", SIGXFSZ
);
6206 handle_signal ("VTALRM", SIGVTALRM
);
6209 handle_signal ("PROF", SIGPROF
);
6212 handle_signal ("WINCH", SIGWINCH
);
6215 handle_signal ("INFO", SIGINFO
);
6218 handle_signal ("USR1", SIGUSR1
);
6221 handle_signal ("USR2", SIGUSR2
);
6224 error ("Undefined signal name %s", name
);
6227 #undef handle_signal
6229 return make_number (kill (pid
, XINT (sigcode
)));
6232 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6233 doc
: /* Make PROCESS see end-of-file in its input.
6234 EOF comes after any text already sent to it.
6235 PROCESS may be a process, a buffer, the name of a process or buffer, or
6236 nil, indicating the current buffer's process.
6237 If PROCESS is a network connection, or is a process communicating
6238 through a pipe (as opposed to a pty), then you cannot send any more
6239 text to PROCESS after you call this function. */)
6241 Lisp_Object process
;
6244 struct coding_system
*coding
;
6246 if (DATAGRAM_CONN_P (process
))
6249 proc
= get_process (process
);
6250 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6252 /* Make sure the process is really alive. */
6253 if (XPROCESS (proc
)->raw_status_new
)
6254 update_status (XPROCESS (proc
));
6255 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6256 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6258 if (CODING_REQUIRE_FLUSHING (coding
))
6260 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6261 send_process (proc
, "", 0, Qnil
);
6265 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6267 if (!NILP (XPROCESS (proc
)->pty_flag
))
6268 send_process (proc
, "\004", 1, Qnil
);
6271 int old_outfd
, new_outfd
;
6273 #ifdef HAVE_SHUTDOWN
6274 /* If this is a network connection, or socketpair is used
6275 for communication with the subprocess, call shutdown to cause EOF.
6276 (In some old system, shutdown to socketpair doesn't work.
6277 Then we just can't win.) */
6278 if (XPROCESS (proc
)->pid
== 0
6279 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6280 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6281 /* In case of socketpair, outfd == infd, so don't close it. */
6282 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6283 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6284 #else /* not HAVE_SHUTDOWN */
6285 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6286 #endif /* not HAVE_SHUTDOWN */
6287 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6290 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6292 if (!proc_encode_coding_system
[new_outfd
])
6293 proc_encode_coding_system
[new_outfd
]
6294 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6295 bcopy (proc_encode_coding_system
[old_outfd
],
6296 proc_encode_coding_system
[new_outfd
],
6297 sizeof (struct coding_system
));
6298 bzero (proc_encode_coding_system
[old_outfd
],
6299 sizeof (struct coding_system
));
6301 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6307 /* Kill all processes associated with `buffer'.
6308 If `buffer' is nil, kill all processes */
6311 kill_buffer_processes (buffer
)
6314 Lisp_Object tail
, proc
;
6316 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6318 proc
= XCDR (XCAR (tail
));
6319 if (GC_PROCESSP (proc
)
6320 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6322 if (NETCONN_P (proc
))
6323 Fdelete_process (proc
);
6324 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6325 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6330 /* On receipt of a signal that a child status has changed, loop asking
6331 about children with changed statuses until the system says there
6334 All we do is change the status; we do not run sentinels or print
6335 notifications. That is saved for the next time keyboard input is
6336 done, in order to avoid timing errors.
6338 ** WARNING: this can be called during garbage collection.
6339 Therefore, it must not be fooled by the presence of mark bits in
6342 ** USG WARNING: Although it is not obvious from the documentation
6343 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6344 signal() before executing at least one wait(), otherwise the
6345 handler will be called again, resulting in an infinite loop. The
6346 relevant portion of the documentation reads "SIGCLD signals will be
6347 queued and the signal-catching function will be continually
6348 reentered until the queue is empty". Invoking signal() causes the
6349 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6352 ** Malloc WARNING: This should never call malloc either directly or
6353 indirectly; if it does, that is a bug */
6357 sigchld_handler (signo
)
6360 int old_errno
= errno
;
6362 register struct Lisp_Process
*p
;
6363 extern EMACS_TIME
*input_available_clear_time
;
6365 SIGNAL_THREAD_CHECK (signo
);
6369 sigheld
|= sigbit (SIGCHLD
);
6381 #endif /* no WUNTRACED */
6382 /* Keep trying to get a status until we get a definitive result. */
6386 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6388 while (pid
< 0 && errno
== EINTR
);
6392 /* PID == 0 means no processes found, PID == -1 means a real
6393 failure. We have done all our job, so return. */
6395 /* USG systems forget handlers when they are used;
6396 must reestablish each time */
6397 #if defined (USG) && !defined (POSIX_SIGNALS)
6398 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6401 sigheld
&= ~sigbit (SIGCHLD
);
6409 #endif /* no WNOHANG */
6411 /* Find the process that signaled us, and record its status. */
6413 /* The process can have been deleted by Fdelete_process. */
6414 tail
= Fmember (make_fixnum_or_float (pid
), deleted_pid_list
);
6417 Fsetcar (tail
, Qnil
);
6418 goto sigchld_end_of_loop
;
6421 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6423 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6425 proc
= XCDR (XCAR (tail
));
6426 p
= XPROCESS (proc
);
6427 if (GC_EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6432 /* Look for an asynchronous process whose pid hasn't been filled
6435 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6437 proc
= XCDR (XCAR (tail
));
6438 p
= XPROCESS (proc
);
6444 /* Change the status of the process that was found. */
6447 union { int i
; WAITTYPE wt
; } u
;
6448 int clear_desc_flag
= 0;
6450 XSETINT (p
->tick
, ++process_tick
);
6452 p
->raw_status
= u
.i
;
6453 p
->raw_status_new
= 1;
6455 /* If process has terminated, stop waiting for its output. */
6456 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6457 && XINT (p
->infd
) >= 0)
6458 clear_desc_flag
= 1;
6460 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6461 if (clear_desc_flag
)
6463 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6464 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6467 /* Tell wait_reading_process_output that it needs to wake up and
6469 if (input_available_clear_time
)
6470 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6473 /* There was no asynchronous process found for that pid: we have
6474 a synchronous process. */
6477 synch_process_alive
= 0;
6479 /* Report the status of the synchronous process. */
6481 synch_process_retcode
= WRETCODE (w
);
6482 else if (WIFSIGNALED (w
))
6483 synch_process_termsig
= WTERMSIG (w
);
6485 /* Tell wait_reading_process_output that it needs to wake up and
6487 if (input_available_clear_time
)
6488 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6491 sigchld_end_of_loop
:
6494 /* On some systems, we must return right away.
6495 If any more processes want to signal us, we will
6497 Otherwise (on systems that have WNOHANG), loop around
6498 to use up all the processes that have something to tell us. */
6499 #if (defined WINDOWSNT \
6500 || (defined USG && !defined GNU_LINUX \
6501 && !(defined HPUX && defined WNOHANG)))
6502 #if defined (USG) && ! defined (POSIX_SIGNALS)
6503 signal (signo
, sigchld_handler
);
6507 #endif /* USG, but not HPUX with WNOHANG */
6510 #endif /* SIGCHLD */
6514 exec_sentinel_unwind (data
)
6517 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6522 exec_sentinel_error_handler (error
)
6525 cmd_error_internal (error
, "error in process sentinel: ");
6527 update_echo_area ();
6528 Fsleep_for (make_number (2), Qnil
);
6533 exec_sentinel (proc
, reason
)
6534 Lisp_Object proc
, reason
;
6536 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6537 register struct Lisp_Process
*p
= XPROCESS (proc
);
6538 int count
= SPECPDL_INDEX ();
6539 int outer_running_asynch_code
= running_asynch_code
;
6540 int waiting
= waiting_for_user_input_p
;
6542 /* No need to gcpro these, because all we do with them later
6543 is test them for EQness, and none of them should be a string. */
6544 odeactivate
= Vdeactivate_mark
;
6545 XSETBUFFER (obuffer
, current_buffer
);
6546 okeymap
= current_buffer
->keymap
;
6548 sentinel
= p
->sentinel
;
6549 if (NILP (sentinel
))
6552 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6553 assure that it gets restored no matter how the sentinel exits. */
6555 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6556 /* Inhibit quit so that random quits don't screw up a running filter. */
6557 specbind (Qinhibit_quit
, Qt
);
6558 specbind (Qlast_nonmenu_event
, Qt
);
6560 /* In case we get recursively called,
6561 and we already saved the match data nonrecursively,
6562 save the same match data in safely recursive fashion. */
6563 if (outer_running_asynch_code
)
6566 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6567 restore_search_regs ();
6568 record_unwind_save_match_data ();
6569 Fset_match_data (tem
, Qt
);
6572 /* For speed, if a search happens within this code,
6573 save the match data in a special nonrecursive fashion. */
6574 running_asynch_code
= 1;
6576 internal_condition_case_1 (read_process_output_call
,
6578 Fcons (proc
, Fcons (reason
, Qnil
))),
6579 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6580 exec_sentinel_error_handler
);
6582 /* If we saved the match data nonrecursively, restore it now. */
6583 restore_search_regs ();
6584 running_asynch_code
= outer_running_asynch_code
;
6586 Vdeactivate_mark
= odeactivate
;
6588 /* Restore waiting_for_user_input_p as it was
6589 when we were called, in case the filter clobbered it. */
6590 waiting_for_user_input_p
= waiting
;
6593 if (! EQ (Fcurrent_buffer (), obuffer
)
6594 || ! EQ (current_buffer
->keymap
, okeymap
))
6596 /* But do it only if the caller is actually going to read events.
6597 Otherwise there's no need to make him wake up, and it could
6598 cause trouble (for example it would make sit_for return). */
6599 if (waiting_for_user_input_p
== -1)
6600 record_asynch_buffer_change ();
6602 unbind_to (count
, Qnil
);
6605 /* Report all recent events of a change in process status
6606 (either run the sentinel or output a message).
6607 This is usually done while Emacs is waiting for keyboard input
6608 but can be done at other times. */
6611 status_notify (deleting_process
)
6612 struct Lisp_Process
*deleting_process
;
6614 register Lisp_Object proc
, buffer
;
6615 Lisp_Object tail
, msg
;
6616 struct gcpro gcpro1
, gcpro2
;
6620 /* We need to gcpro tail; if read_process_output calls a filter
6621 which deletes a process and removes the cons to which tail points
6622 from Vprocess_alist, and then causes a GC, tail is an unprotected
6626 /* Set this now, so that if new processes are created by sentinels
6627 that we run, we get called again to handle their status changes. */
6628 update_tick
= process_tick
;
6630 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6633 register struct Lisp_Process
*p
;
6635 proc
= Fcdr (Fcar (tail
));
6636 p
= XPROCESS (proc
);
6638 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6640 XSETINT (p
->update_tick
, XINT (p
->tick
));
6642 /* If process is still active, read any output that remains. */
6643 while (! EQ (p
->filter
, Qt
)
6644 && ! EQ (p
->status
, Qconnect
)
6645 && ! EQ (p
->status
, Qlisten
)
6646 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6647 && XINT (p
->infd
) >= 0
6648 && p
!= deleting_process
6649 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6653 /* Get the text to use for the message. */
6654 if (p
->raw_status_new
)
6656 msg
= status_message (p
);
6658 /* If process is terminated, deactivate it or delete it. */
6660 if (CONSP (p
->status
))
6661 symbol
= XCAR (p
->status
);
6663 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6664 || EQ (symbol
, Qclosed
))
6666 if (delete_exited_processes
)
6667 remove_process (proc
);
6669 deactivate_process (proc
);
6672 /* The actions above may have further incremented p->tick.
6673 So set p->update_tick again
6674 so that an error in the sentinel will not cause
6675 this code to be run again. */
6676 XSETINT (p
->update_tick
, XINT (p
->tick
));
6677 /* Now output the message suitably. */
6678 if (!NILP (p
->sentinel
))
6679 exec_sentinel (proc
, msg
);
6680 /* Don't bother with a message in the buffer
6681 when a process becomes runnable. */
6682 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6684 Lisp_Object ro
, tem
;
6685 struct buffer
*old
= current_buffer
;
6686 int opoint
, opoint_byte
;
6687 int before
, before_byte
;
6689 ro
= XBUFFER (buffer
)->read_only
;
6691 /* Avoid error if buffer is deleted
6692 (probably that's why the process is dead, too) */
6693 if (NILP (XBUFFER (buffer
)->name
))
6695 Fset_buffer (buffer
);
6698 opoint_byte
= PT_BYTE
;
6699 /* Insert new output into buffer
6700 at the current end-of-output marker,
6701 thus preserving logical ordering of input and output. */
6702 if (XMARKER (p
->mark
)->buffer
)
6703 Fgoto_char (p
->mark
);
6705 SET_PT_BOTH (ZV
, ZV_BYTE
);
6708 before_byte
= PT_BYTE
;
6710 tem
= current_buffer
->read_only
;
6711 current_buffer
->read_only
= Qnil
;
6712 insert_string ("\nProcess ");
6713 Finsert (1, &p
->name
);
6714 insert_string (" ");
6716 current_buffer
->read_only
= tem
;
6717 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6719 if (opoint
>= before
)
6720 SET_PT_BOTH (opoint
+ (PT
- before
),
6721 opoint_byte
+ (PT_BYTE
- before_byte
));
6723 SET_PT_BOTH (opoint
, opoint_byte
);
6725 set_buffer_internal (old
);
6730 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6731 redisplay_preserve_echo_area (13);
6737 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6738 Sset_process_coding_system
, 1, 3, 0,
6739 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6740 DECODING will be used to decode subprocess output and ENCODING to
6741 encode subprocess input. */)
6742 (process
, decoding
, encoding
)
6743 register Lisp_Object process
, decoding
, encoding
;
6745 register struct Lisp_Process
*p
;
6747 CHECK_PROCESS (process
);
6748 p
= XPROCESS (process
);
6749 if (XINT (p
->infd
) < 0)
6750 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6751 if (XINT (p
->outfd
) < 0)
6752 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6753 Fcheck_coding_system (decoding
);
6754 Fcheck_coding_system (encoding
);
6755 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6756 p
->decode_coding_system
= decoding
;
6757 p
->encode_coding_system
= encoding
;
6758 setup_process_coding_systems (process
);
6763 DEFUN ("process-coding-system",
6764 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6765 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6767 register Lisp_Object process
;
6769 CHECK_PROCESS (process
);
6770 return Fcons (XPROCESS (process
)->decode_coding_system
,
6771 XPROCESS (process
)->encode_coding_system
);
6774 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6775 Sset_process_filter_multibyte
, 2, 2, 0,
6776 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6777 If FLAG is non-nil, the filter is given multibyte strings.
6778 If FLAG is nil, the filter is given unibyte strings. In this case,
6779 all character code conversion except for end-of-line conversion is
6782 Lisp_Object process
, flag
;
6784 register struct Lisp_Process
*p
;
6786 CHECK_PROCESS (process
);
6787 p
= XPROCESS (process
);
6788 p
->filter_multibyte
= flag
;
6789 setup_process_coding_systems (process
);
6794 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6795 Sprocess_filter_multibyte_p
, 1, 1, 0,
6796 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6798 Lisp_Object process
;
6800 register struct Lisp_Process
*p
;
6802 CHECK_PROCESS (process
);
6803 p
= XPROCESS (process
);
6805 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6810 /* The first time this is called, assume keyboard input comes from DESC
6811 instead of from where we used to expect it.
6812 Subsequent calls mean assume input keyboard can come from DESC
6813 in addition to other places. */
6815 static int add_keyboard_wait_descriptor_called_flag
;
6818 add_keyboard_wait_descriptor (desc
)
6821 if (! add_keyboard_wait_descriptor_called_flag
)
6822 FD_CLR (0, &input_wait_mask
);
6823 add_keyboard_wait_descriptor_called_flag
= 1;
6824 FD_SET (desc
, &input_wait_mask
);
6825 FD_SET (desc
, &non_process_wait_mask
);
6826 if (desc
> max_keyboard_desc
)
6827 max_keyboard_desc
= desc
;
6830 /* From now on, do not expect DESC to give keyboard input. */
6833 delete_keyboard_wait_descriptor (desc
)
6837 int lim
= max_keyboard_desc
;
6839 FD_CLR (desc
, &input_wait_mask
);
6840 FD_CLR (desc
, &non_process_wait_mask
);
6842 if (desc
== max_keyboard_desc
)
6843 for (fd
= 0; fd
< lim
; fd
++)
6844 if (FD_ISSET (fd
, &input_wait_mask
)
6845 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6846 max_keyboard_desc
= fd
;
6849 /* Return nonzero if *MASK has a bit set
6850 that corresponds to one of the keyboard input descriptors. */
6853 keyboard_bit_set (mask
)
6858 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6859 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6860 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6873 if (! noninteractive
|| initialized
)
6875 signal (SIGCHLD
, sigchld_handler
);
6878 FD_ZERO (&input_wait_mask
);
6879 FD_ZERO (&non_keyboard_wait_mask
);
6880 FD_ZERO (&non_process_wait_mask
);
6881 max_process_desc
= 0;
6883 #ifdef NON_BLOCKING_CONNECT
6884 FD_ZERO (&connect_wait_mask
);
6885 num_pending_connects
= 0;
6888 #ifdef ADAPTIVE_READ_BUFFERING
6889 process_output_delay_count
= 0;
6890 process_output_skip
= 0;
6893 FD_SET (0, &input_wait_mask
);
6895 Vprocess_alist
= Qnil
;
6897 deleted_pid_list
= Qnil
;
6899 for (i
= 0; i
< MAXDESC
; i
++)
6901 chan_process
[i
] = Qnil
;
6902 proc_buffered_char
[i
] = -1;
6904 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6905 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6906 #ifdef DATAGRAM_SOCKETS
6907 bzero (datagram_address
, sizeof datagram_address
);
6912 Lisp_Object subfeatures
= Qnil
;
6913 struct socket_options
*sopt
;
6915 #define ADD_SUBFEATURE(key, val) \
6916 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6918 #ifdef NON_BLOCKING_CONNECT
6919 ADD_SUBFEATURE (QCnowait
, Qt
);
6921 #ifdef DATAGRAM_SOCKETS
6922 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6924 #ifdef HAVE_LOCAL_SOCKETS
6925 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6927 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6929 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6931 #ifdef HAVE_GETSOCKNAME
6932 ADD_SUBFEATURE (QCservice
, Qt
);
6934 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6935 ADD_SUBFEATURE (QCserver
, Qt
);
6938 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6939 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6941 Fprovide (intern ("make-network-process"), subfeatures
);
6943 #endif /* HAVE_SOCKETS */
6945 #if defined (DARWIN) || defined (MAC_OSX)
6946 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6947 processes. As such, we only change the default value. */
6950 char *release
= get_operating_system_release();
6951 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6952 && release
[1] == '.')) {
6953 Vprocess_connection_type
= Qnil
;
6962 Qprocessp
= intern ("processp");
6963 staticpro (&Qprocessp
);
6964 Qrun
= intern ("run");
6966 Qstop
= intern ("stop");
6968 Qsignal
= intern ("signal");
6969 staticpro (&Qsignal
);
6971 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6974 Qexit = intern ("exit");
6975 staticpro (&Qexit); */
6977 Qopen
= intern ("open");
6979 Qclosed
= intern ("closed");
6980 staticpro (&Qclosed
);
6981 Qconnect
= intern ("connect");
6982 staticpro (&Qconnect
);
6983 Qfailed
= intern ("failed");
6984 staticpro (&Qfailed
);
6985 Qlisten
= intern ("listen");
6986 staticpro (&Qlisten
);
6987 Qlocal
= intern ("local");
6988 staticpro (&Qlocal
);
6989 Qipv4
= intern ("ipv4");
6992 Qipv6
= intern ("ipv6");
6995 Qdatagram
= intern ("datagram");
6996 staticpro (&Qdatagram
);
6998 QCname
= intern (":name");
6999 staticpro (&QCname
);
7000 QCbuffer
= intern (":buffer");
7001 staticpro (&QCbuffer
);
7002 QChost
= intern (":host");
7003 staticpro (&QChost
);
7004 QCservice
= intern (":service");
7005 staticpro (&QCservice
);
7006 QCtype
= intern (":type");
7007 staticpro (&QCtype
);
7008 QClocal
= intern (":local");
7009 staticpro (&QClocal
);
7010 QCremote
= intern (":remote");
7011 staticpro (&QCremote
);
7012 QCcoding
= intern (":coding");
7013 staticpro (&QCcoding
);
7014 QCserver
= intern (":server");
7015 staticpro (&QCserver
);
7016 QCnowait
= intern (":nowait");
7017 staticpro (&QCnowait
);
7018 QCsentinel
= intern (":sentinel");
7019 staticpro (&QCsentinel
);
7020 QClog
= intern (":log");
7022 QCnoquery
= intern (":noquery");
7023 staticpro (&QCnoquery
);
7024 QCstop
= intern (":stop");
7025 staticpro (&QCstop
);
7026 QCoptions
= intern (":options");
7027 staticpro (&QCoptions
);
7028 QCplist
= intern (":plist");
7029 staticpro (&QCplist
);
7030 QCfilter_multibyte
= intern (":filter-multibyte");
7031 staticpro (&QCfilter_multibyte
);
7033 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
7034 staticpro (&Qlast_nonmenu_event
);
7036 staticpro (&Vprocess_alist
);
7038 staticpro (&deleted_pid_list
);
7041 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7042 doc
: /* *Non-nil means delete processes immediately when they exit.
7043 nil means don't delete them until `list-processes' is run. */);
7045 delete_exited_processes
= 1;
7047 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7048 doc
: /* Control type of device used to communicate with subprocesses.
7049 Values are nil to use a pipe, or t or `pty' to use a pty.
7050 The value has no effect if the system has no ptys or if all ptys are busy:
7051 then a pipe is used in any case.
7052 The value takes effect when `start-process' is called. */);
7053 Vprocess_connection_type
= Qt
;
7055 #ifdef ADAPTIVE_READ_BUFFERING
7056 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7057 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7058 On some systems, when Emacs reads the output from a subprocess, the output data
7059 is read in very small blocks, potentially resulting in very poor performance.
7060 This behavior can be remedied to some extent by setting this variable to a
7061 non-nil value, as it will automatically delay reading from such processes, to
7062 allow them to produce more output before Emacs tries to read it.
7063 If the value is t, the delay is reset after each write to the process; any other
7064 non-nil value means that the delay is not reset on write.
7065 The variable takes effect when `start-process' is called. */);
7066 Vprocess_adaptive_read_buffering
= Qt
;
7069 defsubr (&Sprocessp
);
7070 defsubr (&Sget_process
);
7071 defsubr (&Sget_buffer_process
);
7072 defsubr (&Sdelete_process
);
7073 defsubr (&Sprocess_status
);
7074 defsubr (&Sprocess_exit_status
);
7075 defsubr (&Sprocess_id
);
7076 defsubr (&Sprocess_name
);
7077 defsubr (&Sprocess_tty_name
);
7078 defsubr (&Sprocess_command
);
7079 defsubr (&Sset_process_buffer
);
7080 defsubr (&Sprocess_buffer
);
7081 defsubr (&Sprocess_mark
);
7082 defsubr (&Sset_process_filter
);
7083 defsubr (&Sprocess_filter
);
7084 defsubr (&Sset_process_sentinel
);
7085 defsubr (&Sprocess_sentinel
);
7086 defsubr (&Sset_process_window_size
);
7087 defsubr (&Sset_process_inherit_coding_system_flag
);
7088 defsubr (&Sprocess_inherit_coding_system_flag
);
7089 defsubr (&Sset_process_query_on_exit_flag
);
7090 defsubr (&Sprocess_query_on_exit_flag
);
7091 defsubr (&Sprocess_contact
);
7092 defsubr (&Sprocess_plist
);
7093 defsubr (&Sset_process_plist
);
7094 defsubr (&Slist_processes
);
7095 defsubr (&Sprocess_list
);
7096 defsubr (&Sstart_process
);
7098 defsubr (&Sset_network_process_option
);
7099 defsubr (&Smake_network_process
);
7100 defsubr (&Sformat_network_address
);
7101 #endif /* HAVE_SOCKETS */
7102 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7104 defsubr (&Snetwork_interface_list
);
7106 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7107 defsubr (&Snetwork_interface_info
);
7109 #endif /* HAVE_SOCKETS ... */
7110 #ifdef DATAGRAM_SOCKETS
7111 defsubr (&Sprocess_datagram_address
);
7112 defsubr (&Sset_process_datagram_address
);
7114 defsubr (&Saccept_process_output
);
7115 defsubr (&Sprocess_send_region
);
7116 defsubr (&Sprocess_send_string
);
7117 defsubr (&Sinterrupt_process
);
7118 defsubr (&Skill_process
);
7119 defsubr (&Squit_process
);
7120 defsubr (&Sstop_process
);
7121 defsubr (&Scontinue_process
);
7122 defsubr (&Sprocess_running_child_p
);
7123 defsubr (&Sprocess_send_eof
);
7124 defsubr (&Ssignal_process
);
7125 defsubr (&Swaiting_for_user_input_p
);
7126 /* defsubr (&Sprocess_connection); */
7127 defsubr (&Sset_process_coding_system
);
7128 defsubr (&Sprocess_coding_system
);
7129 defsubr (&Sset_process_filter_multibyte
);
7130 defsubr (&Sprocess_filter_multibyte_p
);
7134 #else /* not subprocesses */
7136 #include <sys/types.h>
7140 #include "systime.h"
7141 #include "character.h"
7143 #include "termopts.h"
7144 #include "sysselect.h"
7146 extern int frame_garbaged
;
7148 extern EMACS_TIME
timer_check ();
7149 extern int timers_run
;
7153 /* As described above, except assuming that there are no subprocesses:
7155 Wait for timeout to elapse and/or keyboard input to be available.
7158 timeout in seconds, or
7159 zero for no limit, or
7160 -1 means gobble data immediately available but don't wait for any.
7162 read_kbd is a Lisp_Object:
7163 0 to ignore keyboard input, or
7164 1 to return when input is available, or
7165 -1 means caller will actually read the input, so don't throw to
7168 see full version for other parameters. We know that wait_proc will
7169 always be NULL, since `subprocesses' isn't defined.
7171 do_display != 0 means redisplay should be done to show subprocess
7172 output that arrives.
7174 Return true iff we received input from any process. */
7177 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7178 wait_for_cell
, wait_proc
, just_wait_proc
)
7179 int time_limit
, microsecs
, read_kbd
, do_display
;
7180 Lisp_Object wait_for_cell
;
7181 struct Lisp_Process
*wait_proc
;
7185 EMACS_TIME end_time
, timeout
;
7186 SELECT_TYPE waitchannels
;
7189 /* What does time_limit really mean? */
7190 if (time_limit
|| microsecs
)
7192 EMACS_GET_TIME (end_time
);
7193 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7194 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7197 /* Turn off periodic alarms (in case they are in use)
7198 and then turn off any other atimers,
7199 because the select emulator uses alarms. */
7201 turn_on_atimers (0);
7205 int timeout_reduced_for_timers
= 0;
7207 /* If calling from keyboard input, do not quit
7208 since we want to return C-g as an input character.
7209 Otherwise, do pending quit if requested. */
7213 /* Exit now if the cell we're waiting for became non-nil. */
7214 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7217 /* Compute time from now till when time limit is up */
7218 /* Exit if already run out */
7219 if (time_limit
== -1)
7221 /* -1 specified for timeout means
7222 gobble output available now
7223 but don't wait at all. */
7225 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7227 else if (time_limit
|| microsecs
)
7229 EMACS_GET_TIME (timeout
);
7230 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7231 if (EMACS_TIME_NEG_P (timeout
))
7236 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7239 /* If our caller will not immediately handle keyboard events,
7240 run timer events directly.
7241 (Callers that will immediately read keyboard events
7242 call timer_delay on their own.) */
7243 if (NILP (wait_for_cell
))
7245 EMACS_TIME timer_delay
;
7249 int old_timers_run
= timers_run
;
7250 timer_delay
= timer_check (1);
7251 if (timers_run
!= old_timers_run
&& do_display
)
7252 /* We must retry, since a timer may have requeued itself
7253 and that could alter the time delay. */
7254 redisplay_preserve_echo_area (14);
7258 while (!detect_input_pending ());
7260 /* If there is unread keyboard input, also return. */
7262 && requeued_events_pending_p ())
7265 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7267 EMACS_TIME difference
;
7268 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7269 if (EMACS_TIME_NEG_P (difference
))
7271 timeout
= timer_delay
;
7272 timeout_reduced_for_timers
= 1;
7277 /* Cause C-g and alarm signals to take immediate action,
7278 and cause input available signals to zero out timeout. */
7280 set_waiting_for_input (&timeout
);
7282 /* Wait till there is something to do. */
7284 if (! read_kbd
&& NILP (wait_for_cell
))
7285 FD_ZERO (&waitchannels
);
7287 FD_SET (0, &waitchannels
);
7289 /* If a frame has been newly mapped and needs updating,
7290 reprocess its display stuff. */
7291 if (frame_garbaged
&& do_display
)
7293 clear_waiting_for_input ();
7294 redisplay_preserve_echo_area (15);
7296 set_waiting_for_input (&timeout
);
7299 if (read_kbd
&& detect_input_pending ())
7302 FD_ZERO (&waitchannels
);
7305 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7310 /* Make C-g and alarm signals set flags again */
7311 clear_waiting_for_input ();
7313 /* If we woke up due to SIGWINCH, actually change size now. */
7314 do_pending_window_change (0);
7316 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7317 /* We waited the full specified time, so return now. */
7322 /* If the system call was interrupted, then go around the
7324 if (xerrno
== EINTR
)
7325 FD_ZERO (&waitchannels
);
7327 error ("select error: %s", emacs_strerror (xerrno
));
7330 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7331 /* System sometimes fails to deliver SIGIO. */
7332 kill (getpid (), SIGIO
);
7335 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7336 kill (getpid (), SIGIO
);
7339 /* Check for keyboard input */
7342 && detect_input_pending_run_timers (do_display
))
7344 swallow_events (do_display
);
7345 if (detect_input_pending_run_timers (do_display
))
7349 /* If there is unread keyboard input, also return. */
7351 && requeued_events_pending_p ())
7354 /* If wait_for_cell. check for keyboard input
7355 but don't run any timers.
7356 ??? (It seems wrong to me to check for keyboard
7357 input at all when wait_for_cell, but the code
7358 has been this way since July 1994.
7359 Try changing this after version 19.31.) */
7360 if (! NILP (wait_for_cell
)
7361 && detect_input_pending ())
7363 swallow_events (do_display
);
7364 if (detect_input_pending ())
7368 /* Exit now if the cell we're waiting for became non-nil. */
7369 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7379 /* Don't confuse make-docfile by having two doc strings for this function.
7380 make-docfile does not pay attention to #if, for good reason! */
7381 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7384 register Lisp_Object name
;
7389 /* Don't confuse make-docfile by having two doc strings for this function.
7390 make-docfile does not pay attention to #if, for good reason! */
7391 DEFUN ("process-inherit-coding-system-flag",
7392 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7396 register Lisp_Object process
;
7398 /* Ignore the argument and return the value of
7399 inherit-process-coding-system. */
7400 return inherit_process_coding_system
? Qt
: Qnil
;
7403 /* Kill all processes associated with `buffer'.
7404 If `buffer' is nil, kill all processes.
7405 Since we have no subprocesses, this does nothing. */
7408 kill_buffer_processes (buffer
)
7421 QCtype
= intern (":type");
7422 staticpro (&QCtype
);
7424 defsubr (&Sget_buffer_process
);
7425 defsubr (&Sprocess_inherit_coding_system_flag
);
7429 #endif /* not subprocesses */
7431 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7432 (do not change this comment) */