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, 2007, 2008 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 3 of the License, or
11 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
25 /* This file is split into two parts by the following preprocessor
26 conditional. The 'then' clause contains all of the support for
27 asynchronous subprocesses. The 'else' clause contains stub
28 versions of some of the asynchronous subprocess routines that are
29 often called elsewhere in Emacs, so we don't have to #ifdef the
30 sections that call them. */
38 #include <sys/types.h> /* some typedefs are used in sys/file.h */
41 #ifdef HAVE_INTTYPES_H
48 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
51 #endif /* not WINDOWSNT */
53 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
54 #include <sys/socket.h>
56 #include <netinet/in.h>
57 #include <arpa/inet.h>
59 /* Are local (unix) sockets supported? */
60 #if defined (HAVE_SYS_UN_H)
61 #if !defined (AF_LOCAL) && defined (AF_UNIX)
62 #define AF_LOCAL AF_UNIX
65 #define HAVE_LOCAL_SOCKETS
69 #endif /* HAVE_SOCKETS */
71 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
76 #if defined(BSD_SYSTEM)
77 #include <sys/ioctl.h>
78 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
80 #endif /* HAVE_PTYS and no O_NDELAY */
81 #endif /* BSD_SYSTEM */
87 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
89 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
90 /* sys/ioctl.h may have been included already */
92 #include <sys/ioctl.h>
99 #include <sys/sysmacros.h> /* for "minor" */
100 #endif /* not IRIS */
103 #include <sys/wait.h>
107 #include <netinet/in.h>
108 #include <arpa/nameser.h>
118 #include "character.h"
122 #include "termhooks.h"
123 #include "termopts.h"
124 #include "commands.h"
125 #include "keyboard.h"
126 #include "blockinput.h"
127 #include "dispextern.h"
128 #include "composite.h"
131 Lisp_Object Qprocessp
;
132 Lisp_Object Qrun
, Qstop
, Qsignal
;
133 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
134 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
135 Lisp_Object Qreal
, Qnetwork
, Qserial
;
139 Lisp_Object QCport
, QCspeed
, QCprocess
;
140 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
141 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
142 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
143 Lisp_Object QClocal
, QCremote
, QCcoding
;
144 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
145 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
146 Lisp_Object Qlast_nonmenu_event
;
147 /* QCfamily is declared and initialized in xfaces.c,
148 QCfilter in keyboard.c. */
149 extern Lisp_Object QCfamily
, QCfilter
;
151 /* Qexit is declared and initialized in eval.c. */
153 /* QCfamily is defined in xfaces.c. */
154 extern Lisp_Object QCfamily
;
155 /* QCfilter is defined in keyboard.c. */
156 extern Lisp_Object QCfilter
;
159 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
160 #define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
161 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
162 #define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
164 #define NETCONN_P(p) 0
165 #define NETCONN1_P(p) 0
166 #define SERIALCONN_P(p) 0
167 #define SERIALCONN1_P(p) 0
168 #endif /* HAVE_SOCKETS */
170 /* Define first descriptor number available for subprocesses. */
172 #define FIRST_PROC_DESC 1
174 #define FIRST_PROC_DESC 3
177 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
180 #if !defined (SIGCHLD) && defined (SIGCLD)
181 #define SIGCHLD SIGCLD
184 #include "syssignal.h"
188 extern char *get_operating_system_release ();
190 /* Serial processes require termios or Windows. */
191 #if defined (HAVE_TERMIOS) || defined (WINDOWSNT)
196 /* From sysdep.c or w32.c */
197 extern int serial_open (char *port
);
198 extern void serial_configure (struct Lisp_Process
*p
, Lisp_Object contact
);
205 extern char *sys_errlist
[];
212 /* t means use pty, nil means use a pipe,
213 maybe other values to come. */
214 static Lisp_Object Vprocess_connection_type
;
216 /* These next two vars are non-static since sysdep.c uses them in the
217 emulation of `select'. */
218 /* Number of events of change of status of a process. */
220 /* Number of events for which the user or sentinel has been notified. */
223 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
225 #ifdef BROKEN_NON_BLOCKING_CONNECT
226 #undef NON_BLOCKING_CONNECT
228 #ifndef NON_BLOCKING_CONNECT
231 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
232 #if defined (O_NONBLOCK) || defined (O_NDELAY)
233 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
234 #define NON_BLOCKING_CONNECT
235 #endif /* EWOULDBLOCK || EINPROGRESS */
236 #endif /* O_NONBLOCK || O_NDELAY */
237 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
238 #endif /* HAVE_SELECT */
239 #endif /* HAVE_SOCKETS */
240 #endif /* NON_BLOCKING_CONNECT */
241 #endif /* BROKEN_NON_BLOCKING_CONNECT */
243 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
244 this system. We need to read full packets, so we need a
245 "non-destructive" select. So we require either native select,
246 or emulation of select using FIONREAD. */
248 #ifdef BROKEN_DATAGRAM_SOCKETS
249 #undef DATAGRAM_SOCKETS
251 #ifndef DATAGRAM_SOCKETS
253 #if defined (HAVE_SELECT) || defined (FIONREAD)
254 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
255 #define DATAGRAM_SOCKETS
256 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
257 #endif /* HAVE_SELECT || FIONREAD */
258 #endif /* HAVE_SOCKETS */
259 #endif /* DATAGRAM_SOCKETS */
260 #endif /* BROKEN_DATAGRAM_SOCKETS */
263 #undef NON_BLOCKING_CONNECT
264 #undef DATAGRAM_SOCKETS
267 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
268 #ifdef EMACS_HAS_USECS
269 #define ADAPTIVE_READ_BUFFERING
273 #ifdef ADAPTIVE_READ_BUFFERING
274 #define READ_OUTPUT_DELAY_INCREMENT 10000
275 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
276 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
278 /* Number of processes which have a non-zero read_output_delay,
279 and therefore might be delayed for adaptive read buffering. */
281 static int process_output_delay_count
;
283 /* Non-zero if any process has non-nil read_output_skip. */
285 static int process_output_skip
;
287 /* Non-nil means to delay reading process output to improve buffering.
288 A value of t means that delay is reset after each send, any other
289 non-nil value does not reset the delay. A value of nil disables
290 adaptive read buffering completely. */
291 static Lisp_Object Vprocess_adaptive_read_buffering
;
293 #define process_output_delay_count 0
297 #include "sysselect.h"
299 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
300 static void deactivate_process
P_ ((Lisp_Object
));
301 static void status_notify
P_ ((struct Lisp_Process
*));
302 static int read_process_output
P_ ((Lisp_Object
, int));
304 /* If we support a window system, turn on the code to poll periodically
305 to detect C-g. It isn't actually used when doing interrupt input. */
306 #ifdef HAVE_WINDOW_SYSTEM
307 #define POLL_FOR_INPUT
310 static Lisp_Object
get_process ();
311 static void exec_sentinel ();
313 extern EMACS_TIME
timer_check ();
314 extern int timers_run
;
316 /* Mask of bits indicating the descriptors that we wait for input on. */
318 static SELECT_TYPE input_wait_mask
;
320 /* Mask that excludes keyboard input descriptor(s). */
322 static SELECT_TYPE non_keyboard_wait_mask
;
324 /* Mask that excludes process input descriptor(s). */
326 static SELECT_TYPE non_process_wait_mask
;
328 /* Mask for the gpm mouse input descriptor. */
330 static SELECT_TYPE gpm_wait_mask
;
332 #ifdef NON_BLOCKING_CONNECT
333 /* Mask of bits indicating the descriptors that we wait for connect to
334 complete on. Once they complete, they are removed from this mask
335 and added to the input_wait_mask and non_keyboard_wait_mask. */
337 static SELECT_TYPE connect_wait_mask
;
339 /* Number of bits set in connect_wait_mask. */
340 static int num_pending_connects
;
342 #define IF_NON_BLOCKING_CONNECT(s) s
344 #define IF_NON_BLOCKING_CONNECT(s)
347 /* The largest descriptor currently in use for a process object. */
348 static int max_process_desc
;
350 /* The largest descriptor currently in use for keyboard input. */
351 static int max_keyboard_desc
;
353 /* The largest descriptor currently in use for gpm mouse input. */
354 static int max_gpm_desc
;
356 /* Nonzero means delete a process right away if it exits. */
357 static int delete_exited_processes
;
359 /* Indexed by descriptor, gives the process (if any) for that descriptor */
360 Lisp_Object chan_process
[MAXDESC
];
362 /* Alist of elements (NAME . PROCESS) */
363 Lisp_Object Vprocess_alist
;
365 /* Buffered-ahead input char from process, indexed by channel.
366 -1 means empty (no char is buffered).
367 Used on sys V where the only way to tell if there is any
368 output from the process is to read at least one char.
369 Always -1 on systems that support FIONREAD. */
371 /* Don't make static; need to access externally. */
372 int proc_buffered_char
[MAXDESC
];
374 /* Table of `struct coding-system' for each process. */
375 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
376 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
378 #ifdef DATAGRAM_SOCKETS
379 /* Table of `partner address' for datagram sockets. */
380 struct sockaddr_and_len
{
383 } datagram_address
[MAXDESC
];
384 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
385 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
387 #define DATAGRAM_CHAN_P(chan) (0)
388 #define DATAGRAM_CONN_P(proc) (0)
391 /* Maximum number of bytes to send to a pty without an eof. */
392 static int pty_max_bytes
;
394 /* Nonzero means don't run process sentinels. This is used
396 int inhibit_sentinels
;
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 (int);
414 struct Lisp_Process
*p
;
416 eassert (p
->raw_status_new
);
417 p
->status
= status_convert (p
->raw_status
);
418 p
->raw_status_new
= 0;
421 /* Convert a process status word in Unix format to
422 the list that we use internally. */
425 status_convert (int w
)
428 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
429 else if (WIFEXITED (w
))
430 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
431 WCOREDUMP (w
) ? Qt
: Qnil
));
432 else if (WIFSIGNALED (w
))
433 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
434 WCOREDUMP (w
) ? Qt
: Qnil
));
439 /* Given a status-list, extract the three pieces of information
440 and store them individually through the three pointers. */
443 decode_status (l
, symbol
, code
, coredump
)
461 *code
= XFASTINT (XCAR (tem
));
463 *coredump
= !NILP (tem
);
467 /* Return a string describing a process status list. */
471 struct Lisp_Process
*p
;
473 Lisp_Object status
= p
->status
;
476 Lisp_Object string
, string2
;
478 decode_status (status
, &symbol
, &code
, &coredump
);
480 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
483 synchronize_system_messages_locale ();
484 signame
= strsignal (code
);
487 string
= build_string (signame
);
488 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
489 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
490 return concat2 (string
, string2
);
492 else if (EQ (symbol
, Qexit
))
495 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
497 return build_string ("finished\n");
498 string
= Fnumber_to_string (make_number (code
));
499 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
500 return concat3 (build_string ("exited abnormally with code "),
503 else if (EQ (symbol
, Qfailed
))
505 string
= Fnumber_to_string (make_number (code
));
506 string2
= build_string ("\n");
507 return concat3 (build_string ("failed with code "),
511 return Fcopy_sequence (Fsymbol_name (symbol
));
516 /* Open an available pty, returning a file descriptor.
517 Return -1 on failure.
518 The file name of the terminal corresponding to the pty
519 is left in the variable pty_name. */
530 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
531 for (i
= 0; i
< 16; i
++)
534 struct stat stb
; /* Used in some PTY_OPEN. */
535 #ifdef PTY_NAME_SPRINTF
538 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
539 #endif /* no PTY_NAME_SPRINTF */
543 #else /* no PTY_OPEN */
546 /* Unusual IRIS code */
547 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
550 if (fstat (fd
, &stb
) < 0)
552 # else /* not IRIS */
553 { /* Some systems name their pseudoterminals so that there are gaps in
554 the usual sequence - for example, on HP9000/S700 systems, there
555 are no pseudoterminals with names ending in 'f'. So we wait for
556 three failures in a row before deciding that we've reached the
558 int failed_count
= 0;
560 if (stat (pty_name
, &stb
) < 0)
563 if (failed_count
>= 3)
570 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
572 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
574 # endif /* not IRIS */
576 #endif /* no PTY_OPEN */
580 /* check to make certain that both sides are available
581 this avoids a nasty yet stupid bug in rlogins */
582 #ifdef PTY_TTY_NAME_SPRINTF
585 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
586 #endif /* no PTY_TTY_NAME_SPRINTF */
587 if (access (pty_name
, 6) != 0)
590 # if !defined(IRIS) && !defined(__sgi)
602 #endif /* HAVE_PTYS */
608 register Lisp_Object val
, tem
, name1
;
609 register struct Lisp_Process
*p
;
613 p
= allocate_process ();
621 p
->raw_status_new
= 0;
623 p
->mark
= Fmake_marker ();
625 #ifdef ADAPTIVE_READ_BUFFERING
626 p
->adaptive_read_buffering
= 0;
627 p
->read_output_delay
= 0;
628 p
->read_output_skip
= 0;
631 /* If name is already in use, modify it until it is unused. */
636 tem
= Fget_process (name1
);
637 if (NILP (tem
)) break;
638 sprintf (suffix
, "<%d>", i
);
639 name1
= concat2 (name
, build_string (suffix
));
643 XSETPROCESS (val
, p
);
644 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
649 remove_process (proc
)
650 register Lisp_Object proc
;
652 register Lisp_Object pair
;
654 pair
= Frassq (proc
, Vprocess_alist
);
655 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
657 deactivate_process (proc
);
660 /* Setup coding systems of PROCESS. */
663 setup_process_coding_systems (process
)
666 struct Lisp_Process
*p
= XPROCESS (process
);
668 int outch
= p
->outfd
;
669 Lisp_Object coding_system
;
671 if (inch
< 0 || outch
< 0)
674 if (!proc_decode_coding_system
[inch
])
675 proc_decode_coding_system
[inch
]
676 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
677 coding_system
= p
->decode_coding_system
;
678 if (! NILP (p
->filter
))
680 else if (BUFFERP (p
->buffer
))
682 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
683 coding_system
= raw_text_coding_system (coding_system
);
685 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
687 if (!proc_encode_coding_system
[outch
])
688 proc_encode_coding_system
[outch
]
689 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
690 setup_coding_system (p
->encode_coding_system
,
691 proc_encode_coding_system
[outch
]);
694 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
695 doc
: /* Return t if OBJECT is a process. */)
699 return PROCESSP (object
) ? Qt
: Qnil
;
702 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
703 doc
: /* Return the process named NAME, or nil if there is none. */)
705 register Lisp_Object name
;
710 return Fcdr (Fassoc (name
, Vprocess_alist
));
713 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
714 doc
: /* Return the (or a) process associated with BUFFER.
715 BUFFER may be a buffer or the name of one. */)
717 register Lisp_Object buffer
;
719 register Lisp_Object buf
, tail
, proc
;
721 if (NILP (buffer
)) return Qnil
;
722 buf
= Fget_buffer (buffer
);
723 if (NILP (buf
)) return Qnil
;
725 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
727 proc
= Fcdr (XCAR (tail
));
728 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
734 /* This is how commands for the user decode process arguments. It
735 accepts a process, a process name, a buffer, a buffer name, or nil.
736 Buffers denote the first process in the buffer, and nil denotes the
741 register Lisp_Object name
;
743 register Lisp_Object proc
, obj
;
746 obj
= Fget_process (name
);
748 obj
= Fget_buffer (name
);
750 error ("Process %s does not exist", SDATA (name
));
752 else if (NILP (name
))
753 obj
= Fcurrent_buffer ();
757 /* Now obj should be either a buffer object or a process object.
761 proc
= Fget_buffer_process (obj
);
763 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
775 /* Fdelete_process promises to immediately forget about the process, but in
776 reality, Emacs needs to remember those processes until they have been
777 treated by sigchld_handler; otherwise this handler would consider the
778 process as being synchronous and say that the synchronous process is
780 static Lisp_Object deleted_pid_list
;
783 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
784 doc
: /* Delete PROCESS: kill it and forget about it immediately.
785 PROCESS may be a process, a buffer, the name of a process or buffer, or
786 nil, indicating the current buffer's process. */)
788 register Lisp_Object process
;
790 register struct Lisp_Process
*p
;
792 process
= get_process (process
);
793 p
= XPROCESS (process
);
795 p
->raw_status_new
= 0;
796 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
798 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
799 p
->tick
= ++process_tick
;
802 else if (p
->infd
>= 0)
806 /* Assignment to EMACS_INT stops GCC whining about limited range
808 EMACS_INT pid
= p
->pid
;
810 /* No problem storing the pid here, as it is still in Vprocess_alist. */
811 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
812 /* GC treated elements set to nil. */
813 Fdelq (Qnil
, deleted_pid_list
));
814 /* If the process has already signaled, remove it from the list. */
815 if (p
->raw_status_new
)
818 if (CONSP (p
->status
))
819 symbol
= XCAR (p
->status
);
820 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
822 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
826 Fkill_process (process
, Qnil
);
827 /* Do this now, since remove_process will make sigchld_handler do nothing. */
829 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
830 p
->tick
= ++process_tick
;
834 remove_process (process
);
838 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
839 doc
: /* Return the status of PROCESS.
840 The returned value is one of the following symbols:
841 run -- for a process that is running.
842 stop -- for a process stopped but continuable.
843 exit -- for a process that has exited.
844 signal -- for a process that has got a fatal signal.
845 open -- for a network stream connection that is open.
846 listen -- for a network stream server that is listening.
847 closed -- for a network stream connection that is closed.
848 connect -- when waiting for a non-blocking connection to complete.
849 failed -- when a non-blocking connection has failed.
850 nil -- if arg is a process name and no such process exists.
851 PROCESS may be a process, a buffer, the name of a process, or
852 nil, indicating the current buffer's process. */)
854 register Lisp_Object process
;
856 register struct Lisp_Process
*p
;
857 register Lisp_Object status
;
859 if (STRINGP (process
))
860 process
= Fget_process (process
);
862 process
= get_process (process
);
867 p
= XPROCESS (process
);
868 if (p
->raw_status_new
)
872 status
= XCAR (status
);
873 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
875 if (EQ (status
, Qexit
))
877 else if (EQ (p
->command
, Qt
))
879 else if (EQ (status
, Qrun
))
885 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
887 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
888 If PROCESS has not yet exited or died, return 0. */)
890 register Lisp_Object process
;
892 CHECK_PROCESS (process
);
893 if (XPROCESS (process
)->raw_status_new
)
894 update_status (XPROCESS (process
));
895 if (CONSP (XPROCESS (process
)->status
))
896 return XCAR (XCDR (XPROCESS (process
)->status
));
897 return make_number (0);
900 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
901 doc
: /* Return the process id of PROCESS.
902 This is the pid of the external process which PROCESS uses or talks to.
903 For a network connection, this value is nil. */)
905 register Lisp_Object process
;
907 /* Assignment to EMACS_INT stops GCC whining about limited range of
911 CHECK_PROCESS (process
);
912 pid
= XPROCESS (process
)->pid
;
913 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
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 network or serial process, this is nil (process is running) or t
932 \(process is stopped). */)
934 register Lisp_Object process
;
936 CHECK_PROCESS (process
);
937 return XPROCESS (process
)->command
;
940 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
941 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
942 This is the terminal that the process itself reads and writes on,
943 not the name of the pty that Emacs uses to talk with that terminal. */)
945 register Lisp_Object process
;
947 CHECK_PROCESS (process
);
948 return XPROCESS (process
)->tty_name
;
951 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
953 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
955 register Lisp_Object process
, buffer
;
957 struct Lisp_Process
*p
;
959 CHECK_PROCESS (process
);
961 CHECK_BUFFER (buffer
);
962 p
= XPROCESS (process
);
964 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
965 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
966 setup_process_coding_systems (process
);
970 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
972 doc
: /* Return the buffer PROCESS is associated with.
973 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
975 register Lisp_Object process
;
977 CHECK_PROCESS (process
);
978 return XPROCESS (process
)->buffer
;
981 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
983 doc
: /* Return the marker for the end of the last output from PROCESS. */)
985 register Lisp_Object process
;
987 CHECK_PROCESS (process
);
988 return XPROCESS (process
)->mark
;
991 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
993 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
994 A value of t means stop accepting output from the process.
996 When a process has a filter, its buffer is not used for output.
997 Instead, each time it does output, the entire string of output is
998 passed to the filter.
1000 The filter gets two arguments: the process and the string of output.
1001 The string argument is normally a multibyte string, except:
1002 - if the process' input coding system is no-conversion or raw-text,
1003 it is a unibyte string (the non-converted input), or else
1004 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1005 string (the result of converting the decoded input multibyte
1006 string to unibyte with `string-make-unibyte'). */)
1008 register Lisp_Object process
, filter
;
1010 struct Lisp_Process
*p
;
1012 CHECK_PROCESS (process
);
1013 p
= XPROCESS (process
);
1015 /* Don't signal an error if the process' input file descriptor
1016 is closed. This could make debugging Lisp more difficult,
1017 for example when doing something like
1019 (setq process (start-process ...))
1021 (set-process-filter process ...) */
1025 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1027 FD_CLR (p
->infd
, &input_wait_mask
);
1028 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1030 else if (EQ (p
->filter
, Qt
)
1031 /* Network or serial process not stopped: */
1032 && !EQ (p
->command
, Qt
))
1034 FD_SET (p
->infd
, &input_wait_mask
);
1035 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1040 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1041 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1042 setup_process_coding_systems (process
);
1046 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1048 doc
: /* Returns the filter function of PROCESS; nil if none.
1049 See `set-process-filter' for more info on filter functions. */)
1051 register Lisp_Object process
;
1053 CHECK_PROCESS (process
);
1054 return XPROCESS (process
)->filter
;
1057 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1059 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1060 The sentinel is called as a function when the process changes state.
1061 It gets two arguments: the process, and a string describing the change. */)
1063 register Lisp_Object process
, sentinel
;
1065 struct Lisp_Process
*p
;
1067 CHECK_PROCESS (process
);
1068 p
= XPROCESS (process
);
1070 p
->sentinel
= sentinel
;
1071 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1072 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1076 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1078 doc
: /* Return the sentinel of PROCESS; nil if none.
1079 See `set-process-sentinel' for more info on sentinels. */)
1081 register Lisp_Object process
;
1083 CHECK_PROCESS (process
);
1084 return XPROCESS (process
)->sentinel
;
1087 DEFUN ("set-process-window-size", Fset_process_window_size
,
1088 Sset_process_window_size
, 3, 3, 0,
1089 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1090 (process
, height
, width
)
1091 register Lisp_Object process
, height
, width
;
1093 CHECK_PROCESS (process
);
1094 CHECK_NATNUM (height
);
1095 CHECK_NATNUM (width
);
1097 if (XPROCESS (process
)->infd
< 0
1098 || set_window_size (XPROCESS (process
)->infd
,
1099 XINT (height
), XINT (width
)) <= 0)
1105 DEFUN ("set-process-inherit-coding-system-flag",
1106 Fset_process_inherit_coding_system_flag
,
1107 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1108 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1109 If the second argument FLAG is non-nil, then the variable
1110 `buffer-file-coding-system' of the buffer associated with PROCESS
1111 will be bound to the value of the coding system used to decode
1114 This is useful when the coding system specified for the process buffer
1115 leaves either the character code conversion or the end-of-line conversion
1116 unspecified, or if the coding system used to decode the process output
1117 is more appropriate for saving the process buffer.
1119 Binding the variable `inherit-process-coding-system' to non-nil before
1120 starting the process is an alternative way of setting the inherit flag
1121 for the process which will run. */)
1123 register Lisp_Object process
, flag
;
1125 CHECK_PROCESS (process
);
1126 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1130 DEFUN ("process-inherit-coding-system-flag",
1131 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1133 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1134 If this flag is t, `buffer-file-coding-system' of the buffer
1135 associated with PROCESS will inherit the coding system used to decode
1136 the process output. */)
1138 register Lisp_Object process
;
1140 CHECK_PROCESS (process
);
1141 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
1144 DEFUN ("set-process-query-on-exit-flag",
1145 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1147 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1148 If the second argument FLAG is non-nil, Emacs will query the user before
1149 exiting if PROCESS is running. */)
1151 register Lisp_Object process
, flag
;
1153 CHECK_PROCESS (process
);
1154 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1158 DEFUN ("process-query-on-exit-flag",
1159 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1161 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1163 register Lisp_Object process
;
1165 CHECK_PROCESS (process
);
1166 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1169 #ifdef DATAGRAM_SOCKETS
1170 Lisp_Object
Fprocess_datagram_address ();
1173 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1175 doc
: /* Return the contact info of PROCESS; t for a real child.
1176 For a network or serial connection, the value depends on the optional
1177 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1178 SERVICE) for a network connection or (PORT SPEED) for a serial
1179 connection. If KEY is t, the complete contact information for the
1180 connection is returned, else the specific value for the keyword KEY is
1181 returned. See `make-network-process' or `make-serial-process' for a
1182 list of keywords. */)
1184 register Lisp_Object process
, key
;
1186 Lisp_Object contact
;
1188 CHECK_PROCESS (process
);
1189 contact
= XPROCESS (process
)->childp
;
1191 #ifdef DATAGRAM_SOCKETS
1192 if (DATAGRAM_CONN_P (process
)
1193 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1194 contact
= Fplist_put (contact
, QCremote
,
1195 Fprocess_datagram_address (process
));
1198 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1200 if (NILP (key
) && NETCONN_P (process
))
1201 return Fcons (Fplist_get (contact
, QChost
),
1202 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1203 if (NILP (key
) && SERIALCONN_P (process
))
1204 return Fcons (Fplist_get (contact
, QCport
),
1205 Fcons (Fplist_get (contact
, QCspeed
), Qnil
));
1206 return Fplist_get (contact
, key
);
1209 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1211 doc
: /* Return the plist of PROCESS. */)
1213 register Lisp_Object process
;
1215 CHECK_PROCESS (process
);
1216 return XPROCESS (process
)->plist
;
1219 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1221 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1223 register Lisp_Object process
, plist
;
1225 CHECK_PROCESS (process
);
1228 XPROCESS (process
)->plist
= plist
;
1232 #if 0 /* Turned off because we don't currently record this info
1233 in the process. Perhaps add it. */
1234 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1235 doc
: /* Return the connection type of PROCESS.
1236 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1237 a socket connection. */)
1239 Lisp_Object process
;
1241 return XPROCESS (process
)->type
;
1245 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1246 doc
: /* Return the connection type of PROCESS.
1247 The value is either the symbol `real', `network', or `serial'.
1248 PROCESS may be a process, a buffer, the name of a process or buffer, or
1249 nil, indicating the current buffer's process. */)
1251 Lisp_Object process
;
1254 proc
= get_process (process
);
1255 return XPROCESS (proc
)->type
;
1259 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1261 doc
: /* Convert network ADDRESS from internal format to a string.
1262 A 4 or 5 element vector represents an IPv4 address (with port number).
1263 An 8 or 9 element vector represents an IPv6 address (with port number).
1264 If optional second argument OMIT-PORT is non-nil, don't include a port
1265 number in the string, even when present in ADDRESS.
1266 Returns nil if format of ADDRESS is invalid. */)
1267 (address
, omit_port
)
1268 Lisp_Object address
, omit_port
;
1273 if (STRINGP (address
)) /* AF_LOCAL */
1276 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1278 register struct Lisp_Vector
*p
= XVECTOR (address
);
1279 Lisp_Object args
[10];
1282 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1284 args
[0] = build_string ("%d.%d.%d.%d");
1287 else if (p
->size
== 5)
1289 args
[0] = build_string ("%d.%d.%d.%d:%d");
1292 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1294 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1297 else if (p
->size
== 9)
1299 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1305 for (i
= 0; i
< nargs
; i
++)
1307 EMACS_INT element
= XINT (p
->contents
[i
]);
1309 if (element
< 0 || element
> 65535)
1312 if (nargs
<= 5 /* IPv4 */
1313 && i
< 4 /* host, not port */
1317 args
[i
+1] = p
->contents
[i
];
1320 return Fformat (nargs
+1, args
);
1323 if (CONSP (address
))
1325 Lisp_Object args
[2];
1326 args
[0] = build_string ("<Family %d>");
1327 args
[1] = Fcar (address
);
1328 return Fformat (2, args
);
1336 list_processes_1 (query_only
)
1337 Lisp_Object query_only
;
1339 register Lisp_Object tail
, tem
;
1340 Lisp_Object proc
, minspace
, tem1
;
1341 register struct Lisp_Process
*p
;
1343 int w_proc
, w_buffer
, w_tty
;
1345 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1347 w_proc
= 4; /* Proc */
1348 w_buffer
= 6; /* Buffer */
1349 w_tty
= 0; /* Omit if no ttys */
1351 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1355 proc
= Fcdr (XCAR (tail
));
1356 p
= XPROCESS (proc
);
1359 if (!NILP (query_only
) && p
->kill_without_query
)
1361 if (STRINGP (p
->name
)
1362 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1364 if (!NILP (p
->buffer
))
1366 if (NILP (XBUFFER (p
->buffer
)->name
))
1369 w_buffer
= 8; /* (Killed) */
1371 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1374 if (STRINGP (p
->tty_name
)
1375 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1379 XSETFASTINT (i_status
, w_proc
+ 1);
1380 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1383 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1384 XSETFASTINT (i_command
, XFASTINT (i_tty
) + w_tty
+ 1);
1389 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1392 XSETFASTINT (minspace
, 1);
1394 set_buffer_internal (XBUFFER (Vstandard_output
));
1395 current_buffer
->undo_list
= Qt
;
1397 current_buffer
->truncate_lines
= Qt
;
1399 write_string ("Proc", -1);
1400 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1401 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1404 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1406 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1407 write_string ("\n", -1);
1409 write_string ("----", -1);
1410 Findent_to (i_status
, minspace
); write_string ("------", -1);
1411 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1414 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1416 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1417 write_string ("\n", -1);
1419 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1423 proc
= Fcdr (XCAR (tail
));
1424 p
= XPROCESS (proc
);
1427 if (!NILP (query_only
) && p
->kill_without_query
)
1430 Finsert (1, &p
->name
);
1431 Findent_to (i_status
, minspace
);
1433 if (p
->raw_status_new
)
1436 if (CONSP (p
->status
))
1437 symbol
= XCAR (p
->status
);
1439 if (EQ (symbol
, Qsignal
))
1442 tem
= Fcar (Fcdr (p
->status
));
1444 if (XINT (tem
) < NSIG
)
1445 write_string (sys_errlist
[XINT (tem
)], -1);
1448 Fprinc (symbol
, Qnil
);
1450 else if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1452 if (EQ (symbol
, Qexit
))
1453 write_string ("closed", -1);
1454 else if (EQ (p
->command
, Qt
))
1455 write_string ("stopped", -1);
1456 else if (EQ (symbol
, Qrun
))
1457 write_string ("open", -1);
1459 Fprinc (symbol
, Qnil
);
1461 else if (SERIALCONN1_P (p
))
1463 write_string ("running", -1);
1466 Fprinc (symbol
, Qnil
);
1468 if (EQ (symbol
, Qexit
))
1471 tem
= Fcar (Fcdr (p
->status
));
1474 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1475 write_string (tembuf
, -1);
1479 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
) || EQ (symbol
, Qclosed
))
1482 Findent_to (i_buffer
, minspace
);
1483 if (NILP (p
->buffer
))
1484 insert_string ("(none)");
1485 else if (NILP (XBUFFER (p
->buffer
)->name
))
1486 insert_string ("(Killed)");
1488 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1492 Findent_to (i_tty
, minspace
);
1493 if (STRINGP (p
->tty_name
))
1494 Finsert (1, &p
->tty_name
);
1497 Findent_to (i_command
, minspace
);
1499 if (EQ (p
->status
, Qlisten
))
1501 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1502 if (INTEGERP (port
))
1503 port
= Fnumber_to_string (port
);
1505 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1506 sprintf (tembuf
, "(network %s server on %s)\n",
1507 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1508 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1509 insert_string (tembuf
);
1511 else if (NETCONN1_P (p
))
1513 /* For a local socket, there is no host name,
1514 so display service instead. */
1515 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1516 if (!STRINGP (host
))
1518 host
= Fplist_get (p
->childp
, QCservice
);
1519 if (INTEGERP (host
))
1520 host
= Fnumber_to_string (host
);
1523 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1524 sprintf (tembuf
, "(network %s connection to %s)\n",
1525 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1526 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1527 insert_string (tembuf
);
1529 else if (SERIALCONN1_P (p
))
1531 Lisp_Object port
= Fplist_get (p
->childp
, QCport
);
1532 Lisp_Object speed
= Fplist_get (p
->childp
, QCspeed
);
1533 insert_string ("(serial port ");
1535 insert_string (SDATA (port
));
1537 insert_string ("?");
1538 if (INTEGERP (speed
))
1540 sprintf (tembuf
, " at %d b/s", XINT (speed
));
1541 insert_string (tembuf
);
1543 insert_string (")\n");
1555 insert_string (" ");
1557 insert_string ("\n");
1561 status_notify (NULL
);
1565 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1566 doc
: /* Display a list of all processes.
1567 If optional argument QUERY-ONLY is non-nil, only processes with
1568 the query-on-exit flag set will be listed.
1569 Any process listed as exited or signaled is actually eliminated
1570 after the listing is made. */)
1572 Lisp_Object query_only
;
1574 internal_with_output_to_temp_buffer ("*Process List*",
1575 list_processes_1
, query_only
);
1579 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1580 doc
: /* Return a list of all processes. */)
1583 return Fmapcar (Qcdr
, Vprocess_alist
);
1586 /* Starting asynchronous inferior processes. */
1588 static Lisp_Object
start_process_unwind ();
1590 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1591 doc
: /* Start a program in a subprocess. Return the process object for it.
1592 NAME is name for process. It is modified if necessary to make it unique.
1593 BUFFER is the buffer (or buffer name) to associate with the process.
1595 Process output (both standard output and standard error streams) goes
1596 at end of BUFFER, unless you specify an output stream or filter
1597 function to handle the output. BUFFER may also be nil, meaning that
1598 this process is not associated with any buffer.
1600 PROGRAM is the program file name. It is searched for in PATH.
1601 Remaining arguments are strings to give program as arguments.
1603 If you want to separate standard output from standard error, invoke
1604 the command through a shell and redirect one of them using the shell
1607 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1610 register Lisp_Object
*args
;
1612 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1614 register unsigned char *new_argv
;
1617 register unsigned char **new_argv
;
1620 int count
= SPECPDL_INDEX ();
1624 buffer
= Fget_buffer_create (buffer
);
1626 /* Make sure that the child will be able to chdir to the current
1627 buffer's current directory, or its unhandled equivalent. We
1628 can't just have the child check for an error when it does the
1629 chdir, since it's in a vfork.
1631 We have to GCPRO around this because Fexpand_file_name and
1632 Funhandled_file_name_directory might call a file name handling
1633 function. The argument list is protected by the caller, so all
1634 we really have to worry about is buffer. */
1636 struct gcpro gcpro1
, gcpro2
;
1638 current_dir
= current_buffer
->directory
;
1640 GCPRO2 (buffer
, current_dir
);
1642 current_dir
= Funhandled_file_name_directory (current_dir
);
1643 if (NILP (current_dir
))
1644 /* If the file name handler says that current_dir is unreachable, use
1645 a sensible default. */
1646 current_dir
= build_string ("~/");
1647 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1648 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1649 report_file_error ("Setting current directory",
1650 Fcons (current_buffer
->directory
, Qnil
));
1656 CHECK_STRING (name
);
1660 CHECK_STRING (program
);
1662 proc
= make_process (name
);
1663 /* If an error occurs and we can't start the process, we want to
1664 remove it from the process list. This means that each error
1665 check in create_process doesn't need to call remove_process
1666 itself; it's all taken care of here. */
1667 record_unwind_protect (start_process_unwind
, proc
);
1669 XPROCESS (proc
)->childp
= Qt
;
1670 XPROCESS (proc
)->plist
= Qnil
;
1671 XPROCESS (proc
)->type
= Qreal
;
1672 XPROCESS (proc
)->buffer
= buffer
;
1673 XPROCESS (proc
)->sentinel
= Qnil
;
1674 XPROCESS (proc
)->filter
= Qnil
;
1675 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1677 #ifdef ADAPTIVE_READ_BUFFERING
1678 XPROCESS (proc
)->adaptive_read_buffering
1679 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1680 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1683 /* Make the process marker point into the process buffer (if any). */
1684 if (BUFFERP (buffer
))
1685 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1686 BUF_ZV (XBUFFER (buffer
)),
1687 BUF_ZV_BYTE (XBUFFER (buffer
)));
1690 /* Decide coding systems for communicating with the process. Here
1691 we don't setup the structure coding_system nor pay attention to
1692 unibyte mode. They are done in create_process. */
1694 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1695 Lisp_Object coding_systems
= Qt
;
1696 Lisp_Object val
, *args2
;
1697 struct gcpro gcpro1
, gcpro2
;
1699 val
= Vcoding_system_for_read
;
1702 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1703 args2
[0] = Qstart_process
;
1704 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1705 GCPRO2 (proc
, current_dir
);
1706 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1708 if (CONSP (coding_systems
))
1709 val
= XCAR (coding_systems
);
1710 else if (CONSP (Vdefault_process_coding_system
))
1711 val
= XCAR (Vdefault_process_coding_system
);
1713 XPROCESS (proc
)->decode_coding_system
= val
;
1715 val
= Vcoding_system_for_write
;
1718 if (EQ (coding_systems
, Qt
))
1720 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1721 args2
[0] = Qstart_process
;
1722 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1723 GCPRO2 (proc
, current_dir
);
1724 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1727 if (CONSP (coding_systems
))
1728 val
= XCDR (coding_systems
);
1729 else if (CONSP (Vdefault_process_coding_system
))
1730 val
= XCDR (Vdefault_process_coding_system
);
1732 XPROCESS (proc
)->encode_coding_system
= val
;
1736 /* Make a one member argv with all args concatenated
1737 together separated by a blank. */
1738 len
= SBYTES (program
) + 2;
1739 for (i
= 3; i
< nargs
; i
++)
1743 len
+= SBYTES (tem
) + 1; /* count the blank */
1745 new_argv
= (unsigned char *) alloca (len
);
1746 strcpy (new_argv
, SDATA (program
));
1747 for (i
= 3; i
< nargs
; i
++)
1751 strcat (new_argv
, " ");
1752 strcat (new_argv
, SDATA (tem
));
1754 /* Need to add code here to check for program existence on VMS */
1757 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1759 /* If program file name is not absolute, search our path for it.
1760 Put the name we will really use in TEM. */
1761 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1762 && !(SCHARS (program
) > 1
1763 && IS_DEVICE_SEP (SREF (program
, 1))))
1765 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1768 GCPRO4 (name
, program
, buffer
, current_dir
);
1769 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1772 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1773 tem
= Fexpand_file_name (tem
, Qnil
);
1777 if (!NILP (Ffile_directory_p (program
)))
1778 error ("Specified program for new process is a directory");
1782 /* If program file name starts with /: for quoting a magic name,
1784 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1785 && SREF (tem
, 1) == ':')
1786 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1788 /* Encode the file name and put it in NEW_ARGV.
1789 That's where the child will use it to execute the program. */
1790 tem
= ENCODE_FILE (tem
);
1791 new_argv
[0] = SDATA (tem
);
1793 /* Here we encode arguments by the coding system used for sending
1794 data to the process. We don't support using different coding
1795 systems for encoding arguments and for encoding data sent to the
1798 for (i
= 3; i
< nargs
; i
++)
1802 if (STRING_MULTIBYTE (tem
))
1803 tem
= (code_convert_string_norecord
1804 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1805 new_argv
[i
- 2] = SDATA (tem
);
1807 new_argv
[i
- 2] = 0;
1808 #endif /* not VMS */
1810 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1811 XPROCESS (proc
)->decoding_carryover
= 0;
1812 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1814 XPROCESS (proc
)->inherit_coding_system_flag
1815 = !(NILP (buffer
) || !inherit_process_coding_system
);
1817 create_process (proc
, (char **) new_argv
, current_dir
);
1819 return unbind_to (count
, proc
);
1822 /* This function is the unwind_protect form for Fstart_process. If
1823 PROC doesn't have its pid set, then we know someone has signaled
1824 an error and the process wasn't started successfully, so we should
1825 remove it from the process list. */
1827 start_process_unwind (proc
)
1830 if (!PROCESSP (proc
))
1833 /* Was PROC started successfully? */
1834 if (XPROCESS (proc
)->pid
<= 0)
1835 remove_process (proc
);
1841 create_process_1 (timer
)
1842 struct atimer
*timer
;
1844 /* Nothing to do. */
1848 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1851 /* Mimic blocking of signals on system V, which doesn't really have it. */
1853 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1854 int sigchld_deferred
;
1857 create_process_sigchld ()
1859 signal (SIGCHLD
, create_process_sigchld
);
1861 sigchld_deferred
= 1;
1867 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1869 create_process (process
, new_argv
, current_dir
)
1870 Lisp_Object process
;
1872 Lisp_Object current_dir
;
1874 int inchannel
, outchannel
;
1877 #ifdef POSIX_SIGNALS
1880 struct sigaction sigint_action
;
1881 struct sigaction sigquit_action
;
1883 struct sigaction sighup_action
;
1885 #else /* !POSIX_SIGNALS */
1888 SIGTYPE (*sigchld
)();
1891 #endif /* !POSIX_SIGNALS */
1892 /* Use volatile to protect variables from being clobbered by longjmp. */
1893 volatile int forkin
, forkout
;
1894 volatile int pty_flag
= 0;
1896 extern char **environ
;
1899 inchannel
= outchannel
= -1;
1902 if (!NILP (Vprocess_connection_type
))
1903 outchannel
= inchannel
= allocate_pty ();
1907 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1908 /* On most USG systems it does not work to open the pty's tty here,
1909 then close it and reopen it in the child. */
1911 /* Don't let this terminal become our controlling terminal
1912 (in case we don't have one). */
1913 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1915 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1918 report_file_error ("Opening pty", Qnil
);
1919 #if defined (DONT_REOPEN_PTY)
1920 /* In the case that vfork is defined as fork, the parent process
1921 (Emacs) may send some data before the child process completes
1922 tty options setup. So we setup tty before forking. */
1923 child_setup_tty (forkout
);
1924 #endif /* DONT_REOPEN_PTY */
1926 forkin
= forkout
= -1;
1927 #endif /* not USG, or USG_SUBTTY_WORKS */
1931 #endif /* HAVE_PTYS */
1936 report_file_error ("Creating pipe", Qnil
);
1942 emacs_close (inchannel
);
1943 emacs_close (forkout
);
1944 report_file_error ("Creating pipe", Qnil
);
1951 /* Replaced by close_process_descs */
1952 set_exclusive_use (inchannel
);
1953 set_exclusive_use (outchannel
);
1957 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1958 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1961 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1962 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1966 /* Record this as an active process, with its channels.
1967 As a result, child_setup will close Emacs's side of the pipes. */
1968 chan_process
[inchannel
] = process
;
1969 XPROCESS (process
)->infd
= inchannel
;
1970 XPROCESS (process
)->outfd
= outchannel
;
1972 /* Previously we recorded the tty descriptor used in the subprocess.
1973 It was only used for getting the foreground tty process, so now
1974 we just reopen the device (see emacs_get_tty_pgrp) as this is
1975 more portable (see USG_SUBTTY_WORKS above). */
1977 XPROCESS (process
)->pty_flag
= pty_flag
;
1978 XPROCESS (process
)->status
= Qrun
;
1979 setup_process_coding_systems (process
);
1981 /* Delay interrupts until we have a chance to store
1982 the new fork's pid in its process structure */
1983 #ifdef POSIX_SIGNALS
1984 sigemptyset (&blocked
);
1986 sigaddset (&blocked
, SIGCHLD
);
1988 #ifdef HAVE_WORKING_VFORK
1989 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1990 this sets the parent's signal handlers as well as the child's.
1991 So delay all interrupts whose handlers the child might munge,
1992 and record the current handlers so they can be restored later. */
1993 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1994 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1996 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1998 #endif /* HAVE_WORKING_VFORK */
1999 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
2000 #else /* !POSIX_SIGNALS */
2002 #if defined (BSD_SYSTEM) || defined (HPUX)
2003 sigsetmask (sigmask (SIGCHLD
));
2004 #else /* ordinary USG */
2006 sigchld_deferred
= 0;
2007 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
2009 #endif /* ordinary USG */
2010 #endif /* SIGCHLD */
2011 #endif /* !POSIX_SIGNALS */
2013 FD_SET (inchannel
, &input_wait_mask
);
2014 FD_SET (inchannel
, &non_keyboard_wait_mask
);
2015 if (inchannel
> max_process_desc
)
2016 max_process_desc
= inchannel
;
2018 /* Until we store the proper pid, enable sigchld_handler
2019 to recognize an unknown pid as standing for this process.
2020 It is very important not to let this `marker' value stay
2021 in the table after this function has returned; if it does
2022 it might cause call-process to hang and subsequent asynchronous
2023 processes to get their return values scrambled. */
2024 XPROCESS (process
)->pid
= -1;
2029 /* child_setup must clobber environ on systems with true vfork.
2030 Protect it from permanent change. */
2031 char **save_environ
= environ
;
2033 current_dir
= ENCODE_FILE (current_dir
);
2038 #endif /* not WINDOWSNT */
2040 int xforkin
= forkin
;
2041 int xforkout
= forkout
;
2043 #if 0 /* This was probably a mistake--it duplicates code later on,
2044 but fails to handle all the cases. */
2045 /* Make sure SIGCHLD is not blocked in the child. */
2046 sigsetmask (SIGEMPTYMASK
);
2049 /* Make the pty be the controlling terminal of the process. */
2051 /* First, disconnect its current controlling terminal. */
2053 /* We tried doing setsid only if pty_flag, but it caused
2054 process_set_signal to fail on SGI when using a pipe. */
2056 /* Make the pty's terminal the controlling terminal. */
2060 /* We ignore the return value
2061 because faith@cs.unc.edu says that is necessary on Linux. */
2062 ioctl (xforkin
, TIOCSCTTY
, 0);
2065 #else /* not HAVE_SETSID */
2067 /* It's very important to call setpgrp here and no time
2068 afterwards. Otherwise, we lose our controlling tty which
2069 is set when we open the pty. */
2072 #endif /* not HAVE_SETSID */
2073 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2074 if (pty_flag
&& xforkin
>= 0)
2077 tcgetattr (xforkin
, &t
);
2079 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2080 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2083 #if defined (NTTYDISC) && defined (TIOCSETD)
2084 if (pty_flag
&& xforkin
>= 0)
2086 /* Use new line discipline. */
2087 int ldisc
= NTTYDISC
;
2088 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2093 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2094 can do TIOCSPGRP only to the process's controlling tty. */
2097 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2098 I can't test it since I don't have 4.3. */
2099 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2100 ioctl (j
, TIOCNOTTY
, 0);
2103 /* In order to get a controlling terminal on some versions
2104 of BSD, it is necessary to put the process in pgrp 0
2105 before it opens the terminal. */
2113 #endif /* TIOCNOTTY */
2115 #if !defined (DONT_REOPEN_PTY)
2116 /*** There is a suggestion that this ought to be a
2117 conditional on TIOCSPGRP,
2118 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2119 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2120 that system does seem to need this code, even though
2121 both HAVE_SETSID and TIOCSCTTY are defined. */
2122 /* Now close the pty (if we had it open) and reopen it.
2123 This makes the pty the controlling terminal of the subprocess. */
2127 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2130 emacs_close (xforkin
);
2131 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2135 emacs_write (1, "Couldn't open the pty terminal ", 31);
2136 emacs_write (1, pty_name
, strlen (pty_name
));
2137 emacs_write (1, "\n", 1);
2142 #endif /* not DONT_REOPEN_PTY */
2144 #ifdef SETUP_SLAVE_PTY
2149 #endif /* SETUP_SLAVE_PTY */
2151 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2152 Now reenable it in the child, so it will die when we want it to. */
2154 signal (SIGHUP
, SIG_DFL
);
2156 #endif /* HAVE_PTYS */
2158 signal (SIGINT
, SIG_DFL
);
2159 signal (SIGQUIT
, SIG_DFL
);
2161 /* Stop blocking signals in the child. */
2162 #ifdef POSIX_SIGNALS
2163 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2164 #else /* !POSIX_SIGNALS */
2166 #if defined (BSD_SYSTEM) || defined (HPUX)
2167 sigsetmask (SIGEMPTYMASK
);
2168 #else /* ordinary USG */
2170 signal (SIGCHLD
, sigchld
);
2172 #endif /* ordinary USG */
2173 #endif /* SIGCHLD */
2174 #endif /* !POSIX_SIGNALS */
2176 #if !defined (DONT_REOPEN_PTY)
2178 child_setup_tty (xforkout
);
2179 #endif /* not DONT_REOPEN_PTY */
2181 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2182 new_argv
, 1, current_dir
);
2183 #else /* not WINDOWSNT */
2184 child_setup (xforkin
, xforkout
, xforkout
,
2185 new_argv
, 1, current_dir
);
2186 #endif /* not WINDOWSNT */
2188 environ
= save_environ
;
2193 /* This runs in the Emacs process. */
2197 emacs_close (forkin
);
2198 if (forkin
!= forkout
&& forkout
>= 0)
2199 emacs_close (forkout
);
2203 /* vfork succeeded. */
2204 XPROCESS (process
)->pid
= pid
;
2207 register_child (pid
, inchannel
);
2208 #endif /* WINDOWSNT */
2210 /* If the subfork execv fails, and it exits,
2211 this close hangs. I don't know why.
2212 So have an interrupt jar it loose. */
2214 struct atimer
*timer
;
2218 EMACS_SET_SECS_USECS (offset
, 1, 0);
2219 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2222 emacs_close (forkin
);
2224 cancel_atimer (timer
);
2228 if (forkin
!= forkout
&& forkout
>= 0)
2229 emacs_close (forkout
);
2233 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2236 XPROCESS (process
)->tty_name
= Qnil
;
2239 /* Restore the signal state whether vfork succeeded or not.
2240 (We will signal an error, below, if it failed.) */
2241 #ifdef POSIX_SIGNALS
2242 #ifdef HAVE_WORKING_VFORK
2243 /* Restore the parent's signal handlers. */
2244 sigaction (SIGINT
, &sigint_action
, 0);
2245 sigaction (SIGQUIT
, &sigquit_action
, 0);
2247 sigaction (SIGHUP
, &sighup_action
, 0);
2249 #endif /* HAVE_WORKING_VFORK */
2250 /* Stop blocking signals in the parent. */
2251 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2252 #else /* !POSIX_SIGNALS */
2254 #if defined (BSD_SYSTEM) || defined (HPUX)
2255 sigsetmask (SIGEMPTYMASK
);
2256 #else /* ordinary USG */
2258 signal (SIGCHLD
, sigchld
);
2259 /* Now really handle any of these signals
2260 that came in during this function. */
2261 if (sigchld_deferred
)
2262 kill (getpid (), SIGCHLD
);
2264 #endif /* ordinary USG */
2265 #endif /* SIGCHLD */
2266 #endif /* !POSIX_SIGNALS */
2268 /* Now generate the error if vfork failed. */
2270 report_file_error ("Doing vfork", Qnil
);
2272 #endif /* not VMS */
2277 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2278 The address family of sa is not included in the result. */
2281 conv_sockaddr_to_lisp (sa
, len
)
2282 struct sockaddr
*sa
;
2285 Lisp_Object address
;
2288 register struct Lisp_Vector
*p
;
2290 switch (sa
->sa_family
)
2294 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2295 len
= sizeof (sin
->sin_addr
) + 1;
2296 address
= Fmake_vector (make_number (len
), Qnil
);
2297 p
= XVECTOR (address
);
2298 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2299 cp
= (unsigned char *)&sin
->sin_addr
;
2305 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2306 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2307 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2308 address
= Fmake_vector (make_number (len
), Qnil
);
2309 p
= XVECTOR (address
);
2310 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2311 for (i
= 0; i
< len
; i
++)
2312 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2316 #ifdef HAVE_LOCAL_SOCKETS
2319 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2320 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2321 if (sockun
->sun_path
[i
] == 0)
2323 return make_unibyte_string (sockun
->sun_path
, i
);
2327 len
-= sizeof (sa
->sa_family
);
2328 address
= Fcons (make_number (sa
->sa_family
),
2329 Fmake_vector (make_number (len
), Qnil
));
2330 p
= XVECTOR (XCDR (address
));
2331 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2337 p
->contents
[i
++] = make_number (*cp
++);
2343 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2346 get_lisp_to_sockaddr_size (address
, familyp
)
2347 Lisp_Object address
;
2350 register struct Lisp_Vector
*p
;
2352 if (VECTORP (address
))
2354 p
= XVECTOR (address
);
2358 return sizeof (struct sockaddr_in
);
2361 else if (p
->size
== 9)
2363 *familyp
= AF_INET6
;
2364 return sizeof (struct sockaddr_in6
);
2368 #ifdef HAVE_LOCAL_SOCKETS
2369 else if (STRINGP (address
))
2371 *familyp
= AF_LOCAL
;
2372 return sizeof (struct sockaddr_un
);
2375 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2377 struct sockaddr
*sa
;
2378 *familyp
= XINT (XCAR (address
));
2379 p
= XVECTOR (XCDR (address
));
2380 return p
->size
+ sizeof (sa
->sa_family
);
2385 /* Convert an address object (vector or string) to an internal sockaddr.
2387 The address format has been basically validated by
2388 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2389 it could have come from user data. So if FAMILY is not valid,
2390 we return after zeroing *SA. */
2393 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2395 Lisp_Object address
;
2396 struct sockaddr
*sa
;
2399 register struct Lisp_Vector
*p
;
2400 register unsigned char *cp
= NULL
;
2405 if (VECTORP (address
))
2407 p
= XVECTOR (address
);
2408 if (family
== AF_INET
)
2410 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2411 len
= sizeof (sin
->sin_addr
) + 1;
2412 i
= XINT (p
->contents
[--len
]);
2413 sin
->sin_port
= htons (i
);
2414 cp
= (unsigned char *)&sin
->sin_addr
;
2415 sa
->sa_family
= family
;
2418 else if (family
== AF_INET6
)
2420 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2421 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2422 len
= sizeof (sin6
->sin6_addr
) + 1;
2423 i
= XINT (p
->contents
[--len
]);
2424 sin6
->sin6_port
= htons (i
);
2425 for (i
= 0; i
< len
; i
++)
2426 if (INTEGERP (p
->contents
[i
]))
2428 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2431 sa
->sa_family
= family
;
2436 else if (STRINGP (address
))
2438 #ifdef HAVE_LOCAL_SOCKETS
2439 if (family
== AF_LOCAL
)
2441 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2442 cp
= SDATA (address
);
2443 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2444 sockun
->sun_path
[i
] = *cp
++;
2445 sa
->sa_family
= family
;
2452 p
= XVECTOR (XCDR (address
));
2453 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2456 for (i
= 0; i
< len
; i
++)
2457 if (INTEGERP (p
->contents
[i
]))
2458 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2461 #ifdef DATAGRAM_SOCKETS
2462 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2464 doc
: /* Get the current datagram address associated with PROCESS. */)
2466 Lisp_Object process
;
2470 CHECK_PROCESS (process
);
2472 if (!DATAGRAM_CONN_P (process
))
2475 channel
= XPROCESS (process
)->infd
;
2476 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2477 datagram_address
[channel
].len
);
2480 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2482 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2483 Returns nil upon error setting address, ADDRESS otherwise. */)
2485 Lisp_Object process
, address
;
2490 CHECK_PROCESS (process
);
2492 if (!DATAGRAM_CONN_P (process
))
2495 channel
= XPROCESS (process
)->infd
;
2497 len
= get_lisp_to_sockaddr_size (address
, &family
);
2498 if (datagram_address
[channel
].len
!= len
)
2500 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2506 static struct socket_options
{
2507 /* The name of this option. Should be lowercase version of option
2508 name without SO_ prefix. */
2510 /* Option level SOL_... */
2512 /* Option number SO_... */
2514 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2515 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2516 } socket_options
[] =
2518 #ifdef SO_BINDTODEVICE
2519 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2522 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2525 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2528 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2531 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2534 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2537 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2540 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2542 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2545 /* Set option OPT to value VAL on socket S.
2547 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2548 Signals an error if setting a known option fails.
2552 set_socket_option (s
, opt
, val
)
2554 Lisp_Object opt
, val
;
2557 struct socket_options
*sopt
;
2562 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2563 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2564 if (strcmp (name
, sopt
->name
) == 0)
2567 switch (sopt
->opttype
)
2572 optval
= NILP (val
) ? 0 : 1;
2573 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2574 &optval
, sizeof (optval
));
2582 optval
= XINT (val
);
2584 error ("Bad option value for %s", name
);
2585 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2586 &optval
, sizeof (optval
));
2590 #ifdef SO_BINDTODEVICE
2593 char devname
[IFNAMSIZ
+1];
2595 /* This is broken, at least in the Linux 2.4 kernel.
2596 To unbind, the arg must be a zero integer, not the empty string.
2597 This should work on all systems. KFS. 2003-09-23. */
2598 bzero (devname
, sizeof devname
);
2601 char *arg
= (char *) SDATA (val
);
2602 int len
= min (strlen (arg
), IFNAMSIZ
);
2603 bcopy (arg
, devname
, len
);
2605 else if (!NILP (val
))
2606 error ("Bad option value for %s", name
);
2607 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2616 struct linger linger
;
2619 linger
.l_linger
= 0;
2621 linger
.l_linger
= XINT (val
);
2623 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2624 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2625 &linger
, sizeof (linger
));
2635 report_file_error ("Cannot set network option",
2636 Fcons (opt
, Fcons (val
, Qnil
)));
2637 return (1 << sopt
->optbit
);
2641 DEFUN ("set-network-process-option",
2642 Fset_network_process_option
, Sset_network_process_option
,
2644 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2645 See `make-network-process' for a list of options and values.
2646 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2647 OPTION is not a supported option, return nil instead; otherwise return t. */)
2648 (process
, option
, value
, no_error
)
2649 Lisp_Object process
, option
, value
;
2650 Lisp_Object no_error
;
2653 struct Lisp_Process
*p
;
2655 CHECK_PROCESS (process
);
2656 p
= XPROCESS (process
);
2657 if (!NETCONN1_P (p
))
2658 error ("Process is not a network process");
2662 error ("Process is not running");
2664 if (set_socket_option (s
, option
, value
))
2666 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2670 if (NILP (no_error
))
2671 error ("Unknown or unsupported option");
2678 DEFUN ("serial-process-configure",
2679 Fserial_process_configure
,
2680 Sserial_process_configure
,
2682 doc
: /* Configure speed, bytesize, etc. of a serial process.
2684 Arguments are specified as keyword/argument pairs. Attributes that
2685 are not given are re-initialized from the process's current
2686 configuration (available via the function `process-contact') or set to
2687 reasonable default values. The following arguments are defined:
2693 -- Any of these arguments can be given to identify the process that is
2694 to be configured. If none of these arguments is given, the current
2695 buffer's process is used.
2697 :speed SPEED -- SPEED is the speed of the serial port in bits per
2698 second, also called baud rate. Any value can be given for SPEED, but
2699 most serial ports work only at a few defined values between 1200 and
2700 115200, with 9600 being the most common value. If SPEED is nil, the
2701 serial port is not configured any further, i.e., all other arguments
2702 are ignored. This may be useful for special serial ports such as
2703 Bluetooth-to-serial converters which can only be configured through AT
2704 commands. A value of nil for SPEED can be used only when passed
2705 through `make-serial-process' or `serial-term'.
2707 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2708 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2710 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2711 `odd' (use odd parity), or the symbol `even' (use even parity). If
2712 PARITY is not given, no parity is used.
2714 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2715 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2716 is not given or nil, 1 stopbit is used.
2718 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2719 flowcontrol to be used, which is either nil (don't use flowcontrol),
2720 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2721 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2722 flowcontrol is used.
2724 `serial-process-configure' is called by `make-serial-process' for the
2725 initial configuration of the serial port.
2729 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2731 \(serial-process-configure
2732 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2734 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2736 usage: (serial-process-configure &rest ARGS) */)
2741 struct Lisp_Process
*p
;
2742 Lisp_Object contact
= Qnil
;
2743 Lisp_Object proc
= Qnil
;
2744 struct gcpro gcpro1
;
2746 contact
= Flist (nargs
, args
);
2749 proc
= Fplist_get (contact
, QCprocess
);
2751 proc
= Fplist_get (contact
, QCname
);
2753 proc
= Fplist_get (contact
, QCbuffer
);
2755 proc
= Fplist_get (contact
, QCport
);
2756 proc
= get_process (proc
);
2757 p
= XPROCESS (proc
);
2758 if (!EQ (p
->type
, Qserial
))
2759 error ("Not a serial process");
2761 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2767 serial_configure (p
, contact
);
2772 #endif /* HAVE_SERIAL */
2775 /* Used by make-serial-process to recover from errors. */
2776 Lisp_Object
make_serial_process_unwind (Lisp_Object proc
)
2778 if (!PROCESSP (proc
))
2780 remove_process (proc
);
2783 #endif /* HAVE_SERIAL */
2786 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2788 doc
: /* Create and return a serial port process.
2790 In Emacs, serial port connections are represented by process objects,
2791 so input and output work as for subprocesses, and `delete-process'
2792 closes a serial port connection. However, a serial process has no
2793 process id, it cannot be signaled, and the status codes are different
2794 from normal processes.
2796 `make-serial-process' creates a process and a buffer, on which you
2797 probably want to use `process-send-string'. Try \\[serial-term] for
2798 an interactive terminal. See below for examples.
2800 Arguments are specified as keyword/argument pairs. The following
2801 arguments are defined:
2803 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2804 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2805 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2806 the backslashes in strings).
2808 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2809 which is called by `make-serial-process'.
2811 :name NAME -- NAME is the name of the process. If NAME is not given,
2812 the value of PORT is used.
2814 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2815 with the process. Process output goes at the end of that buffer,
2816 unless you specify an output stream or filter function to handle the
2817 output. If BUFFER is not given, the value of NAME is used.
2819 :coding CODING -- If CODING is a symbol, it specifies the coding
2820 system used for both reading and writing for this process. If CODING
2821 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2822 ENCODING is used for writing.
2824 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2825 the process is running. If BOOL is not given, query before exiting.
2827 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2828 In the stopped state, a serial process does not accept incoming data,
2829 but you can send outgoing data. The stopped state is cleared by
2830 `continue-process' and set by `stop-process'.
2832 :filter FILTER -- Install FILTER as the process filter.
2834 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2836 :plist PLIST -- Install PLIST as the initial plist of the process.
2843 -- These arguments are handled by `serial-process-configure', which is
2844 called by `make-serial-process'.
2846 The original argument list, possibly modified by later configuration,
2847 is available via the function `process-contact'.
2851 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2853 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2855 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2857 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2859 usage: (make-serial-process &rest ARGS) */)
2865 Lisp_Object proc
, contact
, port
;
2866 struct Lisp_Process
*p
;
2867 struct gcpro gcpro1
;
2868 Lisp_Object name
, buffer
;
2869 Lisp_Object tem
, val
;
2870 int specpdl_count
= -1;
2875 contact
= Flist (nargs
, args
);
2878 port
= Fplist_get (contact
, QCport
);
2880 error ("No port specified");
2881 CHECK_STRING (port
);
2883 if (NILP (Fplist_member (contact
, QCspeed
)))
2884 error (":speed not specified");
2885 if (!NILP (Fplist_get (contact
, QCspeed
)))
2886 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2888 name
= Fplist_get (contact
, QCname
);
2891 CHECK_STRING (name
);
2892 proc
= make_process (name
);
2893 specpdl_count
= SPECPDL_INDEX ();
2894 record_unwind_protect (make_serial_process_unwind
, proc
);
2895 p
= XPROCESS (proc
);
2897 fd
= serial_open ((char*) SDATA (port
));
2900 if (fd
> max_process_desc
)
2901 max_process_desc
= fd
;
2902 chan_process
[fd
] = proc
;
2904 buffer
= Fplist_get (contact
, QCbuffer
);
2907 buffer
= Fget_buffer_create (buffer
);
2910 p
->childp
= contact
;
2911 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
2913 p
->sentinel
= Fplist_get (contact
, QCsentinel
);
2914 p
->filter
= Fplist_get (contact
, QCfilter
);
2916 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2917 p
->kill_without_query
= 1;
2918 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2922 if (!EQ (p
->command
, Qt
))
2924 FD_SET (fd
, &input_wait_mask
);
2925 FD_SET (fd
, &non_keyboard_wait_mask
);
2928 if (BUFFERP (buffer
))
2930 set_marker_both (p
->mark
, buffer
,
2931 BUF_ZV (XBUFFER (buffer
)),
2932 BUF_ZV_BYTE (XBUFFER (buffer
)));
2935 tem
= Fplist_member (contact
, QCcoding
);
2936 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2942 val
= XCAR (XCDR (tem
));
2946 else if (!NILP (Vcoding_system_for_read
))
2947 val
= Vcoding_system_for_read
;
2948 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2949 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2951 p
->decode_coding_system
= val
;
2956 val
= XCAR (XCDR (tem
));
2960 else if (!NILP (Vcoding_system_for_write
))
2961 val
= Vcoding_system_for_write
;
2962 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2963 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2965 p
->encode_coding_system
= val
;
2967 setup_process_coding_systems (proc
);
2968 p
->decoding_buf
= make_uninit_string (0);
2969 p
->decoding_carryover
= 0;
2970 p
->encoding_buf
= make_uninit_string (0);
2971 p
->inherit_coding_system_flag
2972 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2974 Fserial_process_configure(nargs
, args
);
2976 specpdl_ptr
= specpdl
+ specpdl_count
;
2981 #endif /* HAVE_SERIAL */
2983 /* Create a network stream/datagram client/server process. Treated
2984 exactly like a normal process when reading and writing. Primary
2985 differences are in status display and process deletion. A network
2986 connection has no PID; you cannot signal it. All you can do is
2987 stop/continue it and deactivate/close it via delete-process */
2989 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2991 doc
: /* Create and return a network server or client process.
2993 In Emacs, network connections are represented by process objects, so
2994 input and output work as for subprocesses and `delete-process' closes
2995 a network connection. However, a network process has no process id,
2996 it cannot be signaled, and the status codes are different from normal
2999 Arguments are specified as keyword/argument pairs. The following
3000 arguments are defined:
3002 :name NAME -- NAME is name for process. It is modified if necessary
3005 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3006 with the process. Process output goes at end of that buffer, unless
3007 you specify an output stream or filter function to handle the output.
3008 BUFFER may be also nil, meaning that this process is not associated
3011 :host HOST -- HOST is name of the host to connect to, or its IP
3012 address. The symbol `local' specifies the local host. If specified
3013 for a server process, it must be a valid name or address for the local
3014 host, and only clients connecting to that address will be accepted.
3016 :service SERVICE -- SERVICE is name of the service desired, or an
3017 integer specifying a port number to connect to. If SERVICE is t,
3018 a random port number is selected for the server. (If Emacs was
3019 compiled with getaddrinfo, a port number can also be specified as a
3020 string, e.g. "80", as well as an integer. This is not portable.)
3022 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3023 stream type connection, `datagram' creates a datagram type connection.
3025 :family FAMILY -- FAMILY is the address (and protocol) family for the
3026 service specified by HOST and SERVICE. The default (nil) is to use
3027 whatever address family (IPv4 or IPv6) that is defined for the host
3028 and port number specified by HOST and SERVICE. Other address families
3030 local -- for a local (i.e. UNIX) address specified by SERVICE.
3031 ipv4 -- use IPv4 address family only.
3032 ipv6 -- use IPv6 address family only.
3034 :local ADDRESS -- ADDRESS is the local address used for the connection.
3035 This parameter is ignored when opening a client process. When specified
3036 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3038 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3039 connection. This parameter is ignored when opening a stream server
3040 process. For a datagram server process, it specifies the initial
3041 setting of the remote datagram address. When specified for a client
3042 process, the FAMILY, HOST, and SERVICE args are ignored.
3044 The format of ADDRESS depends on the address family:
3045 - An IPv4 address is represented as an vector of integers [A B C D P]
3046 corresponding to numeric IP address A.B.C.D and port number P.
3047 - A local address is represented as a string with the address in the
3048 local address space.
3049 - An "unsupported family" address is represented by a cons (F . AV)
3050 where F is the family number and AV is a vector containing the socket
3051 address data with one element per address data byte. Do not rely on
3052 this format in portable code, as it may depend on implementation
3053 defined constants, data sizes, and data structure alignment.
3055 :coding CODING -- If CODING is a symbol, it specifies the coding
3056 system used for both reading and writing for this process. If CODING
3057 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3058 ENCODING is used for writing.
3060 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
3061 return without waiting for the connection to complete; instead, the
3062 sentinel function will be called with second arg matching "open" (if
3063 successful) or "failed" when the connect completes. Default is to use
3064 a blocking connect (i.e. wait) for stream type connections.
3066 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3067 running when Emacs is exited.
3069 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3070 In the stopped state, a server process does not accept new
3071 connections, and a client process does not handle incoming traffic.
3072 The stopped state is cleared by `continue-process' and set by
3075 :filter FILTER -- Install FILTER as the process filter.
3077 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3078 process filter are multibyte, otherwise they are unibyte.
3079 If this keyword is not specified, the strings are multibyte if
3080 `default-enable-multibyte-characters' is non-nil.
3082 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3084 :log LOG -- Install LOG as the server process log function. This
3085 function is called when the server accepts a network connection from a
3086 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3087 is the server process, CLIENT is the new process for the connection,
3088 and MESSAGE is a string.
3090 :plist PLIST -- Install PLIST as the new process' initial plist.
3092 :server QLEN -- if QLEN is non-nil, create a server process for the
3093 specified FAMILY, SERVICE, and connection type (stream or datagram).
3094 If QLEN is an integer, it is used as the max. length of the server's
3095 pending connection queue (also known as the backlog); the default
3096 queue length is 5. Default is to create a client process.
3098 The following network options can be specified for this connection:
3100 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3101 :dontroute BOOL -- Only send to directly connected hosts.
3102 :keepalive BOOL -- Send keep-alive messages on network stream.
3103 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3104 :oobinline BOOL -- Place out-of-band data in receive data stream.
3105 :priority INT -- Set protocol defined priority for sent packets.
3106 :reuseaddr BOOL -- Allow reusing a recently used local address
3107 (this is allowed by default for a server process).
3108 :bindtodevice NAME -- bind to interface NAME. Using this may require
3109 special privileges on some systems.
3111 Consult the relevant system programmer's manual pages for more
3112 information on using these options.
3115 A server process will listen for and accept connections from clients.
3116 When a client connection is accepted, a new network process is created
3117 for the connection with the following parameters:
3119 - The client's process name is constructed by concatenating the server
3120 process' NAME and a client identification string.
3121 - If the FILTER argument is non-nil, the client process will not get a
3122 separate process buffer; otherwise, the client's process buffer is a newly
3123 created buffer named after the server process' BUFFER name or process
3124 NAME concatenated with the client identification string.
3125 - The connection type and the process filter and sentinel parameters are
3126 inherited from the server process' TYPE, FILTER and SENTINEL.
3127 - The client process' contact info is set according to the client's
3128 addressing information (typically an IP address and a port number).
3129 - The client process' plist is initialized from the server's plist.
3131 Notice that the FILTER and SENTINEL args are never used directly by
3132 the server process. Also, the BUFFER argument is not used directly by
3133 the server process, but via the optional :log function, accepted (and
3134 failed) connections may be logged in the server process' buffer.
3136 The original argument list, modified with the actual connection
3137 information, is available via the `process-contact' function.
3139 usage: (make-network-process &rest ARGS) */)
3145 Lisp_Object contact
;
3146 struct Lisp_Process
*p
;
3147 #ifdef HAVE_GETADDRINFO
3148 struct addrinfo ai
, *res
, *lres
;
3149 struct addrinfo hints
;
3150 char *portstring
, portbuf
[128];
3151 #else /* HAVE_GETADDRINFO */
3152 struct _emacs_addrinfo
3158 struct sockaddr
*ai_addr
;
3159 struct _emacs_addrinfo
*ai_next
;
3161 #endif /* HAVE_GETADDRINFO */
3162 struct sockaddr_in address_in
;
3163 #ifdef HAVE_LOCAL_SOCKETS
3164 struct sockaddr_un address_un
;
3169 int s
= -1, outch
, inch
;
3170 struct gcpro gcpro1
;
3171 int count
= SPECPDL_INDEX ();
3173 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
3175 Lisp_Object name
, buffer
, host
, service
, address
;
3176 Lisp_Object filter
, sentinel
;
3177 int is_non_blocking_client
= 0;
3178 int is_server
= 0, backlog
= 5;
3185 /* Save arguments for process-contact and clone-process. */
3186 contact
= Flist (nargs
, args
);
3190 /* Ensure socket support is loaded if available. */
3191 init_winsock (TRUE
);
3194 /* :type TYPE (nil: stream, datagram */
3195 tem
= Fplist_get (contact
, QCtype
);
3197 socktype
= SOCK_STREAM
;
3198 #ifdef DATAGRAM_SOCKETS
3199 else if (EQ (tem
, Qdatagram
))
3200 socktype
= SOCK_DGRAM
;
3203 error ("Unsupported connection type");
3206 tem
= Fplist_get (contact
, QCserver
);
3209 /* Don't support network sockets when non-blocking mode is
3210 not available, since a blocked Emacs is not useful. */
3211 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
3212 error ("Network servers not supported");
3216 backlog
= XINT (tem
);
3220 /* Make QCaddress an alias for :local (server) or :remote (client). */
3221 QCaddress
= is_server
? QClocal
: QCremote
;
3224 if (!is_server
&& socktype
== SOCK_STREAM
3225 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
3227 #ifndef NON_BLOCKING_CONNECT
3228 error ("Non-blocking connect not supported");
3230 is_non_blocking_client
= 1;
3234 name
= Fplist_get (contact
, QCname
);
3235 buffer
= Fplist_get (contact
, QCbuffer
);
3236 filter
= Fplist_get (contact
, QCfilter
);
3237 sentinel
= Fplist_get (contact
, QCsentinel
);
3239 CHECK_STRING (name
);
3242 /* Let's handle TERM before things get complicated ... */
3243 host
= Fplist_get (contact
, QChost
);
3244 CHECK_STRING (host
);
3246 service
= Fplist_get (contact
, QCservice
);
3247 if (INTEGERP (service
))
3248 port
= htons ((unsigned short) XINT (service
));
3251 struct servent
*svc_info
;
3252 CHECK_STRING (service
);
3253 svc_info
= getservbyname (SDATA (service
), "tcp");
3255 error ("Unknown service: %s", SDATA (service
));
3256 port
= svc_info
->s_port
;
3259 s
= connect_server (0);
3261 report_file_error ("error creating socket", Fcons (name
, Qnil
));
3262 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
3263 send_command (s
, C_DUMB
, 1, 0);
3265 #else /* not TERM */
3267 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
3268 ai
.ai_socktype
= socktype
;
3273 /* :local ADDRESS or :remote ADDRESS */
3274 address
= Fplist_get (contact
, QCaddress
);
3275 if (!NILP (address
))
3277 host
= service
= Qnil
;
3279 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
3280 error ("Malformed :address");
3281 ai
.ai_family
= family
;
3282 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
3283 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
3287 /* :family FAMILY -- nil (for Inet), local, or integer. */
3288 tem
= Fplist_get (contact
, QCfamily
);
3291 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
3297 #ifdef HAVE_LOCAL_SOCKETS
3298 else if (EQ (tem
, Qlocal
))
3302 else if (EQ (tem
, Qipv6
))
3305 else if (EQ (tem
, Qipv4
))
3307 else if (INTEGERP (tem
))
3308 family
= XINT (tem
);
3310 error ("Unknown address family");
3312 ai
.ai_family
= family
;
3314 /* :service SERVICE -- string, integer (port number), or t (random port). */
3315 service
= Fplist_get (contact
, QCservice
);
3317 #ifdef HAVE_LOCAL_SOCKETS
3318 if (family
== AF_LOCAL
)
3320 /* Host is not used. */
3322 CHECK_STRING (service
);
3323 bzero (&address_un
, sizeof address_un
);
3324 address_un
.sun_family
= AF_LOCAL
;
3325 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3326 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3327 ai
.ai_addrlen
= sizeof address_un
;
3332 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3333 host
= Fplist_get (contact
, QChost
);
3336 if (EQ (host
, Qlocal
))
3337 host
= build_string ("localhost");
3338 CHECK_STRING (host
);
3341 /* Slow down polling to every ten seconds.
3342 Some kernels have a bug which causes retrying connect to fail
3343 after a connect. Polling can interfere with gethostbyname too. */
3344 #ifdef POLL_FOR_INPUT
3345 if (socktype
== SOCK_STREAM
)
3347 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3348 bind_polling_period (10);
3352 #ifdef HAVE_GETADDRINFO
3353 /* If we have a host, use getaddrinfo to resolve both host and service.
3354 Otherwise, use getservbyname to lookup the service. */
3358 /* SERVICE can either be a string or int.
3359 Convert to a C string for later use by getaddrinfo. */
3360 if (EQ (service
, Qt
))
3362 else if (INTEGERP (service
))
3364 sprintf (portbuf
, "%ld", (long) XINT (service
));
3365 portstring
= portbuf
;
3369 CHECK_STRING (service
);
3370 portstring
= SDATA (service
);
3375 memset (&hints
, 0, sizeof (hints
));
3377 hints
.ai_family
= family
;
3378 hints
.ai_socktype
= socktype
;
3379 hints
.ai_protocol
= 0;
3381 #ifdef HAVE_RES_INIT
3385 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3387 #ifdef HAVE_GAI_STRERROR
3388 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3390 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3396 #endif /* HAVE_GETADDRINFO */
3398 /* We end up here if getaddrinfo is not defined, or in case no hostname
3399 has been specified (e.g. for a local server process). */
3401 if (EQ (service
, Qt
))
3403 else if (INTEGERP (service
))
3404 port
= htons ((unsigned short) XINT (service
));
3407 struct servent
*svc_info
;
3408 CHECK_STRING (service
);
3409 svc_info
= getservbyname (SDATA (service
),
3410 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3412 error ("Unknown service: %s", SDATA (service
));
3413 port
= svc_info
->s_port
;
3416 bzero (&address_in
, sizeof address_in
);
3417 address_in
.sin_family
= family
;
3418 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3419 address_in
.sin_port
= port
;
3421 #ifndef HAVE_GETADDRINFO
3424 struct hostent
*host_info_ptr
;
3426 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3427 as it may `hang' Emacs for a very long time. */
3431 #ifdef HAVE_RES_INIT
3435 host_info_ptr
= gethostbyname (SDATA (host
));
3440 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3441 host_info_ptr
->h_length
);
3442 family
= host_info_ptr
->h_addrtype
;
3443 address_in
.sin_family
= family
;
3446 /* Attempt to interpret host as numeric inet address */
3448 unsigned long numeric_addr
;
3449 numeric_addr
= inet_addr ((char *) SDATA (host
));
3450 if (numeric_addr
== -1)
3451 error ("Unknown host \"%s\"", SDATA (host
));
3453 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3454 sizeof (address_in
.sin_addr
));
3458 #endif /* not HAVE_GETADDRINFO */
3460 ai
.ai_family
= family
;
3461 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3462 ai
.ai_addrlen
= sizeof address_in
;
3466 /* Do this in case we never enter the for-loop below. */
3467 count1
= SPECPDL_INDEX ();
3470 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3476 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3483 #ifdef DATAGRAM_SOCKETS
3484 if (!is_server
&& socktype
== SOCK_DGRAM
)
3486 #endif /* DATAGRAM_SOCKETS */
3488 #ifdef NON_BLOCKING_CONNECT
3489 if (is_non_blocking_client
)
3492 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3494 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3506 /* Make us close S if quit. */
3507 record_unwind_protect (close_file_unwind
, make_number (s
));
3509 /* Parse network options in the arg list.
3510 We simply ignore anything which isn't a known option (including other keywords).
3511 An error is signaled if setting a known option fails. */
3512 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3513 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3517 /* Configure as a server socket. */
3519 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3520 explicit :reuseaddr key to override this. */
3521 #ifdef HAVE_LOCAL_SOCKETS
3522 if (family
!= AF_LOCAL
)
3524 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3527 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3528 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3531 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3532 report_file_error ("Cannot bind server socket", Qnil
);
3534 #ifdef HAVE_GETSOCKNAME
3535 if (EQ (service
, Qt
))
3537 struct sockaddr_in sa1
;
3538 int len1
= sizeof (sa1
);
3539 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3541 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3542 service
= make_number (ntohs (sa1
.sin_port
));
3543 contact
= Fplist_put (contact
, QCservice
, service
);
3548 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3549 report_file_error ("Cannot listen on server socket", Qnil
);
3557 /* This turns off all alarm-based interrupts; the
3558 bind_polling_period call above doesn't always turn all the
3559 short-interval ones off, especially if interrupt_input is
3562 It'd be nice to be able to control the connect timeout
3563 though. Would non-blocking connect calls be portable?
3565 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3567 turn_on_atimers (0);
3569 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3572 turn_on_atimers (1);
3574 if (ret
== 0 || xerrno
== EISCONN
)
3576 /* The unwind-protect will be discarded afterwards.
3577 Likewise for immediate_quit. */
3581 #ifdef NON_BLOCKING_CONNECT
3583 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3587 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3595 /* Discard the unwind protect closing S. */
3596 specpdl_ptr
= specpdl
+ count1
;
3600 if (xerrno
== EINTR
)
3606 #ifdef DATAGRAM_SOCKETS
3607 if (socktype
== SOCK_DGRAM
)
3609 if (datagram_address
[s
].sa
)
3611 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3612 datagram_address
[s
].len
= lres
->ai_addrlen
;
3616 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3617 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3620 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3621 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3622 conv_lisp_to_sockaddr (rfamily
, remote
,
3623 datagram_address
[s
].sa
, rlen
);
3627 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3630 contact
= Fplist_put (contact
, QCaddress
,
3631 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3632 #ifdef HAVE_GETSOCKNAME
3635 struct sockaddr_in sa1
;
3636 int len1
= sizeof (sa1
);
3637 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3638 contact
= Fplist_put (contact
, QClocal
,
3639 conv_sockaddr_to_lisp (&sa1
, len1
));
3646 #ifdef HAVE_GETADDRINFO
3655 /* Discard the unwind protect for closing S, if any. */
3656 specpdl_ptr
= specpdl
+ count1
;
3658 /* Unwind bind_polling_period and request_sigio. */
3659 unbind_to (count
, Qnil
);
3663 /* If non-blocking got this far - and failed - assume non-blocking is
3664 not supported after all. This is probably a wrong assumption, but
3665 the normal blocking calls to open-network-stream handles this error
3667 if (is_non_blocking_client
)
3672 report_file_error ("make server process failed", contact
);
3674 report_file_error ("make client process failed", contact
);
3677 #endif /* not TERM */
3683 buffer
= Fget_buffer_create (buffer
);
3684 proc
= make_process (name
);
3686 chan_process
[inch
] = proc
;
3689 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3692 fcntl (inch
, F_SETFL
, O_NDELAY
);
3696 p
= XPROCESS (proc
);
3698 p
->childp
= contact
;
3699 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3703 p
->sentinel
= sentinel
;
3705 p
->log
= Fplist_get (contact
, QClog
);
3706 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3707 p
->kill_without_query
= 1;
3708 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3713 if (is_server
&& socktype
== SOCK_STREAM
)
3714 p
->status
= Qlisten
;
3716 /* Make the process marker point into the process buffer (if any). */
3717 if (BUFFERP (buffer
))
3718 set_marker_both (p
->mark
, buffer
,
3719 BUF_ZV (XBUFFER (buffer
)),
3720 BUF_ZV_BYTE (XBUFFER (buffer
)));
3722 #ifdef NON_BLOCKING_CONNECT
3723 if (is_non_blocking_client
)
3725 /* We may get here if connect did succeed immediately. However,
3726 in that case, we still need to signal this like a non-blocking
3728 p
->status
= Qconnect
;
3729 if (!FD_ISSET (inch
, &connect_wait_mask
))
3731 FD_SET (inch
, &connect_wait_mask
);
3732 num_pending_connects
++;
3737 /* A server may have a client filter setting of Qt, but it must
3738 still listen for incoming connects unless it is stopped. */
3739 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3740 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3742 FD_SET (inch
, &input_wait_mask
);
3743 FD_SET (inch
, &non_keyboard_wait_mask
);
3746 if (inch
> max_process_desc
)
3747 max_process_desc
= inch
;
3749 tem
= Fplist_member (contact
, QCcoding
);
3750 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3751 tem
= Qnil
; /* No error message (too late!). */
3754 /* Setup coding systems for communicating with the network stream. */
3755 struct gcpro gcpro1
;
3756 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3757 Lisp_Object coding_systems
= Qt
;
3758 Lisp_Object args
[5], val
;
3762 val
= XCAR (XCDR (tem
));
3766 else if (!NILP (Vcoding_system_for_read
))
3767 val
= Vcoding_system_for_read
;
3768 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3769 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3770 /* We dare not decode end-of-line format by setting VAL to
3771 Qraw_text, because the existing Emacs Lisp libraries
3772 assume that they receive bare code including a sequene of
3777 if (NILP (host
) || NILP (service
))
3778 coding_systems
= Qnil
;
3781 args
[0] = Qopen_network_stream
, args
[1] = name
,
3782 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3784 coding_systems
= Ffind_operation_coding_system (5, args
);
3787 if (CONSP (coding_systems
))
3788 val
= XCAR (coding_systems
);
3789 else if (CONSP (Vdefault_process_coding_system
))
3790 val
= XCAR (Vdefault_process_coding_system
);
3794 p
->decode_coding_system
= val
;
3798 val
= XCAR (XCDR (tem
));
3802 else if (!NILP (Vcoding_system_for_write
))
3803 val
= Vcoding_system_for_write
;
3804 else if (NILP (current_buffer
->enable_multibyte_characters
))
3808 if (EQ (coding_systems
, Qt
))
3810 if (NILP (host
) || NILP (service
))
3811 coding_systems
= Qnil
;
3814 args
[0] = Qopen_network_stream
, args
[1] = name
,
3815 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3817 coding_systems
= Ffind_operation_coding_system (5, args
);
3821 if (CONSP (coding_systems
))
3822 val
= XCDR (coding_systems
);
3823 else if (CONSP (Vdefault_process_coding_system
))
3824 val
= XCDR (Vdefault_process_coding_system
);
3828 p
->encode_coding_system
= val
;
3830 setup_process_coding_systems (proc
);
3832 p
->decoding_buf
= make_uninit_string (0);
3833 p
->decoding_carryover
= 0;
3834 p
->encoding_buf
= make_uninit_string (0);
3836 p
->inherit_coding_system_flag
3837 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3842 #endif /* HAVE_SOCKETS */
3845 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3848 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3849 doc
: /* Return an alist of all network interfaces and their network address.
3850 Each element is a cons, the car of which is a string containing the
3851 interface name, and the cdr is the network address in internal
3852 format; see the description of ADDRESS in `make-network-process'. */)
3855 struct ifconf ifconf
;
3856 struct ifreq
*ifreqs
= NULL
;
3861 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3867 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3868 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3875 ifconf
.ifc_len
= buf_size
;
3876 ifconf
.ifc_req
= ifreqs
;
3877 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3883 if (ifconf
.ifc_len
== buf_size
)
3887 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3890 while (--ifaces
>= 0)
3892 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3893 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3894 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3896 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3897 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3898 res
= Fcons (Fcons (build_string (namebuf
),
3899 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3900 sizeof (struct sockaddr
))),
3906 #endif /* SIOCGIFCONF */
3908 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3915 static struct ifflag_def ifflag_table
[] = {
3919 #ifdef IFF_BROADCAST
3920 { IFF_BROADCAST
, "broadcast" },
3923 { IFF_DEBUG
, "debug" },
3926 { IFF_LOOPBACK
, "loopback" },
3928 #ifdef IFF_POINTOPOINT
3929 { IFF_POINTOPOINT
, "pointopoint" },
3932 { IFF_RUNNING
, "running" },
3935 { IFF_NOARP
, "noarp" },
3938 { IFF_PROMISC
, "promisc" },
3940 #ifdef IFF_NOTRAILERS
3941 { IFF_NOTRAILERS
, "notrailers" },
3944 { IFF_ALLMULTI
, "allmulti" },
3947 { IFF_MASTER
, "master" },
3950 { IFF_SLAVE
, "slave" },
3952 #ifdef IFF_MULTICAST
3953 { IFF_MULTICAST
, "multicast" },
3956 { IFF_PORTSEL
, "portsel" },
3958 #ifdef IFF_AUTOMEDIA
3959 { IFF_AUTOMEDIA
, "automedia" },
3962 { IFF_DYNAMIC
, "dynamic" },
3965 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3968 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3971 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3974 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3977 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3982 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3983 doc
: /* Return information about network interface named IFNAME.
3984 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3985 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3986 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3987 FLAGS is the current flags of the interface. */)
3992 Lisp_Object res
= Qnil
;
3997 CHECK_STRING (ifname
);
3999 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
4000 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
4002 s
= socket (AF_INET
, SOCK_STREAM
, 0);
4007 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
4008 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
4010 int flags
= rq
.ifr_flags
;
4011 struct ifflag_def
*fp
;
4015 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
4017 if (flags
& fp
->flag_bit
)
4019 elt
= Fcons (intern (fp
->flag_sym
), elt
);
4020 flags
-= fp
->flag_bit
;
4023 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
4025 if (flags
& (1 << fnum
))
4027 elt
= Fcons (make_number (fnum
), elt
);
4032 res
= Fcons (elt
, res
);
4035 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
4036 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
4038 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4039 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4043 for (n
= 0; n
< 6; n
++)
4044 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
4045 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
4048 res
= Fcons (elt
, res
);
4051 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
4052 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
4055 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4056 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
4058 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4062 res
= Fcons (elt
, res
);
4065 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4066 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
4069 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
4072 res
= Fcons (elt
, res
);
4075 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
4076 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
4079 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4082 res
= Fcons (elt
, res
);
4086 return any
? res
: Qnil
;
4089 #endif /* HAVE_SOCKETS */
4091 /* Turn off input and output for process PROC. */
4094 deactivate_process (proc
)
4097 register int inchannel
, outchannel
;
4098 register struct Lisp_Process
*p
= XPROCESS (proc
);
4100 inchannel
= p
->infd
;
4101 outchannel
= p
->outfd
;
4103 #ifdef ADAPTIVE_READ_BUFFERING
4104 if (p
->read_output_delay
> 0)
4106 if (--process_output_delay_count
< 0)
4107 process_output_delay_count
= 0;
4108 p
->read_output_delay
= 0;
4109 p
->read_output_skip
= 0;
4115 /* Beware SIGCHLD hereabouts. */
4116 flush_pending_output (inchannel
);
4119 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
4120 sys$
dassgn (outchannel
);
4121 vs
= get_vms_process_pointer (p
->pid
);
4123 give_back_vms_process_stuff (vs
);
4126 emacs_close (inchannel
);
4127 if (outchannel
>= 0 && outchannel
!= inchannel
)
4128 emacs_close (outchannel
);
4133 #ifdef DATAGRAM_SOCKETS
4134 if (DATAGRAM_CHAN_P (inchannel
))
4136 xfree (datagram_address
[inchannel
].sa
);
4137 datagram_address
[inchannel
].sa
= 0;
4138 datagram_address
[inchannel
].len
= 0;
4141 chan_process
[inchannel
] = Qnil
;
4142 FD_CLR (inchannel
, &input_wait_mask
);
4143 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
4144 #ifdef NON_BLOCKING_CONNECT
4145 if (FD_ISSET (inchannel
, &connect_wait_mask
))
4147 FD_CLR (inchannel
, &connect_wait_mask
);
4148 if (--num_pending_connects
< 0)
4152 if (inchannel
== max_process_desc
)
4155 /* We just closed the highest-numbered process input descriptor,
4156 so recompute the highest-numbered one now. */
4157 max_process_desc
= 0;
4158 for (i
= 0; i
< MAXDESC
; i
++)
4159 if (!NILP (chan_process
[i
]))
4160 max_process_desc
= i
;
4165 /* Close all descriptors currently in use for communication
4166 with subprocess. This is used in a newly-forked subprocess
4167 to get rid of irrelevant descriptors. */
4170 close_process_descs ()
4174 for (i
= 0; i
< MAXDESC
; i
++)
4176 Lisp_Object process
;
4177 process
= chan_process
[i
];
4178 if (!NILP (process
))
4180 int in
= XPROCESS (process
)->infd
;
4181 int out
= XPROCESS (process
)->outfd
;
4184 if (out
>= 0 && in
!= out
)
4191 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
4193 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
4194 It is read into the process' buffers or given to their filter functions.
4195 Non-nil arg PROCESS means do not return until some output has been received
4198 Non-nil second arg SECONDS and third arg MILLISEC are number of
4199 seconds and milliseconds to wait; return after that much time whether
4200 or not there is input. If SECONDS is a floating point number,
4201 it specifies a fractional number of seconds to wait.
4202 The MILLISEC argument is obsolete and should be avoided.
4204 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
4205 from PROCESS, suspending reading output from other processes.
4206 If JUST-THIS-ONE is an integer, don't run any timers either.
4207 Return non-nil if we received any output before the timeout expired. */)
4208 (process
, seconds
, millisec
, just_this_one
)
4209 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
4211 int secs
, usecs
= 0;
4213 if (! NILP (process
))
4214 CHECK_PROCESS (process
);
4216 just_this_one
= Qnil
;
4218 if (!NILP (millisec
))
4219 { /* Obsolete calling convention using integers rather than floats. */
4220 CHECK_NUMBER (millisec
);
4222 seconds
= make_float (XINT (millisec
) / 1000.0);
4225 CHECK_NUMBER (seconds
);
4226 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
4230 if (!NILP (seconds
))
4232 if (INTEGERP (seconds
))
4233 secs
= XINT (seconds
);
4234 else if (FLOATP (seconds
))
4236 double timeout
= XFLOAT_DATA (seconds
);
4237 secs
= (int) timeout
;
4238 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
4241 wrong_type_argument (Qnumberp
, seconds
);
4243 if (secs
< 0 || (secs
== 0 && usecs
== 0))
4244 secs
= -1, usecs
= 0;
4247 secs
= NILP (process
) ? -1 : 0;
4250 (wait_reading_process_output (secs
, usecs
, 0, 0,
4252 !NILP (process
) ? XPROCESS (process
) : NULL
,
4253 NILP (just_this_one
) ? 0 :
4254 !INTEGERP (just_this_one
) ? 1 : -1)
4258 /* Accept a connection for server process SERVER on CHANNEL. */
4260 static int connect_counter
= 0;
4263 server_accept_connection (server
, channel
)
4267 Lisp_Object proc
, caller
, name
, buffer
;
4268 Lisp_Object contact
, host
, service
;
4269 struct Lisp_Process
*ps
= XPROCESS (server
);
4270 struct Lisp_Process
*p
;
4274 struct sockaddr_in in
;
4276 struct sockaddr_in6 in6
;
4278 #ifdef HAVE_LOCAL_SOCKETS
4279 struct sockaddr_un un
;
4282 int len
= sizeof saddr
;
4284 s
= accept (channel
, &saddr
.sa
, &len
);
4293 if (code
== EWOULDBLOCK
)
4297 if (!NILP (ps
->log
))
4298 call3 (ps
->log
, server
, Qnil
,
4299 concat3 (build_string ("accept failed with code"),
4300 Fnumber_to_string (make_number (code
)),
4301 build_string ("\n")));
4307 /* Setup a new process to handle the connection. */
4309 /* Generate a unique identification of the caller, and build contact
4310 information for this process. */
4313 switch (saddr
.sa
.sa_family
)
4317 Lisp_Object args
[5];
4318 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4319 args
[0] = build_string ("%d.%d.%d.%d");
4320 args
[1] = make_number (*ip
++);
4321 args
[2] = make_number (*ip
++);
4322 args
[3] = make_number (*ip
++);
4323 args
[4] = make_number (*ip
++);
4324 host
= Fformat (5, args
);
4325 service
= make_number (ntohs (saddr
.in
.sin_port
));
4327 args
[0] = build_string (" <%s:%d>");
4330 caller
= Fformat (3, args
);
4337 Lisp_Object args
[9];
4338 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4340 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4341 for (i
= 0; i
< 8; i
++)
4342 args
[i
+1] = make_number (ntohs(ip6
[i
]));
4343 host
= Fformat (9, args
);
4344 service
= make_number (ntohs (saddr
.in
.sin_port
));
4346 args
[0] = build_string (" <[%s]:%d>");
4349 caller
= Fformat (3, args
);
4354 #ifdef HAVE_LOCAL_SOCKETS
4358 caller
= Fnumber_to_string (make_number (connect_counter
));
4359 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4363 /* Create a new buffer name for this process if it doesn't have a
4364 filter. The new buffer name is based on the buffer name or
4365 process name of the server process concatenated with the caller
4368 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4372 buffer
= ps
->buffer
;
4374 buffer
= Fbuffer_name (buffer
);
4379 buffer
= concat2 (buffer
, caller
);
4380 buffer
= Fget_buffer_create (buffer
);
4384 /* Generate a unique name for the new server process. Combine the
4385 server process name with the caller identification. */
4387 name
= concat2 (ps
->name
, caller
);
4388 proc
= make_process (name
);
4390 chan_process
[s
] = proc
;
4393 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4396 fcntl (s
, F_SETFL
, O_NDELAY
);
4400 p
= XPROCESS (proc
);
4402 /* Build new contact information for this setup. */
4403 contact
= Fcopy_sequence (ps
->childp
);
4404 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4405 contact
= Fplist_put (contact
, QChost
, host
);
4406 if (!NILP (service
))
4407 contact
= Fplist_put (contact
, QCservice
, service
);
4408 contact
= Fplist_put (contact
, QCremote
,
4409 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4410 #ifdef HAVE_GETSOCKNAME
4412 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4413 contact
= Fplist_put (contact
, QClocal
,
4414 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4417 p
->childp
= contact
;
4418 p
->plist
= Fcopy_sequence (ps
->plist
);
4422 p
->sentinel
= ps
->sentinel
;
4423 p
->filter
= ps
->filter
;
4430 /* Client processes for accepted connections are not stopped initially. */
4431 if (!EQ (p
->filter
, Qt
))
4433 FD_SET (s
, &input_wait_mask
);
4434 FD_SET (s
, &non_keyboard_wait_mask
);
4437 if (s
> max_process_desc
)
4438 max_process_desc
= s
;
4440 /* Setup coding system for new process based on server process.
4441 This seems to be the proper thing to do, as the coding system
4442 of the new process should reflect the settings at the time the
4443 server socket was opened; not the current settings. */
4445 p
->decode_coding_system
= ps
->decode_coding_system
;
4446 p
->encode_coding_system
= ps
->encode_coding_system
;
4447 setup_process_coding_systems (proc
);
4449 p
->decoding_buf
= make_uninit_string (0);
4450 p
->decoding_carryover
= 0;
4451 p
->encoding_buf
= make_uninit_string (0);
4453 p
->inherit_coding_system_flag
4454 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4456 if (!NILP (ps
->log
))
4457 call3 (ps
->log
, server
, proc
,
4458 concat3 (build_string ("accept from "),
4459 (STRINGP (host
) ? host
: build_string ("-")),
4460 build_string ("\n")));
4462 if (!NILP (p
->sentinel
))
4463 exec_sentinel (proc
,
4464 concat3 (build_string ("open from "),
4465 (STRINGP (host
) ? host
: build_string ("-")),
4466 build_string ("\n")));
4469 /* This variable is different from waiting_for_input in keyboard.c.
4470 It is used to communicate to a lisp process-filter/sentinel (via the
4471 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4472 for user-input when that process-filter was called.
4473 waiting_for_input cannot be used as that is by definition 0 when
4474 lisp code is being evalled.
4475 This is also used in record_asynch_buffer_change.
4476 For that purpose, this must be 0
4477 when not inside wait_reading_process_output. */
4478 static int waiting_for_user_input_p
;
4481 wait_reading_process_output_unwind (data
)
4484 waiting_for_user_input_p
= XINT (data
);
4488 /* This is here so breakpoints can be put on it. */
4490 wait_reading_process_output_1 ()
4494 /* Use a wrapper around select to work around a bug in gdb 5.3.
4495 Normally, the wrapper is optimzed away by inlining.
4497 If emacs is stopped inside select, the gdb backtrace doesn't
4498 show the function which called select, so it is practically
4499 impossible to step through wait_reading_process_output. */
4503 select_wrapper (n
, rfd
, wfd
, xfd
, tmo
)
4505 SELECT_TYPE
*rfd
, *wfd
, *xfd
;
4508 return select (n
, rfd
, wfd
, xfd
, tmo
);
4510 #define select select_wrapper
4513 /* Read and dispose of subprocess output while waiting for timeout to
4514 elapse and/or keyboard input to be available.
4517 timeout in seconds, or
4518 zero for no limit, or
4519 -1 means gobble data immediately available but don't wait for any.
4522 an additional duration to wait, measured in microseconds.
4523 If this is nonzero and time_limit is 0, then the timeout
4524 consists of MICROSECS only.
4526 READ_KBD is a lisp value:
4527 0 to ignore keyboard input, or
4528 1 to return when input is available, or
4529 -1 meaning caller will actually read the input, so don't throw to
4530 the quit handler, or
4532 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4533 output that arrives.
4535 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4536 (and gobble terminal input into the buffer if any arrives).
4538 If WAIT_PROC is specified, wait until something arrives from that
4539 process. The return value is true if we read some input from
4542 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4543 (suspending output from other processes). A negative value
4544 means don't run any timers either.
4546 If WAIT_PROC is specified, then the function returns true if we
4547 received input from that process before the timeout elapsed.
4548 Otherwise, return true if we received input from any process. */
4551 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4552 wait_for_cell
, wait_proc
, just_wait_proc
)
4553 int time_limit
, microsecs
, read_kbd
, do_display
;
4554 Lisp_Object wait_for_cell
;
4555 struct Lisp_Process
*wait_proc
;
4558 register int channel
, nfds
;
4559 SELECT_TYPE Available
;
4560 #ifdef NON_BLOCKING_CONNECT
4561 SELECT_TYPE Connecting
;
4564 int check_delay
, no_avail
;
4567 EMACS_TIME timeout
, end_time
;
4568 int wait_channel
= -1;
4569 int got_some_input
= 0;
4570 int count
= SPECPDL_INDEX ();
4572 FD_ZERO (&Available
);
4573 #ifdef NON_BLOCKING_CONNECT
4574 FD_ZERO (&Connecting
);
4577 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4578 if (wait_proc
!= NULL
)
4579 wait_channel
= wait_proc
->infd
;
4581 record_unwind_protect (wait_reading_process_output_unwind
,
4582 make_number (waiting_for_user_input_p
));
4583 waiting_for_user_input_p
= read_kbd
;
4585 /* Since we may need to wait several times,
4586 compute the absolute time to return at. */
4587 if (time_limit
|| microsecs
)
4589 EMACS_GET_TIME (end_time
);
4590 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4591 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4596 int timeout_reduced_for_timers
= 0;
4598 /* If calling from keyboard input, do not quit
4599 since we want to return C-g as an input character.
4600 Otherwise, do pending quit if requested. */
4606 if (interrupt_input_pending
)
4607 handle_async_input ();
4608 if (pending_atimers
)
4609 do_pending_atimers ();
4613 /* Exit now if the cell we're waiting for became non-nil. */
4614 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4617 /* Compute time from now till when time limit is up */
4618 /* Exit if already run out */
4619 if (time_limit
== -1)
4621 /* -1 specified for timeout means
4622 gobble output available now
4623 but don't wait at all. */
4625 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4627 else if (time_limit
|| microsecs
)
4629 EMACS_GET_TIME (timeout
);
4630 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4631 if (EMACS_TIME_NEG_P (timeout
))
4636 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4639 /* Normally we run timers here.
4640 But not if wait_for_cell; in those cases,
4641 the wait is supposed to be short,
4642 and those callers cannot handle running arbitrary Lisp code here. */
4643 if (NILP (wait_for_cell
)
4644 && just_wait_proc
>= 0)
4646 EMACS_TIME timer_delay
;
4650 int old_timers_run
= timers_run
;
4651 struct buffer
*old_buffer
= current_buffer
;
4652 Lisp_Object old_window
= selected_window
;
4654 timer_delay
= timer_check (1);
4656 /* If a timer has run, this might have changed buffers
4657 an alike. Make read_key_sequence aware of that. */
4658 if (timers_run
!= old_timers_run
4659 && (old_buffer
!= current_buffer
4660 || !EQ (old_window
, selected_window
))
4661 && waiting_for_user_input_p
== -1)
4662 record_asynch_buffer_change ();
4664 if (timers_run
!= old_timers_run
&& do_display
)
4665 /* We must retry, since a timer may have requeued itself
4666 and that could alter the time_delay. */
4667 redisplay_preserve_echo_area (9);
4671 while (!detect_input_pending ());
4673 /* If there is unread keyboard input, also return. */
4675 && requeued_events_pending_p ())
4678 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4680 EMACS_TIME difference
;
4681 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4682 if (EMACS_TIME_NEG_P (difference
))
4684 timeout
= timer_delay
;
4685 timeout_reduced_for_timers
= 1;
4688 /* If time_limit is -1, we are not going to wait at all. */
4689 else if (time_limit
!= -1)
4691 /* This is so a breakpoint can be put here. */
4692 wait_reading_process_output_1 ();
4696 /* Cause C-g and alarm signals to take immediate action,
4697 and cause input available signals to zero out timeout.
4699 It is important that we do this before checking for process
4700 activity. If we get a SIGCHLD after the explicit checks for
4701 process activity, timeout is the only way we will know. */
4703 set_waiting_for_input (&timeout
);
4705 /* If status of something has changed, and no input is
4706 available, notify the user of the change right away. After
4707 this explicit check, we'll let the SIGCHLD handler zap
4708 timeout to get our attention. When Emacs is run
4709 interactively, only do this with a nonzero DO_DISPLAY
4710 argument, because status_notify triggers redisplay. */
4711 if (update_tick
!= process_tick
4712 && (do_display
|| noninteractive
))
4715 #ifdef NON_BLOCKING_CONNECT
4719 Atemp
= input_wait_mask
;
4721 /* On Mac OS X 10.0, the SELECT system call always says input is
4722 present (for reading) at stdin, even when none is. This
4723 causes the call to SELECT below to return 1 and
4724 status_notify not to be called. As a result output of
4725 subprocesses are incorrectly discarded.
4729 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4731 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4732 if ((select (max (max (max_process_desc
, max_keyboard_desc
),
4735 #ifdef NON_BLOCKING_CONNECT
4736 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4740 (SELECT_TYPE
*)0, &timeout
)
4743 /* It's okay for us to do this and then continue with
4744 the loop, since timeout has already been zeroed out. */
4745 clear_waiting_for_input ();
4746 status_notify (NULL
);
4750 /* Don't wait for output from a non-running process. Just
4751 read whatever data has already been received. */
4752 if (wait_proc
&& wait_proc
->raw_status_new
)
4753 update_status (wait_proc
);
4755 && ! EQ (wait_proc
->status
, Qrun
)
4756 && ! EQ (wait_proc
->status
, Qconnect
))
4758 int nread
, total_nread
= 0;
4760 clear_waiting_for_input ();
4761 XSETPROCESS (proc
, wait_proc
);
4763 /* Read data from the process, until we exhaust it. */
4764 while (wait_proc
->infd
>= 0)
4766 nread
= read_process_output (proc
, wait_proc
->infd
);
4773 total_nread
+= nread
;
4777 else if (nread
== -1 && EIO
== errno
)
4781 else if (nread
== -1 && EAGAIN
== errno
)
4785 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4789 if (total_nread
> 0 && do_display
)
4790 redisplay_preserve_echo_area (10);
4795 /* Wait till there is something to do */
4797 if (wait_proc
&& just_wait_proc
)
4799 if (wait_proc
->infd
< 0) /* Terminated */
4801 FD_SET (wait_proc
->infd
, &Available
);
4803 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4805 else if (!NILP (wait_for_cell
))
4807 Available
= non_process_wait_mask
;
4809 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4814 Available
= non_keyboard_wait_mask
;
4816 Available
= input_wait_mask
;
4817 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4818 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4821 /* If frame size has changed or the window is newly mapped,
4822 redisplay now, before we start to wait. There is a race
4823 condition here; if a SIGIO arrives between now and the select
4824 and indicates that a frame is trashed, the select may block
4825 displaying a trashed screen. */
4826 if (frame_garbaged
&& do_display
)
4828 clear_waiting_for_input ();
4829 redisplay_preserve_echo_area (11);
4831 set_waiting_for_input (&timeout
);
4835 if (read_kbd
&& detect_input_pending ())
4842 #ifdef NON_BLOCKING_CONNECT
4844 Connecting
= connect_wait_mask
;
4847 #ifdef ADAPTIVE_READ_BUFFERING
4848 /* Set the timeout for adaptive read buffering if any
4849 process has non-zero read_output_skip and non-zero
4850 read_output_delay, and we are not reading output for a
4851 specific wait_channel. It is not executed if
4852 Vprocess_adaptive_read_buffering is nil. */
4853 if (process_output_skip
&& check_delay
> 0)
4855 int usecs
= EMACS_USECS (timeout
);
4856 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4857 usecs
= READ_OUTPUT_DELAY_MAX
;
4858 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4860 proc
= chan_process
[channel
];
4863 /* Find minimum non-zero read_output_delay among the
4864 processes with non-zero read_output_skip. */
4865 if (XPROCESS (proc
)->read_output_delay
> 0)
4868 if (!XPROCESS (proc
)->read_output_skip
)
4870 FD_CLR (channel
, &Available
);
4871 XPROCESS (proc
)->read_output_skip
= 0;
4872 if (XPROCESS (proc
)->read_output_delay
< usecs
)
4873 usecs
= XPROCESS (proc
)->read_output_delay
;
4876 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4877 process_output_skip
= 0;
4881 nfds
= select (max (max (max_process_desc
, max_keyboard_desc
),
4884 #ifdef NON_BLOCKING_CONNECT
4885 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4889 (SELECT_TYPE
*)0, &timeout
);
4894 /* Make C-g and alarm signals set flags again */
4895 clear_waiting_for_input ();
4897 /* If we woke up due to SIGWINCH, actually change size now. */
4898 do_pending_window_change (0);
4900 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4901 /* We wanted the full specified time, so return now. */
4905 if (xerrno
== EINTR
)
4907 else if (xerrno
== EBADF
)
4910 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4911 the child's closure of the pts gives the parent a SIGHUP, and
4912 the ptc file descriptor is automatically closed,
4913 yielding EBADF here or at select() call above.
4914 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4915 in m/ibmrt-aix.h), and here we just ignore the select error.
4916 Cleanup occurs c/o status_notify after SIGCLD. */
4917 no_avail
= 1; /* Cannot depend on values returned */
4923 error ("select error: %s", emacs_strerror (xerrno
));
4928 FD_ZERO (&Available
);
4929 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4932 #if defined(sun) && !defined(USG5_4)
4933 if (nfds
> 0 && keyboard_bit_set (&Available
)
4935 /* System sometimes fails to deliver SIGIO.
4937 David J. Mackenzie says that Emacs doesn't compile under
4938 Solaris if this code is enabled, thus the USG5_4 in the CPP
4939 conditional. "I haven't noticed any ill effects so far.
4940 If you find a Solaris expert somewhere, they might know
4942 kill (getpid (), SIGIO
);
4945 #if 0 /* When polling is used, interrupt_input is 0,
4946 so get_input_pending should read the input.
4947 So this should not be needed. */
4948 /* If we are using polling for input,
4949 and we see input available, make it get read now.
4950 Otherwise it might not actually get read for a second.
4951 And on hpux, since we turn off polling in wait_reading_process_output,
4952 it might never get read at all if we don't spend much time
4953 outside of wait_reading_process_output. */
4954 if (read_kbd
&& interrupt_input
4955 && keyboard_bit_set (&Available
)
4956 && input_polling_used ())
4957 kill (getpid (), SIGALRM
);
4960 /* Check for keyboard input */
4961 /* If there is any, return immediately
4962 to give it higher priority than subprocesses */
4966 int old_timers_run
= timers_run
;
4967 struct buffer
*old_buffer
= current_buffer
;
4968 Lisp_Object old_window
= selected_window
;
4971 if (detect_input_pending_run_timers (do_display
))
4973 swallow_events (do_display
);
4974 if (detect_input_pending_run_timers (do_display
))
4978 /* If a timer has run, this might have changed buffers
4979 an alike. Make read_key_sequence aware of that. */
4980 if (timers_run
!= old_timers_run
4981 && waiting_for_user_input_p
== -1
4982 && (old_buffer
!= current_buffer
4983 || !EQ (old_window
, selected_window
)))
4984 record_asynch_buffer_change ();
4990 /* If there is unread keyboard input, also return. */
4992 && requeued_events_pending_p ())
4995 /* If we are not checking for keyboard input now,
4996 do process events (but don't run any timers).
4997 This is so that X events will be processed.
4998 Otherwise they may have to wait until polling takes place.
4999 That would causes delays in pasting selections, for example.
5001 (We used to do this only if wait_for_cell.) */
5002 if (read_kbd
== 0 && detect_input_pending ())
5004 swallow_events (do_display
);
5005 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5006 if (detect_input_pending ())
5011 /* Exit now if the cell we're waiting for became non-nil. */
5012 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5016 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5017 go read it. This can happen with X on BSD after logging out.
5018 In that case, there really is no input and no SIGIO,
5019 but select says there is input. */
5021 if (read_kbd
&& interrupt_input
5022 && keyboard_bit_set (&Available
) && ! noninteractive
)
5023 kill (getpid (), SIGIO
);
5027 got_some_input
|= nfds
> 0;
5029 /* If checking input just got us a size-change event from X,
5030 obey it now if we should. */
5031 if (read_kbd
|| ! NILP (wait_for_cell
))
5032 do_pending_window_change (0);
5034 /* Check for data from a process. */
5035 if (no_avail
|| nfds
== 0)
5038 /* Really FIRST_PROC_DESC should be 0 on Unix,
5039 but this is safer in the short run. */
5040 for (channel
= 0; channel
<= max_process_desc
; channel
++)
5042 if (FD_ISSET (channel
, &Available
)
5043 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
5047 /* If waiting for this channel, arrange to return as
5048 soon as no more input to be processed. No more
5050 if (wait_channel
== channel
)
5056 proc
= chan_process
[channel
];
5060 /* If this is a server stream socket, accept connection. */
5061 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
5063 server_accept_connection (proc
, channel
);
5067 /* Read data from the process, starting with our
5068 buffered-ahead character if we have one. */
5070 nread
= read_process_output (proc
, channel
);
5073 /* Since read_process_output can run a filter,
5074 which can call accept-process-output,
5075 don't try to read from any other processes
5076 before doing the select again. */
5077 FD_ZERO (&Available
);
5080 redisplay_preserve_echo_area (12);
5083 else if (nread
== -1 && errno
== EWOULDBLOCK
)
5086 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
5087 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
5089 else if (nread
== -1 && errno
== EAGAIN
)
5093 else if (nread
== -1 && errno
== EAGAIN
)
5095 /* Note that we cannot distinguish between no input
5096 available now and a closed pipe.
5097 With luck, a closed pipe will be accompanied by
5098 subprocess termination and SIGCHLD. */
5099 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
5101 #endif /* O_NDELAY */
5102 #endif /* O_NONBLOCK */
5104 /* On some OSs with ptys, when the process on one end of
5105 a pty exits, the other end gets an error reading with
5106 errno = EIO instead of getting an EOF (0 bytes read).
5107 Therefore, if we get an error reading and errno =
5108 EIO, just continue, because the child process has
5109 exited and should clean itself up soon (e.g. when we
5112 However, it has been known to happen that the SIGCHLD
5113 got lost. So raise the signal again just in case.
5115 else if (nread
== -1 && errno
== EIO
)
5117 /* Clear the descriptor now, so we only raise the signal once. */
5118 FD_CLR (channel
, &input_wait_mask
);
5119 FD_CLR (channel
, &non_keyboard_wait_mask
);
5121 kill (getpid (), SIGCHLD
);
5123 #endif /* HAVE_PTYS */
5124 /* If we can detect process termination, don't consider the process
5125 gone just because its pipe is closed. */
5127 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
5132 /* Preserve status of processes already terminated. */
5133 XPROCESS (proc
)->tick
= ++process_tick
;
5134 deactivate_process (proc
);
5135 if (XPROCESS (proc
)->raw_status_new
)
5136 update_status (XPROCESS (proc
));
5137 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5138 XPROCESS (proc
)->status
5139 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5142 #ifdef NON_BLOCKING_CONNECT
5143 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
5144 && FD_ISSET (channel
, &connect_wait_mask
))
5146 struct Lisp_Process
*p
;
5148 FD_CLR (channel
, &connect_wait_mask
);
5149 if (--num_pending_connects
< 0)
5152 proc
= chan_process
[channel
];
5156 p
= XPROCESS (proc
);
5159 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
5160 So only use it on systems where it is known to work. */
5162 int xlen
= sizeof(xerrno
);
5163 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5168 struct sockaddr pname
;
5169 int pnamelen
= sizeof(pname
);
5171 /* If connection failed, getpeername will fail. */
5173 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
5175 /* Obtain connect failure code through error slippage. */
5178 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
5185 p
->tick
= ++process_tick
;
5186 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
5187 deactivate_process (proc
);
5192 /* Execute the sentinel here. If we had relied on
5193 status_notify to do it later, it will read input
5194 from the process before calling the sentinel. */
5195 exec_sentinel (proc
, build_string ("open\n"));
5196 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
5198 FD_SET (p
->infd
, &input_wait_mask
);
5199 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5203 #endif /* NON_BLOCKING_CONNECT */
5204 } /* end for each file descriptor */
5205 } /* end while exit conditions not met */
5207 unbind_to (count
, Qnil
);
5209 /* If calling from keyboard input, do not quit
5210 since we want to return C-g as an input character.
5211 Otherwise, do pending quit if requested. */
5214 /* Prevent input_pending from remaining set if we quit. */
5215 clear_input_pending ();
5219 return got_some_input
;
5222 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5225 read_process_output_call (fun_and_args
)
5226 Lisp_Object fun_and_args
;
5228 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5232 read_process_output_error_handler (error
)
5235 cmd_error_internal (error
, "error in process filter: ");
5237 update_echo_area ();
5238 Fsleep_for (make_number (2), Qnil
);
5242 /* Read pending output from the process channel,
5243 starting with our buffered-ahead character if we have one.
5244 Yield number of decoded characters read.
5246 This function reads at most 4096 characters.
5247 If you want to read all available subprocess output,
5248 you must call it repeatedly until it returns zero.
5250 The characters read are decoded according to PROC's coding-system
5254 read_process_output (proc
, channel
)
5256 register int channel
;
5258 register int nbytes
;
5260 register Lisp_Object outstream
;
5261 register struct buffer
*old
= current_buffer
;
5262 register struct Lisp_Process
*p
= XPROCESS (proc
);
5263 register int opoint
;
5264 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5265 int carryover
= p
->decoding_carryover
;
5269 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5271 vs
= get_vms_process_pointer (p
->pid
);
5275 return (0); /* Really weird if it does this */
5276 if (!(vs
->iosb
[0] & 1))
5277 return -1; /* I/O error */
5280 error ("Could not get VMS process pointer");
5281 chars
= vs
->inputBuffer
;
5282 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
5285 start_vms_process_read (vs
); /* Crank up the next read on the process */
5286 return 1; /* Nothing worth printing, say we got 1 */
5290 /* The data carried over in the previous decoding (which are at
5291 the tail of decoding buffer) should be prepended to the new
5292 data read to decode all together. */
5293 chars
= (char *) alloca (nbytes
+ carryover
);
5294 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
5295 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
5299 chars
= (char *) alloca (carryover
+ readmax
);
5301 /* See the comment above. */
5302 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
5304 #ifdef DATAGRAM_SOCKETS
5305 /* We have a working select, so proc_buffered_char is always -1. */
5306 if (DATAGRAM_CHAN_P (channel
))
5308 int len
= datagram_address
[channel
].len
;
5309 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5310 0, datagram_address
[channel
].sa
, &len
);
5314 if (proc_buffered_char
[channel
] < 0)
5316 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5317 #ifdef ADAPTIVE_READ_BUFFERING
5318 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5320 int delay
= p
->read_output_delay
;
5323 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5326 process_output_delay_count
++;
5327 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5330 else if (delay
> 0 && (nbytes
== readmax
))
5332 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5334 process_output_delay_count
--;
5336 p
->read_output_delay
= delay
;
5339 p
->read_output_skip
= 1;
5340 process_output_skip
= 1;
5347 chars
[carryover
] = proc_buffered_char
[channel
];
5348 proc_buffered_char
[channel
] = -1;
5349 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5353 nbytes
= nbytes
+ 1;
5355 #endif /* not VMS */
5357 p
->decoding_carryover
= 0;
5359 /* At this point, NBYTES holds number of bytes just received
5360 (including the one in proc_buffered_char[channel]). */
5363 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5365 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5368 /* Now set NBYTES how many bytes we must decode. */
5369 nbytes
+= carryover
;
5371 /* Read and dispose of the process output. */
5372 outstream
= p
->filter
;
5373 if (!NILP (outstream
))
5375 /* We inhibit quit here instead of just catching it so that
5376 hitting ^G when a filter happens to be running won't screw
5378 int count
= SPECPDL_INDEX ();
5379 Lisp_Object odeactivate
;
5380 Lisp_Object obuffer
, okeymap
;
5382 int outer_running_asynch_code
= running_asynch_code
;
5383 int waiting
= waiting_for_user_input_p
;
5385 /* No need to gcpro these, because all we do with them later
5386 is test them for EQness, and none of them should be a string. */
5387 odeactivate
= Vdeactivate_mark
;
5388 XSETBUFFER (obuffer
, current_buffer
);
5389 okeymap
= current_buffer
->keymap
;
5391 specbind (Qinhibit_quit
, Qt
);
5392 specbind (Qlast_nonmenu_event
, Qt
);
5394 /* In case we get recursively called,
5395 and we already saved the match data nonrecursively,
5396 save the same match data in safely recursive fashion. */
5397 if (outer_running_asynch_code
)
5400 /* Don't clobber the CURRENT match data, either! */
5401 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5402 restore_search_regs ();
5403 record_unwind_save_match_data ();
5404 Fset_match_data (tem
, Qt
);
5407 /* For speed, if a search happens within this code,
5408 save the match data in a special nonrecursive fashion. */
5409 running_asynch_code
= 1;
5411 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5412 text
= coding
->dst_object
;
5413 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5414 /* A new coding system might be found. */
5415 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5417 p
->decode_coding_system
= Vlast_coding_system_used
;
5419 /* Don't call setup_coding_system for
5420 proc_decode_coding_system[channel] here. It is done in
5421 detect_coding called via decode_coding above. */
5423 /* If a coding system for encoding is not yet decided, we set
5424 it as the same as coding-system for decoding.
5426 But, before doing that we must check if
5427 proc_encode_coding_system[p->outfd] surely points to a
5428 valid memory because p->outfd will be changed once EOF is
5429 sent to the process. */
5430 if (NILP (p
->encode_coding_system
)
5431 && proc_encode_coding_system
[p
->outfd
])
5433 p
->encode_coding_system
5434 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5435 setup_coding_system (p
->encode_coding_system
,
5436 proc_encode_coding_system
[p
->outfd
]);
5440 if (coding
->carryover_bytes
> 0)
5442 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5443 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5444 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5445 coding
->carryover_bytes
);
5446 p
->decoding_carryover
= coding
->carryover_bytes
;
5448 if (SBYTES (text
) > 0)
5449 internal_condition_case_1 (read_process_output_call
,
5451 Fcons (proc
, Fcons (text
, Qnil
))),
5452 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5453 read_process_output_error_handler
);
5455 /* If we saved the match data nonrecursively, restore it now. */
5456 restore_search_regs ();
5457 running_asynch_code
= outer_running_asynch_code
;
5459 /* Handling the process output should not deactivate the mark. */
5460 Vdeactivate_mark
= odeactivate
;
5462 /* Restore waiting_for_user_input_p as it was
5463 when we were called, in case the filter clobbered it. */
5464 waiting_for_user_input_p
= waiting
;
5466 #if 0 /* Call record_asynch_buffer_change unconditionally,
5467 because we might have changed minor modes or other things
5468 that affect key bindings. */
5469 if (! EQ (Fcurrent_buffer (), obuffer
)
5470 || ! EQ (current_buffer
->keymap
, okeymap
))
5472 /* But do it only if the caller is actually going to read events.
5473 Otherwise there's no need to make him wake up, and it could
5474 cause trouble (for example it would make sit_for return). */
5475 if (waiting_for_user_input_p
== -1)
5476 record_asynch_buffer_change ();
5479 start_vms_process_read (vs
);
5481 unbind_to (count
, Qnil
);
5485 /* If no filter, write into buffer if it isn't dead. */
5486 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5488 Lisp_Object old_read_only
;
5489 int old_begv
, old_zv
;
5490 int old_begv_byte
, old_zv_byte
;
5491 Lisp_Object odeactivate
;
5492 int before
, before_byte
;
5497 odeactivate
= Vdeactivate_mark
;
5499 Fset_buffer (p
->buffer
);
5501 opoint_byte
= PT_BYTE
;
5502 old_read_only
= current_buffer
->read_only
;
5505 old_begv_byte
= BEGV_BYTE
;
5506 old_zv_byte
= ZV_BYTE
;
5508 current_buffer
->read_only
= Qnil
;
5510 /* Insert new output into buffer
5511 at the current end-of-output marker,
5512 thus preserving logical ordering of input and output. */
5513 if (XMARKER (p
->mark
)->buffer
)
5514 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5515 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5518 SET_PT_BOTH (ZV
, ZV_BYTE
);
5520 before_byte
= PT_BYTE
;
5522 /* If the output marker is outside of the visible region, save
5523 the restriction and widen. */
5524 if (! (BEGV
<= PT
&& PT
<= ZV
))
5527 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5528 text
= coding
->dst_object
;
5529 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5530 /* A new coding system might be found. See the comment in the
5531 similar code in the previous `if' block. */
5532 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5534 p
->decode_coding_system
= Vlast_coding_system_used
;
5535 if (NILP (p
->encode_coding_system
)
5536 && proc_encode_coding_system
[p
->outfd
])
5538 p
->encode_coding_system
5539 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5540 setup_coding_system (p
->encode_coding_system
,
5541 proc_encode_coding_system
[p
->outfd
]);
5544 if (coding
->carryover_bytes
> 0)
5546 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5547 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5548 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5549 coding
->carryover_bytes
);
5550 p
->decoding_carryover
= coding
->carryover_bytes
;
5552 /* Adjust the multibyteness of TEXT to that of the buffer. */
5553 if (NILP (current_buffer
->enable_multibyte_characters
)
5554 != ! STRING_MULTIBYTE (text
))
5555 text
= (STRING_MULTIBYTE (text
)
5556 ? Fstring_as_unibyte (text
)
5557 : Fstring_to_multibyte (text
));
5558 /* Insert before markers in case we are inserting where
5559 the buffer's mark is, and the user's next command is Meta-y. */
5560 insert_from_string_before_markers (text
, 0, 0,
5561 SCHARS (text
), SBYTES (text
), 0);
5563 /* Make sure the process marker's position is valid when the
5564 process buffer is changed in the signal_after_change above.
5565 W3 is known to do that. */
5566 if (BUFFERP (p
->buffer
)
5567 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5568 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5570 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5572 update_mode_lines
++;
5574 /* Make sure opoint and the old restrictions
5575 float ahead of any new text just as point would. */
5576 if (opoint
>= before
)
5578 opoint
+= PT
- before
;
5579 opoint_byte
+= PT_BYTE
- before_byte
;
5581 if (old_begv
> before
)
5583 old_begv
+= PT
- before
;
5584 old_begv_byte
+= PT_BYTE
- before_byte
;
5586 if (old_zv
>= before
)
5588 old_zv
+= PT
- before
;
5589 old_zv_byte
+= PT_BYTE
- before_byte
;
5592 /* If the restriction isn't what it should be, set it. */
5593 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5594 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5596 /* Handling the process output should not deactivate the mark. */
5597 Vdeactivate_mark
= odeactivate
;
5599 current_buffer
->read_only
= old_read_only
;
5600 SET_PT_BOTH (opoint
, opoint_byte
);
5601 set_buffer_internal (old
);
5604 start_vms_process_read (vs
);
5609 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5611 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5612 This is intended for use by asynchronous process output filters and sentinels. */)
5615 return (waiting_for_user_input_p
? Qt
: Qnil
);
5618 /* Sending data to subprocess */
5620 jmp_buf send_process_frame
;
5621 Lisp_Object process_sent_to
;
5624 send_process_trap ()
5626 SIGNAL_THREAD_CHECK (SIGPIPE
);
5627 sigunblock (sigmask (SIGPIPE
));
5628 longjmp (send_process_frame
, 1);
5631 /* Send some data to process PROC.
5632 BUF is the beginning of the data; LEN is the number of characters.
5633 OBJECT is the Lisp object that the data comes from. If OBJECT is
5634 nil or t, it means that the data comes from C string.
5636 If OBJECT is not nil, the data is encoded by PROC's coding-system
5637 for encoding before it is sent.
5639 This function can evaluate Lisp code and can garbage collect. */
5642 send_process (proc
, buf
, len
, object
)
5643 volatile Lisp_Object proc
;
5644 unsigned char *volatile buf
;
5646 volatile Lisp_Object object
;
5648 /* Use volatile to protect variables from being clobbered by longjmp. */
5649 struct Lisp_Process
*p
= XPROCESS (proc
);
5651 struct coding_system
*coding
;
5652 struct gcpro gcpro1
;
5653 SIGTYPE (*volatile old_sigpipe
) ();
5658 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5661 if (p
->raw_status_new
)
5663 if (! EQ (p
->status
, Qrun
))
5664 error ("Process %s not running", SDATA (p
->name
));
5666 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5668 coding
= proc_encode_coding_system
[p
->outfd
];
5669 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5671 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5672 || (BUFFERP (object
)
5673 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5676 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5677 /* The coding system for encoding was changed to raw-text
5678 because we sent a unibyte text previously. Now we are
5679 sending a multibyte text, thus we must encode it by the
5680 original coding system specified for the current process. */
5681 setup_coding_system (p
->encode_coding_system
, coding
);
5682 coding
->src_multibyte
= 1;
5686 /* For sending a unibyte text, character code conversion should
5687 not take place but EOL conversion should. So, setup raw-text
5688 or one of the subsidiary if we have not yet done it. */
5689 if (CODING_REQUIRE_ENCODING (coding
))
5691 if (CODING_REQUIRE_FLUSHING (coding
))
5693 /* But, before changing the coding, we must flush out data. */
5694 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5695 send_process (proc
, "", 0, Qt
);
5696 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5698 setup_coding_system (raw_text_coding_system
5699 (Vlast_coding_system_used
),
5701 coding
->src_multibyte
= 0;
5704 coding
->dst_multibyte
= 0;
5706 if (CODING_REQUIRE_ENCODING (coding
))
5708 coding
->dst_object
= Qt
;
5709 if (BUFFERP (object
))
5711 int from_byte
, from
, to
;
5712 int save_pt
, save_pt_byte
;
5713 struct buffer
*cur
= current_buffer
;
5715 set_buffer_internal (XBUFFER (object
));
5716 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5718 from_byte
= PTR_BYTE_POS (buf
);
5719 from
= BYTE_TO_CHAR (from_byte
);
5720 to
= BYTE_TO_CHAR (from_byte
+ len
);
5721 TEMP_SET_PT_BOTH (from
, from_byte
);
5722 encode_coding_object (coding
, object
, from
, from_byte
,
5723 to
, from_byte
+ len
, Qt
);
5724 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5725 set_buffer_internal (cur
);
5727 else if (STRINGP (object
))
5729 encode_coding_string (coding
, object
, 1);
5733 coding
->dst_object
= make_unibyte_string (buf
, len
);
5734 coding
->produced
= len
;
5737 len
= coding
->produced
;
5738 buf
= SDATA (coding
->dst_object
);
5742 vs
= get_vms_process_pointer (p
->pid
);
5744 error ("Could not find this process: %x", p
->pid
);
5745 else if (write_to_vms_process (vs
, buf
, len
))
5749 if (pty_max_bytes
== 0)
5751 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5752 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5753 if (pty_max_bytes
< 0)
5754 pty_max_bytes
= 250;
5756 pty_max_bytes
= 250;
5758 /* Deduct one, to leave space for the eof. */
5762 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5763 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5764 when returning with longjmp despite being declared volatile. */
5765 if (!setjmp (send_process_frame
))
5767 process_sent_to
= proc
;
5772 /* Decide how much data we can send in one batch.
5773 Long lines need to be split into multiple batches. */
5776 /* Starting this at zero is always correct when not the first
5777 iteration because the previous iteration ended by sending C-d.
5778 It may not be correct for the first iteration
5779 if a partial line was sent in a separate send_process call.
5780 If that proves worth handling, we need to save linepos
5781 in the process object. */
5783 unsigned char *ptr
= (unsigned char *) buf
;
5784 unsigned char *end
= (unsigned char *) buf
+ len
;
5786 /* Scan through this text for a line that is too long. */
5787 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5795 /* If we found one, break the line there
5796 and put in a C-d to force the buffer through. */
5800 /* Send this batch, using one or more write calls. */
5803 int outfd
= p
->outfd
;
5804 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5805 #ifdef DATAGRAM_SOCKETS
5806 if (DATAGRAM_CHAN_P (outfd
))
5808 rv
= sendto (outfd
, (char *) buf
, this,
5809 0, datagram_address
[outfd
].sa
,
5810 datagram_address
[outfd
].len
);
5811 if (rv
< 0 && errno
== EMSGSIZE
)
5813 signal (SIGPIPE
, old_sigpipe
);
5814 report_file_error ("sending datagram",
5815 Fcons (proc
, Qnil
));
5821 rv
= emacs_write (outfd
, (char *) buf
, this);
5822 #ifdef ADAPTIVE_READ_BUFFERING
5823 if (p
->read_output_delay
> 0
5824 && p
->adaptive_read_buffering
== 1)
5826 p
->read_output_delay
= 0;
5827 process_output_delay_count
--;
5828 p
->read_output_skip
= 0;
5832 signal (SIGPIPE
, old_sigpipe
);
5838 || errno
== EWOULDBLOCK
5844 /* Buffer is full. Wait, accepting input;
5845 that may allow the program
5846 to finish doing output and read more. */
5850 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5851 /* A gross hack to work around a bug in FreeBSD.
5852 In the following sequence, read(2) returns
5856 write(2) 954 bytes, get EAGAIN
5857 read(2) 1024 bytes in process_read_output
5858 read(2) 11 bytes in process_read_output
5860 That is, read(2) returns more bytes than have
5861 ever been written successfully. The 1033 bytes
5862 read are the 1022 bytes written successfully
5863 after processing (for example with CRs added if
5864 the terminal is set up that way which it is
5865 here). The same bytes will be seen again in a
5866 later read(2), without the CRs. */
5868 if (errno
== EAGAIN
)
5871 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5873 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5875 /* Running filters might relocate buffers or strings.
5876 Arrange to relocate BUF. */
5877 if (BUFFERP (object
))
5878 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5879 else if (STRINGP (object
))
5880 offset
= buf
- SDATA (object
);
5882 #ifdef EMACS_HAS_USECS
5883 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5885 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5888 if (BUFFERP (object
))
5889 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5890 else if (STRINGP (object
))
5891 buf
= offset
+ SDATA (object
);
5896 /* This is a real error. */
5897 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5904 /* If we sent just part of the string, put in an EOF (C-d)
5905 to force it through, before we send the rest. */
5907 Fprocess_send_eof (proc
);
5910 #endif /* not VMS */
5913 signal (SIGPIPE
, old_sigpipe
);
5915 proc
= process_sent_to
;
5916 p
= XPROCESS (proc
);
5918 p
->raw_status_new
= 0;
5919 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5920 p
->tick
= ++process_tick
;
5921 deactivate_process (proc
);
5923 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5925 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5932 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5934 doc
: /* Send current contents of region as input to PROCESS.
5935 PROCESS may be a process, a buffer, the name of a process or buffer, or
5936 nil, indicating the current buffer's process.
5937 Called from program, takes three arguments, PROCESS, START and END.
5938 If the region is more than 500 characters long,
5939 it is sent in several bunches. This may happen even for shorter regions.
5940 Output from processes can arrive in between bunches. */)
5941 (process
, start
, end
)
5942 Lisp_Object process
, start
, end
;
5947 proc
= get_process (process
);
5948 validate_region (&start
, &end
);
5950 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5951 move_gap (XINT (start
));
5953 start1
= CHAR_TO_BYTE (XINT (start
));
5954 end1
= CHAR_TO_BYTE (XINT (end
));
5955 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5956 Fcurrent_buffer ());
5961 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5963 doc
: /* Send PROCESS the contents of STRING as input.
5964 PROCESS may be a process, a buffer, the name of a process or buffer, or
5965 nil, indicating the current buffer's process.
5966 If STRING is more than 500 characters long,
5967 it is sent in several bunches. This may happen even for shorter strings.
5968 Output from processes can arrive in between bunches. */)
5970 Lisp_Object process
, string
;
5973 CHECK_STRING (string
);
5974 proc
= get_process (process
);
5975 send_process (proc
, SDATA (string
),
5976 SBYTES (string
), string
);
5980 /* Return the foreground process group for the tty/pty that
5981 the process P uses. */
5983 emacs_get_tty_pgrp (p
)
5984 struct Lisp_Process
*p
;
5989 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5992 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5993 master side. Try the slave side. */
5994 fd
= emacs_open (SDATA (p
->tty_name
), O_RDONLY
, 0);
5998 ioctl (fd
, TIOCGPGRP
, &gid
);
6002 #endif /* defined (TIOCGPGRP ) */
6007 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
6008 Sprocess_running_child_p
, 0, 1, 0,
6009 doc
: /* Return t if PROCESS has given the terminal to a child.
6010 If the operating system does not make it possible to find out,
6011 return t unconditionally. */)
6013 Lisp_Object process
;
6015 /* Initialize in case ioctl doesn't exist or gives an error,
6016 in a way that will cause returning t. */
6019 struct Lisp_Process
*p
;
6021 proc
= get_process (process
);
6022 p
= XPROCESS (proc
);
6024 if (!EQ (p
->type
, Qreal
))
6025 error ("Process %s is not a subprocess",
6028 error ("Process %s is not active",
6031 gid
= emacs_get_tty_pgrp (p
);
6038 /* send a signal number SIGNO to PROCESS.
6039 If CURRENT_GROUP is t, that means send to the process group
6040 that currently owns the terminal being used to communicate with PROCESS.
6041 This is used for various commands in shell mode.
6042 If CURRENT_GROUP is lambda, that means send to the process group
6043 that currently owns the terminal, but only if it is NOT the shell itself.
6045 If NOMSG is zero, insert signal-announcements into process's buffers
6048 If we can, we try to signal PROCESS by sending control characters
6049 down the pty. This allows us to signal inferiors who have changed
6050 their uid, for which killpg would return an EPERM error. */
6053 process_send_signal (process
, signo
, current_group
, nomsg
)
6054 Lisp_Object process
;
6056 Lisp_Object current_group
;
6060 register struct Lisp_Process
*p
;
6064 proc
= get_process (process
);
6065 p
= XPROCESS (proc
);
6067 if (!EQ (p
->type
, Qreal
))
6068 error ("Process %s is not a subprocess",
6071 error ("Process %s is not active",
6075 current_group
= Qnil
;
6077 /* If we are using pgrps, get a pgrp number and make it negative. */
6078 if (NILP (current_group
))
6079 /* Send the signal to the shell's process group. */
6083 #ifdef SIGNALS_VIA_CHARACTERS
6084 /* If possible, send signals to the entire pgrp
6085 by sending an input character to it. */
6087 /* TERMIOS is the latest and bestest, and seems most likely to
6088 work. If the system has it, use it. */
6091 cc_t
*sig_char
= NULL
;
6093 tcgetattr (p
->infd
, &t
);
6098 sig_char
= &t
.c_cc
[VINTR
];
6102 sig_char
= &t
.c_cc
[VQUIT
];
6106 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
6107 sig_char
= &t
.c_cc
[VSWTCH
];
6109 sig_char
= &t
.c_cc
[VSUSP
];
6114 if (sig_char
&& *sig_char
!= CDISABLE
)
6116 send_process (proc
, sig_char
, 1, Qnil
);
6119 /* If we can't send the signal with a character,
6120 fall through and send it another way. */
6121 #else /* ! HAVE_TERMIOS */
6123 /* On Berkeley descendants, the following IOCTL's retrieve the
6124 current control characters. */
6125 #if defined (TIOCGLTC) && defined (TIOCGETC)
6133 ioctl (p
->infd
, TIOCGETC
, &c
);
6134 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
6137 ioctl (p
->infd
, TIOCGETC
, &c
);
6138 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
6142 ioctl (p
->infd
, TIOCGLTC
, &lc
);
6143 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
6145 #endif /* ! defined (SIGTSTP) */
6148 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6150 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
6157 ioctl (p
->infd
, TCGETA
, &t
);
6158 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
6161 ioctl (p
->infd
, TCGETA
, &t
);
6162 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
6166 ioctl (p
->infd
, TCGETA
, &t
);
6167 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
6169 #endif /* ! defined (SIGTSTP) */
6171 #else /* ! defined (TCGETA) */
6172 Your configuration files are messed up
.
6173 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
6174 you'd better be using one of the alternatives above! */
6175 #endif /* ! defined (TCGETA) */
6176 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6177 /* In this case, the code above should alway return. */
6179 #endif /* ! defined HAVE_TERMIOS */
6181 /* The code above may fall through if it can't
6182 handle the signal. */
6183 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6186 /* Get the current pgrp using the tty itself, if we have that.
6187 Otherwise, use the pty to get the pgrp.
6188 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6189 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6190 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6191 His patch indicates that if TIOCGPGRP returns an error, then
6192 we should just assume that p->pid is also the process group id. */
6194 gid
= emacs_get_tty_pgrp (p
);
6197 /* If we can't get the information, assume
6198 the shell owns the tty. */
6201 /* It is not clear whether anything really can set GID to -1.
6202 Perhaps on some system one of those ioctls can or could do so.
6203 Or perhaps this is vestigial. */
6206 #else /* ! defined (TIOCGPGRP ) */
6207 /* Can't select pgrps on this system, so we know that
6208 the child itself heads the pgrp. */
6210 #endif /* ! defined (TIOCGPGRP ) */
6212 /* If current_group is lambda, and the shell owns the terminal,
6213 don't send any signal. */
6214 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6222 p
->raw_status_new
= 0;
6224 p
->tick
= ++process_tick
;
6226 status_notify (NULL
);
6228 #endif /* ! defined (SIGCONT) */
6231 send_process (proc
, "\003", 1, Qnil
); /* ^C */
6236 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
6241 sys$
forcex (&(p
->pid
), 0, 1);
6244 flush_pending_output (p
->infd
);
6248 /* If we don't have process groups, send the signal to the immediate
6249 subprocess. That isn't really right, but it's better than any
6250 obvious alternative. */
6253 kill (p
->pid
, signo
);
6257 /* gid may be a pid, or minus a pgrp's number */
6259 if (!NILP (current_group
))
6261 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
6262 EMACS_KILLPG (gid
, signo
);
6269 #else /* ! defined (TIOCSIGSEND) */
6270 EMACS_KILLPG (gid
, signo
);
6271 #endif /* ! defined (TIOCSIGSEND) */
6274 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6275 doc
: /* Interrupt process PROCESS.
6276 PROCESS may be a process, a buffer, or the name of a process or buffer.
6277 No arg or nil means current buffer's process.
6278 Second arg CURRENT-GROUP non-nil means send signal to
6279 the current process-group of the process's controlling terminal
6280 rather than to the process's own process group.
6281 If the process is a shell, this means interrupt current subjob
6282 rather than the shell.
6284 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6285 don't send the signal. */)
6286 (process
, current_group
)
6287 Lisp_Object process
, current_group
;
6289 process_send_signal (process
, SIGINT
, current_group
, 0);
6293 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6294 doc
: /* Kill process PROCESS. May be process or name of one.
6295 See function `interrupt-process' for more details on usage. */)
6296 (process
, current_group
)
6297 Lisp_Object process
, current_group
;
6299 process_send_signal (process
, SIGKILL
, current_group
, 0);
6303 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6304 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6305 See function `interrupt-process' for more details on usage. */)
6306 (process
, current_group
)
6307 Lisp_Object process
, current_group
;
6309 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6313 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6314 doc
: /* Stop process PROCESS. May be process or name of one.
6315 See function `interrupt-process' for more details on usage.
6316 If PROCESS is a network or serial process, inhibit handling of incoming
6318 (process
, current_group
)
6319 Lisp_Object process
, current_group
;
6322 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6324 struct Lisp_Process
*p
;
6326 p
= XPROCESS (process
);
6327 if (NILP (p
->command
)
6330 FD_CLR (p
->infd
, &input_wait_mask
);
6331 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6338 error ("No SIGTSTP support");
6340 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6345 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6346 doc
: /* Continue process PROCESS. May be process or name of one.
6347 See function `interrupt-process' for more details on usage.
6348 If PROCESS is a network or serial process, resume handling of incoming
6350 (process
, current_group
)
6351 Lisp_Object process
, current_group
;
6354 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6356 struct Lisp_Process
*p
;
6358 p
= XPROCESS (process
);
6359 if (EQ (p
->command
, Qt
)
6361 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6363 FD_SET (p
->infd
, &input_wait_mask
);
6364 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6366 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6367 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6370 tcflush (p
->infd
, TCIFLUSH
);
6378 process_send_signal (process
, SIGCONT
, current_group
, 0);
6380 error ("No SIGCONT support");
6385 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6386 2, 2, "sProcess (name or number): \nnSignal code: ",
6387 doc
: /* Send PROCESS the signal with code SIGCODE.
6388 PROCESS may also be a number specifying the process id of the
6389 process to signal; in this case, the process need not be a child of
6391 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6393 Lisp_Object process
, sigcode
;
6397 if (INTEGERP (process
))
6399 pid
= XINT (process
);
6403 if (FLOATP (process
))
6405 pid
= (pid_t
) XFLOAT_DATA (process
);
6409 if (STRINGP (process
))
6412 if (tem
= Fget_process (process
), NILP (tem
))
6414 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6421 process
= get_process (process
);
6426 CHECK_PROCESS (process
);
6427 pid
= XPROCESS (process
)->pid
;
6429 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6433 #define parse_signal(NAME, VALUE) \
6434 else if (!xstrcasecmp (name, NAME)) \
6435 XSETINT (sigcode, VALUE)
6437 if (INTEGERP (sigcode
))
6441 unsigned char *name
;
6443 CHECK_SYMBOL (sigcode
);
6444 name
= SDATA (SYMBOL_NAME (sigcode
));
6446 if (!strncmp(name
, "SIG", 3) || !strncmp(name
, "sig", 3))
6452 parse_signal ("usr1", SIGUSR1
);
6455 parse_signal ("usr2", SIGUSR2
);
6458 parse_signal ("term", SIGTERM
);
6461 parse_signal ("hup", SIGHUP
);
6464 parse_signal ("int", SIGINT
);
6467 parse_signal ("quit", SIGQUIT
);
6470 parse_signal ("ill", SIGILL
);
6473 parse_signal ("abrt", SIGABRT
);
6476 parse_signal ("emt", SIGEMT
);
6479 parse_signal ("kill", SIGKILL
);
6482 parse_signal ("fpe", SIGFPE
);
6485 parse_signal ("bus", SIGBUS
);
6488 parse_signal ("segv", SIGSEGV
);
6491 parse_signal ("sys", SIGSYS
);
6494 parse_signal ("pipe", SIGPIPE
);
6497 parse_signal ("alrm", SIGALRM
);
6500 parse_signal ("urg", SIGURG
);
6503 parse_signal ("stop", SIGSTOP
);
6506 parse_signal ("tstp", SIGTSTP
);
6509 parse_signal ("cont", SIGCONT
);
6512 parse_signal ("chld", SIGCHLD
);
6515 parse_signal ("ttin", SIGTTIN
);
6518 parse_signal ("ttou", SIGTTOU
);
6521 parse_signal ("io", SIGIO
);
6524 parse_signal ("xcpu", SIGXCPU
);
6527 parse_signal ("xfsz", SIGXFSZ
);
6530 parse_signal ("vtalrm", SIGVTALRM
);
6533 parse_signal ("prof", SIGPROF
);
6536 parse_signal ("winch", SIGWINCH
);
6539 parse_signal ("info", SIGINFO
);
6542 error ("Undefined signal name %s", name
);
6547 return make_number (kill (pid
, XINT (sigcode
)));
6550 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6551 doc
: /* Make PROCESS see end-of-file in its input.
6552 EOF comes after any text already sent to it.
6553 PROCESS may be a process, a buffer, the name of a process or buffer, or
6554 nil, indicating the current buffer's process.
6555 If PROCESS is a network connection, or is a process communicating
6556 through a pipe (as opposed to a pty), then you cannot send any more
6557 text to PROCESS after you call this function.
6558 If PROCESS is a serial process, wait until all output written to the
6559 process has been transmitted to the serial port. */)
6561 Lisp_Object process
;
6564 struct coding_system
*coding
;
6566 if (DATAGRAM_CONN_P (process
))
6569 proc
= get_process (process
);
6570 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6572 /* Make sure the process is really alive. */
6573 if (XPROCESS (proc
)->raw_status_new
)
6574 update_status (XPROCESS (proc
));
6575 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6576 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6578 if (CODING_REQUIRE_FLUSHING (coding
))
6580 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6581 send_process (proc
, "", 0, Qnil
);
6585 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6587 if (XPROCESS (proc
)->pty_flag
)
6588 send_process (proc
, "\004", 1, Qnil
);
6589 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6592 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6593 error ("tcdrain() failed: %s", emacs_strerror (errno
));
6595 /* Do nothing on Windows because writes are blocking. */
6599 int old_outfd
, new_outfd
;
6601 #ifdef HAVE_SHUTDOWN
6602 /* If this is a network connection, or socketpair is used
6603 for communication with the subprocess, call shutdown to cause EOF.
6604 (In some old system, shutdown to socketpair doesn't work.
6605 Then we just can't win.) */
6606 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6607 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6608 shutdown (XPROCESS (proc
)->outfd
, 1);
6609 /* In case of socketpair, outfd == infd, so don't close it. */
6610 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6611 emacs_close (XPROCESS (proc
)->outfd
);
6612 #else /* not HAVE_SHUTDOWN */
6613 emacs_close (XPROCESS (proc
)->outfd
);
6614 #endif /* not HAVE_SHUTDOWN */
6615 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6618 old_outfd
= XPROCESS (proc
)->outfd
;
6620 if (!proc_encode_coding_system
[new_outfd
])
6621 proc_encode_coding_system
[new_outfd
]
6622 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6623 bcopy (proc_encode_coding_system
[old_outfd
],
6624 proc_encode_coding_system
[new_outfd
],
6625 sizeof (struct coding_system
));
6626 bzero (proc_encode_coding_system
[old_outfd
],
6627 sizeof (struct coding_system
));
6629 XPROCESS (proc
)->outfd
= new_outfd
;
6635 /* Kill all processes associated with `buffer'.
6636 If `buffer' is nil, kill all processes */
6639 kill_buffer_processes (buffer
)
6642 Lisp_Object tail
, proc
;
6644 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6646 proc
= XCDR (XCAR (tail
));
6648 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6650 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
6651 Fdelete_process (proc
);
6652 else if (XPROCESS (proc
)->infd
>= 0)
6653 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6658 /* On receipt of a signal that a child status has changed, loop asking
6659 about children with changed statuses until the system says there
6662 All we do is change the status; we do not run sentinels or print
6663 notifications. That is saved for the next time keyboard input is
6664 done, in order to avoid timing errors.
6666 ** WARNING: this can be called during garbage collection.
6667 Therefore, it must not be fooled by the presence of mark bits in
6670 ** USG WARNING: Although it is not obvious from the documentation
6671 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6672 signal() before executing at least one wait(), otherwise the
6673 handler will be called again, resulting in an infinite loop. The
6674 relevant portion of the documentation reads "SIGCLD signals will be
6675 queued and the signal-catching function will be continually
6676 reentered until the queue is empty". Invoking signal() causes the
6677 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6680 ** Malloc WARNING: This should never call malloc either directly or
6681 indirectly; if it does, that is a bug */
6685 sigchld_handler (signo
)
6688 int old_errno
= errno
;
6690 register struct Lisp_Process
*p
;
6691 extern EMACS_TIME
*input_available_clear_time
;
6693 SIGNAL_THREAD_CHECK (signo
);
6704 #endif /* no WUNTRACED */
6705 /* Keep trying to get a status until we get a definitive result. */
6709 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6711 while (pid
< 0 && errno
== EINTR
);
6715 /* PID == 0 means no processes found, PID == -1 means a real
6716 failure. We have done all our job, so return. */
6718 /* USG systems forget handlers when they are used;
6719 must reestablish each time */
6720 #if defined (USG) && !defined (POSIX_SIGNALS)
6721 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6728 #endif /* no WNOHANG */
6730 /* Find the process that signaled us, and record its status. */
6732 /* The process can have been deleted by Fdelete_process. */
6733 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6735 Lisp_Object xpid
= XCAR (tail
);
6736 if ((INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6737 || (FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6739 XSETCAR (tail
, Qnil
);
6740 goto sigchld_end_of_loop
;
6744 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6746 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6748 proc
= XCDR (XCAR (tail
));
6749 p
= XPROCESS (proc
);
6750 if (EQ (p
->type
, Qreal
) && p
->pid
== pid
)
6755 /* Look for an asynchronous process whose pid hasn't been filled
6758 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6760 proc
= XCDR (XCAR (tail
));
6761 p
= XPROCESS (proc
);
6767 /* Change the status of the process that was found. */
6770 int clear_desc_flag
= 0;
6772 p
->tick
= ++process_tick
;
6774 p
->raw_status_new
= 1;
6776 /* If process has terminated, stop waiting for its output. */
6777 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6779 clear_desc_flag
= 1;
6781 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6782 if (clear_desc_flag
)
6784 FD_CLR (p
->infd
, &input_wait_mask
);
6785 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6788 /* Tell wait_reading_process_output that it needs to wake up and
6790 if (input_available_clear_time
)
6791 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6794 /* There was no asynchronous process found for that pid: we have
6795 a synchronous process. */
6798 synch_process_alive
= 0;
6800 /* Report the status of the synchronous process. */
6802 synch_process_retcode
= WRETCODE (w
);
6803 else if (WIFSIGNALED (w
))
6804 synch_process_termsig
= WTERMSIG (w
);
6806 /* Tell wait_reading_process_output that it needs to wake up and
6808 if (input_available_clear_time
)
6809 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6812 sigchld_end_of_loop
:
6815 /* On some systems, we must return right away.
6816 If any more processes want to signal us, we will
6818 Otherwise (on systems that have WNOHANG), loop around
6819 to use up all the processes that have something to tell us. */
6820 #if (defined WINDOWSNT \
6821 || (defined USG && !defined GNU_LINUX \
6822 && !(defined HPUX && defined WNOHANG)))
6823 #if defined (USG) && ! defined (POSIX_SIGNALS)
6824 signal (signo
, sigchld_handler
);
6828 #endif /* USG, but not HPUX with WNOHANG */
6831 #endif /* SIGCHLD */
6835 exec_sentinel_unwind (data
)
6838 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6843 exec_sentinel_error_handler (error
)
6846 cmd_error_internal (error
, "error in process sentinel: ");
6848 update_echo_area ();
6849 Fsleep_for (make_number (2), Qnil
);
6854 exec_sentinel (proc
, reason
)
6855 Lisp_Object proc
, reason
;
6857 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6858 register struct Lisp_Process
*p
= XPROCESS (proc
);
6859 int count
= SPECPDL_INDEX ();
6860 int outer_running_asynch_code
= running_asynch_code
;
6861 int waiting
= waiting_for_user_input_p
;
6863 if (inhibit_sentinels
)
6866 /* No need to gcpro these, because all we do with them later
6867 is test them for EQness, and none of them should be a string. */
6868 odeactivate
= Vdeactivate_mark
;
6869 XSETBUFFER (obuffer
, current_buffer
);
6870 okeymap
= current_buffer
->keymap
;
6872 sentinel
= p
->sentinel
;
6873 if (NILP (sentinel
))
6876 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6877 assure that it gets restored no matter how the sentinel exits. */
6879 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6880 /* Inhibit quit so that random quits don't screw up a running filter. */
6881 specbind (Qinhibit_quit
, Qt
);
6882 specbind (Qlast_nonmenu_event
, Qt
);
6884 /* In case we get recursively called,
6885 and we already saved the match data nonrecursively,
6886 save the same match data in safely recursive fashion. */
6887 if (outer_running_asynch_code
)
6890 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6891 restore_search_regs ();
6892 record_unwind_save_match_data ();
6893 Fset_match_data (tem
, Qt
);
6896 /* For speed, if a search happens within this code,
6897 save the match data in a special nonrecursive fashion. */
6898 running_asynch_code
= 1;
6900 internal_condition_case_1 (read_process_output_call
,
6902 Fcons (proc
, Fcons (reason
, Qnil
))),
6903 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6904 exec_sentinel_error_handler
);
6906 /* If we saved the match data nonrecursively, restore it now. */
6907 restore_search_regs ();
6908 running_asynch_code
= outer_running_asynch_code
;
6910 Vdeactivate_mark
= odeactivate
;
6912 /* Restore waiting_for_user_input_p as it was
6913 when we were called, in case the filter clobbered it. */
6914 waiting_for_user_input_p
= waiting
;
6917 if (! EQ (Fcurrent_buffer (), obuffer
)
6918 || ! EQ (current_buffer
->keymap
, okeymap
))
6920 /* But do it only if the caller is actually going to read events.
6921 Otherwise there's no need to make him wake up, and it could
6922 cause trouble (for example it would make sit_for return). */
6923 if (waiting_for_user_input_p
== -1)
6924 record_asynch_buffer_change ();
6926 unbind_to (count
, Qnil
);
6929 /* Report all recent events of a change in process status
6930 (either run the sentinel or output a message).
6931 This is usually done while Emacs is waiting for keyboard input
6932 but can be done at other times. */
6935 status_notify (deleting_process
)
6936 struct Lisp_Process
*deleting_process
;
6938 register Lisp_Object proc
, buffer
;
6939 Lisp_Object tail
, msg
;
6940 struct gcpro gcpro1
, gcpro2
;
6944 /* We need to gcpro tail; if read_process_output calls a filter
6945 which deletes a process and removes the cons to which tail points
6946 from Vprocess_alist, and then causes a GC, tail is an unprotected
6950 /* Set this now, so that if new processes are created by sentinels
6951 that we run, we get called again to handle their status changes. */
6952 update_tick
= process_tick
;
6954 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6957 register struct Lisp_Process
*p
;
6959 proc
= Fcdr (XCAR (tail
));
6960 p
= XPROCESS (proc
);
6962 if (p
->tick
!= p
->update_tick
)
6964 p
->update_tick
= p
->tick
;
6966 /* If process is still active, read any output that remains. */
6967 while (! EQ (p
->filter
, Qt
)
6968 && ! EQ (p
->status
, Qconnect
)
6969 && ! EQ (p
->status
, Qlisten
)
6970 /* Network or serial process not stopped: */
6971 && ! EQ (p
->command
, Qt
)
6973 && p
!= deleting_process
6974 && read_process_output (proc
, p
->infd
) > 0);
6978 /* Get the text to use for the message. */
6979 if (p
->raw_status_new
)
6981 msg
= status_message (p
);
6983 /* If process is terminated, deactivate it or delete it. */
6985 if (CONSP (p
->status
))
6986 symbol
= XCAR (p
->status
);
6988 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6989 || EQ (symbol
, Qclosed
))
6991 if (delete_exited_processes
)
6992 remove_process (proc
);
6994 deactivate_process (proc
);
6997 /* The actions above may have further incremented p->tick.
6998 So set p->update_tick again
6999 so that an error in the sentinel will not cause
7000 this code to be run again. */
7001 p
->update_tick
= p
->tick
;
7002 /* Now output the message suitably. */
7003 if (!NILP (p
->sentinel
))
7004 exec_sentinel (proc
, msg
);
7005 /* Don't bother with a message in the buffer
7006 when a process becomes runnable. */
7007 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
7009 Lisp_Object ro
, tem
;
7010 struct buffer
*old
= current_buffer
;
7011 int opoint
, opoint_byte
;
7012 int before
, before_byte
;
7014 ro
= XBUFFER (buffer
)->read_only
;
7016 /* Avoid error if buffer is deleted
7017 (probably that's why the process is dead, too) */
7018 if (NILP (XBUFFER (buffer
)->name
))
7020 Fset_buffer (buffer
);
7023 opoint_byte
= PT_BYTE
;
7024 /* Insert new output into buffer
7025 at the current end-of-output marker,
7026 thus preserving logical ordering of input and output. */
7027 if (XMARKER (p
->mark
)->buffer
)
7028 Fgoto_char (p
->mark
);
7030 SET_PT_BOTH (ZV
, ZV_BYTE
);
7033 before_byte
= PT_BYTE
;
7035 tem
= current_buffer
->read_only
;
7036 current_buffer
->read_only
= Qnil
;
7037 insert_string ("\nProcess ");
7038 Finsert (1, &p
->name
);
7039 insert_string (" ");
7041 current_buffer
->read_only
= tem
;
7042 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
7044 if (opoint
>= before
)
7045 SET_PT_BOTH (opoint
+ (PT
- before
),
7046 opoint_byte
+ (PT_BYTE
- before_byte
));
7048 SET_PT_BOTH (opoint
, opoint_byte
);
7050 set_buffer_internal (old
);
7055 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
7056 redisplay_preserve_echo_area (13);
7062 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
7063 Sset_process_coding_system
, 1, 3, 0,
7064 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
7065 DECODING will be used to decode subprocess output and ENCODING to
7066 encode subprocess input. */)
7067 (process
, decoding
, encoding
)
7068 register Lisp_Object process
, decoding
, encoding
;
7070 register struct Lisp_Process
*p
;
7072 CHECK_PROCESS (process
);
7073 p
= XPROCESS (process
);
7075 error ("Input file descriptor of %s closed", SDATA (p
->name
));
7077 error ("Output file descriptor of %s closed", SDATA (p
->name
));
7078 Fcheck_coding_system (decoding
);
7079 Fcheck_coding_system (encoding
);
7080 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
7081 p
->decode_coding_system
= decoding
;
7082 p
->encode_coding_system
= encoding
;
7083 setup_process_coding_systems (process
);
7088 DEFUN ("process-coding-system",
7089 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
7090 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7092 register Lisp_Object process
;
7094 CHECK_PROCESS (process
);
7095 return Fcons (XPROCESS (process
)->decode_coding_system
,
7096 XPROCESS (process
)->encode_coding_system
);
7099 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
7100 Sset_process_filter_multibyte
, 2, 2, 0,
7101 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
7102 If FLAG is non-nil, the filter is given multibyte strings.
7103 If FLAG is nil, the filter is given unibyte strings. In this case,
7104 all character code conversion except for end-of-line conversion is
7107 Lisp_Object process
, flag
;
7109 register struct Lisp_Process
*p
;
7111 CHECK_PROCESS (process
);
7112 p
= XPROCESS (process
);
7114 p
->decode_coding_system
= raw_text_coding_system (p
->decode_coding_system
);
7115 setup_process_coding_systems (process
);
7120 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
7121 Sprocess_filter_multibyte_p
, 1, 1, 0,
7122 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7124 Lisp_Object process
;
7126 register struct Lisp_Process
*p
;
7127 struct coding_system
*coding
;
7129 CHECK_PROCESS (process
);
7130 p
= XPROCESS (process
);
7131 coding
= proc_decode_coding_system
[p
->infd
];
7132 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
7137 /* Add DESC to the set of keyboard input descriptors. */
7140 add_keyboard_wait_descriptor (desc
)
7143 FD_SET (desc
, &input_wait_mask
);
7144 FD_SET (desc
, &non_process_wait_mask
);
7145 if (desc
> max_keyboard_desc
)
7146 max_keyboard_desc
= desc
;
7149 static int add_gpm_wait_descriptor_called_flag
;
7152 add_gpm_wait_descriptor (desc
)
7155 if (! add_gpm_wait_descriptor_called_flag
)
7156 FD_CLR (0, &input_wait_mask
);
7157 add_gpm_wait_descriptor_called_flag
= 1;
7158 FD_SET (desc
, &input_wait_mask
);
7159 FD_SET (desc
, &gpm_wait_mask
);
7160 if (desc
> max_gpm_desc
)
7161 max_gpm_desc
= desc
;
7164 /* From now on, do not expect DESC to give keyboard input. */
7167 delete_keyboard_wait_descriptor (desc
)
7171 int lim
= max_keyboard_desc
;
7173 FD_CLR (desc
, &input_wait_mask
);
7174 FD_CLR (desc
, &non_process_wait_mask
);
7176 if (desc
== max_keyboard_desc
)
7177 for (fd
= 0; fd
< lim
; fd
++)
7178 if (FD_ISSET (fd
, &input_wait_mask
)
7179 && !FD_ISSET (fd
, &non_keyboard_wait_mask
)
7180 && !FD_ISSET (fd
, &gpm_wait_mask
))
7181 max_keyboard_desc
= fd
;
7185 delete_gpm_wait_descriptor (desc
)
7189 int lim
= max_gpm_desc
;
7191 FD_CLR (desc
, &input_wait_mask
);
7192 FD_CLR (desc
, &non_process_wait_mask
);
7194 if (desc
== max_gpm_desc
)
7195 for (fd
= 0; fd
< lim
; fd
++)
7196 if (FD_ISSET (fd
, &input_wait_mask
)
7197 && !FD_ISSET (fd
, &non_keyboard_wait_mask
)
7198 && !FD_ISSET (fd
, &non_process_wait_mask
))
7202 /* Return nonzero if *MASK has a bit set
7203 that corresponds to one of the keyboard input descriptors. */
7206 keyboard_bit_set (mask
)
7211 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
7212 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
7213 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
7224 inhibit_sentinels
= 0;
7228 if (! noninteractive
|| initialized
)
7230 signal (SIGCHLD
, sigchld_handler
);
7233 FD_ZERO (&input_wait_mask
);
7234 FD_ZERO (&non_keyboard_wait_mask
);
7235 FD_ZERO (&non_process_wait_mask
);
7236 max_process_desc
= 0;
7238 #ifdef NON_BLOCKING_CONNECT
7239 FD_ZERO (&connect_wait_mask
);
7240 num_pending_connects
= 0;
7243 #ifdef ADAPTIVE_READ_BUFFERING
7244 process_output_delay_count
= 0;
7245 process_output_skip
= 0;
7248 /* Don't do this, it caused infinite select loops. The display
7249 method should call add_keyboard_wait_descriptor on stdin if it
7252 FD_SET (0, &input_wait_mask
);
7255 Vprocess_alist
= Qnil
;
7257 deleted_pid_list
= Qnil
;
7259 for (i
= 0; i
< MAXDESC
; i
++)
7261 chan_process
[i
] = Qnil
;
7262 proc_buffered_char
[i
] = -1;
7264 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
7265 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
7266 #ifdef DATAGRAM_SOCKETS
7267 bzero (datagram_address
, sizeof datagram_address
);
7272 Lisp_Object subfeatures
= Qnil
;
7273 struct socket_options
*sopt
;
7275 #define ADD_SUBFEATURE(key, val) \
7276 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
7278 #ifdef NON_BLOCKING_CONNECT
7279 ADD_SUBFEATURE (QCnowait
, Qt
);
7281 #ifdef DATAGRAM_SOCKETS
7282 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7284 #ifdef HAVE_LOCAL_SOCKETS
7285 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7287 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7289 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7291 #ifdef HAVE_GETSOCKNAME
7292 ADD_SUBFEATURE (QCservice
, Qt
);
7294 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
7295 ADD_SUBFEATURE (QCserver
, Qt
);
7298 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7299 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
7301 Fprovide (intern ("make-network-process"), subfeatures
);
7303 #endif /* HAVE_SOCKETS */
7305 #if defined (DARWIN) || defined (MAC_OSX)
7306 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7307 processes. As such, we only change the default value. */
7310 char *release
= get_operating_system_release();
7311 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7312 && release
[1] == '.')) {
7313 Vprocess_connection_type
= Qnil
;
7322 Qprocessp
= intern ("processp");
7323 staticpro (&Qprocessp
);
7324 Qrun
= intern ("run");
7326 Qstop
= intern ("stop");
7328 Qsignal
= intern ("signal");
7329 staticpro (&Qsignal
);
7331 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7334 Qexit = intern ("exit");
7335 staticpro (&Qexit); */
7337 Qopen
= intern ("open");
7339 Qclosed
= intern ("closed");
7340 staticpro (&Qclosed
);
7341 Qconnect
= intern ("connect");
7342 staticpro (&Qconnect
);
7343 Qfailed
= intern ("failed");
7344 staticpro (&Qfailed
);
7345 Qlisten
= intern ("listen");
7346 staticpro (&Qlisten
);
7347 Qlocal
= intern ("local");
7348 staticpro (&Qlocal
);
7349 Qipv4
= intern ("ipv4");
7352 Qipv6
= intern ("ipv6");
7355 Qdatagram
= intern ("datagram");
7356 staticpro (&Qdatagram
);
7358 QCport
= intern (":port");
7359 staticpro (&QCport
);
7360 QCspeed
= intern (":speed");
7361 staticpro (&QCspeed
);
7362 QCprocess
= intern (":process");
7363 staticpro (&QCprocess
);
7365 QCbytesize
= intern (":bytesize");
7366 staticpro (&QCbytesize
);
7367 QCstopbits
= intern (":stopbits");
7368 staticpro (&QCstopbits
);
7369 QCparity
= intern (":parity");
7370 staticpro (&QCparity
);
7371 Qodd
= intern ("odd");
7373 Qeven
= intern ("even");
7375 QCflowcontrol
= intern (":flowcontrol");
7376 staticpro (&QCflowcontrol
);
7377 Qhw
= intern ("hw");
7379 Qsw
= intern ("sw");
7381 QCsummary
= intern (":summary");
7382 staticpro (&QCsummary
);
7384 Qreal
= intern ("real");
7386 Qnetwork
= intern ("network");
7387 staticpro (&Qnetwork
);
7388 Qserial
= intern ("serial");
7389 staticpro (&Qserial
);
7391 QCname
= intern (":name");
7392 staticpro (&QCname
);
7393 QCbuffer
= intern (":buffer");
7394 staticpro (&QCbuffer
);
7395 QChost
= intern (":host");
7396 staticpro (&QChost
);
7397 QCservice
= intern (":service");
7398 staticpro (&QCservice
);
7399 QCtype
= intern (":type");
7400 staticpro (&QCtype
);
7401 QClocal
= intern (":local");
7402 staticpro (&QClocal
);
7403 QCremote
= intern (":remote");
7404 staticpro (&QCremote
);
7405 QCcoding
= intern (":coding");
7406 staticpro (&QCcoding
);
7407 QCserver
= intern (":server");
7408 staticpro (&QCserver
);
7409 QCnowait
= intern (":nowait");
7410 staticpro (&QCnowait
);
7411 QCsentinel
= intern (":sentinel");
7412 staticpro (&QCsentinel
);
7413 QClog
= intern (":log");
7415 QCnoquery
= intern (":noquery");
7416 staticpro (&QCnoquery
);
7417 QCstop
= intern (":stop");
7418 staticpro (&QCstop
);
7419 QCoptions
= intern (":options");
7420 staticpro (&QCoptions
);
7421 QCplist
= intern (":plist");
7422 staticpro (&QCplist
);
7424 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
7425 staticpro (&Qlast_nonmenu_event
);
7427 staticpro (&Vprocess_alist
);
7429 staticpro (&deleted_pid_list
);
7432 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7433 doc
: /* *Non-nil means delete processes immediately when they exit.
7434 A value of nil means don't delete them until `list-processes' is run. */);
7436 delete_exited_processes
= 1;
7438 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7439 doc
: /* Control type of device used to communicate with subprocesses.
7440 Values are nil to use a pipe, or t or `pty' to use a pty.
7441 The value has no effect if the system has no ptys or if all ptys are busy:
7442 then a pipe is used in any case.
7443 The value takes effect when `start-process' is called. */);
7444 Vprocess_connection_type
= Qt
;
7446 #ifdef ADAPTIVE_READ_BUFFERING
7447 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7448 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7449 On some systems, when Emacs reads the output from a subprocess, the output data
7450 is read in very small blocks, potentially resulting in very poor performance.
7451 This behavior can be remedied to some extent by setting this variable to a
7452 non-nil value, as it will automatically delay reading from such processes, to
7453 allow them to produce more output before Emacs tries to read it.
7454 If the value is t, the delay is reset after each write to the process; any other
7455 non-nil value means that the delay is not reset on write.
7456 The variable takes effect when `start-process' is called. */);
7457 Vprocess_adaptive_read_buffering
= Qt
;
7460 defsubr (&Sprocessp
);
7461 defsubr (&Sget_process
);
7462 defsubr (&Sget_buffer_process
);
7463 defsubr (&Sdelete_process
);
7464 defsubr (&Sprocess_status
);
7465 defsubr (&Sprocess_exit_status
);
7466 defsubr (&Sprocess_id
);
7467 defsubr (&Sprocess_name
);
7468 defsubr (&Sprocess_tty_name
);
7469 defsubr (&Sprocess_command
);
7470 defsubr (&Sset_process_buffer
);
7471 defsubr (&Sprocess_buffer
);
7472 defsubr (&Sprocess_mark
);
7473 defsubr (&Sset_process_filter
);
7474 defsubr (&Sprocess_filter
);
7475 defsubr (&Sset_process_sentinel
);
7476 defsubr (&Sprocess_sentinel
);
7477 defsubr (&Sset_process_window_size
);
7478 defsubr (&Sset_process_inherit_coding_system_flag
);
7479 defsubr (&Sprocess_inherit_coding_system_flag
);
7480 defsubr (&Sset_process_query_on_exit_flag
);
7481 defsubr (&Sprocess_query_on_exit_flag
);
7482 defsubr (&Sprocess_contact
);
7483 defsubr (&Sprocess_plist
);
7484 defsubr (&Sset_process_plist
);
7485 defsubr (&Slist_processes
);
7486 defsubr (&Sprocess_list
);
7487 defsubr (&Sstart_process
);
7489 defsubr (&Sserial_process_configure
);
7490 defsubr (&Smake_serial_process
);
7491 #endif /* HAVE_SERIAL */
7493 defsubr (&Sset_network_process_option
);
7494 defsubr (&Smake_network_process
);
7495 defsubr (&Sformat_network_address
);
7496 #endif /* HAVE_SOCKETS */
7497 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7499 defsubr (&Snetwork_interface_list
);
7501 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7502 defsubr (&Snetwork_interface_info
);
7504 #endif /* HAVE_SOCKETS ... */
7505 #ifdef DATAGRAM_SOCKETS
7506 defsubr (&Sprocess_datagram_address
);
7507 defsubr (&Sset_process_datagram_address
);
7509 defsubr (&Saccept_process_output
);
7510 defsubr (&Sprocess_send_region
);
7511 defsubr (&Sprocess_send_string
);
7512 defsubr (&Sinterrupt_process
);
7513 defsubr (&Skill_process
);
7514 defsubr (&Squit_process
);
7515 defsubr (&Sstop_process
);
7516 defsubr (&Scontinue_process
);
7517 defsubr (&Sprocess_running_child_p
);
7518 defsubr (&Sprocess_send_eof
);
7519 defsubr (&Ssignal_process
);
7520 defsubr (&Swaiting_for_user_input_p
);
7521 defsubr (&Sprocess_type
);
7522 defsubr (&Sset_process_coding_system
);
7523 defsubr (&Sprocess_coding_system
);
7524 defsubr (&Sset_process_filter_multibyte
);
7525 defsubr (&Sprocess_filter_multibyte_p
);
7529 #else /* not subprocesses */
7531 #include <sys/types.h>
7535 #include "systime.h"
7536 #include "character.h"
7538 #include "termopts.h"
7539 #include "sysselect.h"
7541 extern int frame_garbaged
;
7543 extern EMACS_TIME
timer_check ();
7544 extern int timers_run
;
7548 /* As described above, except assuming that there are no subprocesses:
7550 Wait for timeout to elapse and/or keyboard input to be available.
7553 timeout in seconds, or
7554 zero for no limit, or
7555 -1 means gobble data immediately available but don't wait for any.
7557 read_kbd is a Lisp_Object:
7558 0 to ignore keyboard input, or
7559 1 to return when input is available, or
7560 -1 means caller will actually read the input, so don't throw to
7563 see full version for other parameters. We know that wait_proc will
7564 always be NULL, since `subprocesses' isn't defined.
7566 do_display != 0 means redisplay should be done to show subprocess
7567 output that arrives.
7569 Return true if we received input from any process. */
7572 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7573 wait_for_cell
, wait_proc
, just_wait_proc
)
7574 int time_limit
, microsecs
, read_kbd
, do_display
;
7575 Lisp_Object wait_for_cell
;
7576 struct Lisp_Process
*wait_proc
;
7580 EMACS_TIME end_time
, timeout
;
7581 SELECT_TYPE waitchannels
;
7584 /* What does time_limit really mean? */
7585 if (time_limit
|| microsecs
)
7587 EMACS_GET_TIME (end_time
);
7588 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7589 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7592 /* Turn off periodic alarms (in case they are in use)
7593 and then turn off any other atimers,
7594 because the select emulator uses alarms. */
7596 turn_on_atimers (0);
7600 int timeout_reduced_for_timers
= 0;
7602 /* If calling from keyboard input, do not quit
7603 since we want to return C-g as an input character.
7604 Otherwise, do pending quit if requested. */
7608 /* Exit now if the cell we're waiting for became non-nil. */
7609 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7612 /* Compute time from now till when time limit is up */
7613 /* Exit if already run out */
7614 if (time_limit
== -1)
7616 /* -1 specified for timeout means
7617 gobble output available now
7618 but don't wait at all. */
7620 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7622 else if (time_limit
|| microsecs
)
7624 EMACS_GET_TIME (timeout
);
7625 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7626 if (EMACS_TIME_NEG_P (timeout
))
7631 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7634 /* If our caller will not immediately handle keyboard events,
7635 run timer events directly.
7636 (Callers that will immediately read keyboard events
7637 call timer_delay on their own.) */
7638 if (NILP (wait_for_cell
))
7640 EMACS_TIME timer_delay
;
7644 int old_timers_run
= timers_run
;
7645 timer_delay
= timer_check (1);
7646 if (timers_run
!= old_timers_run
&& do_display
)
7647 /* We must retry, since a timer may have requeued itself
7648 and that could alter the time delay. */
7649 redisplay_preserve_echo_area (14);
7653 while (!detect_input_pending ());
7655 /* If there is unread keyboard input, also return. */
7657 && requeued_events_pending_p ())
7660 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7662 EMACS_TIME difference
;
7663 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7664 if (EMACS_TIME_NEG_P (difference
))
7666 timeout
= timer_delay
;
7667 timeout_reduced_for_timers
= 1;
7672 /* Cause C-g and alarm signals to take immediate action,
7673 and cause input available signals to zero out timeout. */
7675 set_waiting_for_input (&timeout
);
7677 /* Wait till there is something to do. */
7679 if (! read_kbd
&& NILP (wait_for_cell
))
7680 FD_ZERO (&waitchannels
);
7682 FD_SET (0, &waitchannels
);
7684 /* If a frame has been newly mapped and needs updating,
7685 reprocess its display stuff. */
7686 if (frame_garbaged
&& do_display
)
7688 clear_waiting_for_input ();
7689 redisplay_preserve_echo_area (15);
7691 set_waiting_for_input (&timeout
);
7694 if (read_kbd
&& detect_input_pending ())
7697 FD_ZERO (&waitchannels
);
7700 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7705 /* Make C-g and alarm signals set flags again */
7706 clear_waiting_for_input ();
7708 /* If we woke up due to SIGWINCH, actually change size now. */
7709 do_pending_window_change (0);
7711 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7712 /* We waited the full specified time, so return now. */
7717 /* If the system call was interrupted, then go around the
7719 if (xerrno
== EINTR
)
7720 FD_ZERO (&waitchannels
);
7722 error ("select error: %s", emacs_strerror (xerrno
));
7725 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7726 /* System sometimes fails to deliver SIGIO. */
7727 kill (getpid (), SIGIO
);
7730 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7731 kill (getpid (), SIGIO
);
7734 /* Check for keyboard input */
7737 && detect_input_pending_run_timers (do_display
))
7739 swallow_events (do_display
);
7740 if (detect_input_pending_run_timers (do_display
))
7744 /* If there is unread keyboard input, also return. */
7746 && requeued_events_pending_p ())
7749 /* If wait_for_cell. check for keyboard input
7750 but don't run any timers.
7751 ??? (It seems wrong to me to check for keyboard
7752 input at all when wait_for_cell, but the code
7753 has been this way since July 1994.
7754 Try changing this after version 19.31.) */
7755 if (! NILP (wait_for_cell
)
7756 && detect_input_pending ())
7758 swallow_events (do_display
);
7759 if (detect_input_pending ())
7763 /* Exit now if the cell we're waiting for became non-nil. */
7764 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7774 /* Don't confuse make-docfile by having two doc strings for this function.
7775 make-docfile does not pay attention to #if, for good reason! */
7776 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7779 register Lisp_Object name
;
7784 /* Don't confuse make-docfile by having two doc strings for this function.
7785 make-docfile does not pay attention to #if, for good reason! */
7786 DEFUN ("process-inherit-coding-system-flag",
7787 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7791 register Lisp_Object process
;
7793 /* Ignore the argument and return the value of
7794 inherit-process-coding-system. */
7795 return inherit_process_coding_system
? Qt
: Qnil
;
7798 /* Kill all processes associated with `buffer'.
7799 If `buffer' is nil, kill all processes.
7800 Since we have no subprocesses, this does nothing. */
7803 kill_buffer_processes (buffer
)
7816 QCtype
= intern (":type");
7817 staticpro (&QCtype
);
7819 defsubr (&Sget_buffer_process
);
7820 defsubr (&Sprocess_inherit_coding_system_flag
);
7824 #endif /* not subprocesses */
7826 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7827 (do not change this comment) */